larva passes tests

This commit is contained in:
Ted Blackman 2019-06-28 14:26:40 -07:00
parent 3ce90b1f3d
commit 9488984195
2 changed files with 125 additions and 68 deletions

View File

@ -579,7 +579,12 @@
:: $move: output effect; either request or response
::
+$ move [=duct card=(wind note gift)]
:: $queued-event: event to be handled after initial boot completes
::
+$ queued-event
$% [%call =duct type=* wrapped-task=(hobo task)]
[%take =wire =duct type=* =sign]
==
:: $task: job for ames
::
:: %born: process restart notification
@ -688,25 +693,18 @@
:: keys.
::
+$ note
$% $: %a
$% [%memo sponsor=ship message=_[/a/ping ~]]
== ==
$: %b
$~ [%b %wait *@da]
$% $: %b
$% [%wait date=@da]
[%rest date=@da]
== ==
$: %c
$% [%memo =ship =message]
== ==
$: %g
$% [%memo =ship =message]
== ==
$: %j
$% [%memo =ship =message]
::
[%private-keys ~]
$% [%private-keys ~]
[%public-keys =ship]
[%turf ~]
== ==
$: @tas
$% [%memo =ship =message]
== == ==
:: $sign: response from other vane
::
@ -722,27 +720,18 @@
:: triggers the next heartbeat message to be sent.
::
+$ sign
$% $: %a
$% [%done error=(unit error)]
== ==
$: %b
$~ [%b %wake ~]
$% $: %b
$% [%wake error=(unit tang)]
== ==
$: %c
$% [%done error=(unit error)]
[%memo =message]
== ==
$: %g
$% [%done error=(unit error)]
[%memo =message]
== ==
$: %j
$% [%done error=(unit error)]
[%memo =message]
::
[%private-keys =life =private-key]
$% [%private-keys =life =private-key]
[%public-keys =vent-result]
[%turf turfs=(list turf)]
== ==
$: @tas
$% [%done error=(unit error)]
[%memo =message]
== == ==
:: $message-pump-task: job for |message-pump
::
@ -816,8 +805,79 @@
--
:: external vane interface
::
=<
|= pit=vase
:: larval ames, before %born sets .unix-duct; wraps adult ames core
::
=< =* adult-gate .
=| queued-events=(qeu queued-event)
::
|= [our=ship eny=@ now=@da scry-gate=sley]
=* larval-gate .
=* adult-core (adult-gate +<)
|%
:: +call: handle request $task
::
++ call
|= [=duct type=* wrapped-task=(hobo task)]
:: %born: set .unix-duct and start draining .queued-events
::
?: ?=(%born -.wrapped-task)
:: process %born using wrapped adult ames
::
=^ moves adult-gate (call:adult-core duct type wrapped-task)
:: if no events were queued up, metamorphose
::
?~ queued-events
[moves adult-gate]
:: kick off a timer to process the first of .queued-events
::
=. moves :_(moves [duct %pass /larva %b %wait now])
[moves larval-gate]
:: any other event: enqueue it until we have a .unix-duct
::
=. queued-events (~(put to queued-events) %call duct type wrapped-task)
[~ larval-gate]
:: +take: handle response $sign
::
++ take
|= [=wire =duct type=* =sign]
:: enqueue event if not a larval drainage timer
::
?. =(/larva wire)
=. queued-events (~(put to queued-events) %take wire duct type sign)
[~ larval-gate]
:: larval event drainage timer; pop and process a queued event
::
?> ?=(%wake -.sign)
=^ first-event queued-events ~(get to queued-events)
=^ moves adult-gate
?- -.first-event
%call (call:adult-core +.first-event)
%take (take:adult-core +.first-event)
==
:: .queued-events has been cleared; metamorphose
::
?~ queued-events
[moves adult-gate]
:: set timer to drain next event
::
=. moves :_(moves [duct %pass /larva %b %wait now])
[moves larval-gate]
:: lifecycle arms; mostly pass-throughs to the contained adult ames
::
++ scry scry:adult-core
++ stay [queued-events stay:adult-core]
++ load
|= old=_[queued-events stay:adult-core]
^+ larval-gate
::
=. queued-events -.old
=. adult-gate (load:adult-core +.old)
larval-gate
--
:: adult ames, after metamorphosis from larva
::
=<
=| =ames-state
|= [our=ship eny=@ now=@da scry-gate=sley]
=* ames-gate .
@ -860,16 +920,10 @@
=^ moves ames-state
=< abet
?- sign
[@ %done *] (on-take-done:event-core wire error.sign)
[@ %memo *] (on-take-memo:event-core wire message.sign)
::
[%b %wake *] (on-take-wake:event-core wire error.sign)
::
[%a %done *] (on-take-done:event-core wire error.sign)
[%c %done *] (on-take-done:event-core wire error.sign)
[%g %done *] (on-take-done:event-core wire error.sign)
[%j %done *] (on-take-done:event-core wire error.sign)
::
[%c %memo *] (on-take-memo:event-core wire message.sign)
[%g %memo *] (on-take-memo:event-core wire message.sign)
[%j %memo *] (on-take-memo:event-core wire message.sign)
::
[%j %private-keys *] (on-priv:event-core [life private-key]:sign)
[%j %public-keys *] (on-publ:event-core wire vent-result.sign)
@ -936,13 +990,8 @@
++ on-hear
|= [=lane =blob]
^+ event-core
:: register this duct as our new .unix-duct
::
=. unix-duct.ames-state duct
::
=/ =packet (decode-packet blob)
::
(on-hear-packet lane packet)
(on-hear-packet lane (decode-packet blob))
:: +on-hear-packet: handle mildly processed packet receipt
::
++ on-hear-packet
@ -1355,7 +1404,7 @@
:: +on-born: handle unix process restart
:: +on-vega: handle kernel reload
::
++ on-born event-core
++ on-born event-core(unix-duct.ames-state duct)
++ on-vega event-core
:: +enqueue-alien-todo: helper to enqueue a pending request
::

