:: /sys/lull :: %lull: arvo structures !: => ..part ~% %lull ..part ~ |% ++ lull %325 :: :: :: :::: :: :: (1) models :: :: :: :: # %misc :: :: miscellaneous systems types ::+| :: +capped-queue: a +qeu with a maximum number of entries :: ++ capped-queue |$ [item-type] $: queue=(qeu item-type) size=@ud max-size=_64 == :: +clock: polymorphic cache type for use with the clock replacement algorithm :: :: The +by-clock core wraps interface arms for manipulating a mapping from :: :key-type to :val-type. Detailed docs for this type can be found there. :: ++ clock |$ :: key-type: mold of keys :: val-type: mold of values :: [key-type val-type] $: lookup=(map key-type [val=val-type fresh=@ud]) queue=(qeu key-type) size=@ud max-size=_2.048 depth=_1 == :: ++ welt ~/ %welt |* [a=(list) b=(list)] => .(a ^.(homo a), b ^.(homo b)) |- ^+ b ?~ a b $(a t.a, b [i.a b]) :: :: +afx: polymorphic node type for finger trees :: ++ afx |$ [val] $% [%1 p=val ~] [%2 p=val q=val ~] [%3 p=val q=val r=val ~] [%4 p=val q=val r=val s=val ~] == :: :: +pha: finger tree :: ++ pha |$ [val] $~ [%nul ~] $% [%nul ~] [%one p=val] [%big p=(afx val) q=(pha val) r=(afx val)] == :: ++ deq |* val=mold |% :: :: +| %utilities :: ++ make-afx |= ls=(list val) ?+ ls ~|(bad-finger/(lent ls) !!) [* ~] [%1 ls] [* * ~] [%2 ls] [* * * ~] [%3 ls] [* * * * ~] [%4 ls] == :: ++ wyt |= a=(pha val) ^- @ud ?- -.a %nul 0 %one 1 %big :(add (lent +.p.a) (lent +.r.a) $(a q.a)) == :: ++ afx-to-pha |= =(afx val) ^- (pha val) (apl *(pha val) +.afx) :: :: +| %left-biased-operations :: :: +pop-left: remove leftmost value from tree :: ++ pop-left |= a=(pha val) ^- [val=(unit val) pha=(pha val)] ?- -.a %nul ~^a :: %one [`p.a nul/~] :: %big [`p.p.a (big-left +.+.p.a q.a r.a)] == :: :: +peek-left: inspect leftmost value :: ++ peek-left |= a=(pha val) ^- (unit val) ?- -.a %nul ~ %one `p.a %big `p.p.a == :: ++ apl |= [a=(pha val) vals=(list val)] ^- (pha val) =. vals (flop vals) |- ?~ vals a $(a (cons a i.vals), vals t.vals) :: :: ++ dip-left |* state=mold |= $: a=(pha val) =state f=$-([state val] [(unit val) ? state]) == ^+ [state a] =/ acc [stop=`?`%.n state=state] =| new=(pha val) |- ?: stop.acc :: cat new and old [state.acc (weld a new)] =^ val=(unit val) a (pop-left a) ?~ val [state.acc new] =^ res=(unit ^val) acc (f state.acc u.val) ?~ res $ $(new (snoc new u.res)) :: ++ big-left |= [ls=(list val) a=(pha val) sf=(afx val)] ^- (pha val) ?. =(~ ls) [%big (make-afx ls) a sf] =/ [val=(unit val) inner=_a] (pop-left a) ?~ val (afx-to-pha sf) [%big [%1 u.val ~] inner sf] :: ++ cons =| b=(list val) |= [a=(pha val) c=val] ^- (pha val) =. b [c b] |- ?~ b a ?- -.a :: %nul $(a [%one i.b], b t.b) :: %one %= $ b t.b a [%big [%1 i.b ~] [%nul ~] [%1 p.a ~]] == :: %big ?. ?=(%4 -.p.a) %= $ b t.b :: a ?- -.p.a %1 big/[[%2 i.b p.p.a ~] q.a r.a] %2 big/[[%3 i.b p.p.a q.p.a ~] q.a r.a] %3 big/[[%4 i.b p.p.a q.p.a r.p.a ~] q.a r.a] == == =/ inner $(a q.a, b ~[s.p.a r.p.a q.p.a]) =. inner $(a inner, b t.b) big/[[%2 i.b p.p.a ~] inner r.a] == :: :: +| %right-biased-operations :: :: +snoc: append to end (right) of tree :: ++ snoc |= [a=(pha val) b=val] ^+ a ?- -.a %nul [%one b] :: %one :- %big :* [%1 p.a ~] [%nul ~] [%1 b ~] == :: %big ?- -.r.a :: %1 :- %big [p.a q.a [%2 p.r.a b ~]] :: %2 :- %big [p.a q.a [%3 p.r.a q.r.a b ~]] :: %3 :- %big [p.a q.a [%4 p.r.a q.r.a r.r.a b ~]] :: %4 =/ inner $(a q.a, b p.r.a) =. inner $(a inner, b q.r.a) =. inner $(a inner, b r.r.a) :- %big :* p.a inner [%2 s.r.a b ~] == == == :: +apr: append list to end (right) of tree :: ++ apr |= [a=(pha val) vals=(list val)] ^- (pha val) ?~ vals a $(a (snoc a i.vals), vals t.vals) :: :: +big-right: construct a tree, automatically balancing the right :: side ++ big-right |= [pf=(afx val) a=(pha val) ls=(list val)] ^- (pha val) ?. =(~ ls) [%big pf a (make-afx ls)] =/ [val=(unit val) inner=_a] (pop-right a) ?~ val (afx-to-pha pf) [%big pf inner [%1 u.val ~]] :: :: +pop-right: remove rightmost value from tree :: ++ pop-right |= a=(pha val) ^- [val=(unit val) pha=(pha val)] ?- -.a %nul ~^a :: %one [`p.a nul/~] :: %big =/ ls=(list val) +.r.a =^ item ls (flop ls) [`item (big-right p.a q.a (flop ls))] == :: ++ peek-right |= a=(pha val) ?- -.a %nul ~ %one `p.a %big (rear +.r.a) == :: :: +| %manipulation :: :: +weld: concatenate two trees :: :: O(log n) ++ weld =| c=(list val) |= [a=(pha val) b=(pha val)] ^- (pha val) ?- -.b %nul (apr a c) %one (snoc (apr a c) p.b) :: %big ?- -.a %nul (apl b c) %one (cons (apl b c) p.a) :: %big :- %big =- [p.a - r.b] $(a q.a, b q.b, c :(welp +.r.a c +.p.b)) == == :: +tap: transform tree to list :: ++ tap =| res=(list val) |= a=(pha val) !. |^ ^+ res ?- -.a %nul ~ %one ~[p.a] :: %big =/ fst=_res (tap-afx p.a) =/ lst=_res (tap-afx r.a) =/ mid=_res $(a q.a) :(welp fst mid lst) == ++ tap-afx |= ax=(afx val) ^+ res ?- -.ax %1 +.ax %2 +.ax %3 +.ax %4 +.ax == -- -- :: :: +mop: constructs and validates ordered ordered map based on key, :: val, and comparator gate :: ++ mop |* [key=mold value=mold] |= ord=$-([key key] ?) |= a=* =/ b ;;((tree [key=key val=value]) a) ?> (apt:((on key value) ord) b) b :: :: ++ ordered-map on :: +on: treap with user-specified horizontal order, ordered-map :: :: WARNING: ordered-map will not work properly if two keys can be :: unequal under noun equality but equal via the compare gate :: ++ on ~% %on ..part ~ |* [key=mold val=mold] => |% +$ item [key=key val=val] -- :: +compare: item comparator for horizontal order :: ~% %comp +>+ ~ |= compare=$-([key key] ?) ~% %core + ~ |% :: +all: apply logical AND boolean test on all values :: ++ all ~/ %all |= [a=(tree item) b=$-(item ?)] ^- ? |- ?~ a & ?&((b n.a) $(a l.a) $(a r.a)) :: +any: apply logical OR boolean test on all values :: ++ any ~/ %any |= [a=(tree item) b=$-(item ?)] |- ^- ? ?~ a | ?|((b n.a) $(a l.a) $(a r.a)) :: +apt: verify horizontal and vertical orderings :: ++ apt ~/ %apt |= a=(tree item) =| [l=(unit key) r=(unit key)] |- ^- ? :: 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))) == :: +bap: convert to list, right to left :: ++ bap ~/ %bap |= a=(tree item) ^- (list item) =| b=(list item) |- ^+ b ?~ a b $(a r.a, b [n.a $(a l.a)]) :: +del: delete .key from .a if it exists, producing value iff deleted :: ++ del ~/ %del |= [a=(tree item) =key] ^- [(unit val) (tree item)] ?~ a [~ ~] :: we found .key at the root; delete and rebalance :: ?: =(key key.n.a) [`val.n.a (nip a)] :: recurse left or right to find .key :: ?: (compare key key.n.a) =+ [found lef]=$(a l.a) [found a(l lef)] =+ [found rig]=$(a r.a) [found a(r rig)] :: +dip: stateful partial inorder traversal :: :: Mutates .state on each run of .f. Starts at .start key, or if :: .start is ~, starts at the head. Stops when .f produces .stop=%.y. :: Traverses from left to right keys. :: Each run of .f can replace an item's value or delete the item. :: ++ dip ~/ %dip |* 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 |% ++ this . ++ abet [state.acc a] :: +main: main recursive loop; performs a partial inorder traversal :: ++ main ^+ this :: stop if empty or we've been told to stop :: ?: =(~ a) this ?: stop.acc this :: inorder traversal: left -> node -> right, until .f sets .stop :: =. this left ?: stop.acc this =^ del this node =? this !stop.acc right =? a del (nip a) this :: +node: run .f on .n.a, updating .a, .state, and .stop :: ++ node ^+ [del=*? this] :: run .f on node, updating .stop.acc and .state.acc :: ?> ?=(^ a) =^ res acc (f state.acc n.a) ?~ res [del=& this] [del=| this(val.n.a u.res)] :: +left: recurse on left subtree, copying mutant back into .l.a :: ++ left ^+ this ?~ a this =/ lef main(a l.a) lef(a a(l a.lef)) :: +right: recurse on right subtree, copying mutant back into .r.a :: ++ right ^+ this ?~ a this =/ rig main(a r.a) rig(a a(r a.rig)) -- :: +gas: put a list of items :: ++ gas ~/ %gas |= [a=(tree item) b=(list item)] ^- (tree item) ?~ b a $(b t.b, a (put a i.b)) :: +get: get val at key or return ~ :: ++ get ~/ %get |= [a=(tree item) b=key] ^- (unit val) ?~ a ~ ?: =(b key.n.a) `val.n.a ?: (compare b key.n.a) $(a l.a) $(a r.a) :: +got: need value at key :: ++ got |= [a=(tree item) b=key] ^- val (need (get a b)) :: +has: check for key existence :: ++ has ~/ %has |= [a=(tree item) b=key] ^- ? !=(~ (get a b)) :: +lot: take a subset range excluding start and/or end and all elements :: outside the range :: ++ lot ~/ %lot |= $: tre=(tree item) start=(unit key) end=(unit key) == ^- (tree item) |^ ?: ?&(?=(~ start) ?=(~ end)) tre ?~ start (del-span tre %end end) ?~ end (del-span tre %start start) ?> (compare u.start u.end) =. tre (del-span tre %start start) (del-span tre %end end) :: ++ del-span |= [a=(tree item) b=?(%start %end) c=(unit key)] ^- (tree item) ?~ a a ?~ c a ?- b %start :: found key ?: =(key.n.a u.c) (nip a(l ~)) :: traverse to find key ?: (compare key.n.a u.c) :: found key to the left of start $(a (nip a(l ~))) :: found key to the right of start a(l $(a l.a)) :: %end :: found key ?: =(u.c key.n.a) (nip a(r ~)) :: traverse to find key ?: (compare key.n.a u.c) :: found key to the left of end a(r $(a r.a)) :: found key to the right of end $(a (nip a(r ~))) == -- :: +nip: remove root; for internal use :: ++ nip ~/ %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)) :: :: +pop: produce .head (leftmost item) and .rest or crash if empty :: ++ pop ~/ %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)) :: +pry: produce head (leftmost item) or null :: ++ pry ~/ %pry |= a=(tree item) ^- (unit item) ?~ a ~ |- ?~ l.a `n.a $(a l.a) :: +put: ordered item insert :: ++ put ~/ %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)) :: +ram: produce tail (rightmost item) or null :: ++ ram ~/ %ram |= a=(tree item) ^- (unit item) ?~ a ~ |- ?~ r.a `n.a $(a r.a) :: +run: apply gate to transform all values in place :: ++ run ~/ %run |* [a=(tree item) b=$-(val *)] |- ?~ a a [n=[key.n.a (b val.n.a)] l=$(a l.a) r=$(a r.a)] :: +tab: tabulate a subset excluding start element with a max count :: ++ tab ~/ %tab |= [a=(tree item) b=(unit key) c=@] ^- (list item) |^ (flop e:(tabulate (del-span a b) b c)) :: ++ tabulate |= [a=(tree item) b=(unit key) c=@] ^- [d=@ e=(list item)] ?: ?&(?=(~ b) =(c 0)) [0 ~] =| f=[d=@ e=(list item)] |- ^+ f ?: ?|(?=(~ a) =(d.f c)) f =. f $(a l.a) ?: =(d.f c) f =. f [+(d.f) [n.a e.f]] ?:(=(d.f c) f $(a r.a)) :: ++ del-span |= [a=(tree item) b=(unit key)] ^- (tree item) ?~ a a ?~ b a ?: =(key.n.a u.b) r.a ?: (compare key.n.a u.b) $(a r.a) a(l $(a l.a)) -- :: +tap: convert to list, left to right :: ++ tap ~/ %tap |= a=(tree item) ^- (list item) =| b=(list item) |- ^+ b ?~ a b $(a l.a, b [n.a $(a r.a)]) :: +uni: unify two ordered maps :: :: .b takes precedence over .a if keys overlap. :: ++ uni ~/ %uni |= [a=(tree item) b=(tree item)] ^- (tree item) ?~ b a ?~ a b ?: =(key.n.a key.n.b) [n=n.b l=$(a l.a, b l.b) r=$(a r.a, b r.b)] ?: (mor key.n.a key.n.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) ?: (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) -- :: +$ deco ?(~ %bl %br %un) :: text decoration +$ json :: normal json value $@ ~ :: null $% [%a p=(list json)] :: array [%b p=?] :: boolean [%o p=(map @t json)] :: object [%n p=@ta] :: number [%s p=@t] :: string == :: +$ life @ud :: ship key revision +$ rift @ud :: ship continuity +$ mime (pair mite octs) :: mimetyped data +$ octs (pair @ud @) :: octet-stream +$ sock (pair ship ship) :: outgoing [our his] +$ stub (list (pair stye (list @c))) :: styled unicode +$ stye (pair (set deco) (pair tint tint)) :: decos/bg/fg +$ styl %+ pair (unit deco) :: cascading style (pair (unit tint) (unit tint)) :: +$ styx (list $@(@t (pair styl styx))) :: styled text +$ tint $@ ?(%r %g %b %c %m %y %k %w %~) :: text color [r=@uxD g=@uxD b=@uxD] :: 24bit true color +$ turf (list @t) :: domain, tld first :: :::: :::: ++ethereum-types :: eth surs for jael :: :::: ++ ethereum-types |% :: ethereum address, 20 bytes. :: ++ address @ux :: event location :: +$ event-id [block=@ud log=@ud] :: ++ events (set event-id) -- :: :::: :::: ++azimuth-types :: az surs for jael :: :::: ++ azimuth-types =, ethereum-types |% ++ point $: :: ownership :: $= own $: owner=address management-proxy=address voting-proxy=address transfer-proxy=address == :: :: networking :: $= net %- unit $: =life =pass continuity-number=@ud sponsor=[has=? who=@p] escape=(unit @p) == :: :: spawning :: $= kid %- unit $: spawn-proxy=address spawned=(set @p) ::TODO sparse range, pile, see old jael ++py == == :: +$ dnses [pri=@t sec=@t ter=@t] :: ++ diff-azimuth $% [%point who=@p dif=diff-point] [%dns dnses] == :: ++ diff-point $% [%full new=point] :: [%owner new=address] :: OwnerChanged [%activated who=@p] :: Activated [%spawned who=@p] :: Spawned [%keys =life =pass] :: ChangedKeys [%continuity new=@ud] :: BrokeContinuity [%sponsor new=[has=? who=@p]] :: EscapeAcc/LostSpons [%escape new=(unit @p)] :: EscapeReq/Can [%management-proxy new=address] :: ChangedManagementPro [%voting-proxy new=address] :: ChangedVotingProxy [%spawn-proxy new=address] :: ChangedSpawnProxy [%transfer-proxy new=address] :: ChangedTransferProxy == -- :: +vane-task: general tasks shared across vanes :: +$ vane-task $~ [%born ~] $% :: i/o device replaced (reset state) :: [%born ~] :: boot completed (XX legacy) :: [%init ~] :: trim state (in response to memory pressure) :: [%trim p=@ud] :: kernel upgraded :: [%vega ~] :: receive message via %ames :: :: TODO: move .vane from $plea to here :: [%plea =ship =plea:ames] == :: :::: :::: ++http :: :: :::: :: http: shared representations of http concepts :: ++ http ^? |% :: +header-list: an ordered list of http headers :: +$ header-list (list [key=@t value=@t]) :: +method: exhaustive list of http verbs :: +$ method $? %'CONNECT' %'DELETE' %'GET' %'HEAD' %'OPTIONS' %'POST' %'PUT' %'TRACE' == :: +request: a single http request :: +$ request $: :: method: http method :: method=method :: url: the url requested :: :: The url is not escaped. There is no escape. :: url=@t :: header-list: headers to pass with this request :: =header-list :: body: optionally, data to send with this request :: body=(unit octs) == :: +response-header: the status code and header list on an http request :: :: We separate these away from the body data because we may not wait for :: the entire body before we send a %progress to the caller. :: +$ response-header $: :: status: http status code :: status-code=@ud :: headers: http headers :: headers=header-list == :: +http-event: packetized http :: :: Urbit treats Earth's HTTP servers as pipes, where Urbit sends or :: receives one or more %http-events. The first of these will always be a :: %start or an %error, and the last will always be %cancel or will have :: :complete set to %.y to finish the connection. :: :: Calculation of control headers such as 'Content-Length' or :: 'Transfer-Encoding' should be performed at a higher level; this structure :: is merely for what gets sent to or received from Earth. :: +$ http-event $% :: %start: the first packet in a response :: $: %start :: response-header: first event information :: =response-header :: data: data to pass to the pipe :: data=(unit octs) :: whether this completes the request :: complete=? == :: %continue: every subsequent packet :: $: %continue :: data: data to pass to the pipe :: data=(unit octs) :: complete: whether this completes the request :: complete=? == :: %cancel: represents unsuccessful termination :: [%cancel ~] == :: +get-header: returns the value for :header, if it exists in :header-list :: ++ get-header |= [header=@t =header-list] ^- (unit @t) :: ?~ header-list ~ :: ?: =(key.i.header-list header) `value.i.header-list :: $(header-list t.header-list) :: +set-header: sets the value of an item in the header list :: :: This adds to the end if it doesn't exist. :: ++ set-header |= [header=@t value=@t =header-list] ^- ^header-list :: ?~ header-list :: we didn't encounter the value, add it to the end :: [[header value] ~] :: ?: =(key.i.header-list header) [[header value] t.header-list] :: [i.header-list $(header-list t.header-list)] :: +delete-header: removes the first instance of a header from the list :: ++ delete-header |= [header=@t =header-list] ^- ^header-list :: ?~ header-list ~ :: if we see it in the list, remove it :: ?: =(key.i.header-list header) t.header-list :: [i.header-list $(header-list t.header-list)] :: +unpack-header: parse header field values :: ++ unpack-header |^ |= value=@t ^- (unit (list (map @t @t))) (rust (cass (trip value)) values) :: ++ values %+ more (ifix [. .]:(star ;~(pose ace (just '\09'))) com) pairs :: ++ pairs %+ cook ~(gas by *(map @t @t)) %+ most (ifix [. .]:(star ace) mic) ;~(plug token ;~(pose ;~(pfix tis value) (easy ''))) :: ++ value ;~(pose token quoted-string) :: ++ token :: 7230 token %+ cook crip ::NOTE this is ptok:de-purl:html, but can't access that here %- plus ;~ pose aln zap hax buc cen pam soq tar lus hep dot ket cab tic bar sig == :: ++ quoted-string :: 7230 quoted string %+ cook crip %+ ifix [. .]:;~(less (jest '\\"') doq) %- star ;~ pose ;~(pfix bas ;~(pose (just '\09') ace prn)) ;~(pose (just '\09') ;~(less (mask "\22\5c\7f") (shim 0x20 0xff))) == -- :: +simple-payload: a simple, one event response used for generators :: +$ simple-payload $: :: response-header: status code, etc :: =response-header :: data: the data returned as the body :: data=(unit octs) == -- :: :::: :::: ++ames :: (1a) network :: :::: ++ ames ^? |% :: $task: job for ames :: :: Messaging Tasks :: :: %hear: packet from unix :: %heed: track peer's responsiveness; gives %clog if slow :: %jilt: stop tracking peer's responsiveness :: %cork: request to delete message flow :: %kroc: request to delete stale message flows :: %plea: request to send message :: :: Remote Scry Tasks :: :: %keen: peek: [ship /vane/care/case/spur] :: %yawn: cancel request from arvo :: %wham: cancels all scry request from any vane :: :: System and Lifecycle Tasks :: :: %born: process restart notification :: %init: vane boot :: %prod: re-send a packet per flow, to all peers if .ships is ~ :: %sift: limit verbosity to .ships :: %snub: set packet blocklist to .ships :: %spew: set verbosity toggles :: %cong: adjust congestion control parameters :: %stir: recover from timer desync :: %trim: release memory :: %vega: kernel reload notification :: +$ task $% [%hear =lane =blob] [%heed =ship] [%jilt =ship] [%cork =ship] [%kroc dry=?] $>(%plea vane-task) :: [%keen =ship =path] [%yawn =ship =path] [%wham =ship =path] :: $>(%born vane-task) $>(%init vane-task) [%prod ships=(list ship)] [%sift ships=(list ship)] [%snub form=?(%allow %deny) ships=(list ship)] [%spew veb=(list verb)] [%cong msg=@ud mem=@ud] [%stir arg=@t] $>(%trim vane-task) $>(%vega vane-task) == :: $gift: effect from ames :: :: Messaging Gifts :: :: %boon: response message from remote ship :: %clog: notify vane that %boon's to peer are backing up locally :: %done: notify vane that peer (n)acked our message :: %lost: notify vane that we crashed on %boon :: %send: packet to unix :: :: Remote Scry Gifts :: :: %tune: peek result :: %miss: peek dropped :: :: System and Lifecycle Gifts :: :: %turf: domain report, relayed from jael :: +$ gift $% [%boon payload=*] [%clog =ship] [%done error=(unit error)] [%lost ~] [%send =lane =blob] :: [%tune [=ship =path] roar=(unit roar)] [%miss =ship =path] :: [%turf turfs=(list turf)] == :: :::: :: (1a2) :: ++ acru $_ ^? :: asym cryptosuite |% :: opaque object ++ as ^? :: asym ops |% ++ seal |~([a=pass b=@] *@) :: encrypt to a ++ sign |~(a=@ *@) :: certify as us ++ sigh |~(a=@ *@) :: certification only ++ sure |~(a=@ *(unit @)) :: authenticate from us ++ safe |~([a=@ b=@] *?) :: authentication only ++ tear |~([a=pass b=@] *(unit @)) :: accept from a -- ::as :: ++ de |~([a=@ b=@] *(unit @)) :: symmetric de, soft ++ dy |~([a=@ b=@] *@) :: symmetric de, hard ++ en |~([a=@ b=@] *@) :: symmetric en ++ ex ^? :: export |% ++ fig *@uvH :: fingerprint ++ pac *@uvG :: default passcode ++ pub *pass :: public key ++ sec *ring :: private key -- ::ex :: ++ nu ^? :: reconstructors |% ++ pit |~([a=@ b=@] ^?(..nu)) :: from [width seed] ++ nol |~(a=ring ^?(..nu)) :: from ring ++ com |~(a=pass ^?(..nu)) :: from pass -- ::nu :: -- ::acru :: :: +protocol-version: current version of the ames wire protocol :: ++ protocol-version `?(%0 %1 %2 %3 %4 %5 %6 %7)`%0 :: $address: opaque atomic transport address to or from unix :: +$ address @uxaddress :: $verb: verbosity flag for ames :: +$ verb ?(%snd %rcv %odd %msg %ges %for %rot %kay %fin) :: $blob: raw atom to or from unix, representing a packet :: +$ blob @uxblob :: $error: tagged diagnostic trace :: +$ 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) :: $plea: application-level message, as a %pass :: :: vane: destination vane on remote ship :: path: internal route on the receiving ship :: payload: semantic message contents :: +$ plea [vane=@tas =path payload=*] :: :: +| %atomics :: +$ bone @udbone +$ fragment @uwfragment +$ fragment-num @udfragmentnum +$ message-blob @udmessageblob +$ message-num @udmessagenum +$ public-key @uwpublickey +$ symmetric-key @uwsymmetrickey :: +$ hoot @uxhoot :: request packet +$ purr @uxpurr :: response packet +$ hunk [lop=@ len=@] :: range specifier :: :: +| %kinetics :: $dyad: pair of sender and receiver ships :: +$ dyad [sndr=ship rcvr=ship] :: $shot: 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. :: :: req: is a request :: sam: is using the ames protocol (not fine or another protocol) :: +$ shot $: dyad req=? sam=? sndr-tick=@ubC rcvr-tick=@ubC origin=(unit @uxaddress) content=@uxcontent == :: $ack: positive ack, nack packet, or nack trace :: +$ ack $% [%ok ~] [%nack ~] [%naxplanation =error] == :: :: +| %statics :: $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 alien-agenda] [%known peer-state] == :: $alien-agenda: what to do when we learn a peer's life and keys :: :: messages: pleas local vanes have asked us to send :: packets: packets we've tried to send :: heeds: local tracking requests; passed through into $peer-state :: +$ alien-agenda $: messages=(list [=duct =plea]) packets=(set =blob) heeds=(set duct) keens=(jug path duct) == :: $peer-state: state for a peer with known life and keys :: :: route: transport-layer destination for packets to peer :: qos: quality of service; connection status to peer :: ossuary: bone<->duct mapper :: snd: per-bone message pumps to send messages as fragments :: rcv: per-bone message sinks 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. :: heeds: listeners for %clog notifications :: closing: bones closed on the sender side :: corked: bones closed on both sender and receiver :: +$ peer-state $: $: =symmetric-key =life =rift =public-key sponsor=ship == route=(unit [direct=? =lane]) =qos =ossuary snd=(map bone message-pump-state) rcv=(map bone message-sink-state) nax=(set [=bone =message-num]) heeds=(set duct) closing=(set bone) corked=(set bone) keens=(map path keen-state) == +$ keen-state $: wan=(pha want) :: request packets, sent nex=(list want) :: request packets, unsent hav=(list have) :: response packets, backward num-fragments=@ud num-received=@ud next-wake=(unit @da) listeners=(set duct) metrics=pump-metrics == +$ want $: fra=@ud =hoot packet-state == +$ have $: fra=@ud meow == +$ meow :: response packet $: sig=@ux :: signature num=@ud :: number of fragments siz=@ud :: official size of this fragment dat=@ux :: contents == +$ peep :: request data $: =path num=@ud == +$ keen :: signed request $: signature=@ peep == +$ roar :: response message (tale:pki:jael (pair path (unit (cask)))) ::: :: $qos: quality of service; how is our connection to a peer doing? :: :: .last-contact: last time we heard from peer, or if %unborn, when :: we first started tracking time :: +$ qos $~ [%unborn *@da] [?(%live %dead %unborn) last-contact=@da] :: $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 naxplanations). :: :: The least significant bit of a $bone is: :: 1 if "forward", i.e. we send %plea's on this flow, or :: 0 if "backward", i.e. we receive %plea's on this flow. :: :: The second-least significant bit is 1 if the bone is a :: naxplanation bone, and 0 otherwise. Only naxplanation :: messages can be sent on a naxplanation bone, as %boon's. :: +$ 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, which sends every packet it eats. :: Packets rejected by |packet-pump are placed in .unsent-fragments. :: :: When we hear a packet ack, we send it to |packet-pump to be :: removed from its queue of unacked packets. :: :: 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 this ack is for a future message and .current has :: not yet been acked, so we place the ack in .queued-message-acks. :: :: If we hear a message ack before we've sent all the fragments for :: that message, clear .unsent-fragments and have |packet-pump delete :: all sent fragments from the message. If this early message ack was :: positive, print it out because it indicates the peer is not :: behaving properly. :: :: If the ack is for the current message, have |packet-pump delete :: all packets from the message, give the message ack back :: to the client vane, 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. :: :: 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 the timer fires, it will :: generally cause a packet to be re-sent. :: :: Message sequence numbers start at 1 so that the first message will :: be greater than .last-acked.message-sink-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-blob) unsent-fragments=(list static-fragment) queued-message-acks=(map message-num ack) =packet-pump-state == +$ static-fragment $: =message-num num-fragments=fragment-num =fragment-num =fragment == :: $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 :: 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 state for a |packet-pump :: :: This is an Ames adaptation of TCP's Reno congestion control :: algorithm. The information signals and their responses are :: identical to those of the "NewReno" variant of Reno; the :: implementation differs because Ames acknowledgments differ from :: TCP's, because this code uses functional data structures, and :: because TCP's sequence numbers reset when a peer becomes :: unresponsive, whereas Ames sequence numbers only change when a :: ship breaches. :: :: A deviation from Reno is +fast-resend-after-ack, which re-sends :: timed-out packets when a peer starts responding again after a :: period of unresponsiveness. :: :: If .skips reaches 3, we perform a fast retransmit and fast :: recovery. This corresponds to Reno's handling of "three duplicate :: acks". :: :: rto: retransmission timeout :: rtt: roundtrip time estimate, low-passed using EWMA :: rttvar: mean deviation of .rtt, also low-passed with EWMA :: num-live: how many packets sent, awaiting ack :: ssthresh: slow-start threshold :: cwnd: congestion window; max unacked packets :: +$ pump-metrics $: rto=_~s1 rtt=_~s1 rttvar=_~s1 ssthresh=_10.000 cwnd=_1 num-live=@ud counter=@ud == +$ live-packet $: key=live-packet-key val=live-packet-val == +$ live-packet-key $: =message-num =fragment-num == +$ live-packet-val $: packet-state num-fragments=fragment-num =fragment == +$ packet-state $: last-sent=@da tries=_1 skips=@ud == :: $message-sink-state: state of |message-sink 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-sink-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) == :: $rank: which kind of ship address, by length :: :: 0b0: galaxy or star -- 2 bytes :: 0b1: planet -- 4 bytes :: 0b10: moon -- 8 bytes :: 0b11: comet -- 16 bytes :: +$ rank ?(%0b0 %0b1 %0b10 %0b11) :: :: +| %coding :: +sift-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 :: ++ sift-ship-size |= rank=@ubC ^- @ :: ?+ rank !! %0b0 2 %0b1 4 %0b10 8 %0b11 16 == :: +is-valid-rank: does .ship match its stated .size? :: ++ is-valid-rank |= [=ship size=@ubC] ^- ? .= size =/ wid (met 3 ship) ?: (lte wid 1) 2 ?: =(2 wid) 2 ?: (lte wid 4) 4 ?: (lte wid 8) 8 ?> (lte wid 16) 16 :: +sift-shot: deserialize packet from bytestream or crash :: ++ sift-shot |= =blob ^- shot ~| %sift-shot-fail :: first 32 (2^5) bits are header; the rest is body :: =/ header (end 5 blob) =/ body (rsh 5 blob) :: read header; first two bits are reserved :: =/ req =(& (cut 0 [2 1] header)) =/ sam =(& (cut 0 [3 1] header)) :: =/ version (cut 0 [4 3] header) ?. =(protocol-version version) ~& [%ames-protocol-version protocol-version version] ~| ames-protocol-version+version !! :: =/ sndr-size (sift-ship-size (cut 0 [7 2] header)) =/ rcvr-size (sift-ship-size (cut 0 [9 2] header)) =/ checksum (cut 0 [11 20] header) =/ relayed (cut 0 [31 1] header) :: origin, if present, is 6 octets long, at the end of the body :: =^ origin=(unit @) body ?: =(| relayed) [~ body] =/ len (sub (met 3 body) 6) [`(end [3 6] body) (rsh [3 6] body)] :: .checksum does not apply to the origin :: ?. =(checksum (end [0 20] (mug body))) ~& >>> %ames-checksum ~| %ames-checksum !! :: read fixed-length sndr and rcvr life data from body :: :: These represent the last four bits of the sender and receiver :: life fields, to be used for quick dropping of honest packets to :: or from the wrong life. :: =/ sndr-tick (cut 0 [0 4] body) =/ rcvr-tick (cut 0 [4 4] body) :: read variable-length .sndr and .rcvr addresses :: =/ off 1 =^ sndr off [(cut 3 [off sndr-size] body) (add off sndr-size)] ?. (is-valid-rank sndr sndr-size) ~& >>> [%ames-sender-imposter sndr sndr-size] ~| ames-sender-impostor+[sndr sndr-size] !! :: =^ rcvr off [(cut 3 [off rcvr-size] body) (add off rcvr-size)] ?. (is-valid-rank rcvr rcvr-size) ~& >>> [%ames-receiver-imposter rcvr rcvr-size] ~| ames-receiver-impostor+[rcvr rcvr-size] !! :: read variable-length .content from the rest of .body :: =/ content (cut 3 [off (sub (met 3 body) off)] body) [[sndr rcvr] req sam sndr-tick rcvr-tick origin content] :: ++ sift-keen |= =hoot ^- keen :- sig=(end 9 hoot) +:(sift-peep (rsh 9 hoot)) :: ++ sift-purr |= =hoot ^- [=peep =meow] =+ [wid peep]=(sift-peep hoot) [peep (sift-meow (rsh [3 wid] hoot))] :: ++ sift-peep |= =hoot ^- [wid=@ =peep] =+ num=(cut 3 [0 4] hoot) =+ len=(cut 3 [4 2] hoot) =+ pat=(cut 3 [6 len] hoot) ~| pat=pat [(add 6 len) [(stab pat) num]] :: ++ sift-meow |= =purr =; =meow ~| %fine-meow-len^meow ?> (gte siz.meow (met 3 dat.meow)) meow :* sig=(cut 3 [0 64] purr) num=(cut 3 [64 4] purr) siz=(cut 3 [68 2] purr) dat=(rsh 3^70 purr) == :: +etch-shot: serialize a packet into a bytestream :: ++ etch-shot |= shot ^- blob :: =/ sndr-meta (ship-meta sndr) =/ rcvr-meta (ship-meta rcvr) :: =/ body=@ ;: mix sndr-tick (lsh 2 rcvr-tick) (lsh 3 sndr) (lsh [3 +(size.sndr-meta)] rcvr) (lsh [3 +((add size.sndr-meta size.rcvr-meta))] content) == =/ checksum (end [0 20] (mug body)) =? body ?=(^ origin) (mix u.origin (lsh [3 6] body)) :: =/ header=@ %+ can 0 :~ [2 reserved=0] [1 req] [1 sam] [3 protocol-version] [2 rank.sndr-meta] [2 rank.rcvr-meta] [20 checksum] [1 relayed=.?(origin)] == (mix header (lsh 5 body)) :: :: +ship-meta: produce size (in bytes) and address rank for .ship :: :: 0: galaxy or star :: 1: planet :: 2: moon :: 3: comet :: ++ ship-meta |= =ship ^- [size=@ =rank] :: =/ size=@ (met 3 ship) :: ?: (lte size 2) [2 %0b0] ?: (lte size 4) [4 %0b1] ?: (lte size 8) [8 %0b10] [16 %0b11] -- ::ames :: :::: :::: ++behn :: (1b) timekeeping :: :::: ++ behn ^? |% +$ gift :: out result <-$ $% [%doze p=(unit @da)] :: next alarm [%wake error=(unit tang)] :: wakeup or failed [%meta p=vase] [%heck syn=sign-arvo] :: response to %huck == +$ task :: in request ->$ $~ [%vega ~] :: $% $>(%born vane-task) :: new unix process [%rest p=@da] :: cancel alarm [%drip p=vase] :: give in next event [%huck syn=sign-arvo] :: give back $>(%trim vane-task) :: trim state $>(%vega vane-task) :: report upgrade [%wait p=@da] :: set alarm [%wake ~] :: timer activate == -- ::behn :: :::: :::: ++clay :: (1c) versioning :: :::: ++ clay ^? |% +$ gift :: out result <-$ $% [%boon payload=*] :: ames response [%croz rus=(map desk [r=regs w=regs])] :: rules for group [%cruz cez=(map @ta crew)] :: permission groups [%dirk p=@tas] :: mark mount dirty [%ergo p=@tas q=mode] :: version update [%hill p=(list @tas)] :: mount points [%done error=(unit error:ames)] :: ames message (n)ack [%mere p=(each (set path) (pair term tang))] :: merge result [%ogre p=@tas] :: delete mount point [%rule red=dict wit=dict] :: node r+w permissions [%tire p=(each rock:tire wave:tire)] :: app state [%writ p=riot] :: response [%wris p=[%da p=@da] q=(set (pair care path))] :: many changes == :: +$ task :: in request ->$ $~ [%vega ~] :: $% [%boat ~] :: pier rebooted [%cred nom=@ta cew=crew] :: set permission group [%crew ~] :: permission groups [%crow nom=@ta] :: group usage [%drop des=desk] :: cancel pending merge [%info des=desk dit=nori] :: internal edit $>(%init vane-task) :: report install [%into des=desk all=? fis=mode] :: external edit $: %merg :: merge desks des=desk :: target her=@p dem=desk cas=case :: source how=germ :: method == :: $: %fuse :: merge many des=desk :: target desk bas=beak :: base desk con=(list [beak germ]) :: merges == :: [%mont pot=term bem=beam] :: mount to unix [%dirk pot=term] :: mark mount dirty [%ogre pot=$@(term beam)] :: delete mount point [%park des=desk yok=yoki ran=rang] :: synchronous commit [%perm des=desk pax=path rit=rite] :: change permissions [%pork ~] :: resume commit [%prep lat=(map lobe page)] :: prime clay store [%rein des=desk ren=rein] :: extra apps [%stir arg=*] :: debug [%tire p=(unit ~)] :: app state subscribe [%tomb =clue] :: tombstone specific $>(%trim vane-task) :: trim state $>(%vega vane-task) :: report upgrade [%warp wer=ship rif=riff] :: internal file req [%werp who=ship wer=ship rif=riff-any] :: external file req [%wick ~] :: try upgrade [%zeal lit=(list [=desk =zest])] :: batch zest [%zest des=desk liv=zest] :: live $>(%plea vane-task) :: ames request == :: :: :: :::: :: (1c2) :: :: +$ aeon @ud :: version number +$ beam [[p=ship q=desk r=case] s=path] :: global name +$ beak [p=ship q=desk r=case] :: path prefix +$ cable :: lib/sur/mark ref $: face=(unit term) :: file-path=term :: == :: +$ care :: clay submode ?(%a %b %c %d %e %f %p %r %s %t %u %v %w %x %y %z) :: +$ case :: ship desk case spur $% [%da p=@da] :: date [%tas p=@tas] :: label [%ud p=@ud] :: number [%uv p=@uv] :: hash == :: +$ cash :: case or tako $% [%tako p=tako] :: case :: == :: +$ cass [ud=@ud da=@da] :: cases for revision +$ clue :: murder weapon $% [%lobe =lobe] :: specific lobe [%all ~] :: all safe targets [%pick ~] :: collect garbage [%norm =ship =desk =norm] :: set default norm [%worn =ship =desk =tako =norm] :: set commit norm [%seek =ship =desk =cash] :: fetch source blobs == :: +$ cone (map [ship desk] dome) :: domes :: :: Desk state. :: :: Includes a checked-out ankh with current content, most recent version, map :: of all version numbers to commit hashes (commits are in hut.rang), and map :: of labels to version numbers. :: :: `mim` is a cache of the content in the directories that are mounted :: to unix. Often, we convert to/from mime without anything really :: having changed; this lets us short-circuit that in some cases. :: Whenever you give an `%ergo`, you must update this. :: +$ dome $: let=aeon :: top id hit=(map aeon tako) :: versions by id lab=(map @tas aeon) :: labels tom=(map tako norm) :: tomb policies nor=norm :: default policy mim=(map path mime) :: mime cache fod=flue :: ford cache wic=(map weft yoki) :: commit-in-waiting liv=zest :: running agents ren=rein :: force agents on/off == :: +$ crew (set ship) :: permissions group +$ dict [src=path rul=real] :: effective permission +$ domo :: project state $: let=@ud :: top id hit=(map @ud tako) :: changes by id lab=(map @tas @ud) :: labels == :: +$ germ :: merge style $? %init :: new desk %fine :: fast forward %meet :: orthogonal files %mate :: orthogonal changes %meld :: force merge %only-this :: ours with parents %only-that :: hers with parents %take-this :: ours unless absent %take-that :: hers unless absent %meet-this :: ours if conflict %meet-that :: hers if conflict == :: +$ lobe @uvI :: blob ref +$ miso :: file delta $% [%del ~] :: delete [%ins p=cage] :: insert [%dif p=cage] :: mutate from diff [%mut p=cage] :: mutate from raw == :: +$ misu :: computed delta $% [%del ~] :: delete [%ins p=cage] :: insert [%dif p=lobe q=cage] :: mutate from diff == :: +$ mizu [p=@u q=(map @ud tako) r=rang] :: new state +$ moar [p=@ud q=@ud] :: normal change range +$ moat [from=case to=case =path] :: change range +$ mode (list [path (unit mime)]) :: external files +$ mood [=care =case =path] :: request in desk +$ mool [=case paths=(set (pair care path))] :: requests in desk +$ nori :: repository action $% [%& p=soba] :: delta [%| p=@tas q=(unit aeon)] :: label == :: +$ nuri :: repository action $% [%& p=suba] :: delta [%| p=@tas] :: label == :: +$ norm (axal ?) :: tombstone policy +$ open $-(path vase) :: get prelude +$ page ^page :: export for compat +$ pour :: ford build w/content $% [%file =path] [%nave =mark] [%dais =mark] [%cast =mars] [%tube =mars] :: leafs :: [%vale =path =lobe] [%arch =path =(map path lobe)] == +$ rang :: repository $: hut=(map tako yaki) :: changes lat=(map lobe page) :: data == :: +$ rant :: response to request $: p=[p=care q=case r=desk] :: clade release book q=path :: spur r=cage :: data == :: +$ rave :: general request $% [%sing =mood] :: single request [%next =mood] :: await next version [%mult =mool] :: next version of any [%many track=? =moat] :: track range == :: +$ real :: resolved permissions $: mod=?(%black %white) :: who=(pair (set ship) (map @ta crew)) :: == :: +$ regs (map path rule) :: rules for paths +$ rein (map dude:gall ?) :: extra apps +$ riff [p=desk q=(unit rave)] :: request+desist +$ riff-any :: $% [%1 =riff] :: == :: +$ rite :: new permissions $% [%r red=(unit rule)] :: for read [%w wit=(unit rule)] :: for write [%rw red=(unit rule) wit=(unit rule)] :: for read and write == :: +$ riot (unit rant) :: response+complete +$ rule [mod=?(%black %white) who=(set whom)] :: node permission +$ rump [p=care q=case r=@tas s=path] :: relative path +$ saba [p=ship q=@tas r=moar s=dome] :: patch+merge +$ soak :: ford result $% [%cage =cage] [%vase =vase] [%arch dir=(map @ta vase)] [%dais =dais] [%tube =tube] == +$ soba (list [p=path q=miso]) :: delta +$ suba (list [p=path q=misu]) :: delta +$ tako @uvI :: yaki ref +$ toro [p=@ta q=nori] :: general change ++ unce :: change part |* a=mold :: $% [%& p=@ud] :: skip[copy] [%| p=(list a) q=(list a)] :: p -> q[chunk] == :: ++ urge |*(a=mold (list (unce a))) :: list change +$ waft :: kelvin range $^ [[%1 ~] p=(set weft)] :: weft :: +$ whom (each ship @ta) :: ship or named crew +$ yoki (each yuki yaki) :: commit +$ yuki :: proto-commit $: p=(list tako) :: parents q=(map path (each page lobe)) :: namespace == :: +$ yaki :: commit $: p=(list tako) :: parents q=(map path lobe) :: namespace r=tako :: self-reference t=@da :: date == :: +$ zest $~(%dead ?(%dead %live %held)) :: how live :: :: ++ tire :: app state |% :: +$ rock (map desk [=zest wic=(set weft)]) :: +$ wave :: $% [%wait =desk =weft] :: blocked [%warp =desk =weft] :: unblocked [%zest =desk =zest] :: running == :: :: ++ wash :: patch |= [=rock =wave] ^+ rock ?- -.wave %wait =/ got=[=zest wic=(set weft)] (~(gut by rock) desk.wave *zest ~) (~(put by rock) desk.wave got(wic (~(put in wic.got) weft.wave))) :: %warp %- ~(run by rock) |= [=zest wic=(set weft)] [zest (~(del in wic) weft.wave)] :: %zest ?: ?=(%dead zest.wave) (~(del by rock) desk.wave) =/ got=[=zest wic=(set weft)] (~(gut by rock) desk.wave *zest ~) (~(put by rock) desk.wave got(zest zest.wave)) == :: ++ walk :: diff |= [a=rock b=rock] ^- (list wave) =/ adds (~(dif by b) a) =/ dels (~(dif by a) b) =/ bots (~(int by a) b) ;: welp ^- (list wave) %- zing %+ turn ~(tap by adds) |= [=desk =zest wic=(set weft)] ^- (list wave) :- [%zest desk zest] %+ turn ~(tap in wic) |= =weft [%wait desk weft] :: ^- (list wave) %+ turn ~(tap by dels) |= [=desk =zest wic=(set weft)] ^- wave [%zest desk %dead] :: ^- (list wave) %- zing %+ turn ~(tap by bots) |= [=desk * *] ^- (list wave) =/ aa (~(got by a) desk) =/ bb (~(got by b) desk) =/ wadds (~(dif in wic.bb) wic.aa) =/ wdels (~(dif in wic.aa) wic.bb) ;: welp ?: =(zest.aa zest.bb) ~ [%zest desk zest.bb]~ :: %+ turn ~(tap by wadds) |= =weft ^- wave [%wait desk weft] :: %+ turn ~(tap by wdels) |= =weft ^- wave [%warp desk weft] == == -- :: :: +page-to-lobe: hash a page to get a lobe. :: ++ page-to-lobe |=(page (shax (jam +<))) :: ++ cord-to-waft |= =cord ^- waft =/ wefts=(list weft) %+ turn (rash cord (star (ifix [gay gay] tall:vast))) |= =hoon !<(weft (slap !>(~) hoon)) ?: ?=([* ~] wefts) i.wefts [[%1 ~] (sy wefts)] :: ++ waft-to-wefts |= kal=waft ^- (set weft) ?^ -.kal p.kal [kal ~ ~] :: :: +make-yaki: make commit out of a list of parents, content, and date. :: ++ make-yaki |= [p=(list tako) q=(map path lobe) t=@da] ^- yaki =+ ^= has %^ cat 7 (sham [%yaki (roll p add) q t]) (sham [%tako (roll p add) q t]) [p q has t] :: :: $leak: ford cache key :: :: This includes all build inputs, including transitive dependencies, :: recursively. :: +$ leak $~ [*pour ~] $: =pour deps=(set leak) == :: :: $flow: global ford cache :: :: Refcount includes references from other items in the cache, and :: from spills in each desk :: :: This is optimized for minimizing the number of rebuilds, and given :: that, minimizing the amount of memory used. It is relatively slow :: to lookup, because generating a cache key can be fairly slow (for :: files, it requires parsing; for tubes, it even requires building :: the marks). :: +$ flow (map leak [refs=@ud =soak]) :: :: Per-desk ford cache :: :: Spill is the set of "roots" we have into the global ford cache. :: We add a root for everything referenced directly or indirectly on :: a desk, then invalidate them on commit only if their dependencies :: change. :: :: Sprig is a fast-lookup index over the global ford cache. The only :: goal is to make cache hits fast. :: +$ flue [spill=(set leak) sprig=(map mist [=leak =soak])] :: :: Ford build without content. :: +$ mist $% [%file =path] [%nave =mark] [%dais =mark] [%cast =mars] [%tube =mars] [%vale =path] [%arch =path] == :: :: $pile: preprocessed hoon source file :: :: /- sur-file :: surface imports from /sur :: /+ lib-file :: library imports from /lib :: /= face /path :: imports built hoon file at path :: /~ face type /path :: imports built hoon files from directory :: /% face %mark :: imports mark definition from /mar :: /$ face %from %to :: imports mark converter from /mar :: /* face %mark /path :: unbuilt file imports, as mark :: +$ pile $: sur=(list taut) lib=(list taut) raw=(list [face=term =path]) raz=(list [face=term =spec =path]) maz=(list [face=term =mark]) caz=(list [face=term =mars]) bar=(list [face=term =mark =path]) =hoon == :: $taut: file import from /lib or /sur :: +$ taut [face=(unit term) pax=term] :: $mars: mark conversion request :: $tube: mark conversion gate :: $nave: typed mark core :: +$ mars [a=mark b=mark] +$ tube $-(vase vase) ++ nave |$ [typ dif] $_ ^? |% ++ diff |~([old=typ new=typ] *dif) ++ form *mark ++ join |~([a=dif b=dif] *(unit (unit dif))) ++ mash |~ [a=[ship desk dif] b=[ship desk dif]] *(unit dif) ++ pact |~([typ dif] *typ) ++ vale |~(noun *typ) -- :: $dais: processed mark core :: +$ dais $_ ^| |_ sam=vase ++ diff |~(new=_sam *vase) ++ form *mark ++ join |~([a=vase b=vase] *(unit (unit vase))) ++ mash |~ [a=[ship desk diff=vase] b=[ship desk diff=vase]] *(unit vase) ++ pact |~(diff=vase sam) ++ vale |~(noun sam) -- :: ++ get-fit |= [bek=beak pre=@tas pax=@tas] ^- (unit path) =/ paz (segments pax) |- ^- (unit path) ?~ paz ~ =/ puz=path (snoc `path`[pre i.paz] %hoon) =+ .^(=arch cy+[(scot %p p.bek) q.bek (scot r.bek) puz]) ?^ fil.arch `puz $(paz t.paz) :: +segments: compute all paths from :path-part, replacing some `/`s with `-`s :: :: For example, when passed a :path-part of 'foo-bar-baz', :: the product will contain: :: ``` :: dojo> (segments 'foo-bar-baz') :: ~[/foo-bar-baz /foo-bar/baz /foo/bar-baz /foo/bar/baz] :: ``` :: ++ segments |= suffix=@tas ^- (list path) =/ parser (most hep (cook crip ;~(plug ;~(pose low nud) (star ;~(pose low nud))))) =/ torn=(list @tas) (fall (rush suffix parser) ~[suffix]) %- flop |- ^- (list (list @tas)) ?< ?=(~ torn) ?: ?=([@ ~] torn) ~[torn] %- zing %+ turn $(torn t.torn) |= s=(list @tas) ^- (list (list @tas)) ?> ?=(^ s) ~[[i.torn s] [(crip "{(trip i.torn)}-{(trip i.s)}") t.s]] -- ::clay :: :::: :::: ++dill :: (1d) console :: :::: ++ dill ^? |% +$ gift :: out result <-$ $% [%blit p=(list blit)] :: terminal output [%logo ~] :: logout [%meld ~] :: unify memory [%pack ~] :: compact memory [%trim p=@ud] :: trim kernel state [%logs =told] :: system output == :: +$ task :: in request ->$ $~ [%vega ~] :: $% [%boot lit=? p=*] :: weird %dill boot [%crop p=@ud] :: trim kernel state [%flog p=flog] :: wrapped error [%heft ~] :: memory report $>(%init vane-task) :: after gall ready [%logs p=(unit ~)] :: watch system output [%meld ~] :: unify memory [%pack ~] :: compact memory [%seat =desk] :: install desk [%shot ses=@tas task=session-task] :: task for session $>(%trim vane-task) :: trim state $>(%vega vane-task) :: report upgrade [%verb ~] :: verbose mode [%knob tag=term level=?(%hush %soft %loud)] :: deprecated removeme session-task :: for default session told :: system output == :: :: :: +$ session-task :: session request $% [%belt p=belt] :: terminal input [%blew p=blew] :: terminal config [%flee ~] :: unwatch session [%hail ~] :: terminal refresh [%open p=dude:gall q=(list gill:gall)] :: setup session [%shut ~] :: close session [%view ~] :: watch session blits == :: :: :: +$ told :: system output $% [%crud p=@tas q=tang] :: error [%talk p=(list tank)] :: tanks (in order) [%text p=tape] :: tape == :: :: :::: :: (1d2) :: +$ blew [p=@ud q=@ud] :: columns rows +$ belt :: client input $? bolt :: simple input [%mod mod=?(%ctl %met %hyp) key=bolt] :: w/ modifier [%txt p=(list @c)] :: utf32 text ::TODO consider moving %hey, %rez, %yow here :: == :: +$ bolt :: simple input $@ @c :: simple keystroke $% [%aro p=?(%d %l %r %u)] :: arrow key [%bac ~] :: true backspace [%del ~] :: true delete [%hit x=@ud y=@ud] :: mouse click [%ret ~] :: return == :: +$ blit :: client output $% [%bel ~] :: make a noise [%clr ~] :: clear the screen [%hop p=$@(@ud [x=@ud y=@ud])] :: set cursor col/pos [%klr p=stub] :: put styled [%mor p=(list blit)] :: multiple blits [%nel ~] :: newline [%put p=(list @c)] :: put text at cursor [%sag p=path q=*] :: save to jamfile [%sav p=path q=@] :: save to file [%url p=@t] :: activate url [%wyp ~] :: wipe cursor line == :: +$ dill-belt :: arvo input $% belt :: client input [%cru p=@tas q=(list tank)] :: errmsg (deprecated) [%hey ~] :: refresh [%rez p=@ud q=@ud] :: resize, cols, rows [%yow p=gill:gall] :: connect to app == :: +$ dill-blit :: arvo output $% blit :: client output [%qit ~] :: close console == :: +$ flog :: sent to %dill $% [%crop p=@ud] :: trim kernel state $>(%crud told) :: [%heft ~] :: [%meld ~] :: unify memory [%pack ~] :: compact memory $>(%text told) :: [%verb ~] :: verbose mode == :: :: :: +$ poke :: dill to userspace $: ses=@tas :: target session dill-belt :: input == :: -- ::dill :: :::: :::: ++eyre :: (1e) http-server :: :::: ++ eyre ^? |% +$ gift $% :: set-config: configures the external http server :: :: TODO: We need to actually return a (map (unit @t) http-config) :: so we can apply configurations on a per-site basis :: [%set-config =http-config] :: sessions: valid authentication cookie strings :: [%sessions ses=(set @t)] :: response: response to an event from earth :: [%response =http-event:http] :: response to a %connect or %serve :: :: :accepted is whether :binding was valid. Duplicate bindings are :: not allowed. :: [%bound accepted=? =binding] == :: +$ task $~ [%vega ~] $% :: initializes ourselves with an identity :: $>(%init vane-task) :: new unix process :: $>(%born vane-task) :: trim state (in response to memory pressure) :: $>(%trim vane-task) :: report upgrade :: $>(%vega vane-task) :: notifies us of the ports of our live http servers :: [%live insecure=@ud secure=(unit @ud)] :: update http configuration :: [%rule =http-rule] :: starts handling an inbound http request :: [%request secure=? =address =request:http] :: starts handling an backdoor http request :: [%request-local secure=? =address =request:http] :: cancels a previous request :: [%cancel-request ~] :: connects a binding to an app :: [%connect =binding app=term] :: connects a binding to a generator :: [%serve =binding =generator] :: disconnects a binding :: :: This must be called with the same duct that made the binding in :: the first place. :: [%disconnect =binding] :: notifies us that web login code changed :: [%code-changed ~] :: start responding positively to cors requests from origin :: [%approve-origin =origin] :: start responding negatively to cors requests from origin :: [%reject-origin =origin] :: %spew: set verbosity toggle :: [%spew veb=@] == :: +origin: request origin as specified in an Origin header :: +$ origin @torigin :: +cors-registry: origins categorized by approval status :: +$ cors-registry $: requests=(set origin) approved=(set origin) rejected=(set origin) == :: +outstanding-connection: open http connections not fully complete: :: :: This refers to outstanding connections where the connection to :: outside is opened and we are currently waiting on an app to :: produce the results. :: +$ outstanding-connection $: :: action: the action that had matched :: =action :: inbound-request: the original request which caused this connection :: =inbound-request :: response-header: set when we get our first %start :: response-header=(unit response-header:http) :: bytes-sent: the total bytes sent in response :: bytes-sent=@ud == :: +authentication-state: state used in the login system :: +$ authentication-state $: :: sessions: a mapping of session cookies to session information :: sessions=(map @uv session) == :: +session: server side data about a session :: +$ session $: :: expiry-time: when this session expires :: :: We check this server side, too, so we aren't relying on the browser :: to properly handle cookie expiration as a security mechanism. :: expiry-time=@da :: channels: channels opened by this session :: channels=(set @t) :: :: TODO: We should add a system for individual capabilities; we should :: mint some sort of long lived cookie for mobile apps which only has :: access to a single application path. == :: channel-state: state used in the channel system :: +$ channel-state $: :: session: mapping between an arbitrary key to a channel :: session=(map @t channel) :: by-duct: mapping from ducts to session key :: duct-to-key=(map duct @t) == :: +timer: a reference to a timer so we can cancel or update it. :: +$ timer $: :: date: time when the timer will fire :: date=@da :: duct: duct that set the timer so we can cancel :: =duct == :: channel-event: unacknowledged channel event, vaseless sign :: +$ channel-event $% $>(%poke-ack sign:agent:gall) $>(%watch-ack sign:agent:gall) $>(%kick sign:agent:gall) [%fact =mark =noun] == :: channel: connection to the browser :: :: Channels are the main method where a webpage communicates with Gall :: apps. Subscriptions and pokes are issues with PUT requests on a path, :: while GET requests on that same path open a persistent EventSource :: channel. :: :: The EventSource API is a sequence number based API that browser provide :: which allow the server to push individual events to the browser over a :: connection held open. In case of reconnection, the browser will send a :: 'Last-Event-Id: ' header to the server; the server then resends all :: events since then. :: +$ channel $: :: channel-state: expiration time or the duct currently listening :: :: For each channel, there is at most one open EventSource :: connection. A 400 is issues on duplicate attempts to connect to the :: same channel. When an EventSource isn't connected, we set a timer :: to reap the subscriptions. This timer shouldn't be too short :: because the :: state=(each timer duct) :: next-id: next sequence number to use :: next-id=@ud :: last-ack: time of last client ack :: :: used for clog calculations, in combination with :unacked :: last-ack=@da :: events: unacknowledged events :: :: We keep track of all events where we haven't received a :: 'Last-Event-Id: ' response from the client or a per-poke {'ack': :: ...} call. When there's an active EventSource connection on this :: channel, we send the event but we still add it to events because we :: can't assume it got received until we get an acknowledgment. :: events=(qeu [id=@ud request-id=@ud =channel-event]) :: unacked: unacknowledged event counts by request-id :: :: used for clog calculations, in combination with :last-ack :: unacked=(map @ud @ud) :: subscriptions: gall subscriptions by request-id :: :: We maintain a list of subscriptions so if a channel times out, we :: can cancel all the subscriptions we've made. :: subscriptions=(map @ud [ship=@p app=term =path duc=duct]) :: heartbeat: sse heartbeat timer :: heartbeat=(unit timer) == :: +binding: A rule to match a path. :: :: A +binding is a system unique mapping for a path to match. A +binding :: must be system unique because we don't want two handlers for a path; :: what happens if there are two different actions for [~ /]? :: +$ binding $: :: site: the site to match. :: :: A ~ will match the Urbit's identity site (your.urbit.org). Any :: other value will match a domain literal. :: site=(unit @t) :: path: matches this prefix path :: :: /~myapp will match /~myapp or /~myapp/longer/path :: path=(list @t) == :: +action: the action to take when a binding matches an incoming request :: +$ action $% :: dispatch to a generator :: [%gen =generator] :: dispatch to an application :: [%app app=term] :: internal authentication page :: [%authentication ~] :: internal logout page :: [%logout ~] :: gall channel system :: [%channel ~] :: gall scry endpoint :: [%scry ~] :: respond with the @p the requester is authenticated as :: [%name ~] :: respond with the default file not found page :: [%four-oh-four ~] == :: +generator: a generator on the local ship that handles requests :: :: This refers to a generator on the local ship, run with a set of :: arguments. Since http requests are time sensitive, we require that the :: generator be on the current ship. :: +$ generator $: :: desk: desk on current ship that contains the generator :: =desk :: path: path on :desk to the generator's hoon file :: path=(list @t) :: args: arguments passed to the gate :: args=* == :: +http-config: full http-server configuration :: +$ http-config $: :: secure: PEM-encoded RSA private key and cert or cert chain :: secure=(unit [key=wain cert=wain]) :: proxy: reverse TCP proxy HTTP(s) :: proxy=_| :: log: keep HTTP(s) access logs :: log=? :: redirect: send 301 redirects to upgrade HTTP to HTTPS :: :: Note: requires certificate. :: redirect=? == :: +http-rule: update configuration :: +$ http-rule $% :: %cert: set or clear certificate and keypair :: [%cert cert=(unit [key=wain cert=wain])] :: %turf: add or remove established dns binding :: [%turf action=?(%put %del) =turf] == :: +address: client IP address :: +$ address $% [%ipv4 @if] [%ipv6 @is] :: [%ames @p] == :: +inbound-request: +http-request and metadata :: +$ inbound-request $: :: authenticated: has a valid session cookie :: authenticated=? :: secure: whether this request was encrypted (https) :: secure=? :: address: the source address of this request :: =address :: request: the http-request itself :: =request:http == :: +$ cred :: credential $: hut=hart :: client host aut=(jug @tas @t) :: client identities orx=oryx :: CSRF secret acl=(unit @t) :: accept-language cip=(each @if @is) :: client IP cum=(map @tas *) :: custom dirt == :: +$ epic :: FCGI parameters $: qix=(map @t @t) :: query ced=cred :: client credentials bem=beam :: original path == :: :: +$ hart [p=? q=(unit @ud) r=host] :: http sec+port+host +$ hate [p=purl q=@p r=moth] :: semi-cooked request +$ hiss [p=purl q=moth] :: outbound request +$ host (each turf @if) :: http host +$ hoke %+ each [%localhost ~] :: local host ?(%.0.0.0.0 %.127.0.0.1) :: +$ httq :: raw http request $: p=meth :: method q=@t :: unparsed url r=(list [p=@t q=@t]) :: headers s=(unit octs) :: body == :: +$ httr [p=@ud q=mess r=(unit octs)] :: raw http response +$ math (map @t (list @t)) :: semiparsed headers +$ mess (list [p=@t q=@t]) :: raw http headers +$ meth :: http methods $? %conn :: CONNECT %delt :: DELETE %get :: GET %head :: HEAD %opts :: OPTIONS %post :: POST %put :: PUT %trac :: TRACE == :: +$ moth [p=meth q=math r=(unit octs)] :: http operation +$ oryx @t :: CSRF secret +$ pork [p=(unit @ta) q=(list @t)] :: fully parsed url :: +prox: proxy notification :: :: Used on both the proxy (ward) and upstream sides for :: sending/receiving proxied-request notifications. :: +$ prox $: :: por: tcp port :: por=@ud :: sek: secure? :: sek=? :: non: authentication nonce :: non=@uvJ == +$ purf (pair purl (unit @t)) :: url with fragment +$ purl [p=hart q=pork r=quay] :: parsed url +$ quay (list [p=@t q=@t]) :: parsed url query ++ quer |-($@(~ [p=@t q=@t t=$])) :: query tree +$ quri :: request-uri $% [%& p=purl] :: absolute [%| p=pork q=quay] :: relative == :: :: +reserved: check if an ipv4 address is in a reserved range :: ++ reserved |= a=@if ^- ? =/ b (flop (rip 3 a)) :: 0.0.0.0/8 (software) :: ?. ?=([@ @ @ @ ~] b) & ?| :: 10.0.0.0/8 (private) :: =(10 i.b) :: 100.64.0.0/10 (carrier-grade NAT) :: &(=(100 i.b) (gte i.t.b 64) (lte i.t.b 127)) :: 127.0.0.0/8 (localhost) :: =(127 i.b) :: 169.254.0.0/16 (link-local) :: &(=(169 i.b) =(254 i.t.b)) :: 172.16.0.0/12 (private) :: &(=(172 i.b) (gte i.t.b 16) (lte i.t.b 31)) :: 192.0.0.0/24 (protocol assignment) :: &(=(192 i.b) =(0 i.t.b) =(0 i.t.t.b)) :: 192.0.2.0/24 (documentation) :: &(=(192 i.b) =(0 i.t.b) =(2 i.t.t.b)) :: 192.18.0.0/15 (reserved, benchmark) :: &(=(192 i.b) |(=(18 i.t.b) =(19 i.t.b))) :: 192.51.100.0/24 (documentation) :: &(=(192 i.b) =(51 i.t.b) =(100 i.t.t.b)) :: 192.88.99.0/24 (reserved, ex-anycast) :: &(=(192 i.b) =(88 i.t.b) =(99 i.t.t.b)) :: 192.168.0.0/16 (private) :: &(=(192 i.b) =(168 i.t.b)) :: 203.0.113/24 (documentation) :: &(=(203 i.b) =(0 i.t.b) =(113 i.t.t.b)) :: 224.0.0.0/8 (multicast) :: 240.0.0.0/4 (reserved, future) :: 255.255.255.255/32 (broadcast) :: (gte i.b 224) == :: +ipa: parse ip address :: ++ ipa ;~(pose (stag %ipv4 ip4) (stag %ipv6 ip6)) :: +ip4: parse ipv4 address :: ++ ip4 =+ byt=(ape:ag ted:ab) (bass 256 ;~(plug byt (stun [3 3] ;~(pfix dot byt)))) :: +ip6: parse ipv6 address :: ++ ip6 %+ bass 0x1.0000 %+ sear |= hexts=(list $@(@ [~ %zeros])) ^- (unit (list @)) :: not every list of hextets is an ipv6 address :: =/ legit=? =+ l=(lent hexts) =+ c=|=(a=* ?=([~ %zeros] a)) ?| &((lth l 8) ?=([* ~] (skim hexts c))) &(=(8 l) !(lien hexts c)) == ?. legit ~ %- some :: expand zeros :: %- zing %+ turn hexts |= hext=$@(@ [~ %zeros]) ?@ hext [hext]~ (reap (sub 9 (lent hexts)) 0) :: parse hextets, producing cell for shorthand zeroes :: |^ %+ cook |= [a=(list @) b=(list [~ %zeros]) c=(list @)] :(welp a b c) ;~ plug (more col het) (stun [0 1] cel) (more col het) == ++ cel (cold `%zeros ;~(plug col col)) ++ het (bass 16 (stun [1 4] six:ab)) -- :: +$ rout [p=(list host) q=path r=oryx s=path] :: http route (new) +$ user knot :: username -- ::eyre :: :::: :::: ++gall :: (1g) extensions :: :::: ++ gall ^? |% +$ gift :: outgoing result $% [%boon payload=*] :: ames response [%done error=(unit error:ames)] :: ames message (n)ack [%unto p=unto] :: == :: +$ task :: incoming request $~ [%vega ~] :: $% [%deal p=sock q=term r=deal] :: full transmission [%sear =ship] :: clear pending queues [%jolt =desk =dude] :: (re)start agent [%idle =dude] :: suspend agent [%load =load] :: load agent [%nuke =dude] :: delete agent [%doff dude=(unit dude) ship=(unit ship)] :: kill subscriptions [%rake dude=(unit dude) all=?] :: reclaim old subs $>(%init vane-task) :: set owner $>(%trim vane-task) :: trim state $>(%vega vane-task) :: report upgrade $>(%plea vane-task) :: network request [%spew veb=(list verb)] :: set verbosity [%sift dudes=(list dude)] :: per agent == :: +$ bitt (map duct (pair ship path)) :: incoming subs +$ boat (map [=wire =ship =term] [acked=? =path]) :: outgoing subs +$ boar (map [=wire =ship =term] nonce=@) :: and their nonces +$ bowl :: standard app state $: $: our=ship :: host src=ship :: guest dap=term :: agent == :: $: wex=boat :: outgoing subs sup=bitt :: incoming subs $= sky :: scry bindings %+ map path :: ((mop @ud (pair @da (each page @uvI))) lte) :: == :: $: act=@ud :: change number eny=@uvJ :: entropy now=@da :: current time byk=beak :: load source == == :: :: +$ dude term :: server identity +$ gill (pair ship term) :: general contact +$ load (list [=dude =beak =agent]) :: loadout +$ scar :: opaque duct $: p=@ud :: bone sequence q=(map duct bone) :: by duct r=(map bone duct) :: by bone == :: +$ suss (trel dude @tas @da) :: config report +$ well (pair desk term) :: +$ deal $% [%raw-poke =mark =noun] task:agent == +$ unto $% [%raw-fact =mark =noun] sign:agent == :: TODO: add more flags? :: +$ verb ?(%odd) :: :: +agent: app core :: ++ agent =< form |% +$ step (quip card form) +$ card (wind note gift) +$ note $% [%agent [=ship name=term] =task] [%arvo note-arvo] [%pyre =tang] :: [%grow =spur =page] [%tomb =case =spur] [%cull =case =spur] == +$ task $% [%watch =path] [%watch-as =mark =path] [%leave ~] [%poke =cage] [%poke-as =mark =cage] == +$ gift $% [%fact paths=(list path) =cage] [%kick paths=(list path) ship=(unit ship)] [%watch-ack p=(unit tang)] [%poke-ack p=(unit tang)] == +$ sign $% [%poke-ack p=(unit tang)] [%watch-ack p=(unit tang)] [%fact =cage] [%kick ~] == ++ form $_ ^| |_ bowl ++ on-init *(quip card _^|(..on-init)) :: ++ on-save *vase :: ++ on-load |~ old-state=vase *(quip card _^|(..on-init)) :: ++ on-poke |~ [mark vase] *(quip card _^|(..on-init)) :: ++ on-watch |~ path *(quip card _^|(..on-init)) :: ++ on-leave |~ path *(quip card _^|(..on-init)) :: ++ on-peek |~ path *(unit (unit cage)) :: ++ on-agent |~ [wire sign] *(quip card _^|(..on-init)) :: ++ on-arvo |~ [wire sign-arvo] *(quip card _^|(..on-init)) :: ++ on-fail |~ [term tang] *(quip card _^|(..on-init)) -- -- -- ::gall :: %iris http-client interface :: ++ iris ^? |% :: +gift: effects the client can emit :: +$ gift $% :: %request: outbound http-request to earth :: :: TODO: id is sort of wrong for this interface; the duct should :: be enough to identify which request we're talking about? :: [%request id=@ud request=request:http] :: %cancel-request: tell earth to cancel a previous %request :: [%cancel-request id=@ud] :: %response: response to the caller :: [%http-response =client-response] == :: +$ task $~ [%vega ~] $% :: system started up; reset open connections :: $>(%born vane-task) :: trim state (in response to memory pressure) :: $>(%trim vane-task) :: report upgrade :: $>(%vega vane-task) :: fetches a remote resource :: [%request =request:http =outbound-config] :: cancels a previous fetch :: [%cancel-request ~] :: receives http data from outside :: [%receive id=@ud =http-event:http] == :: +client-response: one or more client responses given to the caller :: +$ client-response $% :: periodically sent as an update on the duct that sent %fetch :: $: %progress :: http-response-header: full transaction header :: :: In case of a redirect chain, this is the target of the :: final redirect. :: =response-header:http :: bytes-read: bytes fetched so far :: bytes-read=@ud :: expected-size: the total size if response had a content-length :: expected-size=(unit @ud) :: incremental: data received since the last %http-progress :: incremental=(unit octs) == :: final response of a download, parsed as mime-data if successful :: [%finished =response-header:http full-file=(unit mime-data)] :: canceled by the runtime system :: [%cancel ~] == :: mime-data: externally received but unvalidated mimed data :: +$ mime-data [type=@t data=octs] :: +outbound-config: configuration for outbound http requests :: +$ outbound-config $: :: number of times to follow a 300 redirect before erroring :: :: Common values for this will be 3 (the limit most browsers use), 5 :: (the limit recommended by the http standard), or 0 (let the :: requester deal with 300 redirects). :: redirects=_5 :: number of times to retry before failing :: :: When we retry, we'll automatically try to use the 'Range' header :: to resume the download where we left off if we have the :: 'Accept-Range: bytes' in the original response. :: retries=_3 == :: +to-httr: adapts to old eyre interface :: ++ to-httr |= [header=response-header:http full-file=(unit mime-data)] ^- httr:eyre :: =/ data=(unit octs) ?~(full-file ~ `data.u.full-file) :: [status-code.header headers.header data] -- :: :::: :::: ++jael :: (1h) security :: :::: ++ jael ^? |% +$ public-keys-result $% [%full points=(map ship point)] [%diff who=ship =diff:point] [%breach who=ship] == :: :: +$ gift :: out result <-$ $% [%done error=(unit error:ames)] :: ames message (n)ack [%boon payload=*] :: ames response [%private-keys =life vein=(map life ring)] :: private keys [%public-keys =public-keys-result] :: ethereum changes [%turf turf=(list turf)] :: domains == :: :: +feed: potential boot parameters :: +$ feed $^ [[%1 ~] who=ship kyz=(list [lyf=life key=ring])] seed :: +seed: individual boot parameters :: +$ seed [who=ship lyf=life key=ring sig=(unit oath:pki)] :: +$ task :: in request ->$ $~ [%vega ~] :: $% [%dawn dawn-event] :: boot from keys [%fake =ship] :: fake boot [%listen whos=(set ship) =source] :: set ethereum source ::TODO %next for generating/putting new private key [%meet =ship =life =pass] :: met after breach [%moon =ship =udiff:point] :: register moon keys [%nuke whos=(set ship)] :: cancel tracker from [%private-keys ~] :: sub to privates [%public-keys ships=(set ship)] :: sub to publics [%rekey =life =ring] :: update private keys [%resend ~] :: resend private key [%ruin ships=(set ship)] :: pretend breach $>(%trim vane-task) :: trim state [%turf ~] :: view domains $>(%vega vane-task) :: report upgrade $>(%plea vane-task) :: ames request [%step ~] :: reset web login code == :: :: +$ dawn-event $: =seed spon=(list [=ship point:azimuth-types]) czar=(map ship [=rift =life =pass]) turf=(list turf) bloq=@ud node=(unit purl:eyre) == :: ++ block =< block |% +$ hash @uxblockhash +$ number @udblocknumber +$ id [=hash =number] +$ block [=id =parent=hash] -- :: :: Azimuth points form a groupoid, where the objects are all the :: possible values of +point and the arrows are the possible values :: of (list point-diff). Composition of arrows is concatenation, :: and you can apply the diffs to a +point with +apply. :: :: It's simplest to consider +point as the coproduct of three :: groupoids, Rift, Keys, and Sponsor. Recall that the coproduct :: of monoids is the free monoid (Kleene star) of the coproduct of :: the underlying sets of the monoids. The construction for :: groupoids is similar. Thus, the objects of the coproduct are :: the product of the objects of the underlying groupoids. The :: arrows are a list of a sum of the diff types of the underlying :: groupoids. Given an arrow=(list diff), you can project to the :: underlying arrows with +skim filtering on the head of each diff. :: :: The identity element is ~. Clearly, composing this with any :: +diff gives the original +diff. Since this is a category, :: +compose must be associative (true, because concatenation is :: associative). This is a groupoid, so we must further have that :: every +point-diff has an inverse. These are given by the :: +inverse operation. :: ++ point =< point |% +$ point $: =rift =life keys=(map life [crypto-suite=@ud =pass]) sponsor=(unit @p) == :: +$ key-update [=life crypto-suite=@ud =pass] :: :: Invertible diffs :: +$ diffs (list diff) +$ diff $% [%rift from=rift to=rift] [%keys from=key-update to=key-update] [%spon from=(unit @p) to=(unit @p)] == :: :: Non-invertible diffs :: +$ udiffs (list [=ship =udiff]) +$ udiff $: =id:block $% [%rift =rift boot=?] [%keys key-update boot=?] [%spon sponsor=(unit @p)] [%disavow ~] == == :: ++ udiff-to-diff |= [=a=udiff =a=point] ^- (unit diff) ?- +<.a-udiff %disavow ~|(%udiff-to-diff-disavow !!) %spon `[%spon sponsor.a-point sponsor.a-udiff] %rift ?. (gth rift.a-udiff rift.a-point) ~ ~? &(!=(rift.a-udiff +(rift.a-point)) !boot.a-udiff) [%udiff-to-diff-skipped-rift a-udiff a-point] `[%rift rift.a-point rift.a-udiff] :: %keys ?. (gth life.a-udiff life.a-point) ~ ~? &(!=(life.a-udiff +(life.a-point)) !boot.a-udiff) [%udiff-to-diff-skipped-life a-udiff a-point] :^ ~ %keys [life.a-point (~(gut by keys.a-point) life.a-point *[@ud pass])] [life crypto-suite pass]:a-udiff == :: ++ inverse |= diffs=(list diff) ^- (list diff) %- flop %+ turn diffs |= =diff ^- ^diff ?- -.diff %rift [%rift to from]:diff %keys [%keys to from]:diff %spon [%spon to from]:diff == :: ++ compose (bake weld ,[(list diff) (list diff)]) :: ++ apply |= [diffs=(list diff) =a=point] (roll diffs (apply-diff a-point)) :: ++ apply-diff |= a=point |: [*=diff a-point=a] ^- point ?- -.diff %rift ?> =(rift.a-point from.diff) a-point(rift to.diff) :: %keys ?> =(life.a-point life.from.diff) ?> =((~(get by keys.a-point) life.a-point) `+.from.diff) %_ a-point life life.to.diff keys (~(put by keys.a-point) life.to.diff +.to.diff) == :: %spon ?> =(sponsor.a-point from.diff) a-point(sponsor to.diff) == -- :: :: :::: :: :: :: +$ source (each ship term) +$ source-id @udsourceid :: :: +state-eth-node: state of a connection to an ethereum node :: +$ state-eth-node :: node config + meta $: top-source-id=source-id sources=(map source-id source) sources-reverse=(map source source-id) default-source=source-id ship-sources=(map ship source-id) ship-sources-reverse=(jug source-id ship) == :: :: :: :::: ++pki:jael :: (1h2) certificates :: :::: ++ pki ^? |% ::TODO update to fit azimuth-style keys :: the urbit meta-certificate (++will) is a sequence :: of certificates (++cert). each cert in a will :: revokes and replaces the previous cert. the :: version number of a ship is a ++life. :: :: the deed contains an ++arms, a definition :: of cosmetic identity; a semi-trusted parent, :: which signs the initial certificate and provides :: routing services; and a dirty bit. if the dirty :: bit is set, the new life of this ship may have :: lost information that the old life had. :: +$ hand @uvH :: 128-bit hash +$ mind [who=ship lyf=life] :: key identifier +$ name (pair @ta @t) :: ascii / unicode +$ oath @ :: signature ++ tale :: urbit-signed * |$ [typ] :: payload mold $: dat=typ :: data syg=(map ship (pair life oath)) :: signatures == :: -- :: pki -- :: jael :: :::: :::: ++khan :: (1i) threads :: :::: ++ khan ^? |% +$ gift :: out result <-$ $% [%arow p=(avow cage)] :: in-arvo result [%avow p=(avow page)] :: external result == :: +$ task :: in request ->$ $~ [%vega ~] :: $% $>(%born vane-task) :: new unix process [%done ~] :: socket closed :: TODO mark ignored :: :: :: [%fard p=(fyrd cage)] :: in-arvo thread [%fyrd p=(fyrd cast)] :: external thread [%lard =bear =shed] :: inline thread $>(%trim vane-task) :: trim state $>(%vega vane-task) :: report upgrade == :: :: :: ++ avow |$ [a] (each a goof) :: $fyrd result +$ bear $@(desk beak) :: partial $beak +$ cast (pair mark page) :: output mark + input ++ fyrd |$ [a] [=bear name=term args=a] :: thread run request :: :: +$ shed _*form:(strand:rand ,vase) :: compute vase -- ::khan :: ++ rand :: computation |% +$ card card:agent:gall +$ input $% [%poke =cage] [%sign =wire =sign-arvo] [%agent =wire =sign:agent:gall] [%watch =path] == +$ strand-input [=bowl in=(unit input)] +$ tid @tatid +$ bowl $: our=ship src=ship tid=tid mom=(unit tid) wex=boat:gall sup=bitt:gall eny=@uvJ now=@da byk=beak == :: :: cards: cards to send immediately. These will go out even if a :: later stage of the computation fails, so they shouldn't have :: any semantic effect on the rest of the system. :: Alternately, they may record an entry in contracts with :: enough information to undo the effect if the computation :: fails. :: wait: don't move on, stay here. The next sign should come back :: to this same callback. :: skip: didn't expect this input; drop it down to be handled :: elsewhere :: cont: continue computation with new callback. :: fail: abort computation; don't send effects :: done: finish computation; send effects :: ++ strand-output-raw |* a=mold $~ [~ %done *a] $: cards=(list card) $= next $% [%wait ~] [%skip ~] [%cont self=(strand-form-raw a)] [%fail err=(pair term tang)] [%done value=a] == == :: ++ strand-form-raw |* a=mold $-(strand-input (strand-output-raw a)) :: :: Abort strand computation with error message :: ++ strand-fail |= err=(pair term tang) |= strand-input [~ %fail err] :: :: Asynchronous transcaction monad. :: :: Combo of four monads: :: - Reader on input :: - Writer on card :: - Continuation :: - Exception :: ++ strand |* a=mold |% ++ output (strand-output-raw a) :: :: Type of an strand computation. :: ++ form (strand-form-raw a) :: :: Monadic pure. Identity computation for bind. :: ++ pure |= arg=a ^- form |= strand-input [~ %done arg] :: :: Monadic bind. Combines two computations, associatively. :: ++ bind |* b=mold |= [m-b=(strand-form-raw b) fun=$-(b form)] ^- form |= input=strand-input =/ b-res=(strand-output-raw b) (m-b input) ^- output :- cards.b-res ?- -.next.b-res %wait [%wait ~] %skip [%skip ~] %cont [%cont ..$(m-b self.next.b-res)] %fail [%fail err.next.b-res] %done [%cont (fun value.next.b-res)] == :: :: The strand monad must be evaluted in a particular way to maintain :: its monadic character. +take:eval implements this. :: ++ eval |% :: Indelible state of a strand :: +$ eval-form $: =form == :: :: Convert initial form to eval-form :: ++ from-form |= =form ^- eval-form form :: :: The cases of results of +take :: +$ eval-result $% [%next ~] [%fail err=(pair term tang)] [%done value=a] == :: ++ validate-mark |= [in=* =mark =bowl] ^- cage =+ .^ =dais:clay %cb /(scot %p our.bowl)/[q.byk.bowl]/(scot %da now.bowl)/[mark] == =/ res (mule |.((vale.dais in))) ?: ?=(%| -.res) ~| %spider-mark-fail (mean leaf+"spider: ames vale fail {}" p.res) [mark p.res] :: :: Take a new sign and run the strand against it :: ++ take :: cards: accumulate throughout recursion the cards to be :: produced now =| cards=(list card) |= [=eval-form =strand-input] ^- [[(list card) =eval-result] _eval-form] =* take-loop $ =. in.strand-input ?~ in.strand-input ~ =/ in u.in.strand-input ?. ?=(%agent -.in) `in ?. ?=(%fact -.sign.in) `in :: :- ~ :^ %agent wire.in %fact (validate-mark q.q.cage.sign.in p.cage.sign.in bowl.strand-input) :: run the strand callback :: =/ =output (form.eval-form strand-input) :: add cards to cards :: =. cards %+ welp cards :: XX add tag to wires? cards.output :: case-wise handle next steps :: ?- -.next.output %wait [[cards %next ~] eval-form] %skip [[cards %next ~] eval-form] %fail [[cards %fail err.next.output] eval-form] %done [[cards %done value.next.output] eval-form] %cont :: recurse to run continuation with initialization input :: %_ take-loop form.eval-form self.next.output strand-input [bowl.strand-input ~] == == -- -- -- ::strand :: +$ gift-arvo :: out result <-$ $~ [%doze ~] $% gift:ames gift:behn gift:clay gift:dill gift:eyre gift:gall gift:iris gift:jael gift:khan == +$ task-arvo :: in request ->$ $% task:ames task:clay task:behn task:dill task:eyre task:gall task:iris task:jael task:khan == +$ note-arvo :: out request $-> $~ [%b %wake ~] $% [%a task:ames] [%b task:behn] [%c task:clay] [%d task:dill] [%e task:eyre] [%g task:gall] [%i task:iris] [%j task:jael] [%k task:khan] [%$ %whiz ~] [@tas %meta vase] == :: full vane names are required in vanes :: +$ sign-arvo :: in result $<- $% [%ames gift:ames] $: %behn $% gift:behn $>(%wris gift:clay) $>(%writ gift:clay) $>(%mere gift:clay) $>(%unto gift:gall) == == [%clay gift:clay] [%dill gift:dill] [%eyre gift:eyre] [%gall gift:gall] [%iris gift:iris] [%jael gift:jael] [%khan gift:khan] == :: $unix-task: input from unix :: +$ unix-task :: input from unix $~ [%wake ~] $% :: %dill: keyboard input :: $>(%belt task:dill) :: %dill: configure terminal (resized) :: $>(%blew task:dill) :: %clay: new process :: $>(%boat task:clay) :: %behn/%eyre/%iris: new process :: $>(%born vane-task) :: %eyre: cancel request :: [%cancel-request ~] :: %dill: reset terminal configuration :: $>(%hail task:dill) :: %ames: hear packet :: $>(%hear task:ames) :: %clay: external edit :: $>(%into task:clay) :: %clay: synchronous commit :: :: TODO: make $yuki an option for %into? :: $>(%park task:clay) :: %clay: load blob store :: $>(%prep task:clay) :: %eyre: learn ports of live http servers :: $>(%live task:eyre) :: %iris: hear (partial) http response :: $>(%receive task:iris) :: %eyre: starts handling an inbound http request :: $>(%request task:eyre) :: %eyre: starts handling an backdoor http request :: $>(%request-local task:eyre) :: %dill: close session :: $>(%shut task:dill) :: %behn: wakeup :: $>(%wake task:behn) == -- ::