:: protocol-version: current version of the ames wire protocol :: =/ protocol-version=?(%0 %1 %2 %3 %4 %5 %6 %7) %0 :: |% +| %generics :: $mk-item: constructor for +ordered-map item type :: +* 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 :: ?~(l %.y (compare key.n.a u.l)) :: 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) ?: (mor key.n.a key.n.l) a(l l) l(r a(l r.l)) :: item goes on right; recurse right then rebalance vertical order :: =/ r $(a r.a) ?> ?=(^ r) ?: (mor key.n.a key.n.r) 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 :: ?: |(?=(~ rest.l) (mor key.n.a key.n.rest.l)) a(l rest.l) rest.l(r a(r r.rest.l)) :: +nip: remove root; for internal use :: ++ 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 :: :: Mutates .state on each run of .f. Starts at .start key, or if :: .start is ~, starts at the head (item with smallest key). Stops :: 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 |* state=mold |= $: a=(tree item) =state f=$-([state item] [(unit val) ? state]) == ^+ [state a] :: acc: accumulator :: :: .stop: set to %.y by .f when done traversing :: .state: threaded through each run of .f and produced by +abet :: =/ acc [stop=`?`%.n state=state] =< abet =< main |% ++ abet [state.acc a] :: +main: main recursive loop; performs a partial inorder traversal :: ++ main ^+ . :: stop if empty or we've been told to stop :: ?~ a . ?: stop.acc . :: inorder traversal: left -> node -> right, until .f sets .stop :: => left ?: stop.acc . => node ?: stop.acc . right :: +node: run .f on .n.a, updating .a, .state, and .stop :: ++ node ^+ . :: run .f on node, updating .stop.acc and .state.acc :: =^ res acc ?> ?=(^ a) (f state.acc n.a) :: apply update to .a from .f's product :: =. 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) :: ..node :: +left: recurse on left subtree, copying mutant back into .l.a :: ++ left ^+ . ?~ a . =/ lef main(a l.a) lef(a a(l a.lef)) :: +right: recurse on right subtree, copying mutant back into .r.a :: ++ right ^+ . ?~ a . =/ rig main(a r.a) rig(a a(r a.rig)) -- :: +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)) :: +uni: unify two ordered maps :: :: .b takes precedence over .a if keys overlap. :: ++ 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) -- :: +| %atomics :: +$ address @uxaddress +$ blob @uxblob +$ bone @udbone +$ fragment @uwfragment +$ fragment-num @udfragmentnum +$ message-num @udmessagenum +$ private-key @uwprivatekey +$ public-key @uwpublickey +$ signature @uwsignature +$ 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 :: +$ rank ?(%0 %1 %2 %3) :: +| %kinetics :: :: $point: TODO move to jael :: +$ point $: =rift =life crypto-suite=@ud encryption-key=pass authentication-key=pass sponsor=(unit @p) == :: $diff-point: TODO move to jael :: +$ diff-point $% [%changed-continuity rift=@ud] $: %changed-keys =life crypto-suite=@ud continuity-number=@ud encryption-key=@ud == [%new-sponsor sponsor=(unit @p)] == :: $vent-result: TODO move to jael :: +$ vent-result $% [%full points=(map ship point)] [%diff =ship diff-point] == :: $channel: combined sender and receiver identifying data :: +$ channel $: [our=ship her=ship] now=@da :: our data, common to all dyads :: $: =our=life our-sponsor=ship crypto-core=acru:ames == :: her data, specific to this dyad :: $: =symmetric-key =her=life =her=public-key her-sponsor=ship == == :: $dyad: pair of sender and receiver ships :: +$ dyad [sndr=ship rcvr=ship] :: +$ error [tag=@tas =tang] :: $lane: ship transport address; either opaque $address or galaxy :: :: The runtime knows how to look up galaxies, so we don't need to :: know their transport addresses. :: +$ lane (each @pC address) :: $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. :: +$ packet [dyad encrypted=? origin=(unit lane) content=*] :: $open-packet: unencrypted packet payload, for comet self-attestation :: :: The .signature applies to all other fields in this data structure. :: +$ open-packet $: =signature =public-key sndr=ship =sndr=life rcvr=ship =rcvr=life == :: $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]) :: +| %statics :: :: $ames-state: state for entire vane :: +$ ames-state $: peers=(map ship ship-state) =unix=duct =life sponsor=ship 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 :: %known: we know their life and public keys, so we have a channel :: +$ ship-state $% [%alien pending-requests] [%known peer-state] == :: $pending-requests: what to do when we learn a peer's life and keys :: :: rcv-packets: packets we've received from unix :: snd-messages: messages local vanes have asked us to send :: +$ pending-requests $: rcv-packets=(list [=lane =packet]) snd-messages=(list [=duct =message]) snd-packets=(set =blob) == :: $peer-state: state for a peer with known life and keys :: :: 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 :: nack-trace, or an error when we've received a nack-trace 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+nack-trace, we remove the :: entry and emit a nack to the local vane that asked us to send :: the message. :: +$ peer-state $: $: =symmetric-key =life =public-key sponsor=ship == route=(unit [direct=? =lane]) =ossuary snd=(map bone message-pump-state) rcv=(map bone message-still-state) nax=(set [=bone =message-num]) == :: $ossuary: bone<->duct bijection and .next-bone to map to a duct :: :: The first bone is 0. They increment by 4, since each flow includes :: a bit for each message determining forward vs. backward and a :: second bit for whether the message is on the normal flow or the :: associated diagnostic flow (for nack-traces). :: +$ ossuary $: =next=bone by-duct=(map duct bone) by-bone=(map bone duct) == :: $message-pump-state: persistent state for |message-pump :: :: 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. :: :: 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. :: :: 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. :: :: 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 :: :: At the end of a task, |message-pump sends a %halt 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. :: :: Message sequence numbers start at 1 so the first message will be :: greater than .last-acked.message-still-state on the receiver. :: :: current: sequence number of earliest message sent or being sent :: next: sequence number of next message to send :: unsent-messages: messages to be sent after current message :: unsent-fragments: fragments of current message waiting for sending :: queued-message-acks: future message acks to be applied after current :: packet-pump-state: state of corresponding |packet-pump :: +$ message-pump-state $: current=_`message-num`1 next=_`message-num`1 unsent-messages=(qeu message) unsent-fragments=(list static-fragment) queued-message-acks=(map message-num ok=?) =packet-pump-state == :: $packet-pump-state: persistent state for |packet-pump :: :: next-wake: last timer we've set, or null :: live: packets in flight; sent but not yet acked :: lost: packets to retry, since they timed out with no ack :: metrics: congestion control information :: +$ packet-pump-state $: next-wake=(unit @da) live=(tree [live-packet-key live-packet-val]) metrics=pump-metrics == :: $pump-metrics: congestion control statistics for the |pump-gauge :: :: num-live: number of sent packets in flight :: num-lost: number of expired packets :: last-sent-at: last date at which we sent a packet :: last-dead-at: most recently packet expiry :: rtt: roundtrip time estimate :: max-live: current window size :: +$ pump-metrics $: num-live=@ud num-lost=@ud last-sent-at=@da last-dead-at=@da rtt=@dr max-live=_7 == +$ live-packet-key [=message-num =fragment-num] +$ live-packet-val $: sent-packet-state num-fragments=fragment-num =fragment == +$ sent-packet-state $: expiry=@da sent-date=@da retried=? == +$ static-fragment $: =message-num num-fragments=fragment-num =fragment-num =fragment == :: $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 :: +$ message-still-state $: last-acked=message-num last-heard=message-num pending-vane-ack=(qeu [=message-num =message]) live-messages=(map message-num partial-rcv-message) nax=(set message-num) == :: $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 :: +$ partial-rcv-message $: num-fragments=fragment-num num-received=fragment-num fragments=(map fragment-num fragment) == :: +| %dialectics :: :: $move: output effect; either request or response :: +$ move [=duct card=(wind note gift)] :: :: $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 :: %memo: request to send message :: +$ task $% [%born ~] [%crud =error] [%hear =lane =blob] [%hole =lane =blob] [%init =ship] [%vega ~] [%wegh ~] [%memo =ship =message] == :: $gift: effect from ames :: :: Ames extends Arvo's %pass/%give move semantics across the network. :: :: A "forward flow" message, which is like a request, is passed to :: Ames from a local vane. Ames transmits the message to the peer's :: Ames, which passes the message to the destination vane. :: :: Once the peer has processed the "forward flow" message, it sends a :: message acknowledgment over the wire back to the local Ames. This :: ack can either be positive or negative, in which case we call it a :: "nack". (Don't confuse Ames nacks with TCP nacks, which are a :: different concept). :: :: When the local Ames receives either a positive message ack or a :: combination of a nack and nack-trace (explained in more detail :: below), it gives an %done move to the local vane that had :: requested the original "forward flow" message be sent. :: :: A "backward flow" message, which is similar to a response or a :: subscription update, is given to Ames from a local vane. Ames :: transmits the message to the peer's Ames, which gives the message :: to the destination vane. :: :: Ames will give a %memo to a vane upon hearing the message from a :: remote. This message is a "backward flow" message, forming one of :: potentially many responses to a "forward flow" message that a :: local vane had passed to our local Ames, and which local Ames had :: relayed to the remote. Ames gives the %memo on the same duct the :: local vane had originally used to pass Ames the "forward flow" :: message. :: :: Backward flow messages are acked automatically by the receiver. :: They cannot be nacked, and Ames only uses the ack internally, :: without notifying the client vane. :: :: Forward flow messages can be nacked, in which case the peer will :: send both a message-nack packet and a nack-trace message, which is :: sent on a special diagnostic flow so as not to interfere with :: normal operation. The nack-trace is sent as a full Ames message, :: instead of just a packet, because the contained error information :: can be arbitrarily large. :: :: Once the local Ames has received the nack-trace, it knows the peer :: has received the full message and failed to process it. This :: means if we later hear an ack packet on the failed message, we can :: ignore it. :: :: Also, due to Ames's exactly-once delivery semantics, we know that :: when we receive a nack-trace for message n, we know the peer has :: positively acked all messages m+1 through n-1, where m is the last :: message for which we heard a nack-trace. If we haven't heard acks :: on all those messages, we apply positive acks when we hear the :: nack-trace. :: :: %memo: message to vane from peer :: %send: packet to unix :: %done: notify vane that peer (n)acked our message :: :: %mass: memory usage report :: %turf: domain report, relayed from jael :: +$ gift $% [%memo =message] [%send =lane =blob] [%done error=(unit error)] :: [%mass mass] [%turf turfs=(list turf)] == :: $note: request to other vane :: :: TODO: specialize gall interface for subscription management :: :: Ames passes a %memo note to another vane when it receives a :: message on a "forward flow" from a peer, originally passed from :: one of the peer's vanes to the peer's Ames. :: :: Ames passes a %memo to itself to trigger a heartbeat message to :: our sponsor. :: :: Ames passes a %private-keys to Jael to request our private keys. :: Ames passes a %public-keys to Jael to request a peer's public :: keys. :: +$ note $% $: %a $% [%memo sponsor=ship message=_[/a/ping ~]] == == $: %b $% [%wait date=@da] [%rest date=@da] == == $: %c $% [%memo =ship =message] == == $: %g $% [%memo =ship =message] == == $: %j $% [%memo =ship =message] :: [%private-keys ~] [%public-keys =ship] [%turf ~] == == == :: $sign: response from other vane :: :: A vane gives a %memo sign to Ames on a duct on which it had :: previously received a message on a "forward flow". Ames will :: transmit the message to the peer that had originally sent the :: message on the forward flow. The peer's Ames will then give the :: message to the remote vane from which the forward flow message :: originated. :: :: Ames gives a %done sign to itself when our sponsor acks a :: heartbeat message we sent it. This triggers a timer, which then :: triggers the next heartbeat message to be sent. :: +$ sign $% $: %a $% [%done error=(unit error)] == == $: %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] [%public-keys =vent-result] [%turf turfs=(list turf)] == == == :: $message-pump-task: job for |message-pump :: :: %memo: packetize and send application-level message :: %hear: handle receipt of ack on fragment or message :: %wake: handle timer firing :: +$ message-pump-task $% [%memo =message] [%hear =message-num =ack-meat] [%wake ~] == :: $message-pump-gift: effect from |message-pump :: :: %done: report message acknowledgment :: %send: emit message fragment :: %wait: set a new timer at .date :: %rest: cancel timer at .date :: +$ message-pump-gift $% [%done =message-num ok=?] [%send =static-fragment] [%wait date=@da] [%rest date=@da] == :: $packet-pump-task: job for |packet-pump :: :: %hear: deal with a packet acknowledgment :: %done: deal with message acknowledgment :: %halt: finish event, possibly updating timer :: %wake: handle timer firing :: +$ packet-pump-task $% [%hear =message-num =fragment-num] [%done =message-num lag=@dr] [%halt ~] [%wake ~] == :: $packet-pump-gift: effect from |packet-pump :: :: %send: emit message fragment :: %wait: set a new timer at .date :: %rest: cancel timer at .date :: +$ packet-pump-gift $% [%send =static-fragment] [%wait date=@da] [%rest date=@da] == :: $message-still-task: job for |message-still :: :: %done: receive confirmation from vane of processing or failure :: %drop: clear .message-num from .nax.state :: %hear: handle receiving a message fragment packet :: +$ message-still-task $% [%done ok=?] [%drop =message-num] [%hear =lane =shut-packet] == :: $message-still-gift: effect from |message-still :: :: %memo: $message assembled from received packets, :: to be sent to a local vane for processing :: %send: emit an ack packet :: +$ message-still-gift $% [%memo =message-num =message] [%send =message-num =ack-meat] == -- :: 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] :: =/ =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 on-born:event-core %crud !! %hear (on-hear:event-core [lane blob]:task) %hole !! %init (on-init:event-core ship.task) %vega on-vega:event-core %wegh on-wegh:event-core %memo (on-memo:event-core [ship message]:task) == :: [moves ames-gate] :: +take: handle response $sign :: ++ take |= [=wire =duct type=* =sign] ^- [(list move) _ames-gate] :: =/ event-core (per-event [our eny now scry-gate] duct ames-state) :: =^ moves ames-state =< abet ?- 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) [%j %turf *] (on-take-turf:event-core turfs.sign) == :: [moves 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)) :: [~ ~] -- :: helpers :: |% ++ per-event =| moves=(list move) |= [[our=ship eny=@ now=@da scry-gate=sley] =duct =ames-state] |% ++ event-core . ++ abet [(flop moves) ames-state] ++ emit |=(=move event-core(moves [move moves])) :: +on-take-done: handle notice from vane that it processed a message :: ++ on-take-done |= [=wire error=(unit error)] ^+ event-core :: ?: =(/ping wire) set-sponsor-heartbeat-timer :: =+ ^- [her=ship =bone] (parse-bone-wire wire) :: =/ =peer-state (got-peer-state her) =/ =channel [[our her] now +>.ames-state -.peer-state] =/ peer-core (make-peer-core peer-state channel) =/ ok=? ?=(~ error) :: send message (n)ack packet :: =. event-core abet:(run-message-still:peer-core bone %done ok) :: if positive ack, we're done :: ?: ok event-core :: send nack-trace message on designated bone :: =/ nack-trace-bone=^bone (mix 0b10 bone) =. peer-core (make-peer-core peer-state channel) :: abet:(run-message-pump:peer-core nack-trace-bone %memo /a/nax error) :: +on-hear: handle raw packet receipt :: ++ 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: handle mildly processed packet receipt :: ++ on-hear-packet |= [=lane =packet] ^+ event-core :: %. [lane packet] :: ?. =(our rcvr.packet) on-hear-forward :: ?: encrypted.packet on-hear-shut on-hear-open :: +on-hear-forward: maybe forward a packet to someone else :: :: TODO: filter for transitive closure of sponsors/sponsees. :: ++ on-hear-forward |= [=lane =packet] ^+ event-core :: =/ ship-state (~(get by peers.ames-state) rcvr.packet) :: ignore packets to unfamiliar ships :: ?. ?=([~ %known *] ship-state) event-core :: if we don't have a lane to .rcvr, give up :: ?~ rcvr-lane=route.+.u.ship-state event-core :: set .origin.packet, re-encode, and send :: =/ =blob (encode-packet packet(origin `lane)) :: (emit unix-duct.ames-state %give %send lane.u.rcvr-lane blob) :: +on-hear-open: handle receipt of plaintext comet self-attestation :: ++ on-hear-open |= [=lane =packet] ^+ event-core :: if we already know .sndr, ignore duplicate attestation :: =/ ship-state (~(get by peers.ames-state) sndr.packet) ?: ?=([~ %known *] ship-state) event-core :: =/ =open-packet ;;(open-packet packet) :: assert .our and .her and lives match :: ?> .= sndr.open-packet sndr.packet ?> .= rcvr.open-packet our ?> .= sndr-life.open-packet 1 ?> .= rcvr-life.open-packet life.ames-state :: no ghost comets allowed :: ?> (lte 256 (^sein:title sndr.packet)) :: comet public-key must hash to its @p address :: :: TODO how does this validation work elsewhere? :: ?> =(`@`sndr.packet `@`(shaf %pawn public-key.open-packet)) :: everything after .signature is signed :: :: TODO: should this double-cue instead of re-jamming? :: =/ signed=@ (jam +.open-packet) ?> (verify-signature signed [public-key signature]:open-packet) :: store comet as peer in our state :: =. peers.ames-state %+ ~(put by peers.ames-state) sndr.packet ^- ^ship-state :- %known =| =peer-state =/ our-private-key sec:ex:crypto-core.ames-state =/ =symmetric-key (derive-symmetric-key public-key.open-packet our-private-key) :: %_ peer-state symmetric-key symmetric-key life sndr-life.open-packet public-key public-key.open-packet sponsor (^sein:title sndr.packet) route `[direct=%.y lane] == :: event-core :: +on-hear-shut: handle receipt of encrypted packet :: ++ on-hear-shut |= [=lane =packet] ^+ event-core :: encrypted packet content must be an encrypted atom :: ?> ?=(@ content.packet) :: =/ sndr-state (~(get by peers.ames-state) sndr.packet) :: if we don't know them, enqueue the packet to be handled later :: ?. ?=([~ %known *] sndr-state) %+ enqueue-alien-todo sndr.packet |= todos=pending-requests todos(rcv-packets [[lane packet] rcv-packets.todos]) :: decrypt packet contents using symmetric-key.channel :: :: If we know them, we have a $channel with them, which we've :: populated with a .symmetric-key derived from our private key :: and their public key using elliptic curve Diffie-Hellman. :: =/ =peer-state +.u.sndr-state =/ =channel [[our sndr.packet] now +>.ames-state -.peer-state] =/ =shut-packet (decrypt symmetric-key.channel content.packet) :: ward against replay attacks :: :: We only accept packets from a ship at their known life, and to :: us at our current life. :: ?> =(sndr-life.shut-packet her-life.channel) ?> =(rcvr-life.shut-packet our-life.channel) :: set .lane as new route to peer since packet is valid :: =. route.peer-state `[direct=%.y lane] :: =/ peer-core (make-peer-core peer-state channel) abet:(on-hear-shut-packet:peer-core lane shut-packet) :: +on-take-memo: receive request to give message to peer :: ++ on-take-memo |= [=wire =message] ^+ event-core :: =+ ^- [her=ship =bone] (parse-bone-wire wire) :: =/ =peer-state (got-peer-state her) =/ =channel [[our her] now +>.ames-state -.peer-state] :: abet:(on-memo:(make-peer-core peer-state channel) bone message) :: +on-memo: handle request to send message :: ++ on-memo |= [=ship =message] ^+ event-core :: =/ ship-state (~(get by peers.ames-state) ship) :: ?. ?=([~ %known *] ship-state) %+ enqueue-alien-todo ship |= todos=pending-requests todos(snd-messages [[duct message] snd-messages.todos]) :: =/ =peer-state +.u.ship-state =/ =channel [[our ship] now +>.ames-state -.peer-state] :: =^ =bone ossuary.peer-state (get-bone ossuary.peer-state duct) :: abet:(on-memo:(make-peer-core peer-state channel) bone message) :: +on-take-wake: receive wakeup or error notification from behn :: ++ on-take-wake |= [=wire error=(unit tang)] ^+ event-core :: ?: =(/ping wire) ping-sponsor :: =+ ^- [her=ship =bone] (parse-pump-timer-wire wire) :: =/ =peer-state (got-peer-state her) =/ =channel [[our her] now +>.ames-state -.peer-state] :: abet:(on-wake:(make-peer-core peer-state channel) bone error) :: +on-init: first boot; subscribe to our info from jael :: ++ on-init |= our=ship ^+ event-core :: =~ (emit duct %pass /init/public-keys %j %public-keys our) (emit duct %pass /init/private-keys %j %private-keys ~) (emit duct %pass /init/turf %j %turf ~) == :: +on-priv: set our private key to jael's response :: ++ on-priv |= [=life =private-key] ^+ event-core :: =. life.ames-state life =. crypto-core.ames-state (nol:nu:crub:crypto private-key) :: recalculate each peer's symmetric key :: =/ our-private-key sec:ex:crypto-core.ames-state =. peers.ames-state %- ~(run by peers.ames-state) |= =ship-state ^+ ship-state :: ?. ?=(%known -.ship-state) ship-state :: =/ =peer-state +.ship-state =. symmetric-key.peer-state (derive-symmetric-key public-key.+.ship-state our-private-key) :: [%known peer-state] :: event-core :: +on-publ: update pki data for peer or self :: ++ on-publ |= [=wire =vent-result] ^+ event-core :: |^ ^+ event-core ?- vent-result [%diff @ %changed-continuity *] (on-publ-breach [ship rift]:vent-result) :: [%diff @ %changed-keys *] (on-publ-rekey [ship +>+]:vent-result) :: [%diff @ %new-sponsor *] (on-publ-sponsor [ship sponsor]:vent-result) :: [%full *] (on-publ-full points.vent-result) == :: +on-publ-breach: handle continuity breach of .ship; wipe its state :: :: Abandon all pretense of continuity and delete all state :: associated with .ship, including sent and unsent messages. :: :: TODO: cancel all timers? otherwise we'll get spurious firings :: from behn :: ++ on-publ-breach |= [=ship =rift] ^+ event-core :: =. peers.ames-state (~(del by peers.ames-state) ship) event-core :: +on-publ-rekey: handle new key for peer :: :: TODO: assert .crypto-suite compatibility :: ++ on-publ-rekey |= $: =ship =life crypto-suite=@ud continuity-number=@ud encryption-key=@ud == ^+ event-core :: (insert-peer-state ship (got-peer-state ship) life `@`encryption-key) :: +on-publ-sponsor: handle new or lost sponsor for self or peer :: :: TODO: handle sponsor loss :: ++ on-publ-sponsor |= [=ship sponsor=(unit ship)] ^+ event-core :: ?: =(our ship) =. sponsor.ames-state ship ping-sponsor :: =/ =peer-state (got-peer-state ship) :: ?~ sponsor ~| %lost-sponsor^ship !! :: =. sponsor.peer-state u.sponsor :: =. peers.ames-state (~(put by peers.ames-state) ship %known peer-state) event-core :: +on-publ-full: handle new pki data for peer(s) :: ++ on-publ-full |= points=(map ship point) ^+ event-core :: => .(points ~(tap by points)) |^ ^+ event-core ?~ points event-core :: =+ [ship point]=i.points :: =. event-core ?~ ship-state=(~(get by peers.ames-state) ship) (fresh-peer ship point) :: ?: ?=([~ %alien *] ship-state) (meet-alien ship point +.u.ship-state) (update-known ship point +.u.ship-state) :: $(points t.points) :: ++ fresh-peer |= [=ship =point] ^+ event-core :: (insert-peer-state ship *peer-state [life `@`encryption-key]:point) :: ++ meet-alien |= [=ship =point todos=pending-requests] ^+ event-core :: =. event-core (insert-peer-state ship *peer-state [life `@`encryption-key]:point) :: apply incoming packets :: =. event-core |- ^+ event-core ?~ rcv-packets.todos event-core :: =. event-core (on-hear-packet i.rcv-packets.todos) $(rcv-packets.todos t.rcv-packets.todos) :: we're a comet; send self-attestation packet first :: =? event-core =(%pawn (clan:title our)) (send-blob ship (attestation-packet ship life.point)) :: apply outgoing messages :: =. event-core |- ^+ event-core ?~ snd-messages.todos event-core :: =. event-core %- on-memo(duct duct.i.snd-messages.todos) [ship message.i.snd-messages.todos] :: $(snd-messages.todos t.snd-messages.todos) :: apply outgoing packet blobs :: =. event-core =/ blobs ~(tap in snd-packets.todos) |- ^+ event-core ?~ blobs event-core :: =. event-core (send-blob ship i.blobs) $(blobs t.blobs) :: event-core :: +attestation-packet: generate signed self-attestation for .her :: ++ attestation-packet |= [her=ship =her=life] ^- blob :: =/ signed=_+:*open-packet :* ^= public-key pub:ex:crypto-core.ames-state ^= sndr our ^= sndr-life life.ames-state ^= rcvr her ^= rcvr-life her-life == :: =/ =private-key sec:ex:crypto-core.ames-state =/ =signature (sign-open-packet private-key signed) =/ =open-packet [signature signed] =/ =packet [[our her] encrypted=%.n origin=~ open-packet] :: (encode-packet packet) :: ++ update-known |= [=ship =point =peer-state] ^+ event-core :: (insert-peer-state ship peer-state [life `@`encryption-key]:point) -- :: ++ insert-peer-state |= [=ship =peer-state =life =public-key] ^+ event-core :: =/ =private-key sec:ex:crypto-core.ames-state =/ =symmetric-key (derive-symmetric-key public-key private-key) :: =. life.peer-state life =. public-key.peer-state public-key =. symmetric-key.peer-state symmetric-key :: =. peers.ames-state (~(put by peers.ames-state) ship %known peer-state) :: event-core -- :: +on-take-turf: relay %turf move from jael to unix :: ++ on-take-turf |= turfs=(list turf) ^+ event-core :: (emit unix-duct.ames-state %give %turf turfs) :: +on-wegh: produce memory usage report :: ++ on-wegh ^+ event-core :: =+ [known alien]=(skid ~(tap by peers.ames-state) |=(^ =(%known +<-))) :: %- emit :^ duct %give %mass :+ %ames %| :~ peers-known+&+known peers-alien+&+alien dot+&+ames-state == :: +on-born: handle unix process restart :: +on-vega: handle kernel reload :: ++ on-born event-core ++ on-vega event-core :: +enqueue-alien-todo: helper to enqueue a pending request :: :: Also requests key and life from Jael on first request. :: On a comet, enqueues self-attestation packet on first request. :: ++ enqueue-alien-todo |= [=ship mutate=$-(pending-requests pending-requests)] ^+ event-core :: =/ ship-state (~(get by peers.ames-state) ship) :: create a default $pending-requests on first contact :: =+ ^- [already-pending=? todos=pending-requests] ?~ ship-state [%.n *pending-requests] [%.y ?>(?=(%alien -.u.ship-state) +.u.ship-state)] :: mutate .todos and apply to permanent state :: =. todos (mutate todos) =. peers.ames-state (~(put by peers.ames-state) ship %alien todos) :: ask jael for .sndr life and keys on first contact :: ?: already-pending event-core (emit duct %pass /alien %j %public-keys ship) :: +set-sponsor-heartbeat-timer: trigger sponsor ping after timeout :: ++ set-sponsor-heartbeat-timer ^+ event-core :: (emit duct %pass /ping %b %wait `@da`(add now ~m1)) :: +ping-sponsor: message our sponsor so they know our lane :: ++ ping-sponsor ^+ event-core :: (emit duct %pass /ping %a %memo sponsor.ames-state /a/ping ~) :: +send-blob: fire packet at .ship and maybe sponsors :: :: Send to .ship and sponsors until we find a direct lane. :: If we have no PKI data for a recipient, enqueue the packet and :: request the information from Jael if we haven't already. :: ++ send-blob |= [=ship =blob] ^+ event-core :: =/ ship-state (~(get by peers.ames-state) ship) :: ?. ?=([~ %known *] ship-state) %+ enqueue-alien-todo ship |= todos=pending-requests todos(snd-packets (~(put in snd-packets.todos) blob)) :: =/ =peer-state +.u.ship-state =/ =channel [[our ship] now +>.ames-state -.peer-state] :: =* try-next-sponsor ?: =(ship her-sponsor.channel) event-core $(ship her-sponsor.channel) :: ?~ route=route.peer-state try-next-sponsor :: =. event-core (emit unix-duct.ames-state %give %send lane.u.route blob) :: ?: direct.u.route event-core try-next-sponsor :: +got-peer-state: lookup .her state or crash :: ++ got-peer-state |= her=ship ^- peer-state :: ~| %freaky-alien^her =- ?>(?=(%known -<) ->) (~(got by peers.ames-state) her) :: +make-peer-core: create nested |peer-core for per-peer processing :: ++ make-peer-core |= [=peer-state =channel] |% ++ peer-core . ++ emit |=(move peer-core(event-core (^emit +<))) ++ abet ^+ event-core :: =. peers.ames-state (~(put by peers.ames-state) her.channel %known peer-state) :: event-core :: +on-hear-shut-packet: handle receipt of ack or message fragment :: ++ on-hear-shut-packet |= [=lane =shut-packet] ^+ peer-core :: =/ =bone bone.shut-packet :: ?: ?=(%& -.meat.shut-packet) (run-message-still bone %hear lane shut-packet) (run-message-pump bone %hear [message-num +.meat]:shut-packet) :: +on-memo: handle request to send message :: ++ on-memo |= [=bone =message] ^+ peer-core :: (run-message-pump bone %memo message) :: +on-wake: handle timer expiration :: ++ on-wake |= [=bone error=(unit tang)] ^+ peer-core :: TODO: handle error :: ?^ error !! :: expire direct route :: :: Since a packet's timer expired, mark the .lane.route as :: indirect. The next packets we emit will be sent to the :: receiver's sponsorship chain in case the receiver's :: transport address has changed and this lane is no longer :: valid. :: =. route.peer-state `[direct=%.n lane:(need route.peer-state)] :: (run-message-pump bone %wake ~) :: +run-message-pump: process $message-pump-task and its effects :: ++ run-message-pump |= [=bone task=message-pump-task] ^+ peer-core :: pass .task to the |message-pump and apply state mutations :: =/ =message-pump-state (fall (~(get by snd.peer-state) bone) *message-pump-state) :: =^ client-duct ossuary.peer-state (get-duct ossuary.peer-state bone duct) :: =/ message-pump (make-message-pump message-pump-state channel) =^ pump-gifts message-pump-state (work:message-pump task) =. snd.peer-state (~(put by snd.peer-state) bone message-pump-state) :: process effects from |message-pump :: |^ ^+ peer-core ?~ pump-gifts peer-core =* gift i.pump-gifts =. peer-core ?- -.gift %done (on-pump-done [message-num ok]:gift) %send (on-pump-send static-fragment.gift) %wait (on-pump-wait date.gift) %rest (on-pump-rest date.gift) == $(pump-gifts t.pump-gifts) :: +on-pump-done: handle |message-pump's report of message (n)ack :: ++ on-pump-done |= [=message-num ok=?] ^+ peer-core :: if odd bone, ack is on "subscription update" message; no-op :: ?: =(1 (end 0 1 bone)) peer-core :: even bone; is this bone a nack-trace bone? :: ?: =(1 (end 0 1 (rsh 0 1 bone))) :: nack-trace bone; assume .ok, clear nack from |message-still :: =/ target-bone=^bone (mix 0b10 bone) :: (run-message-still target-bone %drop message-num) :: not a nack-trace bone; positive ack gets emitted trivially :: ?: ok (emit client-duct %give %done error=~) :: nack; enqueue, pending nack-trace message :: =/ nax-key [bone message-num] :: sanity check :: :: The pump must never emit duplicate acks, and if we've :: heard the nack-trace, that should have cleared this :: message from the pump. :: ?< (~(has in nax.peer-state) nax-key) =. nax.peer-state (~(put in nax.peer-state) nax-key) :: peer-core :: +on-pump-send: emit ack packet requested by |message-pump :: ++ on-pump-send |= =static-fragment ^+ peer-core :: encrypt and encode .static-fragment to .blob bitstream :: %- send-shut-packet :* our-life.channel her-life.channel bone message-num.static-fragment %& +.static-fragment == :: +on-pump-wait: relay |message-pump's set-timer request :: ++ on-pump-wait |= date=@da ^+ peer-core :: =/ =wire (make-pump-timer-wire her.channel bone) (emit client-duct %pass wire %b %wait date) :: +on-pump-rest: relay |message-pump's unset-timer request :: ++ on-pump-rest |= date=@da ^+ peer-core :: =/ =wire (make-pump-timer-wire her.channel bone) (emit client-duct %pass wire %b %rest date) -- :: +run-message-still: process $message-still-task and its effects :: ++ run-message-still |= [=bone task=message-still-task] ^+ peer-core :: pass .task to the |message-still and apply state mutations :: =/ =message-still-state (fall (~(get by rcv.peer-state) bone) *message-still-state) :: =/ message-still (make-message-still message-still-state channel) =^ still-gifts message-still-state (work:message-still task) =. rcv.peer-state (~(put by rcv.peer-state) bone message-still-state) :: process effects from |message-still :: |^ ^+ peer-core ?~ still-gifts peer-core =* gift i.still-gifts =. peer-core ?- -.gift %send (on-still-send [message-num ack-meat]:gift) %memo (on-still-memo [message-num message]:gift) == $(still-gifts t.still-gifts) :: +on-still-send: emit ack packet as requested by |message-still :: ++ on-still-send |= [=message-num =ack-meat] ^+ peer-core :: %- send-shut-packet :* our-life.channel her-life.channel bone message-num %| ack-meat == :: +on-still-memo: handle message received by |message-still :: ++ on-still-memo |= [=message-num =message] ^+ peer-core :: ?> ?=([?(%a %c %g %j) *] path.message) :: odd .bone; "request" message to pass to vane before acking :: ?: =(1 (end 0 1 bone)) =/ =wire (make-bone-wire her.channel bone) :: /a/ping means sponsor ping timer; no-op :: ?: =(`path`/a/ping path.message) peer-core :: =^ client-duct ossuary.peer-state (get-duct ossuary.peer-state bone duct) :: ?- i.path.message %a ~| %bad-ames-message^path.message^her.channel !! %c (emit client-duct %pass wire %c %memo her.channel message) %g (emit client-duct %pass wire %g %memo her.channel message) %j (emit client-duct %pass wire %j %memo her.channel message) == :: even bone means backward flow; ack automatically :: :: Only messages from forward flows can be nacked. :: Note: reentrant. :: =. peer-core (run-message-still bone %done ok=%.y) :: is .bone a nack-trace flow? check the second bit :: ?: =(0 (end 0 1 (rsh 0 1 bone))) :: not a nack-trace; give message to local "subscriber" vane :: =/ client-duct (~(got by by-bone.ossuary.peer-state) bone) :: (emit client-duct %give %memo message) :: .bone is a nack-trace; validate message :: ?> =(/a/nax `path`path.message) =+ ;; [=target=^message-num =error] payload.message :: flip .bone's second bit to find referenced flow :: =/ target-bone=^bone (mix 0b10 bone) =/ nax-key [target-bone target-message-num] :: if we haven't heard a message nack, pretend we have :: :: The nack-trace message counts as a valid message nack on :: the original failed message. :: :: This prevents us from having to wait for a message nack :: packet, which would mean we couldn't immediately ack the :: nack-trace message, which would in turn violate the :: semantics of backward flows. :: =? peer-core !(~(has in nax.peer-state) nax-key) %- run-message-pump [target-bone %hear target-message-num %| ok=%.n lag=`@dr`0] :: clear the nack from our state and relay to vane :: =. nax.peer-state (~(del in nax.peer-state) nax-key) =/ target-duct (~(got by by-bone.ossuary.peer-state) target-bone) :: (emit target-duct %give %done `error) -- :: +send-shut-packet: fire encrypted packet at rcvr and maybe sponsors :: ++ send-shut-packet |= =shut-packet ^+ peer-core :: swizzle bone just before sending; TODO document :: =. bone.shut-packet (mix 1 bone.shut-packet) :: =/ content (encrypt symmetric-key.channel shut-packet) =/ =packet [[our her.channel] encrypted=%.y origin=~ content] =/ =blob (encode-packet packet) :: =. event-core (send-blob her.channel blob) peer-core -- -- :: +make-message-pump: constructor for |message-pump :: ++ make-message-pump |= [state=message-pump-state =channel] =| gifts=(list message-pump-gift) :: |% ++ message-pump . ++ give |=(gift=message-pump-gift message-pump(gifts [gift gifts])) ++ packet-pump (make-packet-pump packet-pump-state.state channel) :: +work: handle a $message-pump-task :: ++ work |= task=message-pump-task ^+ [gifts state] :: =~ (dispatch-task task) feed-packets (run-packet-pump %halt ~) [(flop gifts) state] == :: +dispatch-task: perform task-specific processing :: ++ dispatch-task |= task=message-pump-task ^+ message-pump :: ?- -.task %memo (on-memo message.task) %wake (run-packet-pump task) %hear ?- -.ack-meat.task %& (on-hear [message-num fragment-num=p.ack-meat]:task) %| (on-done [message-num [ok lag]:p.ack-meat]:task) == == :: +on-memo: handle request to send a message :: ++ on-memo |= =message ^+ message-pump :: =. unsent-messages.state (~(put to unsent-messages.state) message) message-pump :: +on-hear: handle packet acknowledgment :: ++ on-hear |= [=message-num =fragment-num] ^+ message-pump :: pass to |packet-pump unless duplicate or future ack :: ?. (is-message-num-in-range message-num) message-pump (run-packet-pump %hear message-num fragment-num) :: +on-done: handle message acknowledgment :: ++ on-done :: check-old: loop terminator variable :: =/ check-old=? %.y |= [=message-num ok=? lag=@dr] ^+ message-pump :: unsent messages from the future should never get acked :: ?> (lth message-num next.state) :: ignore duplicate message acks :: ?: (lth message-num current.state) message-pump :: future nack implies positive ack on all earlier messages :: ?: &(!ok check-old) |- ^+ message-pump :: base case: current message got nacked; handle same as ack :: ?: =(message-num current.state) ^$(check-old %.n) :: recursive case: future message got nacked :: =. message-pump ^$(ok %.y, message-num current.state) $ :: ignore duplicate and future acks :: ?. (is-message-num-in-range message-num) message-pump :: clear and print .unsent-fragments if nonempty :: =? unsent-fragments.state &(=(current next) ?=(^ unsent-fragments)):state :: ~& %early-message-ack^ok^her.channel ~ :: clear all packets from this message from the packet pump :: =. message-pump (run-packet-pump %done message-num lag) :: enqueue this ack to be sent back to local client vane :: =. queued-message-acks.state (~(put by queued-message-acks.state) message-num ok) :: emit local acks from .queued-message-acks until incomplete :: |- ^+ message-pump :: if .current hasn't been fully acked, we're done :: ?~ ack=(~(get by queued-message-acks.state) current.state) message-pump :: .current is complete; pop, emit local ack, and try next message :: =. queued-message-acks.state (~(del by queued-message-acks.state) current.state) :: =. message-pump (give %done current.state ok.u.ack) :: $(current.state +(current.state)) :: +is-message-num-in-range: %.y unless duplicate or future ack :: ++ is-message-num-in-range |= =message-num ^- ? :: ?: (gte message-num next.state) %.n ?: (lth message-num current.state) %.n !(~(has by queued-message-acks.state) message-num) :: +feed-packets: give packets to |packet-pump until full :: ++ feed-packets :: if nothing to send, no-op :: ?: &(=(~ unsent-messages) =(~ unsent-fragments)):state message-pump :: we have unsent fragments of the current message; feed them :: ?. =(~ unsent-fragments.state) =/ res (feed:packet-pump unsent-fragments.state) =+ [unsent packet-pump-gifts packet-pump-state]=res :: =. unsent-fragments.state unsent =. packet-pump-state.state packet-pump-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.state ~(get to unsent-messages.state) :: break .message into .chunks and set as .unsent-fragments :: =. unsent-fragments.state (split-message next.state message) :: try to feed packets from the next message :: =. next.state +(next.state) feed-packets :: +run-packet-pump: call +work:packet-pump and process results :: ++ run-packet-pump |= =packet-pump-task ^+ message-pump :: =^ packet-pump-gifts packet-pump-state.state (work:packet-pump packet-pump-task) :: (process-packet-pump-gifts packet-pump-gifts) :: +process-packet-pump-gifts: pass |packet-pump effects up the chain :: ++ 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: construct |packet-pump core :: ++ make-packet-pump |= [state=packet-pump-state =channel] =| gifts=(list packet-pump-gift) |% ++ packet-pump . ++ give |=(packet-pump-gift packet-pump(gifts [+< gifts])) :: +packet-queue: type for 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 :: ++ gauge (make-pump-gauge now.channel metrics.state) :: +work: handle $packet-pump-task request :: ++ work |= task=packet-pump-task ^+ [gifts state] :: =- [(flop gifts) state] :: ?- -.task %hear (on-hear [message-num fragment-num]:task) %done (on-done message-num.task) %wake resend-lost(next-wake.state ~) %halt set-wake == :: +resend-lost: resend as many lost packets as .gauge will allow :: ++ resend-lost ^+ packet-pump :: =- =. packet-pump core.- =. live.state live.- packet-pump :: acc: state to thread through traversal :: :: num-slots: start with max retries; decrement on each resend :: =| $= acc $: num-slots=_num-retry-slots:gauge core=_packet-pump == :: ^+ [acc live=live.state] :: %^ (traverse:packet-queue _acc) live.state acc |= $: acc=_acc key=live-packet-key val=live-packet-val == ^- [new-val=(unit live-packet-val) stop=? _acc] :: load mutant environment :: =. packet-pump core.acc :: if we can't send any more packets, we're done :: ?: =(0 num-slots.acc) [`val stop=%.y acc] :: if the packet hasn't expired, we're done :: ?: (gte expiry.val now.channel) [`val stop=%.y acc] :: packet has expired so re-send it :: =/ =static-fragment => [key val] [message-num num-fragments fragment-num fragment] :: =. packet-pump (give %send static-fragment) =. metrics.state (on-resent:gauge -.val) :: update $sent-packet-state in .val and continue :: =. expiry.val (next-retry-expiry:gauge -.val) =. sent-date.val now.channel =. retried.val %.y :: [`val stop=%.n (dec num-slots.acc) packet-pump] :: +feed: try to send a list of packets, returning unsent and effects :: ++ feed |= fragments=(list static-fragment) ^+ [fragments gifts state] :: return unsent back to caller and reverse effects to finalize :: =- [unsent (flop gifts) state] :: ^+ [unsent=fragments packet-pump] :: resend lost packets first, possibly adjusting congestion control :: =. packet-pump resend-lost :: bite off as many fragments as we can send :: =/ num-slots num-slots:gauge =/ sent (scag num-slots fragments) =/ unsent (slag num-slots fragments) :: :- unsent ^+ packet-pump :: if nothing to send, we're done :: ?~ sent packet-pump :: convert $static-fragment's into +ordered-set [key val] pairs :: =/ send-list %+ turn sent |= static-fragment ^- [key=live-packet-key val=live-packet-val] :: :- [message-num fragment-num] :- :+ expiry=next-expiry:gauge sent-date=now.channel retried=%.n [num-fragments fragment] :: update .live and .metrics :: =. live.state (gas:packet-queue live.state send-list) =. metrics.state (on-sent:gauge (lent send-list)) :: TMI :: => .(sent `(list static-fragment)`sent) :: emit a $packet-pump-gift for each packet to send :: |- ^+ packet-pump ?~ sent packet-pump =. packet-pump (give %send i.sent) $(sent t.sent) :: +on-hear: handle ack on a live packet :: :: Traverse .live from the head, marking packets as lost until we :: find the acked packet. Then delete the acked packet and try to :: resend lost packets. :: :: If we don't find the acked packet, no-op: no mutations, effects, :: or resending of lost packets. :: ++ on-hear |= [=message-num =fragment-num] ^+ packet-pump :: =- :: if no sent packet matches the ack, don't apply mutations or effects :: ?. found.- packet-pump :: =. metrics.state metrics.- =. live.state live.- :: resend-lost :: ^- $: [found=? metrics=pump-metrics] live=(tree [live-packet-key live-packet-val]) == :: =/ acc=[found=? metrics=pump-metrics] [%.n metrics.state] :: %^ (traverse:packet-queue _acc) live.state acc |= $: acc=_acc key=live-packet-key val=live-packet-val == ^- [new-val=(unit live-packet-val) stop=? _acc] :: =/ gauge (make-pump-gauge now.channel metrics.acc) :: is this the acked packet? :: ?: =(key [message-num fragment-num]) :: delete acked packet, update metrics, and stop traversal :: :+ new-val=~ stop=%.y [found=%.y metrics=(on-ack:gauge -.val)] :: ack was out of order; mark expired, tell gauge, and continue :: :+ new-val=`val(expiry `@da`0) stop=%.n [found=%.n metrics=(on-skipped-packet:gauge -.val)] :: +on-done: apply ack to all packets from .message-num :: ++ on-done |= =message-num ^+ packet-pump :: =- =. metrics.state metrics.- =. live.state live.- :: resend-lost :: ^- $: metrics=pump-metrics live=(tree [live-packet-key live-packet-val]) == :: %^ (traverse:packet-queue pump-metrics) live.state acc=metrics.state |= $: metrics=pump-metrics key=live-packet-key val=live-packet-val == ^- [new-val=(unit live-packet-val) stop=? pump-metrics] :: =/ gauge (make-pump-gauge now.channel metrics) :: if ack was out of order, mark expired and continue :: ?: (lth message-num.key message-num) :+ new-val=`val(expiry `@da`0) stop=%.n metrics=(on-skipped-packet:gauge -.val) :: if packet was from acked message, delete it and continue :: ?: =(message-num.key message-num) [new-val=~ stop=%.n metrics=(on-ack:gauge -.val)] :: we've gone past the acked message; we're done :: [new-val=`val stop=%.y metrics] :: +set-wake: set, unset, or reset timer, emitting moves :: ++ set-wake ^+ packet-pump :: if nonempty .live, peek at head to get next wake time :: =/ new-wake=(unit @da) ?~ head=(peek:packet-queue live.state) ~ `expiry.val.u.head :: no-op if no change :: ?: =(new-wake next-wake.state) packet-pump :: unset old timer if non-null :: =? packet-pump !=(~ next-wake.state) =/ old (need next-wake.state) =. next-wake.state ~ (give %rest old) :: set new timer if non-null :: =? packet-pump ?=(^ new-wake) =. next-wake.state new-wake (give %wait u.new-wake) :: packet-pump -- :: +make-pump-gauge: construct |pump-gauge congestion control core :: :: TODO: actual congestion control :: ++ make-pump-gauge |= [now=@da pump-metrics] =* metrics +<+ |% :: +next-expiry: when should a newly sent fresh packet time out? :: ++ next-expiry ^- @da :: (add now ~s5) :: +next-retry-expiry: when should a resent packet time out? :: ++ next-retry-expiry |= sent-packet-state ^- @da (add now ~s10) :: +has-slot: can we send a packet right now? :: ++ has-slot ^- ? (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) :: +num-retry-slots: how many lost packets can we resend right now? :: ++ num-retry-slots ^- @ud max-live :: +on-skipped-packet: adjust metrics based on a misordered ack :: :: TODO: decrease .max-live :: ++ on-skipped-packet |= sent-packet-state metrics :: +on-ack: adjust metrics based on a packet getting acknowledged :: :: TODO: adjust .rtt and .max-live :: ++ on-ack |= sent-packet-state ^- pump-metrics :: metrics(num-live (dec num-live)) :: +on-sent: adjust metrics based on sending .num-sent fresh packets :: ++ on-sent |= 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 |= sent-packet-state ^- pump-metrics metrics -- :: :: ++ make-message-still |= [state=message-still-state =channel] =| gifts=(list message-still-gift) |% ++ message-still . ++ give |=(message-still-gift message-still(gifts [+< gifts])) ++ work |= task=message-still-task ^+ [gifts state] :: =- [(flop gifts) state] :: ?- -.task %done (on-done ok.task) %drop (on-drop message-num.task) %hear (on-hear [lane shut-packet]:task) == :: +on-hear: receive message fragment, possibly completing message :: ++ on-hear |= [=lane =shut-packet] ^+ message-still :: we know this is a fragment, not an ack; expose into namespace :: ?> ?=(%& -.meat.shut-packet) =+ [num-fragments fragment-num fragment]=+.meat.shut-packet :: seq: message sequence number, for convenience :: =/ seq message-num.shut-packet :: ignore messages from far future; limit to 10 in progress :: ?: (gte seq (add 10 last-acked.state)) message-still :: =/ is-last-fragment=? =(+(fragment-num) num-fragments) :: always ack a dupe! :: ?: (lte seq last-acked.state) ?. is-last-fragment :: single packet ack :: (give %send seq %& fragment-num) :: whole message (n)ack :: =/ ok=? (~(has in nax.state) seq) (give %send seq %| ok lag=`@dr`0) :: last-acked (gth num-fragments.u.existing fragment-num) ?> =(num-fragments.u.existing num-fragments) :: u.existing :: =/ already-heard=? (~(has by fragments.partial-rcv-message) seq) :: ack dupes except for the last fragment, in which case drop :: ?: already-heard ?: is-last-fragment message-still (give %send seq %& fragment-num) :: new fragment; store in state and check if message is done :: =. num-received.partial-rcv-message +(num-received.partial-rcv-message) :: =. fragments.partial-rcv-message (~(put by fragments.partial-rcv-message) fragment-num fragment) :: =. live-messages.state (~(put by live-messages.state) seq partial-rcv-message) :: ack any packet other than the last one, and continue either way :: =? message-still !is-last-fragment (give %send seq %& fragment-num) :: enqueue all completed messages starting at +(last-heard.state) :: |- ^+ message-still :: if this is not the next message to ack, we're done :: ?. =(seq +(last-heard.state)) message-still :: if we haven't heard anything from this message, we're done :: ?~ live=(~(get by live-messages.state) seq) message-still :: if the message isn't done yet, we're done :: ?. =(num-received num-fragments):u.live message-still :: we have whole message; update state, assemble, and send to vane :: =. last-heard.state +(last-heard.state) =. live-messages.state (~(del by live-messages.state) seq) :: =/ =message (assemble-fragments [num-fragments fragments]:u.live) =. message-still (enqueue-to-vane seq message) :: $(seq +(seq)) :: +enqueue-to-vane: enqueue message to be sent to local vane :: ++ enqueue-to-vane |= [seq=message-num =message] ^+ message-still :: =/ empty=? =(~ pending-vane-ack.state) =. pending-vane-ack.state (~(put to pending-vane-ack.state) seq message) ?. empty message-still (give %memo seq message) :: +on-done: handle confirmation of message processing from vane :: ++ on-done |= ok=? ^+ message-still :: =^ pending pending-vane-ack.state ~(get to pending-vane-ack.state) =/ =message-num message-num.p.pending :: =. last-acked.state +(last-acked.state) =? nax.state !ok (~(put in nax.state) message-num) :: (give %send message-num %| ok lag=`@dr`0) :: +on-drop: drop .message-num from our .nax state :: ++ on-drop |= =message-num ^+ message-still :: =. nax.state (~(del in nax.state) message-num) :: message-still -- :: +split-message: split message into kilobyte-sized fragments :: ++ split-message |= [=message-num =message] ^- (list static-fragment) :: =/ fragments=(list fragment) (rip 13 (jam message)) =/ num-fragments=fragment-num (lent fragments) =| counter=@ :: |- ^- (list static-fragment) ?~ fragments ~ :: :- [message-num num-fragments counter i.fragments] :: $(fragments t.fragments, counter +(counter)) :: +assemble-fragments: concatenate fragments into a $message :: ++ assemble-fragments |= [num-fragments=fragment-num fragments=(map fragment-num fragment)] ^- message :: =| sorted=(list fragment) =. sorted =/ index=fragment-num 0 |- ^+ sorted ?: =(index num-fragments) sorted $(index +(index), sorted [(~(got by fragments) index) sorted]) :: ;; message %- cue %+ can 13 %+ turn (flop sorted) |=(a=@ [1 a]) :: +get-duct: find or make new duct for .bone in .ossuary :: ++ get-duct |= [=ossuary =bone =default=duct] ^+ [default-duct ossuary] :: ?^ existing=(~(get by by-bone.ossuary) bone) [u.existing ossuary] :: :- default-duct :+ next-bone.ossuary (~(put by by-duct.ossuary) default-duct bone) (~(put by by-bone.ossuary) bone default-duct) :: +get-bone: find or make new bone for .duct in .ossuary :: ++ get-bone |= [=ossuary =duct] ^+ [next-bone.ossuary ossuary] :: ?^ existing=(~(get by by-duct.ossuary) duct) [u.existing ossuary] :: :- next-bone.ossuary :+ (add 4 next-bone.ossuary) (~(put by by-duct.ossuary) duct next-bone.ossuary) (~(put by by-bone.ossuary) next-bone.ossuary duct) :: +make-bone-wire: encode ship and bone in wire for sending to vane :: ++ make-bone-wire |= [her=ship =bone] ^- wire :: /bone/(scot %p her)/(scot %ud bone) :: +parse-bone-wire: decode ship and bone from wire from local vane :: ++ parse-bone-wire |= =wire ^- [her=ship =bone] :: ?> ?=([%bone @ @ ~] wire) [`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)] :: +make-pump-timer-wire: construct wire for |packet-pump timer :: ++ make-pump-timer-wire |= [her=ship =bone] ^- wire /pump/(scot %p her)/(scot %ud bone) :: +parse-pump-timer-wire: parse .her and .bone from |packet-pump wire :: ++ parse-pump-timer-wire |= =wire ^- [her=ship =bone] :: ?> ?=([%pump @ @ ~] wire) [`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)] :: +sign-open-packet: sign the contents of an $open-packet :: ++ sign-open-packet |= [=private-key signed=_+:*open-packet] ^- signature :: (sign:ed:crypto private-key (jam signed)) :: +verify-signature: use .public-key to verify .signature on .content :: ++ verify-signature |= [content=@ =public-key =signature] ^- ? :: (veri:ed:crypto signature content public-key) :: +derive-symmetric-key: $symmetric-key from $private-key and $public-key :: :: Assumes keys have a tag on them like the result of the |ex:crub core. :: ++ derive-symmetric-key |= [=public-key =private-key] ^- symmetric-key :: ?> =('b' (end 3 1 public-key)) =. public-key (rsh 8 1 (rsh 3 1 public-key)) :: ?> =('B' (end 3 1 private-key)) =. private-key (rsh 8 1 (rsh 3 1 private-key)) :: `@`(shar:ed:crypto public-key private-key) :: +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) :: +encode-packet: serialize a packet into a bytestream :: ++ encode-packet |= packet ^- blob :: =/ sndr-meta (encode-ship-metadata sndr) =/ rcvr-meta (encode-ship-metadata rcvr) :: body: <> :: :: 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. :: =/ body=@ ;: mix sndr (lsh 3 size.sndr-meta rcvr) (lsh 3 (add size.sndr-meta size.rcvr-meta) (jam [origin content])) == :: header: 32-bit header assembled from bitstreams of fields :: :: <> :: 4 bits at the end of the header are unused. :: =/ header=@ %+ can 0 :~ [3 protocol-version] [20 (mug body)] [2 rank.sndr-meta] [2 rank.rcvr-meta] [5 ?:(encrypted %0 %1)] == :: result is <
> :: (mix header (lsh 5 1 body)) :: +decode-packet: deserialize packet from bytestream or crash :: ++ decode-packet |= =blob ^- 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 lane) 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 == :: +encode-ship-metadata: produce size (in bytes) and address rank for .ship :: :: 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] --