shrub/pkg/arvo/app/dns-collector.hoon
Fang ae8a57ca25
gall: (list path) in %fact and %kick
Instead of providing a (unit path), allows for (list path), which better
supports the "update to path and subpath cases".

For example, if /things wants updates about everything, and
/things/specific wants updates about the specific thing, they'll both
need to receive a %fact when the specific thing changes.
Previously, these would have been two separate moves. Now, gall handles
the multi-targeting for you.
2019-12-23 13:37:32 +01:00

155 lines
3.8 KiB
Plaintext

/- dns
/+ default-agent, verb
::
:: app types and boilerplate
::
=> |%
+$ card card:agent:gall
+$ app-state
$: %0
requested=(map ship address:dns)
completed=(map ship binding:dns)
==
+$ peek-data
$% [%requested (list (pair ship address:dns))]
[%completed (list (pair ship binding:dns))]
==
+$ in-poke-data
$% [%dns-address =address:dns]
[%dns-complete =ship =binding:dns]
[%noun noun=*]
==
+$ out-peer-data
$% [%dns-binding =binding:dns]
[%dns-request =request:dns]
==
--
|%
++ give-result
|= [=the=path =cage]
^- card
[%give %fact ~[the-path] cage]
--
::
^- agent:gall
=| state=app-state
%+ verb |
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
`this(state !<(app-state old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?+ mark (on-poke:def mark vase)
%noun (handle-noun !<(noun vase))
%dns-address (handle-dns-address !<(address:dns vase))
%dns-complete (handle-dns-complete !<([ship binding:dns] vase))
==
::
++ handle-noun
|= noun=*
^- (quip card _this)
?: ?=(%debug noun)
~& bowl=bowl
~& state=state
`this
::
~& %poke-unknown
`this
::
++ handle-dns-address
|= adr=address:dns
^- (quip card _this)
=* who src.bowl
=/ rac (clan:title who)
?. ?=(?(%king %duke) rac)
~| [%dns-collector-bind-invalid who] !!
?: (reserved:eyre if.adr)
~| [%dns-collector-reserved-address who if.adr] !!
::
=/ req=(unit address:dns) (~(get by requested.state) who)
=/ dun=(unit binding:dns) (~(get by completed.state) who)
?: &(?=(^ dun) =(adr address.u.dun))
=. requested.state (~(del by requested.state) who)
:_ this :_ ~
(give-result /(scot %p who) %dns-binding !>(u.dun))
::
?: &(?=(^ req) =(adr u.req))
`this
:: XX check address?
=/ =request:dns [who adr]
=. requested.state (~(put by requested.state) request)
:_ this :_ ~
(give-result /requests %dns-request !>(request))
::
++ handle-dns-complete
|= [who=ship =binding:dns]
^- (quip card _this)
:: XX or confirm valid binding?
::
?. (team:title [our src]:bowl)
~| %complete-yoself !!
=* adr address.binding
=* tuf turf.binding
=/ req=(unit address:dns) (~(get by requested.state) who)
:: ignore established bindings that don't match requested
::
?: ?| ?=(~ req)
!=(adr u.req)
==
~& %unknown-complete
`this
=: requested.state (~(del by requested.state) who)
completed.state (~(put by completed.state) who [adr tuf])
==
:_ this :_ ~
(give-result /(scot %p who) %dns-binding !>([adr tuf]))
--
::
++ on-watch
|= =path
^- (quip card _this)
?: ?=([%sole *] path)
!!
?. ?=([@ ~] path)
~| %invalid-path !!
?: ?=(%requests i.path)
=/ requests ~(tap by requested.state)
|- ^- (quip card _this)
=* loop $
?~ requests
`this
=/ card (give-result path %dns-request !>(i.requests))
=^ cards this loop(requests t.requests)
[[card cards] this]
::
=/ who=(unit @p) (slaw %p i.path)
?~ who
~| %invalid-path !!
?~ dun=(~(get by completed.state) u.who)
`this
:_ this :_ ~
(give-result path %dns-binding !>(u.dun))
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
?+ path [~ ~]
[%x %requested ~] [~ ~ %requested !>(~(tap by requested.state))]
[%x %completed ~] [~ ~ %completed !>(~(tap by completed.state))]
==
::
++ on-agent on-agent:def
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--