urbit/pkg/arvo/lib/pull-hook.hoon
2020-12-01 17:38:51 -08:00

355 lines
8.4 KiB
Plaintext

:: lib/pull-hook: helper for creating a push hook
::
:: lib/pull-hook is a helper for automatically pulling data from a
:: corresponding push-hook to a store.
::
:: ## Interfacing notes:
::
:: The inner door may interact with the library by producing cards.
:: Do not pass any cards on a wire beginning with /helper as these
:: wires are reserved by this library. Any watches/pokes/peeks not
:: listed below will be routed to the inner door.
::
:: ## Subscription paths
::
:: /tracking: The set of resources we are pulling
::
:: ## Pokes
::
:: %pull-hook-action: Add/remove a resource from pulling.
::
/- *pull-hook
/+ default-agent, resource
::
::
|%
+$ card card:agent:gall
::
:: $config: configuration for the pull hook
::
:: .store-name: name of the store to send subscription updates to.
:: .update-mark: mark that updates will be tagged with
:: .push-hook-name: name of the corresponding push-hook
::
+$ config
$: store-name=term
update=mold
update-mark=term
push-hook-name=term
==
::
:: $base-state-0: state for the pull hook
::
:: .tracking: a map of resources we are pulling, and the ships that
:: we are pulling them from.
:: .inner-state: state given to internal door
::
+$ base-state-0
$: tracking=(map resource ship)
inner-state=vase
==
::
+$ state-0 [%0 base-state-0]
::
+$ state-1 [%1 base-state-0]
::
+$ versioned-state
$% state-0
state-1
==
::
++ default
|* [pull-hook=* =config]
|_ =bowl:gall
::
++ on-pull-nack
|= [=resource =tang]
=/ =tank leaf+"subscribe failed from {<dap.bowl>} for {<resource>}"
%- (slog tank tang)
[~ pull-hook]
::
++ on-pull-kick
|= =resource
*(unit path)
--
::
++ pull-hook
|* config
$_ ^|
|_ bowl:gall
:: +on-pull-nack: handle failed pull subscription
::
:: This arm is called when a pull subscription fails. lib/pull-hook
:: will automatically delete the resource from .tracking by the
:: time this arm is called.
::
++ on-pull-nack
|~ [resource tang]
*[(list card) _^|(..on-init)]
:: +on-pull-kick: produce any additional resubscribe path
::
:: If non-null, the produced path is appended to the original
:: subscription path. This should be used to encode extra
:: information onto the path in order to reduce the payload of a
:: kick and resubscribe.
::
:: If null, a resubscribe is not attempted
::
++ on-pull-kick
|~ resource
*(unit path)
::
:: from agent:gall
++ on-init
*[(list card) _^|(..on-init)]
::
++ on-save
*vase
::
++ on-load
|~ vase
*[(list card) _^|(..on-init)]
::
++ on-poke
|~ [mark vase]
*[(list card) _^|(..on-init)]
::
++ on-watch
|~ path
*[(list card) _^|(..on-init)]
::
++ on-leave
|~ path
*[(list card) _^|(..on-init)]
::
++ on-peek
|~ path
*(unit (unit cage))
::
++ on-agent
|~ [wire sign:agent:gall]
*[(list card) _^|(..on-init)]
::
++ on-arvo
|~ [wire sign-arvo]
*[(list card) _^|(..on-init)]
::
++ on-fail
|~ [term tang]
*[(list card) _^|(..on-init)]
--
++ agent
|* =config
|= =(pull-hook config)
=| state-1
=* state -
^- agent:gall
=<
|_ =bowl:gall
+* this .
og ~(. pull-hook bowl)
hc ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
++ on-init
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
on-init:og
[cards this]
++ on-load
|= =old=vase
=/ old
!<(versioned-state old-vase)
=| cards=(list card:agent:gall)
|^
?- -.old
%1
=^ og-cards pull-hook
(on-load:og inner-state.old)
[(weld cards og-cards) this(state old)]
::
%0
%_ $
-.old %1
::
cards
(weld cards (missing-subscriptions tracking.old))
==
==
++ missing-subscriptions
|= tracking=(map resource ship)
^- (list card:agent:gall)
%+ murn
~(tap by tracking)
|= [rid=resource =ship]
^- (unit card:agent:gall)
=/ =path
resource+(en-path:resource rid)
=/ =wire
(make-wire pull+path)
?: (~(has by wex.bowl) [wire ship push-hook-name.config])
~
`[%pass wire %agent [ship push-hook-name.config] %watch path]
--
::
++ on-save
^- vase
=. inner-state
on-save:og
!>(state)
::
++ on-poke
|= [=mark =vase]
^- [(list card:agent:gall) agent:gall]
?> (team:title our.bowl src.bowl)
?. =(mark %pull-hook-action)
=^ cards pull-hook
(on-poke:og mark vase)
[cards this]
=^ cards state
(poke-hook-action:hc !<(action vase))
[cards this]
::
++ on-watch
|= =path
^- [(list card:agent:gall) agent:gall]
?> (team:title our.bowl src.bowl)
?. ?=([%tracking ~] path)
=^ cards pull-hook
(on-watch:og path)
[cards this]
:_ this
~[give-update]
::
++ on-agent
|= [=wire =sign:agent:gall]
^- [(list card:agent:gall) agent:gall]
?. ?=([%helper %pull-hook @ *] wire)
=^ cards pull-hook
(on-agent:og wire sign)
[cards this]
?. ?=([%pull %resource *] t.t.wire)
(on-agent:def wire sign)
=/ rid=resource
(de-path:resource t.t.t.t.wire)
?+ -.sign (on-agent:def wire sign)
%kick
=/ pax=(unit path)
(on-pull-kick:og rid)
?^ pax
:_ this
~[(watch-resource:hc rid u.pax)]
=. tracking
(~(del by tracking) rid)
:_ this
~[give-update]
::
%watch-ack
?~ p.sign
[~ this]
=. tracking
(~(del by tracking) rid)
=^ cards pull-hook
(on-pull-nack:og rid u.p.sign)
:_ this
[give-update cards]
::
%fact
?. =(update-mark.config p.cage.sign)
=^ cards pull-hook
(on-agent:og wire sign)
[cards this]
:_ this
~[(update-store:hc q.cage.sign)]
==
++ on-leave
|= =path
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-leave:og path)
[cards this]
::
++ on-arvo
|= [=wire =sign-arvo]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-arvo:og wire sign-arvo)
[cards this]
++ on-fail
|= [=term =tang]
^- [(list card:agent:gall) agent:gall]
=^ cards pull-hook
(on-fail:og term tang)
[cards this]
++ on-peek
|= =path
^- (unit (unit cage))
(on-peek:og path)
--
|_ =bowl:gall
+* og ~(. pull-hook bowl)
::
++ poke-hook-action
|= =action
^- [(list card:agent:gall) _state]
|^
?- -.action
%add (add +.action)
%remove (remove +.action)
==
++ add
|= [=ship =resource]
~| resource
?< |(=(our.bowl ship) =(our.bowl entity.resource))
?: (~(has by tracking) resource)
[~ state]
=. tracking
(~(put by tracking) resource ship)
:_ state
~[(watch-resource resource /)]
::
++ remove
|= =resource
:- ~[(leave-resource resource)]
state(tracking (~(del by tracking) resource))
--
::
++ leave-resource
|= rid=resource
^- card
=/ =ship
(~(got by tracking) rid)
=/ =wire
(make-wire pull+resource+(en-path:resource rid))
[%pass wire %agent [ship push-hook-name.config] %leave ~]
++ watch-resource
|= [rid=resource pax=path]
^- card
=/ =ship
(~(got by tracking) rid)
=/ =path
(welp resource+(en-path:resource rid) pax)
=/ =wire
(make-wire pull+path)
[%pass wire %agent [ship push-hook-name.config] %watch path]
::
++ make-wire
|= =wire
^+ wire
%+ weld
/helper/pull-hook
wire
::
++ give-update
^- card
[%give %fact ~[/tracking] %pull-hook-update !>(tracking)]
::
++ update-store
|= =vase
^- card
=/ =wire
(make-wire /store)
[%pass wire %agent [our.bowl store-name.config] %poke update-mark.config vase]
--
--