simplify kale/azimuth-tracker subscription semantics

This commit is contained in:
Philip Monk 2019-07-27 21:01:55 -07:00
parent f78d755a0d
commit efd37a1e3c
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
5 changed files with 168 additions and 152 deletions

View File

@ -2,10 +2,6 @@
=, able:kale
=> |%
+$ pending-udiffs (map number:block udiffs:point)
+$ config
$: url=@ta
from-number=number:block
==
+$ app-state
$: %2
url=@ta
@ -17,14 +13,14 @@
+$ peek-data ~
+$ in-poke-data
$: %azimuth-tracker-poke
$% [%init ~]
[%listen whos=(list ship) =source:kale]
[%watch =config]
$% [%listen whos=(list ship) =source:kale]
[%watch url=@ta]
==
==
+$ out-poke-data ~
+$ in-peer-data ~
+$ out-peer-data ~
+$ out-peer-data
[%azimuth-udiff =ship =udiff:point]
++ tapp
%: ^tapp
app-state
@ -260,7 +256,9 @@
?~ udiffs
(pure:m ~)
~& [%sending-event i.udiffs]
;< ~ bind:m (send-effect:stdio %new-event /ne i.udiffs)
=/ =path /(scot %p ship.i.udiffs)
;< ~ bind:m (give-result:stdio / %azimuth-udiff i.udiffs)
;< ~ bind:m (give-result:stdio path %azimuth-udiff i.udiffs)
loop(udiffs t.udiffs)
--
::
@ -268,15 +266,6 @@
::
=> |%
::
:: Subscribe to %sources from kale
::
++ init
|= state=app-state
=/ m (async:stdio ,app-state)
^- form:m
;< ~ bind:m (send-effect:stdio %sources /se ~)
(pure:m state)
::
:: Send %listen to kale
::
++ listen
@ -286,27 +275,13 @@
;< ~ bind:m (send-effect:stdio %listen /lo (silt whos) source)
(pure:m state)
::
:: Take %source from kale
::
++ take-source
|= [state=app-state whos=(set ship) =source:kale]
=/ m (async:stdio ,app-state)
^- form:m
?: ?=(%& -.source)
(pure:m state)
=/ a-purl=purl:eyre node.p.source
=. url.state (crip (en-purl:html a-purl))
=. whos.state whos
(watch state url.state 0) :: launch:contracts:azimuth)
::
:: Start watching a node
::
++ watch
|= [state=app-state =config]
++ start
|= state=app-state
=/ m (async:stdio ,app-state)
^- form:m
=: url.state url.config
number.state from-number.config
=: number.state 0
pending-udiffs.state *pending-udiffs
blocks.state *(list block)
==
@ -425,9 +400,8 @@
^- form:m
~& [%azimuth-tracker our.bowl number.state in-poke-data]
?- +<.in-poke-data
%init (init state)
%listen (listen state +>.in-poke-data)
%watch (watch state +>.in-poke-data)
%watch (pure:m state(url url.in-poke-data))
==
::
++ handle-take
@ -435,9 +409,17 @@
=/ m tapp-async
^- form:m
?+ -.sign ~|([%strange-sign -.sign] !!)
%source (take-source state +.sign)
%wake (get-updates state)
==
::
++ handle-peer ~(handle-peer default-tapp bowl state)
++ handle-peer
|= =path
=/ m tapp-async
^- form:m
=/ who=(unit ship) ?~(path ~ `(slav %p i.path))
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
(start state)
--

View File

@ -301,18 +301,6 @@
=. moz
:_ moz
[hen %pass /merg/home %c %merg %home our %base da+now %init]
=. moz
:_ moz
:* hen
%pass
~
%g
%deal
[our our]
%azimuth-tracker
%poke
[%azimuth-tracker-poke -:!>([%init ~]) [%init ~]]
==
.
::
++ mere :: continue init

View File

@ -1338,13 +1338,11 @@
%merg `%c
%mint `%j
%mont `%c
%new-event `%k
%nuke `%a
%ogre `%c
%perm `%c
%rest `%b
%snap `%j
%sources `%k
%wait `%b
%want `%a
%warp `%c

View File

@ -37,7 +37,7 @@
=> |%
+$ state :: all vane state
$: ver=$0 :: vane version
pki=state-pki ::
pki=state-pki ::
etn=state-eth-node :: eth connection state
sap=state-snapshots :: state snapshots
== ::
@ -82,6 +82,9 @@
$% $: %a :: to %ames
$>(%want task:able:ames) :: send message
== ::
$: %g :: to self
$>(%deal task:able:gall) :: set ethereum source
== ::
$: %k :: to self
$>(%listen task) :: set ethereum source
== ::
@ -89,9 +92,17 @@
$% $>(%init vane-task) :: report install
== == == ::
:: ::
+$ peer-sign [=ship =udiff:point] ::
:: ::
+$ sign :: in result $<-
$~ [%a %woot *ship ~] ::
$% [%a $>(%woot gift:able:ames)] :: message result
$: %g ::
$> $? %onto ::
%unto ::
== ::
gift:able:gall ::
==
== ::
-- ::
:: ::::
@ -172,6 +183,25 @@
++ abet :: resolve
[(flop moz) lex]
:: :: ++sein:of
++ emit
|= =move
+>.$(moz [move moz])
::
++ poke-watch
|= [hen=duct app=term =purl:eyre]
%- emit
:* hen
%pass
/[app]/poke
%g
%deal
[our our]
app
%poke
%azimuth-tracker-poke
!>([%watch (crip (en-purl:html purl))])
==
::
++ sein :: sponsor
|= who=ship
^- ship
@ -219,7 +249,7 @@
=. boq.own.pki bloq.tac
:: save our ethereum gateway (required for galaxies)
::
=. nod.own.pki
=. nod.own.pki
%+ fall node.tac
(need (de-purl:html 'http://eth-mainnet.urbit.org:8545'))
:: save our parent signature (only for moons)
@ -264,14 +294,22 @@
[%diff ship diff]:i.diffs
$(diffs t.diffs)
::
:: start subscriptions
::
=. +>.$ (poke-watch hen %azimuth-tracker nod.own.pki)
=. +>.$
%- curd =< abet
%+ sources:~(feel su hen our pki etn sap)
?: =(%czar (clan:title our))
~
(silt spon.tac ~)
[%| nod.own.pki *@ud *@da]
[%| %azimuth-tracker]
::
=? +>.$ !=(%czar (clan:title our))
%- curd =< abet
%+ sources:~(feel su hen our pki etn sap)
~
[%& spon.tac]
::
=. moz
%+ weld moz
@ -372,7 +410,6 @@
+>.$
%_ +>.$
yen.own.pki (~(del in yen.own.pki) hen)
yen.etn (~(del in yen.etn) hen)
==
::
:: watch public keys
@ -395,13 +432,6 @@
%snap
(restore-snap hen snap.tac kick.tac)
::
:: sources subscription
:: [%sources ~]
::
%sources
~& [%kale-sources]
(curd abet:~(sources ~(feed su hen our pki etn sap) hen))
::
:: XX should be a subscription
:: XX reconcile with .dns.eth
:: request domains
@ -415,14 +445,6 @@
?< =(fak.own.pki ?=(^ tuf.own.pki))
+>.$(moz [[hen %give %turf tuf.own.pki] moz])
::
:: Update from app
:: [%new-event =ship =udiff:point]
::
%new-event
~& [%kale-new-event ship udiff]:tac
%- curd =< abet
(~(new-event su hen our pki etn sap) ship.tac udiff.tac)
::
:: learn of kernel upgrade
:: [%vega ~]
::
@ -492,8 +514,6 @@
++ take
|= [tea=wire hen=duct hin=sign]
^+ +>
?> ?=([@ *] tea)
=* wir t.tea
?- hin
[%a %woot *]
?~ q.hin +>.$
@ -502,6 +522,36 @@
~_ q.u.u.q.hin
::TODO fail:et
+>.$
::
[%g %onto *]
~& [%kale-onto tea hin]
+>.$
::
[%g %unto *]
?- +>-.hin
$quit ~|([%kale-unexpected-quit tea hin] !!)
$http-response ~|([%kale-unexpected-http-response tea hin] !!)
$coup
?~ p.p.+>.hin
+>.$
%- (slog leaf+"kale-bad-coup" u.p.p.+>.hin)
+>.$
::
$reap
?~ p.p.+>.hin
+>.$
%- (slog u.p.p.+>.hin)
~|([%kale-unexpected-reap tea hin] +>.$)
::
$diff
?> ?=([@ *] tea)
=* app i.tea
=/ =peer-sign ;;(peer-sign q.q.p.p.+>.hin)
%. [hen tea app]
=< pump
%- curd =< abet
(~(new-event su hen our pki etn sap) peer-sign)
==
==
:: :: ++curd:of
++ curd :: relative moves
@ -512,6 +562,10 @@
==
+>(pki pki, etn etn, sap sap, moz (weld (flop moz) ^moz))
:: :: ++wind:of
++ pump
|= [hen=duct =wire app=term]
(emit [hen %pass wire %g %deal [our our] app %pump ~])
::
++ wind :: rewind to snap
|= [hen=duct block=@ud]
^+ +>
@ -575,6 +629,30 @@
?~ noy this-su
$(noy t.noy, moz [[i.noy cad] moz])
::
++ emit-peer
|= [app=term =path]
%- emit
:* hen
%pass
[app path]
%g
%deal
[our our]
app
%peer
path
==
::
++ peer
|= [app=term whos=(set ship)]
?: =(~ whos)
(emit-peer app /)
=/ whol=(list ship) ~(tap in whos)
|- ^+ this-su
?~ whol this-su
=. this-su (emit-peer app /(scot %p i.whol))
$(whol t.whol)
::
++ public-keys-give
|= [yen=(set duct) =public-keys-result]
=+ yez=~(tap in yen)
@ -673,20 +751,6 @@
yen.own (~(put in yen.own) hen)
==
::
++ sources
%_ ..feed
yen.etn (~(put in yen.etn) hen)
moz
%- welp :_ moz
~& [%kale-sources-feed etn=etn]
%+ turn
^- (list (pair source-id (set ship)))
:- [default-source.etn ~]
~(tap by ship-sources-reverse.etn)
|= [=source-id whos=(set ship)]
[hen %give %source whos (~(got by sources.etn) source-id)]
==
:: :: ++fake:feed:su
++ fake :: fake subs and state
?> fak.own.pki
|%
@ -736,12 +800,8 @@
=/ =point (fall maybe-point *point)
=. point
?- -.a-diff
%spon
point(sponsor to.a-diff)
::
%rift
point(rift to.a-diff)
::
%spon point(sponsor to.a-diff)
%rift point(rift to.a-diff)
%keys
%_ point
life life.to.a-diff
@ -774,8 +834,6 @@
=/ send-message
|= =message
[hen %pass /public-keys %a %want p.source /k/public-keys message]
=. ..feel
(emit (send-message %nuke whos))
(emit (send-message %public-keys whos))
=^ =source-id this-su (get-source-id source)
=. ..feed
@ -791,7 +849,7 @@
%- ~(gas ju ship-sources-reverse.etn)
(turn whol |=(=ship [source-id ship]))
..feed
(exec yen.etn [%give %source whos source])
(peer p.source whos)
--
:: :: ++meet:su
++ meet :: seen after breach

View File

@ -2285,7 +2285,50 @@
++ able ^?
=, pki
|%
+$ public-keys-result
$% [%full points=(map ship point)]
[%diff who=ship =diff:point]
==
:: ::
++ gift :: out result <-$
$% [%init p=ship] :: report install unix
[%mass p=mass] :: memory usage report
[%mack p=(unit tang)] :: message n/ack
[%turf turf=(list turf)] :: domains
[%private-keys =life vein=(map life ring)] :: private keys
[%public-keys =public-keys-result] :: ethereum changes
== ::
:: +seed: private boot parameters
::
+$ seed [who=ship lyf=life key=ring sig=(unit oath:pki)]
::
+= task :: in request ->$
$~ [%vega ~] ::
$% $: %dawn :: boot from keys
=seed:able:kale :: identity params
spon=ship :: sponsor
czar=(map ship [=life =pass]) :: galaxy table
turf=(list turf) :: domains
bloq=@ud :: block number
node=(unit purl:eyre) :: gateway url
snap=(unit snapshot) :: head start
== ::
[%fake =ship] :: fake boot
[%listen whos=(set ship) =source] :: set ethereum source
::TODO %next for generating/putting new private key
[%nuke whos=(set ship)] :: cancel tracker from
[%private-keys ~] :: sub to privates
[%public-keys ships=(set ship)] :: sub to publics
[%meet =ship =life =pass] :: met after breach
[%snap snap=snapshot kick=?] :: load snapshot
[%turf ~] :: view domains
$>(%vega vane-task) :: report upgrade
$>(%wegh vane-task) :: memory usage request
$>(%west vane-task) :: remote request
[%wind p=@ud] :: rewind before block
== ::
:: %kale has two general kinds of task: changes
::
:: and change subscriptions.
::
:: change tasks are designed to match high-level
@ -2421,71 +2464,18 @@
a-point(sponsor to.diff)
==
--
::
+$ public-keys-result
$% [%full points=(map ship point)]
[%diff who=ship =diff:point]
==
:: ::
++ gift :: out result <-$
$% [%init p=ship] :: report install unix
[%mass p=mass] :: memory usage report
[%mack p=(unit tang)] :: message n/ack
[%source whos=(set ship) src=source] ::
[%turf turf=(list turf)] :: domains
[%private-keys =life vein=(map life ring)] :: private keys
[%public-keys =public-keys-result] :: ethereum changes
== ::
:: +seed: private boot parameters
::
+$ seed [who=ship lyf=life key=ring sig=(unit oath:pki)]
::
+= task :: in request ->$
$~ [%vega ~] ::
$% $: %dawn :: boot from keys
=seed:able:kale :: identity params
spon=ship :: sponsor
czar=(map ship [=life =pass]) :: galaxy table
turf=(list turf) :: domains
bloq=@ud :: block number
node=(unit purl:eyre) :: gateway url
snap=(unit snapshot) :: head start
== ::
[%fake =ship] :: fake boot
[%listen whos=(set ship) =source] :: set ethereum source
::TODO %next for generating/putting new private key
[%nuke whos=(set ship)] :: cancel tracker from
[%private-keys ~] :: sub to privates
[%public-keys ships=(set ship)] :: sub to publics
[%sources ~]
[%meet =ship =life =pass] :: met after breach
[%snap snap=snapshot kick=?] :: load snapshot
[%turf ~] :: view domains
[%new-event =ship =udiff:point] :: update from app
$>(%vega vane-task) :: report upgrade
$>(%wegh vane-task) :: memory usage request
$>(%west vane-task) :: remote request
[%wind p=@ud] :: rewind before block
== ::
-- ::
:: ::
:::: ::
:: ::
+$ node-src :: ethereum node comms
$: node=purl:eyre :: node url
filter-id=@ud :: current filter
poll-timer=@da :: next filter poll
== ::
::
+$ source (each ship node-src)
+$ source (each ship term)
+$ source-id @udsourceid
+$ snapshot ~
::
:: +state-eth-node: state of a connection to an ethereum node
::
+$ state-eth-node :: node config + meta
$: yen=(set duct)
top-source-id=source-id
$: top-source-id=source-id
sources=(map source-id source)
sources-reverse=(map source source-id)
default-source=source-id