View File

@ -24,8 +24,8 @@
=/ bob-pub pub:ex:crypto-core.ames-state.bob
=/ bob-sec sec:ex:crypto-core.ames-state.bob
::
=/ alice-sym (derive-symmetric-key:alef bob-pub alice-sec)
=/ bob-sym (derive-symmetric-key:alef alice-pub bob-sec)
=/ alice-sym (derive-symmetric-key:vane bob-pub alice-sec)
=/ bob-sym (derive-symmetric-key:vane alice-pub bob-sec)
::
?> =(alice-sym bob-sym)
::
@ -54,7 +54,13 @@
==
=. route.peer-state `[direct=%.y `lane:alef`[%| `@`%lane-bar]]
[%known peer-state]
:: metamorphose
::
=> .(alice +:(call:(alice) ~[//unix] ** %born ~))
=> .(bob +:(call:(bob) ~[//unix] ** %born ~))
:: helper core
::
=>
|%
++ move-to-packet
|= =move:alef
@ -75,7 +81,25 @@
%- move-to-packet
%+ snag index
(skim moves is-move-send)
::
++ call
|= [vane=_alice =duct =task:alef]
^- [moves=(list move:alef) _alice]
::
=/ vane-core (vane(now `@da`(add ~s1 now.vane)))
::
(call:vane-core duct ** task)
::
++ take
|= [vane=_alice =wire =duct =sign:alef]
^- [moves=(list move:alef) _alice]
::
=/ vane-core (vane(now `@da`(add ~s1 now.vane)))
::
(take:vane-core wire duct ** sign)
--
:: test core
::
|%
++ test-packet-encoding ^- tang
::
@ -86,8 +110,8 @@
content=[12 13]
==
::
=/ encoded (encode-packet:alef packet)
=/ decoded (decode-packet:alef encoded)
=/ encoded (encode-packet:vane packet)
=/ decoded (decode-packet:vane encoded)
::
%+ expect-eq
!> packet
@ -111,10 +135,10 @@
:* [sndr=~bus rcvr=~doznec-doznec]
encrypted=%.y
origin=~
content=(encrypt:alef alice-sym shut-packet)
content=(encrypt:vane alice-sym shut-packet)
==
::
=/ =blob:alef (encode-packet:alef packet)
=/ =blob:alef (encode-packet:vane packet)
=^ moves1 bob (call bob ~[//unix] %hear lane-foo blob)
=^ moves2 bob
=/ =point:alef
@ -181,20 +205,4 @@
%+ expect-eq
!> [~[/alice] %give %done `error]
!> (snag 1 `(list move:alef)`moves5)
::
++ call
|= [vane=_alice =duct =task:alef]
^- [moves=(list move:alef) _alice]
::
=/ vane-core (vane(now `@da`(add ~s1 now.vane)))
::
(call:vane-core duct ** task)
::
++ take
|= [vane=_alice =wire =duct =sign:alef]
^- [moves=(list move:alef) _alice]
::
=/ vane-core (vane(now `@da`(add ~s1 now.vane)))
::
(take:vane-core wire duct ** sign)
--