mirror of
https://github.com/urbit/shrub.git
synced 2024-12-01 06:35:32 +03:00
link-hooks: deactivated and deleted state
This commit is contained in:
Logan Allen
parent
a4e21da3f0
commit
291ec5526b
@ -1,644 +1,42 @@
|
||||
:: link-listen-hook: get your friends' bookmarks
|
||||
:: link-listen-hook: no longer in use
|
||||
::
|
||||
:: keeps track of a listening=(set app-path). users can manually add to and
|
||||
:: remove from this set.
|
||||
::
|
||||
:: for all ships in groups associated with those resources, we subscribe to
|
||||
:: their link's local-pages and annotations at the resource path (through
|
||||
:: link-proxy-hook), and forward all entries into our link-store as
|
||||
:: submissions and comments.
|
||||
::
|
||||
:: if a subscription to a target fails, we assume it's because their
|
||||
:: metadata+groups definition hasn't been updated to include us yet.
|
||||
:: we retry with exponential backoff, maxing out at one hour timeouts.
|
||||
:: to expede this process, we prod other potential listeners when we add
|
||||
:: them to our metadata+groups definition.
|
||||
::
|
||||
::
|
||||
/- listen-hook=link-listen-hook, *metadata-store, *group, *link
|
||||
/+ mdl=metadata, default-agent, verb, dbug, group-store, grpl=group, resource, store=link-store
|
||||
/+ default-agent, verb, dbug
|
||||
::
|
||||
~% %link-listen-hook-top ..is ~
|
||||
|%
|
||||
+$ versioned-state
|
||||
$% [%0 state-0]
|
||||
[%1 state-1]
|
||||
[%2 state-2]
|
||||
[%3 state-3]
|
||||
$% [%0 *]
|
||||
[%1 *]
|
||||
[%2 *]
|
||||
[%3 *]
|
||||
[%4 ~]
|
||||
==
|
||||
+$ state-3 state-1
|
||||
+$ state-2 state-1
|
||||
+$ state-1
|
||||
$: listening=(set app-path)
|
||||
state-0
|
||||
==
|
||||
+$ state-0
|
||||
$: retry-timers=(map target @dr)
|
||||
:: reasoning: the resources we're subscribed to,
|
||||
:: and the groups that cause that.
|
||||
::
|
||||
:: we don't strictly need to track this in state, but doing so heavily
|
||||
:: simplifies logic and reduces the amount of big scries we do.
|
||||
:: this also gives us the option to check & restore subscriptions,
|
||||
:: should we ever need that.
|
||||
::
|
||||
reasoning=(jug [ship app-path] group-path)
|
||||
==
|
||||
::
|
||||
+$ what-target ?(%local-pages %annotations)
|
||||
+$ target
|
||||
$: what=what-target
|
||||
who=ship
|
||||
where=path
|
||||
==
|
||||
++ wire-to-target
|
||||
|= =wire
|
||||
^- target
|
||||
?> ?=([what-target @ ^] wire)
|
||||
[i.wire (slav %p i.t.wire) t.t.wire]
|
||||
++ target-to-wire
|
||||
|= target
|
||||
^- wire
|
||||
[what (scot %p who) where]
|
||||
::
|
||||
+$ card card:agent:gall
|
||||
--
|
||||
::
|
||||
=| [%3 state-3]
|
||||
=| [%4 ~]
|
||||
=* state -
|
||||
::
|
||||
%- agent:dbug
|
||||
%+ verb |
|
||||
^- agent:gall
|
||||
=<
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
do ~(. +> bowl)
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
~[watch-metadata:do watch-groups:do]
|
||||
::
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= =vase
|
||||
^- (quip card _this)
|
||||
=/ old=versioned-state
|
||||
!<(versioned-state vase)
|
||||
=| cards=(list card)
|
||||
|-
|
||||
=* upgrade-loop $
|
||||
?- -.old
|
||||
%3 [cards this(state old)]
|
||||
::
|
||||
%2
|
||||
:_ this(state [%3 +.old])
|
||||
%+ welp cards
|
||||
:~ [%pass /groups %agent [our.bowl %group-store] %leave ~]
|
||||
watch-groups:do
|
||||
==
|
||||
::
|
||||
%1
|
||||
:: the upgrade from 0 left out local-only collections.
|
||||
:: here, we pull those back in.
|
||||
::
|
||||
=. listening.old
|
||||
(~(run in ~(key by reasoning.old)) tail)
|
||||
=/ resources=(list [=group-path =app-path])
|
||||
%~ tap in
|
||||
%. %link
|
||||
%~ get ju
|
||||
.^ (jug app-name [group-path app-path])
|
||||
%gy
|
||||
(scot %p our.bowl)
|
||||
%metadata-store
|
||||
(scot %da now.bowl)
|
||||
/app-indices
|
||||
==
|
||||
|-
|
||||
?~ resources
|
||||
upgrade-loop(old [%2 +.old])
|
||||
=, i.resources
|
||||
=/ members=(set ship)
|
||||
(members-from-path:grp:do group-path)
|
||||
:: if we're the only group member, this got incorrectly ignored
|
||||
:: during 0's upgrade logic. watch it now.
|
||||
::
|
||||
?. &(=(1 ~(wyt in members)) (~(has in members) our.bowl))
|
||||
$(resources t.resources)
|
||||
=^ more-cards state
|
||||
(handle-listen-action:do %watch app-path)
|
||||
$(resources t.resources, cards (weld more-cards cards))
|
||||
::
|
||||
%0
|
||||
=/ listening=(set app-path)
|
||||
(~(run in ~(key by reasoning.old)) tail)
|
||||
$(old [%1 listening +.old])
|
||||
==
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
=^ cards state
|
||||
?+ wire ~|([dap.bowl %weird-agent-wire wire] !!)
|
||||
[%metadata ~]
|
||||
(take-metadata-sign:do sign)
|
||||
::
|
||||
[%groups ~]
|
||||
(take-groups-sign:do sign)
|
||||
::
|
||||
[%links ?(%local-pages %annotations) @ ^]
|
||||
(take-link-sign:do (wire-to-target t.wire) sign)
|
||||
::
|
||||
[%forward ^]
|
||||
(take-forward-sign:do t.wire sign)
|
||||
::
|
||||
[%prod *]
|
||||
?> ?=(%poke-ack -.sign)
|
||||
?~ p.sign [~ state]
|
||||
%- (slog leaf+"prod failed" u.p.sign)
|
||||
[~ state]
|
||||
==
|
||||
[cards this]
|
||||
::
|
||||
++ on-poke
|
||||
|= [=mark =vase]
|
||||
?+ mark (on-poke:def mark vase)
|
||||
%link-listen-poke
|
||||
=/ =path !<(path vase)
|
||||
:_ this
|
||||
%+ weld
|
||||
(take-retry:do %local-pages src.bowl path)
|
||||
(take-retry:do %annotations src.bowl path)
|
||||
::
|
||||
%link-listen-action
|
||||
?> (team:title [our src]:bowl)
|
||||
=^ cards state
|
||||
~| p.vase
|
||||
(handle-listen-action:do !<(action:listen-hook vase))
|
||||
[cards this]
|
||||
==
|
||||
::
|
||||
++ on-arvo
|
||||
|= [=wire =sign-arvo]
|
||||
^- (quip card _this)
|
||||
?+ sign-arvo (on-arvo:def wire sign-arvo)
|
||||
[%g %done *]
|
||||
?~ error.sign-arvo [~ this]
|
||||
=/ =tank leaf+"{(trip dap.bowl)}'s message went wrong!"
|
||||
%- (slog tank tang.u.error.sign-arvo)
|
||||
[~ this]
|
||||
::
|
||||
[%b %wake *]
|
||||
?> ?=([%retry @ @ ^] wire)
|
||||
?^ error.sign-arvo
|
||||
=/ =tank leaf+"wake on {(spud wire)} went wrong!"
|
||||
%- (slog tank u.error.sign-arvo)
|
||||
[~ this]
|
||||
:_ this
|
||||
(take-retry:do (wire-to-target t.wire))
|
||||
==
|
||||
::
|
||||
++ on-peek
|
||||
|= =path
|
||||
^- (unit (unit cage))
|
||||
?+ path ~
|
||||
[%x %listening ~] ``noun+!>(listening)
|
||||
[%x %listening ^] ``noun+!>((~(has in listening) t.t.path))
|
||||
==
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
?. ?=([%listening ~] path) (on-watch:def path)
|
||||
?> (team:title [our src]:bowl)
|
||||
:_ this
|
||||
[%give %fact ~ %link-listen-update !>([%listening listening])]~
|
||||
::
|
||||
++ on-leave on-leave:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
::
|
||||
::
|
||||
|_ =bowl:gall
|
||||
+* md ~(. mdl bowl)
|
||||
++ grp ~(. grpl bowl)
|
||||
+* this .
|
||||
def ~(. (default-agent this %|) bowl)
|
||||
::
|
||||
:: user actions & updates
|
||||
++ on-init [~ this]
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= =vase
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
[%pass /groups %agent [our.bowl %group-store] %leave ~]~
|
||||
::
|
||||
++ handle-listen-action
|
||||
|= =action:listen-hook
|
||||
^- (quip card _state)
|
||||
::NOTE no-opping where appropriate happens further down the call stack.
|
||||
:: we *could* no-op here, as %watch when we're already listening should
|
||||
:: result in no-ops all the way down, but walking through everything
|
||||
:: makes this a nice "resurrect if broken unexpectedly" option.
|
||||
::
|
||||
=* app-path path.action
|
||||
=^ cards listening
|
||||
^- (quip card _listening)
|
||||
=/ had=? (~(has in listening) app-path)
|
||||
?- -.action
|
||||
%watch
|
||||
:_ (~(put in listening) app-path)
|
||||
?:(had ~ [(send-update action)]~)
|
||||
::
|
||||
%leave
|
||||
:_ (~(del in listening) app-path)
|
||||
?.(had ~ [(send-update action)]~)
|
||||
==
|
||||
=/ groups=(list group-path)
|
||||
(groups-from-resource:md %link app-path)
|
||||
|-
|
||||
?~ groups [cards state]
|
||||
=^ more-cards state
|
||||
?- -.action
|
||||
%watch (listen-to-group app-path i.groups)
|
||||
%leave (leave-from-group app-path i.groups)
|
||||
==
|
||||
$(cards (weld cards more-cards), groups t.groups)
|
||||
::
|
||||
++ send-update
|
||||
|= =update:listen-hook
|
||||
^- card
|
||||
[%give %fact ~[/listening] %link-listen-update !>(update)]
|
||||
::
|
||||
:: metadata subscription
|
||||
::
|
||||
++ watch-metadata
|
||||
^- card
|
||||
[%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
|
||||
::
|
||||
++ take-metadata-sign
|
||||
|= =sign:agent:gall
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
|
||||
%kick [[watch-metadata]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
"{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
::
|
||||
%fact
|
||||
=* mark p.cage.sign
|
||||
=* vase q.cage.sign
|
||||
?. ?=(%metadata-update mark)
|
||||
~| [dap.bowl %unexpected-mark mark]
|
||||
!!
|
||||
%- handle-metadata-update
|
||||
!<(metadata-update vase)
|
||||
==
|
||||
::
|
||||
++ handle-metadata-update
|
||||
|= upd=metadata-update
|
||||
^- (quip card _state)
|
||||
?+ -.upd [~ state]
|
||||
%add
|
||||
?> =(%link app-name.resource.upd)
|
||||
:: auto-listen to collections in unmanaged groups only
|
||||
::
|
||||
=/ rid=resource
|
||||
(de-path:resource group-path.upd)
|
||||
=/ =group
|
||||
(need (scry-group:grp rid))
|
||||
?. hidden.group
|
||||
[~ state]
|
||||
=, resource.upd
|
||||
=^ update listening
|
||||
^- (quip card _listening)
|
||||
?: (~(has in listening) app-path)
|
||||
[~ listening]
|
||||
:- [(send-update %watch app-path)]~
|
||||
(~(put in listening) app-path)
|
||||
=^ cards state
|
||||
(listen-to-group app-path group-path.upd)
|
||||
[(weld update cards) state]
|
||||
::
|
||||
%remove
|
||||
?> =(%link app-name.resource.upd)
|
||||
=? listening
|
||||
?=(~ (groups-from-resource:md %link app-path.resource.upd))
|
||||
(~(del in listening) app-path.resource.upd)
|
||||
(leave-from-group app-path.resource.upd group-path.upd)
|
||||
==
|
||||
::
|
||||
:: groups subscriptions
|
||||
::
|
||||
++ watch-groups
|
||||
^- card
|
||||
[%pass /groups %agent [our.bowl %group-store] %watch /groups]
|
||||
::
|
||||
++ take-groups-sign
|
||||
|= =sign:agent:gall
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
|
||||
%kick [[watch-groups]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
"{(trip dap.bowl)} failed subscribe to groups. very wrong!"
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
::
|
||||
%fact
|
||||
=* mark p.cage.sign
|
||||
=* vase q.cage.sign
|
||||
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
|
||||
%group-initial [~ state] ::NOTE initial handled using metadata
|
||||
%group-update (handle-group-update !<(update:group-store vase))
|
||||
==
|
||||
==
|
||||
::
|
||||
++ handle-group-update
|
||||
|= upd=update:group-store
|
||||
^- (quip card _state)
|
||||
?. ?=(?(%add-members %initial-group %remove-members) -.upd)
|
||||
[~ state]
|
||||
=/ =path
|
||||
(en-path:resource resource.upd)
|
||||
=/ socs=(list app-path)
|
||||
(app-paths-from-group:md %link path)
|
||||
=/ whos=(list ship)
|
||||
?- -.upd
|
||||
%add-members ~(tap in ships.upd)
|
||||
%remove-members ~(tap in ships.upd)
|
||||
%initial-group ~(tap in members.group.upd)
|
||||
==
|
||||
=| cards=(list card)
|
||||
|-
|
||||
=* loop-socs $
|
||||
?~ socs [cards state]
|
||||
?. (~(has in listening) i.socs)
|
||||
loop-socs(socs t.socs)
|
||||
|-
|
||||
=* loop-whos $
|
||||
?~ whos loop-socs(socs t.socs)
|
||||
=^ caz state
|
||||
?. ?=(%remove-members -.upd)
|
||||
(listen-to-peer i.socs path i.whos)
|
||||
?: =(our.bowl i.whos)
|
||||
(handle-listen-action %leave i.socs)
|
||||
(leave-from-peer i.socs path i.whos)
|
||||
loop-whos(whos t.whos, cards (weld cards caz))
|
||||
::
|
||||
:: link subscriptions
|
||||
::
|
||||
++ listen-to-group
|
||||
|= [=app-path =group-path]
|
||||
^- (quip card _state)
|
||||
=/ peers=(list ship)
|
||||
~| group-path
|
||||
%~ tap in
|
||||
(members-from-path:grp group-path)
|
||||
=| cards=(list card)
|
||||
|-
|
||||
?~ peers [cards state]
|
||||
=^ caz state
|
||||
(listen-to-peer app-path group-path i.peers)
|
||||
$(peers t.peers, cards (weld cards caz))
|
||||
::
|
||||
++ leave-from-group
|
||||
|= [=app-path =group-path]
|
||||
^- (quip card _state)
|
||||
=/ peers=(list ship)
|
||||
%~ tap in
|
||||
(members-from-path:grp group-path)
|
||||
=| cards=(list card)
|
||||
|-
|
||||
?~ peers [cards state]
|
||||
=^ caz state
|
||||
(leave-from-peer app-path group-path i.peers)
|
||||
$(peers t.peers, cards (weld cards caz))
|
||||
::
|
||||
++ listen-to-peer
|
||||
|= [=app-path =group-path who=ship]
|
||||
^- (quip card _state)
|
||||
?: =(our.bowl who)
|
||||
[~ state]
|
||||
:_ =- state(reasoning -)
|
||||
(~(put ju reasoning) [who app-path] group-path)
|
||||
:- (prod-other-listener who app-path)
|
||||
?^ (~(get ju reasoning) [who app-path])
|
||||
~
|
||||
(start-link-subscriptions who app-path)
|
||||
::
|
||||
++ leave-from-peer
|
||||
|= [=app-path =group-path who=ship]
|
||||
^- (quip card _state)
|
||||
?: =(our.bowl who)
|
||||
[~ state]
|
||||
=. reasoning (~(del ju reasoning) [who app-path] group-path)
|
||||
::NOTE leaving is always safe, so we just do it unconditionally
|
||||
(end-link-subscriptions who app-path)
|
||||
::
|
||||
++ start-link-subscriptions
|
||||
|= [=ship =app-path]
|
||||
^- (list card)
|
||||
:~ (start-link-subscription %local-pages ship app-path)
|
||||
(start-link-subscription %annotations ship app-path)
|
||||
==
|
||||
::
|
||||
++ start-link-subscription
|
||||
|= =target
|
||||
^- card
|
||||
:* %pass
|
||||
[%links (target-to-wire target)]
|
||||
%agent
|
||||
[who.target %link-proxy-hook]
|
||||
%watch
|
||||
?- what.target
|
||||
%local-pages [what where]:target
|
||||
%annotations [what %$ where]:target
|
||||
==
|
||||
==
|
||||
::
|
||||
++ end-link-subscriptions
|
||||
|= [who=ship where=path]
|
||||
^- (quip card _state)
|
||||
=. retry-timers (~(del by retry-timers) [%local-pages who where])
|
||||
=. retry-timers (~(del by retry-timers) [%annotations who where])
|
||||
:_ state
|
||||
|^ ~[(end %local-pages) (end %annotations)]
|
||||
::
|
||||
++ end
|
||||
|= what=what-target
|
||||
:* %pass
|
||||
[%links (target-to-wire what who where)]
|
||||
%agent
|
||||
[who %link-proxy-hook]
|
||||
%leave
|
||||
~
|
||||
==
|
||||
--
|
||||
::
|
||||
++ prod-other-listener
|
||||
|= [who=ship where=path]
|
||||
^- card
|
||||
:* %pass
|
||||
[%prod (scot %p who) where]
|
||||
%agent
|
||||
[who %link-listen-hook]
|
||||
%poke
|
||||
%link-listen-poke
|
||||
!>(where)
|
||||
==
|
||||
::
|
||||
++ take-link-sign
|
||||
|= [=target =sign:agent:gall]
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack /links target] !!)
|
||||
%kick [[(start-link-subscription target)]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign
|
||||
=. retry-timers (~(del by retry-timers) target)
|
||||
[~ state]
|
||||
:: our subscription request got rejected,
|
||||
:: most likely because our group definition is out of sync with theirs.
|
||||
:: set timer for retry.
|
||||
::
|
||||
(start-retry target)
|
||||
::
|
||||
%fact
|
||||
=* mark p.cage.sign
|
||||
=* vase q.cage.sign
|
||||
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
|
||||
%link-initial
|
||||
%- handle-link-initial
|
||||
[who.target where.target !<(initial:store vase)]
|
||||
::
|
||||
%link-update
|
||||
%- handle-link-update
|
||||
[who.target where.target !<(update:store vase)]
|
||||
==
|
||||
==
|
||||
::
|
||||
++ start-retry
|
||||
|= =target
|
||||
^- (quip card _state)
|
||||
=/ timer=@dr
|
||||
%+ min ~h1
|
||||
%+ mul 2
|
||||
(~(gut by retry-timers) target ~s15)
|
||||
=. retry-timers
|
||||
(~(put by retry-timers) target timer)
|
||||
:_ state
|
||||
:_ ~
|
||||
:* %pass
|
||||
[%retry (target-to-wire target)]
|
||||
[%arvo %b %wait (add now.bowl timer)]
|
||||
==
|
||||
::
|
||||
++ take-retry
|
||||
|= =target
|
||||
^- (list card)
|
||||
:: relevant: whether :who is still associated with resource :where
|
||||
::
|
||||
=; relevant=?
|
||||
?. relevant ~
|
||||
[(start-link-subscription target)]~
|
||||
?. (~(has in listening) where.target)
|
||||
|
|
||||
?: %- ~(has by wex.bowl)
|
||||
[[%links (target-to-wire target)] who.target %link-proxy-hook]
|
||||
|
|
||||
%+ lien (groups-from-resource:md %link where.target)
|
||||
|= =group-path
|
||||
^- ?
|
||||
%. who.target
|
||||
~(has in (members-from-path:grp group-path))
|
||||
|
||||
::
|
||||
++ do-link-action
|
||||
|= [=wire =action:store]
|
||||
^- card
|
||||
:* %pass
|
||||
wire
|
||||
%agent
|
||||
[our.bowl %link-store]
|
||||
%poke
|
||||
%link-action
|
||||
!>(action)
|
||||
==
|
||||
::
|
||||
++ handle-link-initial
|
||||
|= [who=ship where=path =initial:store]
|
||||
^- (quip card _state)
|
||||
?> =(src.bowl who)
|
||||
?+ -.initial ~|([dap.bowl %unexpected-initial -.initial] !!)
|
||||
%local-pages
|
||||
=/ =pages (~(got by pages.initial) where)
|
||||
(handle-link-update who where [%local-pages where pages])
|
||||
::
|
||||
%annotations
|
||||
=/ urls=(list [=url =notes])
|
||||
~(tap by (~(got by notes.initial) where))
|
||||
=| cards=(list card)
|
||||
|- ^- (quip card _state)
|
||||
?~ urls [cards state]
|
||||
=^ caz state
|
||||
^- (quip card _state)
|
||||
=, i.urls
|
||||
(handle-link-update who where [%annotations where url notes])
|
||||
$(urls t.urls, cards (weld cards caz))
|
||||
==
|
||||
::
|
||||
++ handle-link-update
|
||||
|= [who=ship where=path =update:store]
|
||||
^- (quip card _state)
|
||||
?> =(src.bowl who)
|
||||
:_ state
|
||||
?+ -.update ~|([dap.bowl %unexpected-update -.update] !!)
|
||||
%local-pages
|
||||
%+ turn pages.update
|
||||
|= =page
|
||||
%+ do-link-action
|
||||
[%forward %local-page (scot %p who) where]
|
||||
[%hear where who page]
|
||||
::
|
||||
%annotations
|
||||
%+ turn notes.update
|
||||
|= =note
|
||||
^- card
|
||||
%+ do-link-action
|
||||
`wire`[%forward %annotation (scot %p who) where]
|
||||
`action:store`[%read where url.update `comment`[who note]]
|
||||
==
|
||||
::
|
||||
++ take-forward-sign
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _state)
|
||||
~| [%unexpected-sign on=[%forward wire] -.sign]
|
||||
?> ?=(%poke-ack -.sign)
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
;: weld
|
||||
(trip dap.bowl)
|
||||
" failed to save submission from "
|
||||
(spud wire)
|
||||
==
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
::
|
||||
++ scry-for
|
||||
|* [=mold =app-name =path]
|
||||
.^ mold
|
||||
%gx
|
||||
(scot %p our.bowl)
|
||||
app-name
|
||||
(scot %da now.bowl)
|
||||
(snoc `^path`path %noun)
|
||||
==
|
||||
++ on-agent on-agent:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
|
||||
@ -1,337 +1,41 @@
|
||||
:: link-proxy-hook: make local pages available to foreign ships
|
||||
:: link-proxy-hook: no longer in use
|
||||
::
|
||||
:: this is a "proxy" style hook, relaying foreign subscriptions into local
|
||||
:: stores if permission conditions are met.
|
||||
:: the patterns herein should one day be generalized into a proxy-hook lib.
|
||||
::
|
||||
:: this uses metadata-store to discover resources and their associated
|
||||
:: groups. it sets the permission condition to be that a ship must be in a
|
||||
:: group associated with the resource it's subscribing to.
|
||||
:: we check this on-watch, but also subscribe to metadata & groups so that
|
||||
:: we can kick subscriptions if needed (eg ship removed from group).
|
||||
::
|
||||
:: we deduplicate incoming subscriptions on the same path, ensuring we have
|
||||
:: exactly one local subscription per unique incoming subscription path.
|
||||
:: this comes at the cost of assuming that the store's initial response is
|
||||
:: whatever's returned by the scry at that path, but perhaps that should
|
||||
:: become part of the stores standard anyway.
|
||||
::
|
||||
:: when adding support for new paths, the only things you'll likely want
|
||||
:: to touch are +permitted, +initial-response, & +kick-proxies.
|
||||
::
|
||||
/- *link, *metadata-store, *group
|
||||
/+ metadata, default-agent, verb, dbug, group-store, grpl=group,
|
||||
resource, store=link-store
|
||||
/+ default-agent, verb, dbug
|
||||
~% %link-proxy-hook-top ..is ~
|
||||
|%
|
||||
+$ state-0
|
||||
$: %0
|
||||
::TODO we use this to detect "first sub started" and "last sub left",
|
||||
:: but can't we use [wex sup]:bowl for that?
|
||||
active=(map path (set ship))
|
||||
==
|
||||
+$ state-1
|
||||
$: %1
|
||||
active=(map path (set ship))
|
||||
==
|
||||
::
|
||||
+$ versioned-state
|
||||
$% state-0
|
||||
state-1
|
||||
$% [%0 *]
|
||||
[%1 *]
|
||||
[%2 ~]
|
||||
==
|
||||
::
|
||||
+$ card card:agent:gall
|
||||
--
|
||||
::
|
||||
=| state-1
|
||||
=| [%2 ~]
|
||||
=* state -
|
||||
::
|
||||
%- agent:dbug
|
||||
%+ verb |
|
||||
^- agent:gall
|
||||
=<
|
||||
|_ =bowl:gall
|
||||
+* this .
|
||||
do ~(. +> bowl)
|
||||
def ~(. (default-agent this %&) bowl)
|
||||
::
|
||||
++ on-init
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
~[watch-groups:do watch-metadata:do]
|
||||
::
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
=/ old
|
||||
!<(versioned-state old-vase)
|
||||
?- -.old
|
||||
%1 [~ this(state old)]
|
||||
::
|
||||
%0
|
||||
:_ this(state [%1 +.old])
|
||||
:~ [%pass /groups %agent [our.bowl %group-store] %leave ~]
|
||||
watch-groups:do
|
||||
==
|
||||
==
|
||||
|
||||
::
|
||||
++ on-watch
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
:: the local ship should just use link-store directly
|
||||
::TODO do we want to allow this anyway, to avoid client-side target checks?
|
||||
::
|
||||
?< (team:title [our src]:bowl)
|
||||
?> (permitted:do src.bowl path)
|
||||
=^ cards state
|
||||
(start-proxy:do src.bowl path)
|
||||
[cards this]
|
||||
::
|
||||
++ on-leave
|
||||
|= =path
|
||||
^- (quip card _this)
|
||||
=^ cards state
|
||||
(stop-proxy:do src.bowl path)
|
||||
[cards this]
|
||||
::
|
||||
++ on-agent
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _this)
|
||||
?: ?=([%groups ~] wire)
|
||||
=^ cards state
|
||||
(take-groups-sign:do sign)
|
||||
[cards this]
|
||||
?: ?=([%proxy ^] wire)
|
||||
=^ cards state
|
||||
(handle-proxy-sign t.wire sign)
|
||||
[cards this]
|
||||
~| [dap.bowl %weird-wire wire]
|
||||
!!
|
||||
::
|
||||
++ on-poke on-poke:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
::
|
||||
|_ =bowl:gall
|
||||
+* md ~(. metadata bowl)
|
||||
grp ~(. grpl bowl)
|
||||
+* this .
|
||||
def ~(. (default-agent this %&) bowl)
|
||||
::
|
||||
:: permissions
|
||||
++ on-init on-init:def
|
||||
++ on-save !>(state)
|
||||
++ on-load
|
||||
|= old-vase=vase
|
||||
^- (quip card _this)
|
||||
:_ this
|
||||
[%pass /groups %agent [our.bowl %group-store] %leave ~]~
|
||||
::
|
||||
++ permitted
|
||||
|= [who=ship =path]
|
||||
^- ?
|
||||
:: we only expose /local-pages and /annotations,
|
||||
:: to ships in the groups associated with the resource.
|
||||
:: (no url-specific annotations subscriptions, either.)
|
||||
::
|
||||
=/ target=(unit ^path)
|
||||
?: ?=([%local-pages ^] path)
|
||||
`t.path
|
||||
?: ?=([%annotations ~ ^] path)
|
||||
`t.t.path
|
||||
~
|
||||
?~ target |
|
||||
%+ lien (groups-from-resource:md %link u.target)
|
||||
|= =group-path
|
||||
^- ?
|
||||
(~(has in (members-from-path:grp group-path)) who)
|
||||
::
|
||||
++ kick-revoked-permissions
|
||||
|= [=path who=(list ship)]
|
||||
^- (list card)
|
||||
%+ murn who
|
||||
|= =ship
|
||||
^- (unit card)
|
||||
:: no need to remove to ourselves
|
||||
::
|
||||
?: =(our.bowl ship) ~
|
||||
?: (permitted ship path) ~
|
||||
`(kick-proxies ship path)
|
||||
::
|
||||
:: metadata subscription
|
||||
::
|
||||
++ watch-metadata
|
||||
^- card
|
||||
[%pass /metadata %agent [our.bowl %metadata-store] %watch /app-name/link]
|
||||
::
|
||||
++ take-metadata-sign
|
||||
|= =sign:agent:gall
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack /metadata] !!)
|
||||
%kick [[watch-metadata]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
"{(trip dap.bowl)} failed subscribe to metadata store. very wrong!"
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
::
|
||||
%fact
|
||||
=* mark p.cage.sign
|
||||
=* vase q.cage.sign
|
||||
?. ?=(%metadata-update mark)
|
||||
~| [dap.bowl %unexpected-mark mark]
|
||||
!!
|
||||
%- handle-metadata-update
|
||||
!<(metadata-update vase)
|
||||
==
|
||||
::
|
||||
++ handle-metadata-update
|
||||
|= upd=metadata-update
|
||||
^- (quip card _state)
|
||||
:_ state
|
||||
?. ?=(%remove -.upd) ~
|
||||
?> =(%link app-name.resource.upd)
|
||||
:: if a group is no longer associated with a resource,
|
||||
:: we need to re-check permissions for everyone in that group.
|
||||
::
|
||||
%+ kick-revoked-permissions
|
||||
app-path.resource.upd
|
||||
%~ tap in
|
||||
(members-from-path:grp group-path.upd)
|
||||
::
|
||||
:: groups subscription
|
||||
::TODO largely copied from link-listen-hook. maybe make a store-listener lib?
|
||||
::
|
||||
++ watch-groups
|
||||
^- card
|
||||
[%pass /groups %agent [our.bowl %group-store] %watch /groups]
|
||||
::
|
||||
++ take-groups-sign
|
||||
|= =sign:agent:gall
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack /groups] !!)
|
||||
%kick [[watch-groups]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
"{(trip dap.bowl)} failed subscribe to group store. very wrong!"
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
::
|
||||
%fact
|
||||
=* mark p.cage.sign
|
||||
=* vase q.cage.sign
|
||||
?+ mark ~|([dap.bowl %unexpected-mark mark] !!)
|
||||
%group-initial [~ state]
|
||||
%group-update (handle-group-update !<(update:group-store vase))
|
||||
==
|
||||
==
|
||||
::
|
||||
++ handle-group-update
|
||||
|= upd=update:group-store
|
||||
^- (quip card _state)
|
||||
:_ state
|
||||
?. ?=(%remove-members -.upd) ~
|
||||
:: if someone was removed from a group, find all link resources associated
|
||||
:: with that group, then kick their subscriptions if they're no longer
|
||||
::
|
||||
%- zing
|
||||
%+ turn (app-paths-from-group:md %link (en-path:resource resource.upd))
|
||||
|= =app-path
|
||||
^- (list card)
|
||||
%+ kick-revoked-permissions
|
||||
app-path
|
||||
~(tap in ships.upd)
|
||||
::
|
||||
:: proxy subscriptions
|
||||
::
|
||||
++ kick-proxies
|
||||
|= [who=ship =path]
|
||||
^- card
|
||||
=- [%give %kick - `who]
|
||||
:~ [%local-pages path]
|
||||
[%annotations %$ path]
|
||||
==
|
||||
::
|
||||
++ handle-proxy-sign
|
||||
|= [=wire =sign:agent:gall]
|
||||
^- (quip card _state)
|
||||
?- -.sign
|
||||
%poke-ack ~|([dap.bowl %unexpected-poke-ack wire] !!)
|
||||
%fact [[%give %fact ~[wire] cage.sign]~ state]
|
||||
%kick [[(proxy-pass-link-store wire %watch wire)]~ state]
|
||||
::
|
||||
%watch-ack
|
||||
?~ p.sign [~ state]
|
||||
=/ =tank
|
||||
:- %leaf
|
||||
"{(trip dap.bowl)} failed subscribe to link-store. very wrong!"
|
||||
%- (slog tank u.p.sign)
|
||||
[~ state]
|
||||
==
|
||||
::
|
||||
++ proxy-pass-link-store
|
||||
|= [=path =task:agent:gall]
|
||||
^- card
|
||||
:* %pass
|
||||
[%proxy path]
|
||||
%agent
|
||||
[our.bowl %link-store]
|
||||
task
|
||||
==
|
||||
::
|
||||
++ initial-response
|
||||
|= =path
|
||||
^- card
|
||||
=; =initial:store
|
||||
[%give %fact ~ %link-initial !>(initial)]
|
||||
?+ path !!
|
||||
[%local-pages ^]
|
||||
[%local-pages (scry-for (map ^path pages) %link-store path)]
|
||||
::
|
||||
[%annotations %$ ^]
|
||||
[%annotations (scry-for (per-path-url notes) %link-store path)]
|
||||
==
|
||||
::
|
||||
++ start-proxy
|
||||
|= [who=ship =path]
|
||||
^- (quip card _state)
|
||||
:_ state(active (~(put ju active) path who))
|
||||
:_ ~
|
||||
:: if we already have a local subscription open,
|
||||
::
|
||||
?. =(~ (~(get ju active) path))
|
||||
:: gather the initial response ourselves, and send that.
|
||||
::
|
||||
(initial-response path)
|
||||
:: else, open a local subscription,
|
||||
:: sending outward its initial response when we hear it.
|
||||
::
|
||||
(proxy-pass-link-store path %watch path)
|
||||
::
|
||||
++ stop-proxy
|
||||
|= [who=ship =path]
|
||||
^- (quip card _state)
|
||||
=. active (~(del ju active) path who)
|
||||
:_ state
|
||||
:: if there are still subscriptions remaining, do nothing.
|
||||
::
|
||||
?. =(~ (~(get ju active) path)) ~
|
||||
:: else, close the local subscription.
|
||||
::
|
||||
[(proxy-pass-link-store path %leave ~)]~
|
||||
::
|
||||
:: helpers
|
||||
::
|
||||
++ scry-for
|
||||
|* [=mold =app-name =path]
|
||||
.^ mold
|
||||
%gx
|
||||
(scot %p our.bowl)
|
||||
app-name
|
||||
(scot %da now.bowl)
|
||||
(snoc `^path`path %noun)
|
||||
==
|
||||
++ on-watch on-watch:def
|
||||
++ on-leave on-leave:def
|
||||
++ on-agent on-agent:def
|
||||
++ on-poke on-poke:def
|
||||
++ on-peek on-peek:def
|
||||
++ on-arvo on-arvo:def
|
||||
++ on-fail on-fail:def
|
||||
--
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user