shrub/pkg/landscape/app/notify.hoon
2021-09-06 13:31:11 +10:00

430 lines
11 KiB
Plaintext

::
/- *notify, resource, hark-store, post
/+ default-agent, verb, dbug, group, agentio, graphlib=graph
::
|%
+$ card card:agent:gall
::
+$ provider-state (map term provider-entry)
+$ provider-entry
$: notify-endpoint=@t
binding-endpoint=@t
auth-token=@t
clients=(map ship binding=(unit @t))
=whitelist
==
::
+$ client-state
$: providers=(jug @p term)
==
::
+$ base-state-0
$: =provider-state
=client-state
==
::
+$ state-0
[%0 base-state-0]
::
+$ state-1
[%1 base-state-0]
::
+$ versioned-state
$% state-0
state-1
==
::
--
::
=| state-1
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
::
=<
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
do ~(. +> bowl)
io ~(. agentio bowl)
pass pass:io
::
++ on-init
:_ this
[(~(watch-our pass:io /hark) %hark-store /notes)]~
::
++ on-save !>(state)
++ on-load
|= =old=vase
^- (quip card _this)
=/ old !<(versioned-state old-vase)
=| cards=(list card)
|-
?- -.old
%1 [(flop cards) this]
::
%0
%_ $
::
cards
%+ welp cards
:~ (~(leave-our pass:io /hark) %hark-store)
(~(watch-our pass:io /hark) %hark-store /notes)
==
==
==
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
=^ cards state
?+ mark (on-poke:def mark vase)
%notify-provider-action (handle-provider-action !<(provider-action vase))
%notify-client-action (handle-client-action !<(client-action vase))
==
[cards this]
::
++ handle-provider-action
|= act=provider-action
^- (quip card _state)
?- -.act
%add
?> (team:title our.bowl src.bowl)
=/ new-entry=provider-entry
:* notify.act
binding.act
auth-token.act
~
whitelist.act
==
[~ state(provider-state (~(put by provider-state) service.act new-entry))]
::
%remove
?> (team:title our.bowl src.bowl)
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
:_ state(provider-state (~(del by provider-state) service.act))
%+ turn ~(tap by clients.u.entry)
|= [who=@p *]
^- card
(leave-path:pass [who %notify] /notify/(scot %p who)/[service.act])
::
%client-join
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
?. (is-whitelisted:do src.bowl u.entry)
~|("permission denied" !!)
=. clients.u.entry (~(put by clients.u.entry) src.bowl ~)
:_ state(provider-state (~(put by provider-state) service.act u.entry))
:~ %: register-binding:do
service.act
u.entry
binding-endpoint.u.entry
src.bowl
address.act
==
%+ watch:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
==
::
%client-leave
=/ entry=(unit provider-entry) (~(get by provider-state) service.act)
?~ entry
~|("no such service: {<service.act>}" !!)
?. (is-client:do src.bowl u.entry)
~|("permission denied" !!)
=/ client-info=(unit @t) (~(got by clients.u.entry) src.bowl)
=. clients.u.entry (~(del by clients.u.entry) src.bowl)
:_ state(provider-state (~(put by provider-state) service.act u.entry))
?~ client-info
:_ ~
%+ leave-path:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
:~ %: remove-binding:do
service.act
u.entry
src.bowl
binding-endpoint.u.entry
u.client-info
==
%+ leave-path:pass
[src.bowl %notify]
/notify/(scot %p src.bowl)/[service.act]
==
==
::
++ handle-client-action
|= act=client-action
^- (quip card _state)
?> (team:title our.bowl src.bowl)
?- -.act
%connect-provider
=. providers.client-state
(~(put ju providers.client-state) who.act service.act)
=/ pact=provider-action [%client-join service.act address.act]
:_ state
[(poke:pass [who.act %notify] %notify-provider-action !>(pact))]~
::
%remove-provider
=. providers.client-state
(~(del ju providers.client-state) who.act service.act)
=/ pact=provider-action [%client-leave service.act]
:_ state
[(poke:pass [who.act %notify] %notify-provider-action !>(pact))]~
==
--
::
++ on-watch
|= =path
^- (quip card _this)
?+ path (on-watch:def path)
[%notify @ @ ~]
=* service i.t.t.path
?. (~(has ju providers.client-state) src.bowl service)
~|("permission denied" !!)
`this
==
::
++ on-leave
|= =path
^- (quip card _this)
`this
::
++ on-peek on-peek:def
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?+ wire (on-agent:def wire sign)
::
:: subscription from client to their own hark-store
::
[%hark ~]
?+ -.sign (on-agent:def wire sign)
%fact
:_ this
?. ?=(%hark-update p.cage.sign)
~
=+ !<(hark-update=update:hark-store q.cage.sign)
?~ not=(filter-notifications:do hark-update) ~
:: only send the last one, since hark accumulates notifcations
=/ =update [%notification u.not]
=/ card=(unit card) ~ ::(fact-all:io %notify-update !>(update))
(drop card)
::
%kick
:_ this
[%pass /hark %agent [our.bowl %hark-store] %watch /updates]~
==
::
:: subscription from provider to client
::
[%agentio-watch %notify @ @ ~]
=/ who (slav %p i.t.t.wire)
=* service i.t.t.t.wire
?+ -.sign (on-agent:def wire sign)
%fact
?> ?=(%notify-update p.cage.sign)
=+ !<(=update q.cage.sign)
:_ this
?- -.update
%notification
=/ entry=(unit provider-entry) (~(get by provider-state) service)
?~ entry
~
[(send-notification:do u.entry who notification.update)]~
==
::
%kick
:_ this
[(watch:pass [who %notify] /notify/(scot %p who)/[service])]~
::
%watch-ack
?~ p.sign
`this
((slog u.p.sign) `this)
==
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ wire (on-arvo:def wire sign-arvo)
[%register-binding @ @ @ ~]
=/ who=@p (slav %p i.t.wire)
=* service i.t.t.wire
::
?> ?=(%iris -.sign-arvo)
?> ?=(%http-response +<.sign-arvo)
?> ?=(%finished -.client-response.sign-arvo)
?> ?=(^ full-file.client-response.sign-arvo)
=/ =mime-data:iris u.full-file.client-response.sign-arvo
?> =('application/json' type.mime-data)
=/ jon=json
(fall (rush (@t q.data.mime-data) apex:de-json:html) *json)
=/ [sid=@t message=@t]
%. jon
%- ot:dejs:format
:~ sid+so:dejs:format
message+so:dejs:format
==
::
=/ entry=(unit provider-entry) (~(get by provider-state) service)
:- ~
?~ entry
this
=. clients.u.entry (~(put by clients.u.entry) who `sid)
this(provider-state (~(put by provider-state) service u.entry))
::
[%remove-binding *]
`this
::
[%send-notification *]
`this
==
::
++ on-fail on-fail:def
--
|_ bowl=bowl:gall
+* gra ~(. graphlib bowl)
::
++ filter-notifications
|= =update:hark-store
^- (unit notification)
?. ?=(%add-note -.update) ~
=* place place.bin.update
?. ?=(%landscape desk.place) ~
?. ?=([%graph *] path.place) ~
=/ link=path link.body.update
?. ?=([@ @ @ *] link) ~
?~ ship=(slaw %p i.t.link) ~
=* name i.t.t.link
=/ =resource:resource [u.ship name]
=/ =index:graph-store
(turn t.t.t.link (curr rash dim:ag))
`[resource index]
::
++ group-is-hidden
|= =resource:resource
^- (unit ?)
=/ grp=(unit group:group) (~(scry-group group bowl) resource)
?~ grp ~
`hidden.u.grp
::
++ is-whitelisted
|= [who=@p entry=provider-entry]
^- ?
|^
?| public.whitelist.entry
=(our.bowl who)
is-kid
(~(has in users.whitelist.entry) who)
in-group
==
::
++ is-kid
?& kids.whitelist.entry
=(our.bowl (sein:title our.bowl now.bowl who))
==
::
++ in-group
=/ gs ~(tap in groups.whitelist.entry)
|-
?~ gs %.n
?: (~(is-member group bowl) who i.gs)
%.y
$(gs t.gs)
--
::
++ is-client
|= [who=@p entry=provider-entry]
^- ?
(~(has by clients.entry) who)
::
++ post-form
|= [=wire url=@t auth=@t params=(list [@t @t])]
^- card
=/ data
%+ roll
%+ sort params
|= [[p=@t @t] [q=@t @t]]
(aor p q)
|= [[p=@t q=@t] out=_url]
(rap 3 out p q ~)
=/ hmac-sig (hmac-sha1t:hmac:crypto auth data)
=/ b64-sig (en:base64:mimes:html (met 3 hmac-sig) (swp 3 hmac-sig))
=/ headers
:~ ['X-Twilio-Signature' b64-sig]
['Content-Type' 'application/x-www-form-urlencoded']
==
=/ form-data (build-form-data params)
=/ =request:http
[%'POST' url headers `[(met 3 form-data) form-data]]
[%pass wire %arvo %i %request request *outbound-config:iris]
::
++ build-form-data
|= data=(list [@t @t])
^- @t
%+ roll data
|= [[p=@t q=@t] out=@t]
?: =(out '')
(rap 3 p '=' q ~)
(rap 3 out '&' p '=' q ~)
::
++ send-notification
|= [entry=provider-entry who=@p =notification]
^- card
=/ params=(list [@t @t])
:~ identity+(rsh [3 1] (scot %p who))
ship+(rsh [3 1] (scot %p entity.resource.notification))
graph+name.resource.notification
:- %node
%+ roll index.notification
|= [in=@ out=@t]
(rap 3 out '/' (scot %ud in) ~)
==
%: post-form
/send-notification/(scot %uv (sham eny.bowl))
notify-endpoint.entry
auth-token.entry
params
==
::
++ register-binding
|= [service=term entry=provider-entry url=@t who=@p address=@t]
^- card
=/ params=(list [@t @t])
:~ identity+(rsh [3 1] (scot %p who))
bindingtype+'apn'
address+address
action+'add'
==
%: post-form
/register-binding/(scot %p who)/[service]/(scot %uv (sham eny.bowl))
binding-endpoint.entry
auth-token.entry
params
==
::
++ remove-binding
|= [service=term entry=provider-entry who=@p url=@t sid=@t]
^- card
=/ params=(list [@t @t])
:~ sid+sid
action+'remove'
==
%: post-form
/remove-binding/(scot %p who)/[service]/(scot %uv (sham eny.bowl))
binding-endpoint.entry
auth-token.entry
params
==
--