2019-05-25 08:53:29 +03:00
|
|
|
:: protocol-version: current version of the ames wire protocol
|
|
|
|
::
|
2019-05-25 05:03:33 +03:00
|
|
|
=/ protocol-version=?(%0 %1 %2 %3 %4 %5 %6 %7) %0
|
|
|
|
::
|
|
|
|
|%
|
2019-05-27 02:54:23 +03:00
|
|
|
+| %generics
|
2019-05-31 03:21:05 +03:00
|
|
|
:: $mk-item: constructor for +ordered-map item type
|
2019-05-27 02:54:23 +03:00
|
|
|
::
|
2019-05-31 03:21:05 +03:00
|
|
|
+* mk-item [key val] [key=key val=val]
|
|
|
|
:: +ordered-map: treap with user-specified horizontal order
|
|
|
|
::
|
|
|
|
:: Conceptually smaller items go on the left, so the item with the
|
|
|
|
:: smallest key can be popped off the head. If $key is `@` and
|
|
|
|
:: .compare is +lte, then the numerically smallest item is the head.
|
|
|
|
::
|
|
|
|
++ ordered-map
|
|
|
|
|* [key=mold val=mold]
|
|
|
|
=> |%
|
|
|
|
+$ item (mk-item key val)
|
|
|
|
--
|
|
|
|
:: +compare: item comparator for horizontal order
|
|
|
|
::
|
|
|
|
|= compare=$-([key key] ?)
|
|
|
|
|%
|
|
|
|
:: +check-balance: verify horizontal and vertical orderings
|
|
|
|
::
|
|
|
|
++ check-balance
|
|
|
|
=| [l=(unit key) r=(unit key)]
|
|
|
|
|= a=(tree item)
|
|
|
|
^- ?
|
|
|
|
:: empty tree is valid
|
|
|
|
::
|
|
|
|
?~ a %.y
|
|
|
|
:: nonempty trees must maintain several criteria
|
|
|
|
::
|
|
|
|
?& :: if .n.a is left of .u.l, assert horizontal comparator
|
|
|
|
::
|
2019-05-31 04:29:54 +03:00
|
|
|
?~(l %.y (compare key.n.a u.l))
|
2019-05-31 03:21:05 +03:00
|
|
|
:: if .n.a is right of .u.r, assert horizontal comparator
|
|
|
|
::
|
|
|
|
?~(r %.y (compare u.r key.n.a))
|
|
|
|
:: if .a is not leftmost element, assert vertical order between
|
|
|
|
:: .l.a and .n.a and recurse to the left with .n.a as right
|
|
|
|
:: neighbor
|
|
|
|
::
|
|
|
|
?~(l.a %.y &((mor key.n.a key.n.l.a) $(a l.a, l `key.n.a)))
|
|
|
|
:: if .a is not rightmost element, assert vertical order
|
|
|
|
:: between .r.a and .n.a and recurse to the right with .n.a as
|
|
|
|
:: left neighbor
|
|
|
|
::
|
|
|
|
?~(r.a %.y &((mor key.n.a key.n.r.a) $(a r.a, r `key.n.a)))
|
|
|
|
==
|
|
|
|
:: +put: ordered item insert
|
|
|
|
::
|
|
|
|
++ put
|
|
|
|
|= [a=(tree item) =key =val]
|
|
|
|
^- (tree item)
|
|
|
|
:: base case: replace null with single-item tree
|
|
|
|
::
|
|
|
|
?~ a [n=[key val] l=~ r=~]
|
|
|
|
:: base case: overwrite existing .key with new .val
|
|
|
|
::
|
|
|
|
?: =(key.n.a key) a(val.n val)
|
|
|
|
:: if item goes on left, recurse left then rebalance vertical order
|
|
|
|
::
|
|
|
|
?: (compare key key.n.a)
|
|
|
|
=/ l $(a l.a)
|
|
|
|
?> ?=(^ l)
|
2019-05-31 04:29:54 +03:00
|
|
|
?: (mor key.n.a key.n.l)
|
2019-05-31 03:21:05 +03:00
|
|
|
a(l l)
|
|
|
|
l(r a(l r.l))
|
|
|
|
:: item goes on right; recurse right then rebalance vertical order
|
|
|
|
::
|
|
|
|
=/ r $(a r.a)
|
|
|
|
?> ?=(^ r)
|
2019-05-31 04:29:54 +03:00
|
|
|
?: (mor key.n.a key.n.r)
|
2019-05-31 03:21:05 +03:00
|
|
|
a(r r)
|
|
|
|
r(l a(r l.r))
|
|
|
|
:: +peek: produce head (smallest item) or null
|
|
|
|
::
|
|
|
|
++ peek
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (unit item)
|
|
|
|
::
|
|
|
|
?~ a ~
|
|
|
|
?~ l.a `n.a
|
|
|
|
$(a l.a)
|
|
|
|
:: +pop: produce .head (smallest item) and .rest or crash if empty
|
|
|
|
::
|
|
|
|
++ pop
|
|
|
|
|= a=(tree item)
|
|
|
|
^- [head=item rest=(tree item)]
|
|
|
|
::
|
|
|
|
?~ a !!
|
|
|
|
?~ l.a [n.a r.a]
|
|
|
|
::
|
|
|
|
=/ l $(a l.a)
|
|
|
|
:- head.l
|
|
|
|
:: load .rest.l back into .a and rebalance
|
|
|
|
::
|
2019-05-31 04:29:54 +03:00
|
|
|
?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l))
|
2019-05-31 03:21:05 +03:00
|
|
|
a(l rest.l)
|
|
|
|
rest.l(r a(r r.rest.l))
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +nip: remove root; for internal use
|
2019-05-31 03:21:05 +03:00
|
|
|
::
|
2019-05-31 21:59:28 +03:00
|
|
|
++ nip
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?> ?=(^ a)
|
|
|
|
:: delete .n.a; merge and balance .l.a and .r.a
|
|
|
|
::
|
|
|
|
|- ^- (tree item)
|
|
|
|
?~ l.a r.a
|
|
|
|
?~ r.a l.a
|
|
|
|
?: (mor key.n.l.a key.n.r.a)
|
|
|
|
l.a(r $(l.a r.l.a))
|
|
|
|
r.a(l $(r.a l.r.a))
|
|
|
|
:: +traverse: stateful partial inorder traversal
|
2019-05-31 03:21:05 +03:00
|
|
|
::
|
2019-06-01 00:00:53 +03:00
|
|
|
:: Mutates .state on each run of .f. Starts at .start key, or if
|
|
|
|
:: .start is ~, starts at the head (item with smallest key). Stops
|
2019-05-31 21:59:28 +03:00
|
|
|
:: when .f produces .stop=%.y. Traverses from smaller to larger
|
|
|
|
:: keys. Each run of .f can replace an item's value or delete the
|
|
|
|
:: item.
|
|
|
|
::
|
|
|
|
++ traverse
|
2019-05-31 20:59:45 +03:00
|
|
|
|* state=mold
|
|
|
|
|= $: a=(tree item)
|
2019-06-01 00:00:53 +03:00
|
|
|
start=(unit key)
|
2019-05-31 20:59:45 +03:00
|
|
|
=state
|
2019-05-31 21:59:28 +03:00
|
|
|
f=$-([state item] [(unit val) ? state])
|
2019-05-31 20:59:45 +03:00
|
|
|
==
|
2019-05-31 21:59:28 +03:00
|
|
|
^+ [state a]
|
2019-05-31 20:59:45 +03:00
|
|
|
:: acc: accumulator
|
|
|
|
::
|
2019-05-31 21:59:28 +03:00
|
|
|
:: .stop: set to %.y by .f when done traversing
|
|
|
|
:: .state: threaded through each run of .f and produced by +abet
|
|
|
|
::
|
2019-05-31 20:59:45 +03:00
|
|
|
=/ acc [stop=`?`%.n state=state]
|
2019-05-31 21:59:28 +03:00
|
|
|
=< abet =< main
|
2019-05-31 07:51:06 +03:00
|
|
|
|%
|
2019-05-31 20:59:45 +03:00
|
|
|
++ abet [state.acc a]
|
2019-05-31 07:51:06 +03:00
|
|
|
++ self .
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +main: main recursive loop; performs a partial inorder traversal
|
|
|
|
::
|
|
|
|
++ main
|
2019-05-31 07:51:06 +03:00
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
:: stop if empty or we've been told to stop
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
?~ a .
|
2019-05-31 20:59:45 +03:00
|
|
|
?: stop.acc .
|
2019-06-01 00:00:53 +03:00
|
|
|
:: if nonempty .start, while we're left of .start, move right
|
2019-05-31 21:59:28 +03:00
|
|
|
::
|
2019-06-01 00:00:53 +03:00
|
|
|
?: ?& ?=(^ start)
|
|
|
|
!(compare u.start key.n.a)
|
|
|
|
==
|
|
|
|
right
|
2019-05-31 21:59:28 +03:00
|
|
|
:: inorder traversal: left -> node -> right, recursively
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
=> left
|
2019-05-31 21:59:28 +03:00
|
|
|
:: only continue rightward if we weren't told to stop
|
2019-05-31 20:59:45 +03:00
|
|
|
=< ?. stop.acc
|
2019-05-31 21:59:28 +03:00
|
|
|
right
|
2019-05-31 07:51:06 +03:00
|
|
|
self
|
2019-05-31 21:59:28 +03:00
|
|
|
:: if left told us to stop, don't mutate node
|
|
|
|
::
|
|
|
|
?: stop.acc self
|
|
|
|
:: run .f on node, updating .stop.acc and .state.acc
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
?> ?=(^ a)
|
2019-05-31 20:59:45 +03:00
|
|
|
=^ res acc (f state.acc n.a)
|
2019-05-31 21:59:28 +03:00
|
|
|
:: TMI
|
|
|
|
::
|
|
|
|
=> .(a `(tree item)`a)
|
|
|
|
=. a
|
|
|
|
:: if .f requested node deletion, merge and balance .l.a and .r.a
|
|
|
|
::
|
|
|
|
?~ res (nip a)
|
|
|
|
:: we kept the node; replace its .val; order is unchanged
|
|
|
|
::
|
|
|
|
?> ?=(^ a)
|
|
|
|
a(val.n u.res)
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
self
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +left: recurse on the left subtree, copying mutant back into .a
|
|
|
|
::
|
2019-05-31 07:51:06 +03:00
|
|
|
++ left
|
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
?~ a .
|
|
|
|
=/ lef main(a l.a)
|
2019-05-31 07:51:06 +03:00
|
|
|
lef(a a(l a.lef))
|
2019-05-31 21:59:28 +03:00
|
|
|
:: +right: recurse on the right subtree, copying mutant back into .a
|
|
|
|
::
|
|
|
|
++ right
|
2019-05-31 07:51:06 +03:00
|
|
|
^+ .
|
2019-05-31 21:59:28 +03:00
|
|
|
?~ a .
|
|
|
|
=/ rig main(a r.a)
|
2019-05-31 07:51:06 +03:00
|
|
|
rig(a a(r a.rig))
|
|
|
|
--
|
2019-05-31 03:21:05 +03:00
|
|
|
:: +tap: convert to list, smallest to largest
|
|
|
|
::
|
|
|
|
++ tap
|
|
|
|
|= a=(tree item)
|
|
|
|
^- (list item)
|
|
|
|
::
|
|
|
|
=| b=(list item)
|
|
|
|
|- ^+ b
|
|
|
|
?~ a b
|
|
|
|
::
|
|
|
|
$(a l.a, b [n.a $(a r.a)])
|
|
|
|
:: +gas: put a list of items
|
|
|
|
::
|
|
|
|
++ gas
|
|
|
|
|= [a=(tree item) b=(list item)]
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?~ b a
|
|
|
|
$(b t.b, a (put a i.b))
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +uni: unify two ordered sets
|
|
|
|
::
|
|
|
|
++ uni
|
|
|
|
|= [a=(tree item) b=(tree item)]
|
|
|
|
^- (tree item)
|
|
|
|
::
|
|
|
|
?~ b a
|
|
|
|
?~ a b
|
|
|
|
?: (mor key.n.a key.n.b)
|
|
|
|
::
|
|
|
|
?: =(key.n.b key.n.a)
|
|
|
|
[n.b $(a l.a, b l.b) $(a r.a, b r.b)]
|
|
|
|
::
|
|
|
|
?: (compare key.n.b key.n.a)
|
|
|
|
$(l.a $(a l.a, r.b ~), b r.b)
|
|
|
|
$(r.a $(a r.a, l.b ~), b l.b)
|
|
|
|
::
|
|
|
|
?: =(key.n.a key.n.b)
|
|
|
|
[n.b $(b l.b, a l.a) $(b r.b, a r.a)]
|
|
|
|
::
|
|
|
|
?: (compare key.n.a key.n.b)
|
|
|
|
$(l.b $(b l.b, r.a ~), a r.a)
|
|
|
|
$(r.b $(b r.b, l.a ~), a l.a)
|
2019-05-31 03:21:05 +03:00
|
|
|
--
|
2019-05-27 02:54:23 +03:00
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+| %atomics
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ blob @uxblob
|
|
|
|
+$ bone @udbone
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ fragment @uwfragment
|
2019-05-27 04:48:41 +03:00
|
|
|
+$ fragment-num @udfragmentnum
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ lane @uxlane
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ message-num @udmessagenum
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ public-key @uwpublickey
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ signature @uwsignature
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ symmetric-key @uwsymmetrickey
|
|
|
|
:: $rank: which kind of ship address, by length
|
|
|
|
::
|
|
|
|
:: 0: galaxy or star -- 2 bytes
|
|
|
|
:: 1: planet -- 4 bytes
|
|
|
|
:: 2: moon -- 8 bytes
|
|
|
|
:: 3: comet -- 16 bytes
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
+$ rank ?(%0 %1 %2 %3)
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 06:22:38 +03:00
|
|
|
+| %kinetics
|
2019-05-27 04:48:41 +03:00
|
|
|
::
|
|
|
|
:: $channel: combined sender and receiver identifying data
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 04:48:41 +03:00
|
|
|
+$ channel
|
2019-05-27 04:52:31 +03:00
|
|
|
$: [our=ship her=ship]
|
2019-05-29 01:05:59 +03:00
|
|
|
now=@da
|
2019-05-27 04:48:41 +03:00
|
|
|
:: our data, common to all dyads
|
|
|
|
::
|
|
|
|
$: =our=life
|
|
|
|
crypto-core=acru:ames
|
|
|
|
==
|
|
|
|
:: her data, specific to this dyad
|
|
|
|
::
|
|
|
|
$: =symmetric-key
|
|
|
|
=her=life
|
|
|
|
=her=public-key
|
|
|
|
her-sponsors=(list ship)
|
|
|
|
== ==
|
2019-05-25 08:53:29 +03:00
|
|
|
:: $dyad: pair of sender and receiver ships
|
|
|
|
::
|
|
|
|
+$ dyad [sndr=ship rcvr=ship]
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+$ error [tag=@tas =tang]
|
2019-05-25 08:53:29 +03:00
|
|
|
:: $message: application-level message
|
|
|
|
::
|
|
|
|
:: path: internal route on the receiving ship
|
|
|
|
:: payload: semantic message contents
|
|
|
|
::
|
|
|
|
+$ message [=path payload=*]
|
|
|
|
:: $packet: noun representation of an ames datagram packet
|
|
|
|
::
|
|
|
|
:: Roundtrips losslessly through atom encoding and decoding.
|
|
|
|
::
|
|
|
|
:: .origin is ~ unless the packet is being forwarded. If present,
|
|
|
|
:: it's an atom that encodes a route to another ship, such as an IPv4
|
|
|
|
:: address. Routes are opaque to Arvo and only have meaning in the
|
|
|
|
:: interpreter. This enforces that Ames is transport-agnostic.
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
+$ packet [dyad encrypted=? origin=(unit lane) content=*]
|
2019-05-27 02:54:23 +03:00
|
|
|
:: $open-packet: unencrypted packet payload, for comet self-attestation
|
|
|
|
::
|
|
|
|
+$ open-packet
|
|
|
|
$: =signature
|
|
|
|
=sndr=life
|
|
|
|
=rcvr=life
|
|
|
|
rcvr=ship
|
|
|
|
==
|
|
|
|
:: $shut-packet: encrypted packet payload
|
|
|
|
::
|
|
|
|
+$ shut-packet
|
|
|
|
$: =sndr=life
|
|
|
|
=rcvr=life
|
|
|
|
=bone
|
|
|
|
=message-num
|
|
|
|
meat=(each fragment-meat ack-meat)
|
|
|
|
==
|
|
|
|
:: $fragment-meat: contents of a message-fragment packet
|
|
|
|
::
|
|
|
|
+$ fragment-meat
|
|
|
|
$: num-fragments=fragment-num
|
|
|
|
=fragment-num
|
|
|
|
=fragment
|
|
|
|
==
|
|
|
|
:: $ack-meat: contents of an acknowledgment packet; fragment or message
|
|
|
|
::
|
|
|
|
:: Fragment acks reference the $fragment-num of the target packet.
|
|
|
|
::
|
|
|
|
:: Message acks contain a success flag .ok, which is %.n in case of
|
|
|
|
:: negative acknowledgment (nack), along with .lag that describes the
|
|
|
|
:: time it took to process the message. .lag is zero if the message
|
|
|
|
:: was processed during a single Arvo event. At the moment, .lag is
|
|
|
|
:: always zero.
|
|
|
|
::
|
|
|
|
+$ ack-meat (each fragment-num [ok=? lag=@dr])
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
2019-05-27 04:52:31 +03:00
|
|
|
+| %statics
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
|
|
|
:: $ames-state: state for entire vane
|
|
|
|
::
|
|
|
|
+$ ames-state
|
|
|
|
$: peers=(map ship ship-state)
|
|
|
|
=life
|
|
|
|
crypto-core=acru:ames
|
|
|
|
==
|
|
|
|
:: $ship-state: all we know about a peer
|
|
|
|
::
|
|
|
|
:: %alien: no PKI data, so enqueue actions to perform once we learn it
|
2019-05-28 06:15:17 +03:00
|
|
|
:: %known: we know their life and public keys, so we have a channel
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
|
|
|
+$ ship-state
|
2019-05-29 01:05:59 +03:00
|
|
|
$% [%alien pending-requests]
|
2019-05-28 06:15:17 +03:00
|
|
|
[%known peer-state]
|
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $pending-requests: what to do when we learn a peer's life and keys
|
2019-05-28 06:15:17 +03:00
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
:: rcv-packets: packets we've received from unix
|
|
|
|
:: snd-messages: messages local vanes have asked us to send
|
|
|
|
::
|
|
|
|
+$ pending-requests
|
2019-05-28 06:15:17 +03:00
|
|
|
$: rcv-packets=(list [=lane =packet])
|
|
|
|
snd-messages=(list [=duct =message])
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
|
|
|
:: $peer-state: state for a peer with known life and keys
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
:: route: transport-layer destination for packets to peer
|
|
|
|
:: ossuary: bone<->duct mapper
|
|
|
|
:: snd: per-bone message pumps to send messages as fragments
|
|
|
|
:: rcv: per-bone message stills to assemble messages from fragments
|
|
|
|
:: nax: unprocessed nacks (negative acknowledgments)
|
|
|
|
:: Each value is ~ when we've received the ack packet but not a
|
|
|
|
:: naxplanation, or an error when we've received a naxplanation
|
|
|
|
:: but not the ack packet.
|
|
|
|
::
|
|
|
|
:: When we hear a nack packet or an explanation, if there's no
|
|
|
|
:: entry in .nax, we make a new entry. Otherwise, if this new
|
|
|
|
:: information completes the packet+naxplanation, we remove the
|
|
|
|
:: entry and emit a nack to the local vane that asked us to send
|
|
|
|
:: the message.
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
+$ peer-state
|
|
|
|
$: $: =symmetric-key
|
|
|
|
=life
|
|
|
|
=public-key
|
|
|
|
sponsors=(list ship)
|
|
|
|
==
|
|
|
|
route=(unit [direct=? =lane])
|
|
|
|
=ossuary
|
2019-05-27 02:54:23 +03:00
|
|
|
snd=(map bone message-pump-state)
|
2019-05-29 01:05:59 +03:00
|
|
|
rcv=(map bone message-still-state)
|
|
|
|
nax=(map [=bone =message-num] (unit error))
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-05-27 04:38:19 +03:00
|
|
|
:: $ossuary: bone<->duct bijection and .next-bone to map to a duct
|
2019-05-25 08:53:29 +03:00
|
|
|
::
|
|
|
|
+$ ossuary
|
2019-05-27 04:38:19 +03:00
|
|
|
$: =next=bone
|
2019-05-25 08:53:29 +03:00
|
|
|
by-duct=(map duct bone)
|
|
|
|
by-bone=(map bone duct)
|
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $message-pump-state: persistent state for |message-pump
|
|
|
|
::
|
2019-05-27 07:34:18 +03:00
|
|
|
:: Messages queue up in |message-pump's .unsent-messages until they
|
|
|
|
:: can be packetized and fed into |packet-pump for sending. When we
|
|
|
|
:: pop a message off .unsent-messages, we push as many fragments as
|
|
|
|
:: we can into |packet-pump, then place the remaining in
|
|
|
|
:: .unsent-fragments. We also insert an entry in .unacked-fragments
|
|
|
|
:: initialized with the total number of fragments in the message.
|
|
|
|
::
|
|
|
|
:: When we hear a packet ack, we send it to |packet-pump. If we
|
|
|
|
:: haven't seen it before, |packet-pump reports the fresh ack. We
|
|
|
|
:: then decrement that message's entry in .unacked-fragments.
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
:: When we hear a message ack (positive or negative), we treat that
|
|
|
|
:: as though all fragments have been acked. If this message is not
|
|
|
|
:: .current, then it's a future message and .current has not yet been
|
|
|
|
:: acked, so we place the message in .queued-message-acks.
|
|
|
|
::
|
|
|
|
:: If we hear a message ack before we've sent all the
|
|
|
|
:: fragments for that message, clear .unsent-fragments. If the
|
|
|
|
:: message ack was positive, print it out because it indicates the
|
|
|
|
:: peer is not behaving properly.
|
|
|
|
::
|
|
|
|
:: If the ack is for the current message, emit the message ack,
|
|
|
|
:: increment .current, and check if this next message is in
|
|
|
|
:: .queued-message-acks. If it is, emit the message (n)ack,
|
|
|
|
:: increment .current, and check the next message. Repeat until
|
|
|
|
:: .current is not fully acked.
|
2019-05-27 07:34:18 +03:00
|
|
|
::
|
|
|
|
:: When we hear a message nack, we send it to |packet-pump, which
|
|
|
|
:: deletes all packets from that message. If .current gets nacked,
|
|
|
|
:: clear .unsent-fragments and go into the same flow as when we hear
|
|
|
|
:: the last packet ack on a message.
|
|
|
|
::
|
|
|
|
:: The following equation is always true:
|
|
|
|
:: .next - .current == number of messages in flight
|
|
|
|
::
|
2019-05-27 07:44:11 +03:00
|
|
|
:: At the end of a task, |message-pump sends a %flush task to
|
|
|
|
:: |packet-pump, which can trigger a timer to be set or cleared based
|
|
|
|
:: on congestion control calculations. When it fires, the timer will
|
|
|
|
:: generally cause one or more packets to be resent.
|
|
|
|
::
|
2019-05-27 07:34:18 +03:00
|
|
|
:: current: sequence number of message being sent
|
|
|
|
:: next: sequence number of next message to send
|
2019-05-27 06:22:38 +03:00
|
|
|
:: unsent-messages: messages to be sent after current message
|
|
|
|
:: unsent-fragments: fragments of current message waiting for sending
|
|
|
|
:: unacked-fragments: number of fragments waiting on ack
|
2019-05-29 05:56:05 +03:00
|
|
|
:: queued-message-acks: future message acks to be applied after current
|
2019-05-27 06:22:38 +03:00
|
|
|
:: packet-pump-state: state of corresponding |packet-pump
|
|
|
|
::
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ message-pump-state
|
2019-05-27 07:34:18 +03:00
|
|
|
$: current=message-num
|
|
|
|
next=message-num
|
2019-05-27 02:54:23 +03:00
|
|
|
unsent-messages=(qeu message)
|
2019-05-27 04:38:19 +03:00
|
|
|
unsent-fragments=(list static-fragment)
|
2019-05-29 05:56:05 +03:00
|
|
|
queued-message-acks=(map message-num ok=?)
|
2019-05-27 02:54:23 +03:00
|
|
|
=packet-pump-state
|
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $packet-pump-state: persistent state for |packet-pump
|
|
|
|
::
|
|
|
|
:: next-wake: last timer we've set, or null
|
2019-05-27 07:44:11 +03:00
|
|
|
:: live: packets in flight; sent but not yet acked
|
|
|
|
:: lost: packets to retry, since they timed out with no ack
|
2019-06-01 05:03:09 +03:00
|
|
|
:: metrics: congestion control information
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
2019-05-27 02:54:23 +03:00
|
|
|
+$ packet-pump-state
|
|
|
|
$: next-wake=(unit @da)
|
2019-06-01 01:35:06 +03:00
|
|
|
live=(tree [live-packet-key live-packet-val])
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics=pump-metrics
|
2019-05-27 02:54:23 +03:00
|
|
|
==
|
2019-05-27 04:38:19 +03:00
|
|
|
+$ pump-metrics
|
2019-05-27 04:48:41 +03:00
|
|
|
$: num-live=@ud
|
|
|
|
num-lost=@ud
|
|
|
|
last-sent-at=@da
|
|
|
|
last-dead-at=@da
|
|
|
|
rtt=@dr
|
|
|
|
max-live=@ud
|
|
|
|
==
|
2019-06-01 01:35:06 +03:00
|
|
|
+$ live-packet-key [=message-num =fragment-num]
|
|
|
|
+$ live-packet-val
|
2019-06-01 03:50:22 +03:00
|
|
|
$: sent-packet-state
|
2019-06-01 01:35:06 +03:00
|
|
|
num-fragments=fragment-num
|
|
|
|
=fragment
|
|
|
|
==
|
2019-06-01 03:50:22 +03:00
|
|
|
+$ sent-packet-state
|
|
|
|
$: expiry=@da
|
|
|
|
sent-date=@da
|
2019-05-27 04:38:19 +03:00
|
|
|
retried=?
|
|
|
|
==
|
|
|
|
+$ static-fragment
|
|
|
|
$: =message-num
|
|
|
|
num-fragments=fragment-num
|
2019-05-27 02:54:23 +03:00
|
|
|
=fragment-num
|
|
|
|
=fragment
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $message-still-state: state of |message-still to assemble messages
|
|
|
|
::
|
|
|
|
:: last-acked: highest $message-num we've fully acknowledged
|
|
|
|
:: last-heard: highest $message-num we've heard all fragments on
|
|
|
|
:: pending-vane-ack: heard but not processed by local vane
|
|
|
|
:: live-messages: partially received messages
|
|
|
|
:: naxplanations: enqueued nack diagnostics
|
|
|
|
::
|
|
|
|
+$ message-still-state
|
2019-05-27 04:38:19 +03:00
|
|
|
$: last-acked=message-num
|
|
|
|
last-heard=message-num
|
|
|
|
pending-vane-ack=(qeu [=message-num =message])
|
|
|
|
live-messages=(map message-num partial-rcv-message)
|
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $partial-rcv-message: message for which we've received some fragments
|
|
|
|
::
|
|
|
|
:: num-fragments: total number of fragments in this message
|
|
|
|
:: num-received: how many fragments we've received so far
|
|
|
|
:: fragments: fragments we've received, eventually producing a $message
|
|
|
|
::
|
2019-05-27 04:38:19 +03:00
|
|
|
+$ partial-rcv-message
|
|
|
|
$: num-fragments=fragment-num
|
|
|
|
num-received=fragment-num
|
|
|
|
fragments=(map fragment-num fragment)
|
2019-05-25 08:53:29 +03:00
|
|
|
==
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+| %dialectics
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
:: $move: output effect; either request or response
|
|
|
|
::
|
2019-05-28 06:15:17 +03:00
|
|
|
+$ move [=duct card=(wind note gift)]
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
2019-05-28 04:43:10 +03:00
|
|
|
:: $task: job for ames
|
|
|
|
::
|
|
|
|
:: %born: process restart notification
|
|
|
|
:: %crud: crash report
|
|
|
|
:: %hear: packet from unix
|
|
|
|
:: %hole: report that packet handling crashed
|
|
|
|
:: %init: vane boot
|
|
|
|
:: %sunk: a ship breached and has a new .rift
|
|
|
|
:: %vega: kernel reload notification
|
|
|
|
:: %wegh: request for memory usage report
|
|
|
|
:: %west: request to send message
|
|
|
|
::
|
|
|
|
+$ task
|
|
|
|
$% [%born ~]
|
|
|
|
[%crud =error]
|
|
|
|
[%hear =lane =blob]
|
|
|
|
[%hole =lane =blob]
|
|
|
|
[%init =ship]
|
|
|
|
[%sunk =ship =rift]
|
|
|
|
[%vega ~]
|
|
|
|
[%wegh ~]
|
|
|
|
[%west =ship =message]
|
|
|
|
==
|
|
|
|
:: $gift: effect from ames
|
|
|
|
::
|
|
|
|
:: %east: message to vane from peer
|
|
|
|
:: %send: packet to unix
|
|
|
|
:: %rest: notify vane that peer (n)acked our message
|
|
|
|
::
|
|
|
|
+$ gift
|
|
|
|
$% [%east payload=*]
|
|
|
|
[%send =lane =blob]
|
|
|
|
[%rest error=(unit error)]
|
|
|
|
==
|
|
|
|
:: $note: request to other vane
|
|
|
|
::
|
|
|
|
:: TODO: specialize gall interface for subscription management
|
|
|
|
::
|
|
|
|
+$ note
|
|
|
|
$% $: %b
|
|
|
|
$% [%wait date=@da]
|
|
|
|
[%rest date=@da]
|
|
|
|
== ==
|
|
|
|
$: %c
|
|
|
|
$% [%west =ship =message]
|
|
|
|
== ==
|
|
|
|
$: %g
|
|
|
|
$% [%west =ship =message]
|
|
|
|
== ==
|
|
|
|
$: %j
|
|
|
|
$% [%pubs =ship]
|
|
|
|
[%turf ~]
|
|
|
|
[%west =ship =message]
|
|
|
|
[%vein ~]
|
|
|
|
== == ==
|
|
|
|
:: $sign: response from other vane
|
|
|
|
::
|
|
|
|
+$ sign
|
|
|
|
$% $: %b
|
|
|
|
$% [%wake error=(unit tang)]
|
|
|
|
== ==
|
|
|
|
$: %j
|
|
|
|
$% [%pubs public:able:jael]
|
|
|
|
[%turf turf=(list turf)]
|
|
|
|
[%vein =life vein=(map life ring)]
|
|
|
|
== == ==
|
2019-05-27 06:22:38 +03:00
|
|
|
:: $message-pump-task: job for |message-pump
|
|
|
|
::
|
|
|
|
:: %send: packetize and send application-level message
|
2019-05-29 01:05:59 +03:00
|
|
|
:: %hear-fragment-ack: deal with a packet acknowledgment
|
|
|
|
:: %hear-message-ack: deal with message negative acknowledgment
|
2019-05-27 06:22:38 +03:00
|
|
|
:: %wake: handle timer firing
|
|
|
|
::
|
|
|
|
+$ message-pump-task
|
2019-05-29 05:56:05 +03:00
|
|
|
$% [%send =message]
|
2019-05-29 01:05:59 +03:00
|
|
|
[%hear-fragment-ack =message-num =fragment-num]
|
|
|
|
[%hear-message-ack =message-num ok=? lag=@dr]
|
2019-05-27 06:22:38 +03:00
|
|
|
[%wake ~]
|
|
|
|
==
|
|
|
|
:: $message-pump-gift: effect from |message-pump
|
|
|
|
::
|
|
|
|
:: %ack-message: report message acknowledgment
|
2019-05-31 03:20:42 +03:00
|
|
|
:: %send: emit message fragment
|
|
|
|
:: %wait: set a new timer at .date
|
|
|
|
:: %rest: cancel timer at .date
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+$ message-pump-gift
|
2019-05-28 04:43:10 +03:00
|
|
|
$% [%ack-message =message-num ok=?]
|
2019-05-31 03:20:42 +03:00
|
|
|
[%send =static-fragment]
|
|
|
|
[%wait date=@da]
|
|
|
|
[%rest date=@da]
|
2019-05-27 06:22:38 +03:00
|
|
|
==
|
|
|
|
:: $packet-pump-task: job for |packet-pump
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
:: %hear-fragment-ack: deal with a packet acknowledgment
|
|
|
|
:: %hear-message-ack: deal with message acknowledgment
|
|
|
|
:: %finalize: finish event, possibly updating timer
|
2019-05-27 06:22:38 +03:00
|
|
|
:: %wake: handle timer firing
|
|
|
|
::
|
|
|
|
+$ packet-pump-task
|
2019-05-29 01:05:59 +03:00
|
|
|
$% [%hear-fragment-ack =message-num =fragment-num]
|
2019-05-29 05:56:05 +03:00
|
|
|
[%hear-message-ack =message-num lag=@dr]
|
|
|
|
[%finalize ~]
|
2019-05-27 06:22:38 +03:00
|
|
|
[%wake ~]
|
|
|
|
==
|
|
|
|
:: $packet-pump-gift: effect from |packet-pump
|
|
|
|
::
|
2019-05-31 03:20:42 +03:00
|
|
|
:: %send: emit message fragment
|
|
|
|
:: %wait: set a new timer at .date
|
|
|
|
:: %rest: cancel timer at .date
|
2019-05-27 06:22:38 +03:00
|
|
|
::
|
|
|
|
+$ packet-pump-gift
|
2019-05-31 03:20:42 +03:00
|
|
|
$% [%send =static-fragment]
|
|
|
|
[%wait date=@da]
|
|
|
|
[%rest date=@da]
|
2019-05-27 06:22:38 +03:00
|
|
|
==
|
2019-05-29 01:05:59 +03:00
|
|
|
:: $message-still-task: job for |message-still
|
|
|
|
::
|
|
|
|
:: %hear: handle receiving a message fragment packet
|
|
|
|
:: %done: receive confirmation from vane of processing completion or
|
|
|
|
:: failure with diagnostic
|
|
|
|
::
|
|
|
|
+$ message-still-task
|
|
|
|
$% [%hear =lane =shut-packet]
|
|
|
|
[%done =message-num error=(unit error)]
|
|
|
|
==
|
|
|
|
:: $message-still-gift: effect from |message-still
|
|
|
|
::
|
|
|
|
:: %hear-message: $message assembled from received packets, to be
|
|
|
|
:: sent to a local vane for processing
|
2019-05-31 03:20:42 +03:00
|
|
|
:: %ack-fragment: emit ack in response to heard fragment
|
|
|
|
:: %ack-message: emit ack in response to message processing
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
+$ message-still-gift
|
|
|
|
$% [%hear-message =message]
|
2019-05-31 03:20:42 +03:00
|
|
|
[%ack-fragment =message-num =fragment-num]
|
|
|
|
[%ack-message =message-num ok=? lag=@dr]
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
2019-05-25 05:03:33 +03:00
|
|
|
--
|
2019-05-28 04:43:10 +03:00
|
|
|
:: external vane interface
|
|
|
|
::
|
|
|
|
=<
|
|
|
|
|= pit=vase
|
|
|
|
=| =ames-state
|
|
|
|
|= [our=ship eny=@ now=@da scry-gate=sley]
|
|
|
|
=* ames-gate .
|
|
|
|
|%
|
|
|
|
:: +call: handle request $task
|
|
|
|
::
|
|
|
|
++ call
|
|
|
|
|= [=duct type=* wrapped-task=(hobo task)]
|
|
|
|
^- [(list move) _ames-gate]
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
=/ =task
|
|
|
|
?. ?=(%soft -.wrapped-task)
|
|
|
|
wrapped-task
|
|
|
|
;;(task p.wrapped-task)
|
|
|
|
::
|
|
|
|
=/ event-core (per-event [our eny now scry-gate] duct ames-state)
|
|
|
|
::
|
|
|
|
=^ moves ames-state
|
|
|
|
=< abet
|
|
|
|
?- -.task
|
|
|
|
%born !!
|
|
|
|
%crud !!
|
|
|
|
%hear (on-hear:event-core [lane blob]:task)
|
|
|
|
%hole !!
|
|
|
|
%init !!
|
|
|
|
%sunk !!
|
|
|
|
%vega !!
|
|
|
|
%wegh !!
|
|
|
|
%west !!
|
|
|
|
==
|
|
|
|
::
|
|
|
|
[moves ames-gate]
|
2019-05-28 04:43:10 +03:00
|
|
|
:: +take: handle response $sign
|
|
|
|
::
|
|
|
|
++ take
|
|
|
|
|= [=wire =duct type=* =sign]
|
|
|
|
^- [(list move) _ames-gate]
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
:: +stay: extract state before reload
|
|
|
|
::
|
|
|
|
++ stay ames-state
|
|
|
|
:: +load: load in old state after reload
|
|
|
|
::
|
|
|
|
++ load
|
|
|
|
|= old=^ames-state
|
|
|
|
ames-gate(ames-state old)
|
|
|
|
:: +scry: dereference namespace
|
|
|
|
::
|
|
|
|
++ scry
|
|
|
|
|= [fur=(unit (set monk)) ren=@tas why=shop syd=desk lot=coin tyl=path]
|
|
|
|
^- (unit (unit cage))
|
|
|
|
::
|
|
|
|
[~ ~]
|
|
|
|
--
|
2019-05-28 05:43:47 +03:00
|
|
|
:: helpers
|
2019-05-28 04:43:10 +03:00
|
|
|
::
|
2019-05-25 05:03:33 +03:00
|
|
|
|%
|
2019-05-28 05:43:47 +03:00
|
|
|
++ per-event
|
|
|
|
=| moves=(list move)
|
|
|
|
|= [[our=ship eny=@ now=@da scry-gate=sley] =duct =ames-state]
|
|
|
|
|%
|
|
|
|
++ event-core .
|
|
|
|
++ abet [(flop moves) ames-state]
|
2019-05-28 06:15:17 +03:00
|
|
|
++ emit |=(=move event-core(moves [move moves]))
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear
|
|
|
|
|= [=lane =blob]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ =packet (decode-packet blob)
|
|
|
|
::
|
|
|
|
%. [lane packet]
|
|
|
|
::
|
|
|
|
?. =(our rcvr.packet)
|
|
|
|
on-hear-forward
|
|
|
|
::
|
|
|
|
?: encrypted.packet
|
|
|
|
on-hear-shut
|
|
|
|
on-hear-open
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear-forward
|
|
|
|
|= [=lane =packet]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear-open
|
|
|
|
|= [=lane =packet]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear-shut
|
|
|
|
|= [=lane =packet]
|
|
|
|
^+ event-core
|
2019-05-28 06:59:53 +03:00
|
|
|
:: encrypted packet content must be an encrypted atom
|
|
|
|
::
|
|
|
|
?> ?=(@ content.packet)
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
=/ sndr-state (~(get by peers.ames-state) sndr.packet)
|
|
|
|
::
|
|
|
|
?. ?=([~ %known *] sndr-state)
|
|
|
|
(enqueue-alien-packet lane packet)
|
|
|
|
::
|
2019-05-28 06:59:53 +03:00
|
|
|
=/ =peer-state +.u.sndr-state
|
2019-05-29 01:05:59 +03:00
|
|
|
=/ =channel [[our sndr.packet] now +.ames-state -.peer-state]
|
2019-05-28 06:59:53 +03:00
|
|
|
=/ =shut-packet (decrypt symmetric-key.channel content.packet)
|
2019-05-29 01:05:59 +03:00
|
|
|
:: ward against replay attacks
|
|
|
|
::
|
|
|
|
?> =(sndr-life.shut-packet her-life.channel)
|
|
|
|
?> =(rcvr-life.shut-packet our-life.channel)
|
|
|
|
::
|
|
|
|
?: ?=(%& -.meat.shut-packet)
|
|
|
|
%+ on-hear-fragment
|
|
|
|
%- fall :_ *message-still-state
|
|
|
|
(~(get by rcv.peer-state) bone.shut-packet)
|
|
|
|
[channel lane shut-packet]
|
|
|
|
::
|
|
|
|
%+ on-hear-ack
|
|
|
|
%- fall :_ *message-pump-state
|
|
|
|
(~(get by snd.peer-state) bone.shut-packet)
|
|
|
|
[channel lane shut-packet]
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear-ack
|
|
|
|
|= [=message-pump-state =channel =lane =shut-packet]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ pump (make-message-pump message-pump-state channel)
|
|
|
|
::
|
|
|
|
=/ task=message-pump-task
|
|
|
|
?> ?=(%| -.meat.shut-packet)
|
|
|
|
?: ?=(%& -.p.meat.shut-packet)
|
|
|
|
[%hear-fragment-ack message-num.shut-packet p.p.meat.shut-packet]
|
|
|
|
[%hear-message-ack message-num.shut-packet p.p.meat.shut-packet]
|
|
|
|
::
|
|
|
|
=^ pump-gifts message-pump-state (work:pump task)
|
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
%+ ~(jab by peers.ames-state) her.channel
|
|
|
|
|= =ship-state
|
|
|
|
?> ?=(%known -.ship-state)
|
|
|
|
=/ =peer-state +.ship-state
|
|
|
|
=. snd.peer-state
|
|
|
|
(~(put by snd.peer-state) bone.shut-packet message-pump-state)
|
|
|
|
[%known peer-state]
|
|
|
|
::
|
|
|
|
(process-pump-gifts pump-gifts)
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ process-pump-gifts
|
|
|
|
|= pump-gifts=(list message-pump-gift)
|
|
|
|
^+ event-core
|
2019-05-28 05:43:47 +03:00
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
++ on-hear-fragment
|
|
|
|
|= [=message-still-state =channel =lane =shut-packet]
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
=/ still (make-message-still message-still-state channel)
|
|
|
|
::
|
|
|
|
=^ still-gifts message-still-state (work:still %hear lane shut-packet)
|
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
%+ ~(jab by peers.ames-state) her.channel
|
|
|
|
|= =ship-state
|
|
|
|
?> ?=(%known -.ship-state)
|
|
|
|
=/ =peer-state +.ship-state
|
|
|
|
=. rcv.peer-state
|
|
|
|
(~(put by rcv.peer-state) bone.shut-packet message-still-state)
|
|
|
|
[%known peer-state]
|
|
|
|
::
|
|
|
|
(process-still-gifts still-gifts)
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ process-still-gifts
|
|
|
|
|= still-gifts=(list message-still-gift)
|
|
|
|
^+ event-core
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
++ enqueue-alien-packet
|
|
|
|
|= [=lane =packet]
|
|
|
|
^+ event-core
|
|
|
|
::
|
2019-05-28 06:15:17 +03:00
|
|
|
=/ sndr-state (~(get by peers.ames-state) sndr.packet)
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
=+ ^- [already-pending=? todos=pending-requests]
|
2019-05-28 06:15:17 +03:00
|
|
|
?~ sndr-state
|
2019-05-29 01:05:59 +03:00
|
|
|
[%.n *pending-requests]
|
2019-05-28 06:15:17 +03:00
|
|
|
[%.y ?>(?=(%alien -.u.sndr-state) +.u.sndr-state)]
|
|
|
|
::
|
|
|
|
=. rcv-packets.todos [[lane packet] rcv-packets.todos]
|
|
|
|
::
|
|
|
|
=. peers.ames-state
|
|
|
|
(~(put by peers.ames-state) sndr.packet %alien todos)
|
|
|
|
::
|
|
|
|
=? event-core !already-pending
|
|
|
|
(emit duct %pass /alien %j %pubs sndr.packet)
|
|
|
|
::
|
|
|
|
event-core
|
2019-05-28 05:43:47 +03:00
|
|
|
--
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
::
|
|
|
|
++ make-message-pump
|
|
|
|
|= [=message-pump-state =channel]
|
|
|
|
=| gifts=(list message-pump-gift)
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
|%
|
2019-05-29 05:56:05 +03:00
|
|
|
++ message-pump .
|
|
|
|
++ give |=(gift=message-pump-gift message-pump(gifts [gift gifts]))
|
|
|
|
++ packet-pump
|
|
|
|
(make-packet-pump packet-pump-state.message-pump-state channel)
|
|
|
|
:: +work: handle a $message-pump-task
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
++ work
|
|
|
|
|= task=message-pump-task
|
|
|
|
^+ [gifts message-pump-state]
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
=~ ?- -.task
|
|
|
|
%send (on-send message.task)
|
|
|
|
%hear-message-ack (on-hear-message-ack [message-num ok lag]:task)
|
|
|
|
* (run-packet-pump task)
|
|
|
|
==
|
|
|
|
feed-packets
|
|
|
|
(run-packet-pump %finalize ~)
|
|
|
|
[(flop gifts) message-pump-state]
|
|
|
|
==
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-send
|
|
|
|
|= =message
|
|
|
|
^+ message-pump
|
|
|
|
::
|
|
|
|
=. unsent-messages.message-pump-state
|
|
|
|
(~(put to unsent-messages.message-pump-state) message)
|
|
|
|
::
|
|
|
|
message-pump
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear-message-ack
|
|
|
|
|= [=message-num ok=? lag=@dr]
|
|
|
|
^+ message-pump
|
|
|
|
:: ignore acks on already-processed messages
|
|
|
|
::
|
|
|
|
?: (lth message-num current.message-pump-state)
|
|
|
|
message-pump
|
|
|
|
:: ignore duplicate already-processed acks waiting for emission
|
|
|
|
::
|
|
|
|
?: (~(has by queued-message-acks.message-pump-state) message-num)
|
|
|
|
message-pump
|
|
|
|
:: clear and print .unsent-fragments if nonempty
|
|
|
|
::
|
|
|
|
=? unsent-fragments.message-pump-state
|
|
|
|
::
|
|
|
|
?& =(current next):message-pump-state
|
|
|
|
?=(^ unsent-fragments.message-pump-state)
|
|
|
|
==
|
|
|
|
~& %early-message-ack^ok^her.channel
|
|
|
|
~
|
|
|
|
:: clear all packets from this message from the packet pump
|
|
|
|
::
|
|
|
|
=. message-pump (run-packet-pump %hear-message-ack message-num lag)
|
|
|
|
::
|
|
|
|
=. queued-message-acks.message-pump-state
|
|
|
|
(~(put by queued-message-acks.message-pump-state) message-num ok)
|
|
|
|
::
|
|
|
|
|- ^+ message-pump
|
|
|
|
::
|
|
|
|
=/ ack
|
|
|
|
%- ~(get by queued-message-acks.message-pump-state)
|
|
|
|
current.message-pump-state
|
|
|
|
::
|
|
|
|
?~ ack
|
|
|
|
message-pump
|
|
|
|
::
|
|
|
|
=. queued-message-acks.message-pump-state
|
|
|
|
%- ~(del by queued-message-acks.message-pump-state)
|
|
|
|
current.message-pump-state
|
|
|
|
::
|
|
|
|
=. message-pump (give %ack-message current.message-pump-state ok.u.ack)
|
|
|
|
::
|
|
|
|
$(current.message-pump-state +(current.message-pump-state))
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ feed-packets
|
|
|
|
:: if nothing to send, no-op
|
|
|
|
::
|
|
|
|
?: ?& =(~ unsent-messages.message-pump-state)
|
|
|
|
=(~ unsent-fragments.message-pump-state)
|
|
|
|
==
|
|
|
|
::
|
|
|
|
message-pump
|
|
|
|
:: we have unsent fragments of the current message; feed them
|
|
|
|
::
|
|
|
|
?. =(~ unsent-fragments.message-pump-state)
|
|
|
|
=/ res (send:packet-pump unsent-fragments.message-pump-state)
|
|
|
|
=+ [unsent packet-pump-gifts state]=res
|
|
|
|
::
|
|
|
|
=. unsent-fragments.message-pump-state unsent
|
|
|
|
=. packet-pump-state.message-pump-state state
|
|
|
|
::
|
|
|
|
=. message-pump (process-packet-pump-gifts packet-pump-gifts)
|
|
|
|
:: if it sent all of them, feed it more; otherwise, we're done
|
|
|
|
::
|
|
|
|
?~ unsent
|
|
|
|
feed-packets
|
|
|
|
message-pump
|
|
|
|
:: .unsent-messages is nonempty; pop a message off and feed it
|
|
|
|
::
|
|
|
|
=^ message unsent-messages.message-pump-state
|
|
|
|
~(get to unsent-messages.message-pump-state)
|
|
|
|
::
|
|
|
|
=. unsent-fragments.message-pump-state
|
|
|
|
::
|
|
|
|
=/ chunks (rip 13 (jam message))
|
|
|
|
=/ num-fragments=fragment-num (lent chunks)
|
|
|
|
=| counter=@
|
|
|
|
::
|
|
|
|
|- ^- (list static-fragment)
|
|
|
|
?~ chunks ~
|
|
|
|
::
|
|
|
|
:- [message-num=next.message-pump-state num-fragments counter i.chunks]
|
|
|
|
::
|
|
|
|
$(chunks t.chunks, counter +(counter))
|
|
|
|
::
|
|
|
|
=. next.message-pump-state +(next.message-pump-state)
|
|
|
|
feed-packets
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ run-packet-pump
|
|
|
|
|= =packet-pump-task
|
|
|
|
^+ message-pump
|
|
|
|
::
|
|
|
|
=^ packet-pump-gifts packet-pump-state.message-pump-state
|
|
|
|
(work:packet-pump packet-pump-task)
|
|
|
|
::
|
|
|
|
(process-packet-pump-gifts packet-pump-gifts)
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ process-packet-pump-gifts
|
|
|
|
|= packet-pump-gifts=(list packet-pump-gift)
|
|
|
|
^+ message-pump
|
|
|
|
::
|
|
|
|
?~ packet-pump-gifts
|
|
|
|
message-pump
|
|
|
|
=. message-pump (give i.packet-pump-gifts)
|
|
|
|
::
|
|
|
|
$(packet-pump-gifts t.packet-pump-gifts)
|
|
|
|
--
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ make-packet-pump
|
2019-06-01 05:03:09 +03:00
|
|
|
|= [state=packet-pump-state =channel]
|
2019-05-29 05:56:05 +03:00
|
|
|
=| gifts=(list packet-pump-gift)
|
|
|
|
|%
|
|
|
|
++ packet-pump .
|
2019-06-01 03:50:22 +03:00
|
|
|
++ give |=(packet-pump-gift packet-pump(gifts [+< gifts]))
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +packet-queue: all sent fragments, ordered by sequence number
|
|
|
|
::
|
|
|
|
++ packet-queue
|
|
|
|
%- (ordered-map live-packet-key live-packet-val)
|
|
|
|
|= [a=live-packet-key b=live-packet-key]
|
|
|
|
^- ?
|
|
|
|
::
|
|
|
|
?: (lth message-num.a message-num.b)
|
|
|
|
%.y
|
|
|
|
?: (gth message-num.a message-num.b)
|
|
|
|
%.n
|
|
|
|
(lte fragment-num.a fragment-num.b)
|
|
|
|
:: +gauge: inflate a |pump-gauge to track congestion control
|
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
++ gauge (make-pump-gauge now.channel metrics.state)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +work: handle $packet-pump-task request
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
++ work
|
|
|
|
|= task=packet-pump-task
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [gifts state]
|
2019-05-29 05:56:05 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=- [(flop gifts) state]
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
?- -.task
|
2019-05-29 05:56:05 +03:00
|
|
|
%hear-fragment-ack !!
|
|
|
|
%hear-message-ack (on-hear-message-ack message-num.task)
|
2019-05-29 01:05:59 +03:00
|
|
|
%wake on-wake
|
2019-05-29 05:56:05 +03:00
|
|
|
%finalize on-finalize
|
2019-05-29 01:05:59 +03:00
|
|
|
==
|
|
|
|
::
|
|
|
|
::
|
2019-06-01 01:35:06 +03:00
|
|
|
++ main
|
|
|
|
^+ packet-pump
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=- =. packet-pump core.-
|
|
|
|
=. live.state live.-
|
2019-06-01 03:50:22 +03:00
|
|
|
packet-pump
|
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [core=packet-pump live=live.state]
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
%- (traverse:packet-queue _packet-pump)
|
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
:^ live.state
|
2019-06-01 03:50:22 +03:00
|
|
|
start=~
|
|
|
|
acc=packet-pump
|
|
|
|
|= $: core=_packet-pump
|
|
|
|
key=live-packet-key
|
|
|
|
val=live-packet-val
|
|
|
|
==
|
|
|
|
^- [new-val=(unit live-packet-val) stop=? _packet-pump]
|
|
|
|
:: load mutant environment
|
|
|
|
::
|
|
|
|
=. packet-pump core
|
|
|
|
:: if we can't send any more packets, we're done
|
|
|
|
::
|
|
|
|
?. has-slot:gauge
|
|
|
|
[`val stop=%.y packet-pump]
|
|
|
|
:: if the packet hasn't expired, we're done
|
|
|
|
::
|
|
|
|
?: (gte expiry.val now.channel)
|
|
|
|
[`val stop=%.y packet-pump]
|
|
|
|
:: packet has expired, so re-send it
|
|
|
|
::
|
|
|
|
=/ =static-fragment
|
|
|
|
=> [key val]
|
|
|
|
[message-num num-fragments fragment-num fragment]
|
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
=. packet-pump (give %send static-fragment)
|
|
|
|
=. metrics.state (on-resent:gauge -.val)
|
2019-06-01 03:50:22 +03:00
|
|
|
:: update $sent-packet-state and continue
|
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
=. expiry.val (next-retry-expiry:gauge -.val)
|
2019-06-01 03:50:22 +03:00
|
|
|
=. sent-date.val now.channel
|
|
|
|
=. retried.val %.y
|
|
|
|
::
|
|
|
|
[`val stop=%.n packet-pump]
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +send: try to send a list of packets, returning unsent and effects
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
++ send
|
|
|
|
|= fragments=(list static-fragment)
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [fragments gifts state]
|
2019-06-01 06:05:21 +03:00
|
|
|
:: bite off as many fragments as we can send
|
|
|
|
::
|
|
|
|
=/ num-slots num-slots:gauge
|
|
|
|
=/ sent (scag num-slots fragments)
|
|
|
|
=/ unsent (slag num-slots fragments)
|
|
|
|
:: convert $static-fragment's into +ordered-set key-val pairs
|
|
|
|
::
|
|
|
|
=/ send-queue
|
|
|
|
%+ gas:packet-queue ~
|
|
|
|
%+ turn sent
|
|
|
|
|= static-fragment
|
|
|
|
^- [live-packet-key live-packet-val]
|
|
|
|
::
|
|
|
|
:- [message-num fragment-num]
|
|
|
|
::
|
|
|
|
:- ^- sent-packet-state
|
|
|
|
::
|
|
|
|
:+ expiry=next-expiry:gauge
|
|
|
|
sent-date=now.channel
|
|
|
|
retried=%.n
|
|
|
|
::
|
|
|
|
[num-fragments fragment]
|
|
|
|
:: send the packets, updating .live and .metrics
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
=. live.state (uni:packet-queue live.state send-queue)
|
|
|
|
=. metrics.state (on-sent:gauge num-slots)
|
|
|
|
=. gifts (flop (turn sent |*(* [%send +<])))
|
|
|
|
:: return unsent back to caller and reverse effects to finalize
|
|
|
|
::
|
|
|
|
[unsent gifts state]
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +on-hear-fragment-ack: handle ack on a live packet
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
2019-06-01 01:35:06 +03:00
|
|
|
++ on-hear-fragment-ack
|
|
|
|
|= [=message-num =fragment-num]
|
|
|
|
^+ packet-pump
|
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=- =. metrics.state metrics.-
|
|
|
|
=. live.state live.-
|
2019-06-01 03:50:22 +03:00
|
|
|
packet-pump
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
^+ [metrics=metrics live=live]:state
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
|
|
|
%- (traverse:packet-queue pump-metrics)
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
:^ live.state
|
2019-06-01 01:35:06 +03:00
|
|
|
start=~
|
2019-06-01 05:03:09 +03:00
|
|
|
acc=metrics.state
|
|
|
|
|= $: metrics=pump-metrics
|
2019-06-01 01:35:06 +03:00
|
|
|
key=live-packet-key
|
|
|
|
val=live-packet-val
|
|
|
|
==
|
2019-06-01 05:03:09 +03:00
|
|
|
^- [new-val=(unit live-packet-val) stop=? pump-metrics]
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
=/ gauge (make-pump-gauge now.channel metrics)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: is this the acked packet?
|
|
|
|
::
|
|
|
|
?: =(key [message-num fragment-num])
|
|
|
|
:: delete acked packet, update metrics, and stop traversal
|
|
|
|
::
|
|
|
|
:+ new-val=~
|
|
|
|
stop=%.y
|
2019-06-01 03:50:22 +03:00
|
|
|
(on-ack:gauge -.val)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: ack was out of order; mark expired, tell gauge, and continue
|
|
|
|
::
|
|
|
|
:+ new-val=`val(expiry `@da`0)
|
|
|
|
stop=%.n
|
2019-06-01 03:50:22 +03:00
|
|
|
(on-skipped-packet:gauge -.val)
|
2019-06-01 01:35:06 +03:00
|
|
|
:: +on-hear-message-ack: apply ack to all packets from .message-num
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
++ on-hear-message-ack
|
2019-05-29 05:56:05 +03:00
|
|
|
|= =message-num
|
|
|
|
^+ packet-pump
|
|
|
|
::
|
2019-05-29 01:05:59 +03:00
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
2019-05-29 05:56:05 +03:00
|
|
|
++ on-finalize
|
|
|
|
^+ packet-pump
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-wake
|
2019-05-29 05:56:05 +03:00
|
|
|
^+ packet-pump
|
2019-05-29 01:05:59 +03:00
|
|
|
::
|
|
|
|
!!
|
2019-06-01 01:35:06 +03:00
|
|
|
--
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +make-pump-gauge: construct |pump-gauge congestion control core
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
:: TODO: actual congestion control
|
|
|
|
::
|
2019-06-01 01:35:06 +03:00
|
|
|
++ make-pump-gauge
|
2019-06-01 05:03:09 +03:00
|
|
|
|= [now=@da pump-metrics]
|
|
|
|
=* metrics +<+
|
2019-06-01 01:35:06 +03:00
|
|
|
|%
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +next-expiry: when should a newly sent fresh packet time out?
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
++ next-expiry
|
|
|
|
^- @da
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 06:05:21 +03:00
|
|
|
(add now ~s2)
|
|
|
|
:: +next-retry-expiry: when should a resent packet time out?
|
|
|
|
::
|
|
|
|
++ next-retry-expiry
|
|
|
|
|= sent-packet-state
|
|
|
|
^- @da
|
2019-06-01 03:50:22 +03:00
|
|
|
(add now ~s10)
|
|
|
|
:: +has-slot: can we send a packet right now?
|
|
|
|
::
|
|
|
|
++ has-slot
|
|
|
|
^- ?
|
2019-06-01 06:05:21 +03:00
|
|
|
(gth num-slots 0)
|
|
|
|
:: +num-slots: how many packets can we send right now?
|
|
|
|
::
|
|
|
|
++ num-slots
|
|
|
|
^- @ud
|
|
|
|
?. (gth max-live num-live)
|
|
|
|
0
|
|
|
|
(sub max-live num-live)
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +on-skipped-packet: adjust metrics based on a misordered ack
|
|
|
|
::
|
|
|
|
:: TODO: decrease .max-live
|
|
|
|
::
|
|
|
|
++ on-skipped-packet
|
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics
|
2019-06-01 03:50:22 +03:00
|
|
|
:: +on-ack: adjust metrics based on a packet getting acknowledged
|
|
|
|
::
|
|
|
|
:: TODO: adjust .rtt and .max-live
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
|
|
|
++ on-ack
|
2019-06-01 03:50:22 +03:00
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
^- pump-metrics
|
2019-06-01 01:35:06 +03:00
|
|
|
::
|
2019-06-01 05:03:09 +03:00
|
|
|
metrics(num-live (dec num-live))
|
2019-06-01 06:05:21 +03:00
|
|
|
:: +on-sent: adjust metrics based on sending .num-sent fresh packets
|
2019-06-01 03:50:22 +03:00
|
|
|
::
|
|
|
|
++ on-sent
|
2019-06-01 06:05:21 +03:00
|
|
|
|= num-sent=@ud
|
|
|
|
^- pump-metrics
|
|
|
|
::
|
|
|
|
metrics(num-live (add num-sent num-live))
|
|
|
|
:: +on-resent: adjust metrics based on retrying an expired packet
|
|
|
|
::
|
|
|
|
++ on-resent
|
2019-06-01 03:50:22 +03:00
|
|
|
|= sent-packet-state
|
2019-06-01 05:03:09 +03:00
|
|
|
^- pump-metrics
|
|
|
|
metrics(num-live +(num-live))
|
2019-05-29 01:05:59 +03:00
|
|
|
--
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ make-message-still
|
|
|
|
|= [=message-still-state =channel]
|
|
|
|
=| gifts=(list message-still-gift)
|
|
|
|
|%
|
|
|
|
++ work
|
|
|
|
|= task=message-still-task
|
|
|
|
^+ [gifts message-still-state]
|
|
|
|
::
|
|
|
|
=- [(flop -.-) +.-]
|
|
|
|
::
|
|
|
|
?- -.task
|
|
|
|
%hear (on-hear [lane shut-packet]:task)
|
|
|
|
%done (on-done [message-num error]:task)
|
|
|
|
==
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-hear
|
|
|
|
|= [=lane =shut-packet]
|
|
|
|
^+ [gifts message-still-state]
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
::
|
|
|
|
::
|
|
|
|
++ on-done
|
|
|
|
|= [=message-num error=(unit error)]
|
|
|
|
^+ [gifts message-still-state]
|
|
|
|
::
|
|
|
|
!!
|
|
|
|
--
|
2019-05-28 06:59:53 +03:00
|
|
|
:: +encrypt: encrypt $shut-packet into atomic packet content
|
|
|
|
::
|
|
|
|
++ encrypt
|
|
|
|
|= [=symmetric-key plaintext=shut-packet]
|
|
|
|
^- @
|
|
|
|
::
|
|
|
|
(en:crub:crypto symmetric-key (jam plaintext))
|
|
|
|
:: +decrypt: decrypt packet content to a $shut-packet or die
|
|
|
|
::
|
|
|
|
++ decrypt
|
|
|
|
|= [=symmetric-key ciphertext=@]
|
|
|
|
^- shut-packet
|
|
|
|
::
|
|
|
|
;; shut-packet
|
|
|
|
%- cue
|
|
|
|
%- need
|
|
|
|
(de:crub:crypto symmetric-key ciphertext)
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +encode-packet: serialize a packet into a bytestream
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
++ encode-packet
|
|
|
|
|= packet
|
2019-05-25 08:53:29 +03:00
|
|
|
^- blob
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
2019-05-28 05:43:47 +03:00
|
|
|
=/ sndr-meta (encode-ship-metadata sndr)
|
|
|
|
=/ rcvr-meta (encode-ship-metadata rcvr)
|
2019-05-25 05:03:33 +03:00
|
|
|
:: body: <<sndr rcvr (jam [origin content])>>
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
:: The .sndr and .rcvr ship addresses are encoded with fixed
|
|
|
|
:: lengths specified by the packet header. They live outside
|
|
|
|
:: the jammed-data section to simplify packet filtering in the
|
|
|
|
:: interpreter.
|
|
|
|
::
|
2019-05-25 05:03:33 +03:00
|
|
|
=/ body=@
|
|
|
|
;: mix
|
2019-05-28 05:43:47 +03:00
|
|
|
sndr
|
|
|
|
(lsh 3 size.sndr-meta rcvr)
|
2019-05-25 05:03:33 +03:00
|
|
|
(lsh 3 (add size.sndr-meta size.rcvr-meta) (jam [origin content]))
|
|
|
|
==
|
|
|
|
:: header: 32-bit header assembled from bitstreams of fields
|
|
|
|
::
|
|
|
|
:: <<version checksum sndr-rank rcvr-rank encryption-type unused>>
|
|
|
|
:: 4 bits at the end of the header are unused.
|
|
|
|
::
|
2019-05-25 08:53:29 +03:00
|
|
|
=/ header=@
|
2019-05-25 05:03:33 +03:00
|
|
|
%+ can 0
|
|
|
|
:~ [3 protocol-version]
|
|
|
|
[20 (mug body)]
|
|
|
|
[2 rank.sndr-meta]
|
|
|
|
[2 rank.rcvr-meta]
|
|
|
|
[5 ?:(encrypted %0 %1)]
|
|
|
|
==
|
|
|
|
:: result is <<header body>>
|
|
|
|
::
|
|
|
|
(mix header (lsh 5 1 body))
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +decode-packet: deserialize packet from bytestream or crash
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
++ decode-packet
|
2019-05-25 08:53:29 +03:00
|
|
|
|= =blob
|
2019-05-25 05:03:33 +03:00
|
|
|
^- packet
|
|
|
|
:: first 32 (2^5) bits are header; the rest is body
|
|
|
|
::
|
|
|
|
=/ header (end 5 1 blob)
|
|
|
|
=/ body (rsh 5 1 blob)
|
|
|
|
::
|
|
|
|
=/ version (end 0 3 header)
|
|
|
|
=/ checksum (cut 0 [3 20] header)
|
|
|
|
=/ sndr-size (decode-ship-size (cut 0 [23 2] header))
|
|
|
|
=/ rcvr-size (decode-ship-size (cut 0 [25 2] header))
|
|
|
|
=/ encrypted ?+((cut 0 [27 5] header) !! %0 %.y, %1 %.n)
|
|
|
|
::
|
|
|
|
?> =(protocol-version version)
|
|
|
|
?> =(checksum (end 0 20 (mug body)))
|
|
|
|
::
|
|
|
|
=/ =dyad
|
|
|
|
:- sndr=(end 3 sndr-size body)
|
|
|
|
rcvr=(cut 3 [sndr-size rcvr-size] body)
|
|
|
|
::
|
|
|
|
=+ ;; [origin=(unit @uxlane) content=*]
|
|
|
|
%- cue
|
|
|
|
(rsh 3 (add rcvr-size sndr-size) body)
|
|
|
|
::
|
|
|
|
[dyad encrypted origin content]
|
|
|
|
:: +decode-ship-size: decode a 2-bit ship type specifier into a byte width
|
|
|
|
::
|
|
|
|
:: Type 0: galaxy or star -- 2 bytes
|
|
|
|
:: Type 1: planet -- 4 bytes
|
|
|
|
:: Type 2: moon -- 8 bytes
|
|
|
|
:: Type 3: comet -- 16 bytes
|
|
|
|
::
|
|
|
|
++ decode-ship-size
|
|
|
|
|= rank=@
|
|
|
|
^- @
|
|
|
|
::
|
|
|
|
?+ rank !!
|
|
|
|
%0 2
|
|
|
|
%1 4
|
|
|
|
%2 8
|
|
|
|
%3 16
|
|
|
|
==
|
2019-05-25 08:53:29 +03:00
|
|
|
:: +encode-ship-metadata: produce size (in bytes) and address rank for .ship
|
2019-05-25 05:03:33 +03:00
|
|
|
::
|
|
|
|
:: 0: galaxy or star
|
|
|
|
:: 1: planet
|
|
|
|
:: 2: moon
|
|
|
|
:: 3: comet
|
|
|
|
::
|
|
|
|
++ encode-ship-metadata
|
|
|
|
|= =ship
|
|
|
|
^- [size=@ =rank]
|
|
|
|
::
|
|
|
|
=/ size=@ (met 3 ship)
|
|
|
|
::
|
|
|
|
?: (lte size 2) [2 %0]
|
|
|
|
?: (lte size 4) [4 %1]
|
|
|
|
?: (lte size 8) [8 %2]
|
|
|
|
[16 %3]
|
|
|
|
--
|