From ae295d445a611d7581add26f7d82b650ce866f11 Mon Sep 17 00:00:00 2001 From: Philip Monk Date: Sat, 9 Nov 2019 16:53:42 -0800 Subject: [PATCH] mall: rm old apps for easier merging --- pkg/arvo/app/aqua-ames.hoon | 83 - pkg/arvo/app/aqua-behn.hoon | 131 -- pkg/arvo/app/aqua-dill.hoon | 78 - pkg/arvo/app/aqua-eyre.hoon | 157 -- pkg/arvo/app/aqua.hoon | 577 ----- pkg/arvo/app/azimuth-tracker.hoon | 231 -- pkg/arvo/app/chat-cli.hoon | 1221 ---------- pkg/arvo/app/chat-store.hoon | 234 -- pkg/arvo/app/clock.hoon | 80 - pkg/arvo/app/dns-collector.hoon | 174 -- pkg/arvo/app/dns.hoon | 303 --- pkg/arvo/app/dojo.hoon | 1271 ----------- pkg/arvo/app/example-tapp-fetch.hoon | 147 -- pkg/arvo/app/example-tapp-subscribe.hoon | 50 - pkg/arvo/app/hood.hoon | 205 -- pkg/arvo/app/ph.hoon | 615 ----- pkg/arvo/sys/vane/gall.hoon | 2638 ---------------------- 17 files changed, 8195 deletions(-) delete mode 100644 pkg/arvo/app/aqua-ames.hoon delete mode 100644 pkg/arvo/app/aqua-behn.hoon delete mode 100644 pkg/arvo/app/aqua-dill.hoon delete mode 100644 pkg/arvo/app/aqua-eyre.hoon delete mode 100644 pkg/arvo/app/aqua.hoon delete mode 100644 pkg/arvo/app/azimuth-tracker.hoon delete mode 100644 pkg/arvo/app/chat-cli.hoon delete mode 100644 pkg/arvo/app/chat-store.hoon delete mode 100644 pkg/arvo/app/clock.hoon delete mode 100644 pkg/arvo/app/dns-collector.hoon delete mode 100644 pkg/arvo/app/dns.hoon delete mode 100644 pkg/arvo/app/dojo.hoon delete mode 100644 pkg/arvo/app/example-tapp-fetch.hoon delete mode 100644 pkg/arvo/app/example-tapp-subscribe.hoon delete mode 100644 pkg/arvo/app/hood.hoon delete mode 100644 pkg/arvo/app/ph.hoon delete mode 100644 pkg/arvo/sys/vane/gall.hoon diff --git a/pkg/arvo/app/aqua-ames.hoon b/pkg/arvo/app/aqua-ames.hoon deleted file mode 100644 index 96e77f809..000000000 --- a/pkg/arvo/app/aqua-ames.hoon +++ /dev/null @@ -1,83 +0,0 @@ -:: This needs a better SDN solution. Every ship should have an IP -:: address, and we should eventually test changing those IP -:: addresses. -:: -:: For now, we broadcast every packet to every ship and rely on them -:: to drop them. -:: -/- aquarium -=, aquarium -=> |% - +$ move (pair bone card) - +$ card - $% [%poke wire dock %aqua-events (list aqua-event)] - [%peer wire dock path] - [%pull wire dock ~] - == - :: - +$ state - $: %0 - subscribed=_| - == - -- -=, gall -=| moves=(list move) -=| aqua-event-list=(list aqua-event) -=| ships=(list ship) -|_ $: bowl - state - == -++ this . -++ apex %_(this moves ~, aqua-event-list ~, ships ~) -++ abet - =? this !=(~ aqua-event-list) - %- emit-moves - [ost %poke /aqua-events [our %aqua] %aqua-events aqua-event-list]~ - :: ~? !?=(~ moves) [%aqua-ames-moves (lent moves)] - [moves this] -:: -++ emit-moves - |= ms=(list move) - %_(this moves (weld moves ms)) -:: -++ emit-aqua-events - |= aes=(list aqua-event) - %_(this aqua-event-list (weld aqua-event-list aes)) -:: -++ poke-aqua-vane-control - |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe)) - (aqua-vane-control-handler our ost subscribed command) -:: -:: Handle effects from ships. We only react to %send effects. -:: -++ diff-aqua-effects - |= [way=wire afs=aqua-effects] - ^- (quip move _this) - =. this apex =< abet - |- ^+ this - ?~ ufs.afs - this - =. this - ?+ -.q.i.ufs.afs this - %restore (handle-restore who.afs) - %send (handle-send i.ufs.afs) - == - $(ufs.afs t.ufs.afs) -:: -++ handle-restore - |= who=@p - %- emit-aqua-events - [%event who [//newt/0v1n.2m9vh %barn ~]]~ -:: -++ handle-send - |= [way=wire %send lan=lane:ames pac=@] - ^+ this - =/ hear [//newt/0v1n.2m9vh %hear lan pac] - =? ships =(~ ships) - .^((list ship) %gx /(scot %p our)/aqua/(scot %da now)/ships/noun) - %- emit-aqua-events - %+ turn ships - |= who=ship - [%event who hear] --- diff --git a/pkg/arvo/app/aqua-behn.hoon b/pkg/arvo/app/aqua-behn.hoon deleted file mode 100644 index c0f67d2df..000000000 --- a/pkg/arvo/app/aqua-behn.hoon +++ /dev/null @@ -1,131 +0,0 @@ -/- aquarium -=, aquarium -=> |% - +$ move (pair bone card) - +$ card - $% [%poke wire dock %aqua-events (list aqua-event)] - [%peer wire dock path] - [%pull wire dock ~] - [%wait wire p=@da] - [%rest wire p=@da] - == - :: - +$ state - $: %0 - subscribed=_| - piers=(map ship pier) - == - :: - +$ pier next-timer=(unit @da) - -- -=, gall -=| moves=(list move) -|_ $: bowl - state - == -++ this . -++ apex %_(this moves ~) -++ abet [(flop moves) this] -++ emit-moves - |= ms=(list move) - %_(this moves (weld ms moves)) -:: -++ emit-aqua-events - |= aes=(list aqua-event) - %- emit-moves - [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ -:: -++ poke-aqua-vane-control - |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe)) - (aqua-vane-control-handler our ost subscribed command) -:: -++ diff-aqua-effects - |= [way=wire afs=aqua-effects] - ^- (quip move _this) - =. this apex =< abet - |- ^+ this - ?~ ufs.afs - this - =. this - ?+ -.q.i.ufs.afs this - %sleep abet-pe:handle-sleep:(pe who.afs) - %restore abet-pe:handle-restore:(pe who.afs) - %doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs) - == - $(ufs.afs t.ufs.afs) -:: -:: Received timer wake -:: -++ wake - |= [way=wire error=(unit tang)] - ^- (quip move _this) - =. this apex =< abet - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - abet-pe:(take-wake:(pe who) t.way error) -:: -++ pe - |= who=ship - =+ (~(gut by piers) who *pier) - =* pier-data - - |% - ++ abet-pe - ^+ this - =. piers (~(put by piers) who pier-data) - this - :: - ++ handle-sleep - ^+ ..abet-pe - =< ..abet-pe(pier-data *pier) - ?~ next-timer - ..abet-pe - cancel-timer - :: - ++ handle-restore - ^+ ..abet-pe - =. this - %- emit-aqua-events - [%event who [//behn/0v1n.2m9vh %born ~]]~ - ..abet-pe - :: - ++ handle-doze - |= [way=wire %doze tim=(unit @da)] - ^+ ..abet-pe - ?~ tim - ?~ next-timer - ..abet-pe - cancel-timer - ?~ next-timer - (set-timer u.tim) - (set-timer:cancel-timer u.tim) - :: - ++ set-timer - |= tim=@da - ~? debug=| [who=who %setting-timer tim] - =. next-timer `tim - =. this (emit-moves [ost %wait /(scot %p who) tim]~) - ..abet-pe - :: - ++ cancel-timer - ~? debug=| [who=who %cancell-timer (need next-timer)] - =. this (emit-moves [ost %rest /(scot %p who) (need next-timer)]~) - =. next-timer ~ - ..abet-pe - :: - ++ take-wake - |= [way=wire error=(unit tang)] - ~? debug=| [who=who %aqua-behn-wake now error=error] - =. next-timer ~ - =. this - %- emit-aqua-events - :_ ~ - ^- aqua-event - :+ %event who - :- //behn/0v1n.2m9vh - ?~ error - [%wake ~] - [%crud %fail u.error] - ..abet-pe - -- --- diff --git a/pkg/arvo/app/aqua-dill.hoon b/pkg/arvo/app/aqua-dill.hoon deleted file mode 100644 index 442104e51..000000000 --- a/pkg/arvo/app/aqua-dill.hoon +++ /dev/null @@ -1,78 +0,0 @@ -:: Would love to see a proper stateful terminal handler. Ideally, -:: you'd be able to ^X into the virtual ship, like the old ^W. -:: -:: However, that's probably not the primary way of interacting with -:: it. In practice, most of the time you'll be running from a file -:: (eg for automated testing) or fanning the same command to multiple -:: ships or otherwise making use of the fact that we can -:: programmatically send events. -:: -/- aquarium -=, aquarium -=> |% - +$ move (pair bone card) - +$ card - $% [%poke wire dock %aqua-events (list aqua-event)] - [%peer wire dock path] - [%pull wire dock ~] - == - :: - +$ state - $: %0 - subscribed=_| - == - -- -=, gall -=| moves=(list move) -|_ $: bowl - state - == -++ this . -++ apex %_(this moves ~) -++ abet [(flop moves) this] -++ emit-moves - |= ms=(list move) - %_(this moves (weld ms moves)) -:: -++ emit-aqua-events - |= aes=(list aqua-event) - %- emit-moves - [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ -:: -++ poke-aqua-vane-control - |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe)) - (aqua-vane-control-handler our ost subscribed command) -:: -++ diff-aqua-effects - |= [way=wire afs=aqua-effects] - ^- (quip move _this) - =. this apex =< abet - |- ^+ this - ?~ ufs.afs - this - =. this - ?+ -.q.i.ufs.afs this - %blit (handle-blit who.afs i.ufs.afs) - == - $(ufs.afs t.ufs.afs) -:: -++ handle-blit - |= [who=@p way=wire %blit blits=(list blit:dill)] - ^+ this - =/ last-line - %+ roll blits - |= [b=blit:dill line=tape] - ?- -.b - %lin (tape p.b) - %mor ~& "{}: {line}" "" - %hop line - %bel line - %clr "" - %sag ~& [%save-jamfile-to p.b] line - %sav ~& [%save-file-to p.b] line - %url ~& [%activate-url p.b] line - == - ~? !=(~ last-line) last-line - this --- diff --git a/pkg/arvo/app/aqua-eyre.hoon b/pkg/arvo/app/aqua-eyre.hoon deleted file mode 100644 index 435a33fbd..000000000 --- a/pkg/arvo/app/aqua-eyre.hoon +++ /dev/null @@ -1,157 +0,0 @@ -:: Pass-through Eyre driver -:: -/- aquarium -=, aquarium -=> |% - +$ move (pair bone card) - +$ card - $% [%poke wire dock %aqua-events (list aqua-event)] - [%peer wire dock path] - [%pull wire dock ~] - [%hiss wire p=(unit user:eyre) q=mark r=(cask hiss:eyre)] - == - :: - +$ state - $: %0 - subscribed=_| - piers=(map ship pier) - == - :: - +$ pier http-requests=(set @ud) - -- -=, gall -=| moves=(list move) -|_ $: bowl - state - == -++ this . -++ apex %_(this moves ~) -++ abet [(flop moves) this] -++ emit-moves - |= ms=(list move) - %_(this moves (weld ms moves)) -:: -++ emit-aqua-events - |= aes=(list aqua-event) - %- emit-moves - [ost %poke /aqua-events [our %aqua] %aqua-events aes]~ -:: -++ poke-aqua-vane-control - |= command=?(%subscribe %unsubscribe) - :_ this(subscribed =(command %subscribe)) - (aqua-vane-control-handler our ost subscribed command) -:: -++ diff-aqua-effects - |= [way=wire afs=aqua-effects] - ^- (quip move _this) - =. this apex =< abet - |- ^+ this - ?~ ufs.afs - this - =. this - ?+ -.q.i.ufs.afs this - %sleep abet-pe:handle-sleep:(pe who.afs) - %restore abet-pe:handle-restore:(pe who.afs) - %thus abet-pe:(handle-thus:(pe who.afs) i.ufs.afs) - == - $(ufs.afs t.ufs.afs) -:: -:: Received inbound HTTP response -:: -++ sigh-httr - |= [way=wire res=httr:eyre] - ^- (quip move _this) - =. this apex =< abet - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - ~& [%received-httr who] - abet-pe:(take-sigh-httr:(pe who) t.way res) -:: -:: Received inbound HTTP response error -:: -++ sigh-tang - |= [way=wire tan=tang] - ^- (quip move _this) - =. this apex =< abet - ?> ?=([@ *] way) - =/ who (,@p (slav %p i.way)) - ~& [%received-httr who] - abet-pe:(take-sigh-tang:(pe who) t.way tan) -:: -++ pe - |= who=ship - =+ (~(gut by piers) who *pier) - =* pier-data - - |% - ++ abet-pe - ^+ this - =. piers (~(put by piers) who pier-data) - this - :: - ++ handle-sleep - ^+ ..abet-pe - ..abet-pe(pier-data *pier) - :: - ++ handle-restore - ^+ ..abet-pe - =. this - %- emit-aqua-events - [%event who [//http/0v1n.2m9vh %born ~]]~ - ..abet-pe - :: - ++ handle-thus - |= [way=wire %thus num=@ud req=(unit hiss:eyre)] - ^+ ..abet-pe - ?~ req - ?. (~(has in http-requests) num) - ..abet-pe - :: Eyre doesn't support cancelling HTTP requests from userspace, - :: so we remove it from our state so we won't pass along the - :: response. - :: - ~& [who=who %aqua-eyre-cant-cancel-thus num=num] - =. http-requests (~(del in http-requests) num) - ..abet-pe - ~& [who=who %aqua-eyre-requesting u.req] - =. http-requests (~(put in http-requests) num) - =. this - %- emit-moves :_ ~ - :* ost - %hiss - /(scot %p who)/(scot %ud num) - ~ - %httr - [%hiss u.req] - == - ..abet-pe - :: - :: Pass HTTP response back to virtual ship - :: - ++ take-sigh-httr - |= [way=wire res=httr:eyre] - ^+ ..abet-pe - ?> ?=([@ ~] way) - =/ num (slav %ud i.way) - ?. (~(has in http-requests) num) - ~& [who=who %ignoring-httr num=num] - ..abet-pe - =. http-requests (~(del in http-requests) num) - =. this - (emit-aqua-events [%event who [//http/0v1n.2m9vh %receive num [%start [p.res q.res] r.res &]]]~) - ..abet-pe - :: - :: Got error in HTTP response - :: - ++ take-sigh-tang - |= [way=wire tan=tang] - ^+ ..abet-pe - ?> ?=([@ ~] way) - =/ num (slav %ud i.way) - ?. (~(has in http-requests) num) - ~& [who=who %ignoring-httr num=num] - ..abet-pe - =. http-requests (~(del in http-requests) num) - %- (slog tan) - ..abet-pe - -- --- diff --git a/pkg/arvo/app/aqua.hoon b/pkg/arvo/app/aqua.hoon deleted file mode 100644 index fab6634e5..000000000 --- a/pkg/arvo/app/aqua.hoon +++ /dev/null @@ -1,577 +0,0 @@ -:: An aquarium of virtual ships. Put in some fish and watch them! -:: -:: usage: -:: |start %aqua -:: /- aquarium -:: :aqua &pill .^(pill:aquarium %cx %/urbit/pill) -:: OR -:: :aqua &pill +solid -:: -:: Then try stuff: -:: :aqua [%init ~[~bud ~dev]] -:: :aqua [%dojo ~[~bud ~dev] "[our eny (add 3 5)]"] -:: :aqua [%dojo ~[~bud] "|hi ~dev"] -:: :aqua [%wish ~[~bud ~dev] '(add 2 3)'] -:: :aqua [%peek ~[~bud] /cx/~bud/home/(scot %da now)/app/curl/hoon] -:: :aqua [%dojo ~[~bud ~dev] '|mount %'] -:: :aqua [%file ~[~bud ~dev] %/sys/vane] -:: :aqua [%pause-events ~[~bud ~dev]] -:: -:: -:: We get ++unix-event and ++pill from /-aquarium -:: -/- aquarium -/+ pill -=, pill-lib=pill -=, aquarium -=> $~ |% - +$ move (pair bone card) - +$ card - $% [%diff diff-type] - == - :: - :: Outgoing subscription updates - :: - +$ diff-type - $% [%aqua-effects aqua-effects] - [%aqua-events aqua-events] - [%aqua-boths aqua-boths] - == - :: - +$ state - $: %0 - pil=pill - assembled=* - tym=@da - fleet-snaps=(map term (map ship pier)) - piers=(map ship pier) - == - :: - +$ pier - $: snap=* - event-log=(list unix-timed-event) - next-events=(qeu unix-event) - processing-events=? - == - -- -=, gall -:: -:: unix-{effects,events,boths}: collect jar of effects and events to -:: brodcast all at once to avoid gall backpressure -:: moves: Hoist moves into state for cleaner state management -:: -=| unix-effects=(jar ship unix-effect) -=| unix-events=(jar ship unix-timed-event) -=| unix-boths=(jar ship unix-both) -=| moves=(list move) -|_ $: hid=bowl - state - == -:: -:: Represents a single ship's state. -:: -++ pe - |= who=ship - =+ (~(gut by piers) who *pier) - =* pier-data - - |% - :: - :: Done; install data - :: - ++ abet-pe - ^+ this - =. piers (~(put by piers) who pier-data) - this - :: - :: Initialize new ship - :: - ++ apex - =. pier-data *pier - =. snap assembled - ~& pill-size=(met 3 (jam snap)) - ..abet-pe - :: - :: Enqueue events to child arvo - :: - ++ push-events - |= ues=(list unix-event) - ^+ ..abet-pe - =. next-events (~(gas to next-events) ues) - ..abet-pe - :: - :: Send moves to host arvo - :: - ++ emit-moves - |= ms=(list move) - =. this (^emit-moves ms) - ..abet-pe - :: - :: Process the events in our queue. - :: - ++ plow - |- ^+ ..abet-pe - ?: =(~ next-events) - ..abet-pe - ?. processing-events - ..abet-pe - =^ ue next-events ~(get to next-events) - =/ poke-arm (mox +47.snap) - ?> ?=(%0 -.poke-arm) - =/ poke p.poke-arm - =. tym (max +(tym) now.hid) - =/ poke-result (mule |.((slum poke tym ue))) - ?: ?=(%| -.poke-result) - %- (slog >%aqua-crash< >guest=who< p.poke-result) - $ - =. snap +.p.poke-result - =. ..abet-pe (publish-event tym ue) - =. ..abet-pe (handle-effects ((list ovum) -.p.poke-result)) - $ - :: - :: Peek - :: - ++ peek - |= p=* - =/ res (mox +46.snap) - ?> ?=(%0 -.res) - =/ peek p.res - =/ pax (path p) - ?> ?=([@ @ @ @ *] pax) - =. i.t.t.t.pax (scot %da tym) - =/ pek (slum peek [tym pax]) - pek - :: - :: Wish - :: - ++ wish - |= txt=@t - =/ res (mox +22.snap) - ?> ?=(%0 -.res) - =/ wish p.res - ~& [who=who %wished (slum wish txt)] - ..abet-pe - :: - ++ mox |=(* (mock [snap +<] scry)) - :: - :: Start/stop processing events. When stopped, events are added to - :: our queue but not processed. - :: - ++ start-processing-events .(processing-events &) - ++ stop-processing-events .(processing-events |) - :: - :: Handle all the effects produced by a single event. - :: - ++ handle-effects - |= effects=(list ovum) - ^+ ..abet-pe - ?~ effects - ..abet-pe - =. ..abet-pe - =/ sof ((soft unix-effect) i.effects) - ?~ sof - ~? aqua-debug=& [who=who %unknown-effect i.effects] - ..abet-pe - (publish-effect u.sof) - $(effects t.effects) - :: - :: Give effect to our subscribers - :: - ++ publish-effect - |= uf=unix-effect - ^+ ..abet-pe - =. unix-effects (~(add ja unix-effects) who uf) - =. unix-boths (~(add ja unix-boths) who [%effect uf]) - ..abet-pe - :: - :: Give event to our subscribers - :: - ++ publish-event - |= ute=unix-timed-event - ^+ ..abet-pe - =. event-log [ute event-log] - =. unix-events (~(add ja unix-events) who ute) - =. unix-boths (~(add ja unix-boths) who [%event ute]) - ..abet-pe - -- -:: -++ this . -:: -:: ++apex-aqua and ++abet-aqua must bookend calls from gall -:: -++ apex-aqua - ^+ this - =: moves ~ - unix-effects ~ - unix-events ~ - unix-boths ~ - == - this -:: -++ abet-aqua - ^- (quip move _this) - =. this - %- emit-moves - %- zing ^- (list (list move)) - %+ turn ~(tap by sup.hid) - |= [b=bone her=ship pax=path] - ^- (list move) - ?+ pax ~ - [%effects @ ~] - =/ who (slav %p i.t.pax) - =/ ufs (~(get ja unix-effects) who) - ?~ ufs - ~ - [b %diff %aqua-effects who (flop ufs)]~ - :: - [%effects ~] - %+ turn - ~(tap by unix-effects) - |= [who=ship ufs=(list unix-effect)] - [b %diff %aqua-effects who (flop ufs)] - :: - [%events @ ~] - =/ who (slav %p i.t.pax) - =/ ve (~(get ja unix-events) who) - ?~ ve - ~ - [b %diff %aqua-events who (flop ve)]~ - :: - [%boths @ ~] - =/ who (slav %p i.t.pax) - =/ bo (~(get ja unix-boths) who) - ?~ bo - ~ - [b %diff %aqua-boths who (flop bo)]~ - == - [(flop moves) this] -:: -++ emit-moves - |= ms=(list move) - =. moves (weld ms moves) - this -:: -:: -:: Run all events on all ships until all queues are empty -:: -++ plow-all - |- ^+ this - =/ who - =/ pers ~(tap by piers) - |- ^- (unit ship) - ?~ pers - ~ - ?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers) - `p.i.pers - $(pers t.pers) - ~? aqua-debug=| plowing=who - ?~ who - this - =. this abet-pe:plow:(pe u.who) - $ -:: -:: Subscribe to effects from a ship -:: -++ peer-effects - |= pax=path - ^- (quip move _this) - ?. ?=([@ *] pax) - ~& [%aqua-bad-peer-effects pax] - `this - ?~ (slaw %p i.pax) - ~& [%aqua-bad-peer-effects-ship pax] - !! - `this -:: -:: Subscribe to events to a ship -:: -++ peer-events - |= pax=path - ^- (quip move _this) - ?. ?=([@ ~] pax) - ~& [%aqua-bad-peer-events pax] - `this - ?~ (slaw %p i.pax) - ~& [%aqua-bad-peer-events-ship pax] - !! - `this -:: -:: Subscribe to both events and effects of a ship -:: -++ peer-boths - |= pax=path - ^- (quip move _this) - ?. ?=([@ ~] pax) - ~& [%aqua-bad-peer-boths pax] - `this - ?~ (slaw %p i.pax) - ~& [%aqua-bad-peer-boths-ship pax] - !! - `this -:: -:: Load a pill and assemble arvo. Doesn't send any of the initial -:: events. -:: -++ poke-pill - |= p=pill - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - =. pil p - ~& lent=(met 3 (jam boot-ova.pil)) - =/ res=toon :: (each * (list tank)) - (mock [boot-ova.pil [2 [0 3] [0 2]]] scry) - =. fleet-snaps ~ - ?- -.res - %0 - ~& %suc - =. assembled +7.p.res - this - :: - %1 - ~& [%vere-blocked p.res] - this - :: - %2 - ~& %vere-fail - %- (slog p.res) - this - == -:: -:: Handle commands from CLI -:: -:: Should put some thought into arg structure, maybe make a mark. -:: -:: Should convert some of these to just rewrite into ++poke-events. -:: -++ poke-noun - |= val=* - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - ^+ this - :: Could potentially factor out the three lines of turn-ships - :: boilerplate - :: - ?+ val ~|(%bad-noun-arg !!) - [%swap-vanes vs=*] - ?> ?=([[%7 * %1 installed=*] ~] boot-ova.pil) - =. installed.boot-ova.pil - %+ roll (,(list term) vs.val) - |= [v=term _installed.boot-ova.pil] - %^ slum installed.boot-ova.pil now.hid - =/ vane - ?+ v ~|([%unknown-vane v] !!) - %a %ames - %b %behn - %c %clay - %d %dill - %e %eyre - %f %ford - %g %gall - %j %jael - %m %mall - == - =/ pax - /(scot %p our.hid)/home/(scot %da now.hid)/sys/vane/[vane] - =/ txt .^(@ %cx (weld pax /hoon)) - [/vane/[vane] [%veer v pax txt]] - => .(this ^+(this this)) - =^ ms this (poke-pill pil) - (emit-moves ms) - :: - [%swap-files ~] - =. userspace-ova.pil - =/ slim-dirs=(list path) - ~[/app /gen /lib /mar /sur /hoon/sys /arvo/sys /zuse/sys /age] - :_ ~ - %- unix-event - %- %*(. file-ovum:pill-lib directories slim-dirs) - /(scot %p our.hid)/home/(scot %da now.hid) - =^ ms this (poke-pill pil) - (emit-moves ms) - :: - [%wish hers=* p=@t] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - (wish:(pe who) p.val) - :: - [%unpause-events hers=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - start-processing-events:(pe who) - :: - [%pause-events hers=*] - %+ turn-ships ((list ship) hers.val) - |= [who=ship thus=_this] - =. this thus - stop-processing-events:(pe who) - :: - [%clear-snap lab=@tas] - =. fleet-snaps ~ :: (~(del by fleet-snaps) lab.val) - this - == -:: -:: Apply a list of events tagged by ship -:: -++ poke-aqua-events - |= events=(list aqua-event) - ^- (quip move _this) - =. this apex-aqua =< abet-aqua - %+ turn-events events - |= [ae=aqua-event thus=_this] - =. this thus - ?- -.ae - %init-ship - =. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~]) - =/ initted - =< plow - %- push-events:apex:(pe who.ae) - ^- (list unix-event) - :~ [/ %wack 0] :: eny - [/ %whom who.ae] :: eny - [//newt/0v1n.2m9vh %barn ~] - [//behn/0v1n.2m9vh %born ~] - :^ //term/1 %boot & - ?~ keys.ae - [%fake who.ae] - [%dawn u.keys.ae] - -.userspace-ova.pil - [//http-client/0v1n.2m9vh %born ~] - [//http-server/0v1n.2m9vh %born ~] - [//http-server/0v1n.2m9vh %live 8.080 `8.445] - == - =. this abet-pe:initted - (pe who.ae) - :: - %pause-events - stop-processing-events:(pe who.ae) - :: - %snap-ships - =. fleet-snaps - %+ ~(put by fleet-snaps) lab.ae - %- malt - %+ murn hers.ae - |= her=ship - ^- (unit (pair ship pier)) - =+ per=(~(get by piers) her) - ?~ per - ~ - `[her u.per] - (pe -.hers.ae) - :: - %restore-snap - =. this - %+ turn-ships (turn ~(tap by piers) head) - |= [who=ship thus=_this] - =. this thus - (publish-effect:(pe who) [/ %sleep ~]) - =. piers (~(uni by piers) (~(got by fleet-snaps) lab.ae)) - =. this - %+ turn-ships (turn ~(tap by piers) head) - |= [who=ship thus=_this] - =. this thus - (publish-effect:(pe who) [/ %restore ~]) - (pe ~bud) :: XX why ~bud? need an example - :: - %event - ~? &(aqua-debug=| !?=(?(%belt %hear) -.q.ue.ae)) - raw-event=[who.ae -.q.ue.ae] - ~? &(debug=| ?=(%receive -.q.ue.ae)) - raw-event=[who.ae ue.ae] - (push-events:(pe who.ae) [ue.ae]~) - == -:: -:: Run a callback function against a list of ships, aggregating state -:: and plowing all ships at the end. -:: -:: I think we should use patterns like this more often. Because we -:: don't, here's some points to be aware. -:: -:: `fun` must take `this` as a parameter, since it needs to be -:: downstream of previous state changes. You could use `state` as -:: the state variable, but it muddles the code and it's not clear -:: whether it's better. You could use the `_(pe)` core if you're -:: sure you'll never need to refer to anything outside of your pier, -:: but I don't think we can guarantee that. -:: -:: The callback function must start with `=. this thus`, or else -:: you don't get the new state. Would be great if you could hot-swap -:: that context in here, but we don't know where to put it unless we -:: restrict the callbacks to always have `this` at a particular axis, -:: and that doesn't feel right -:: -++ turn-plow - |* arg=mold - |= [hers=(list arg) fun=$-([arg _this] _(pe))] - |- ^+ this - ?~ hers - plow-all - =. this - abet-pe:plow:(fun i.hers this) - $(hers t.hers, this this) -:: -++ turn-ships (turn-plow ship) -++ turn-events (turn-plow aqua-event) -:: -:: Check whether we have a snapshot -:: -++ peek-x-fleet-snap - |= pax=path - ^- (unit (unit [%noun noun])) - ?. ?=([@ ~] pax) - ~ - :^ ~ ~ %noun - (~(has by fleet-snaps) i.pax) -:: -:: Pass scry into child ship -:: -++ peek-x-i - |= pax=path - ^- (unit (unit [%noun noun])) - ?. ?=([@ @ @ @ @ *] pax) - ~ - =/ who (slav %p i.pax) - =/ pier (~(get by piers) who) - ?~ pier - ~ - :^ ~ ~ %noun - (peek:(pe who) t.pax) -:: -:: Get all created ships -:: -++ peek-x-ships - |= pax=path - ^- (unit (unit [%noun (list ship)])) - ?. ?=(~ pax) - ~ - :^ ~ ~ %noun - `(list ship)`(turn ~(tap by piers) head) -:: -:: -:: -++ peek-x-pill - |= pax=path - ^- (unit (unit [%pill pill])) - =/ pill-size (met 3 (jam pil)) - ?: (lth pill-size 100) - ~& [%no-pill size=pill-size] - [~ ~] - ``pill+pil -:: -:: Trivial scry for mock -:: -++ scry |=([* *] ~) -:: -:: Throw away old state if it doesn't soft to new state. -:: -++ prep - |= old/(unit noun) - ^- [(list move) _+>.$] - ~& prep=%aqua - ?~ old - `+>.$ - =+ new=((soft state) u.old) - ?~ new - `+>.$ - `+>.$(+<+ u.new) --- diff --git a/pkg/arvo/app/azimuth-tracker.hoon b/pkg/arvo/app/azimuth-tracker.hoon deleted file mode 100644 index 0bad214bf..000000000 --- a/pkg/arvo/app/azimuth-tracker.hoon +++ /dev/null @@ -1,231 +0,0 @@ -/- eth-watcher -/+ tapp, stdio -=, able:jael -=> |% - +$ app-state - $: %3 - url=@ta - whos=(set ship) - == - +$ peek-data ~ - +$ in-poke-data - $: %azimuth-tracker-poke - $% :: %listen - :: - [%listen whos=(list ship) =source:jael] - :: %watch: configure node url - :: - [%watch url=@ta] - == - == - +$ out-poke-data - $: %eth-watcher-poke - poke:eth-watcher - == - +$ in-peer-data - $: %eth-watcher-diff - diff:eth-watcher - == - +$ out-peer-data - [%azimuth-udiff =ship =udiff:point] - ++ tapp - %: ^tapp - app-state - peek-data - in-poke-data - out-poke-data - in-peer-data - out-peer-data - == - ++ tapp-async tapp-async:tapp - ++ stdio (^stdio out-poke-data out-peer-data) - -- -:: -:: Async helpers -:: -=> |% - ++ topics - |= ships=(set ship) - ^- (list ?(@ux (list @ux))) - :: The first topic should be one of these event types - :: - :- => azimuth-events:azimuth - :~ broke-continuity - changed-keys - lost-sponsor - escape-accepted - == - :: If we're looking for a specific set of ships, specify them as - :: the second topic. Otherwise don't specify the second topic so - :: we will match all ships. - :: - ?: =(~ ships) - ~ - [(turn ~(tap in ships) ,@) ~] - :: - ++ event-logs-to-udiffs - |= event-logs=(list =event-log:rpc:ethereum) - ^- =udiffs:point - %+ murn event-logs - |= =event-log:rpc:ethereum - ^- (unit [=ship =udiff:point]) - ?~ mined.event-log - ~ - ?: removed.u.mined.event-log - ~& [%removed-log event-log] - ~ - =/ =id:block [block-hash block-number]:u.mined.event-log - =, azimuth-events:azimuth - =, abi:ethereum - ?: =(broke-continuity i.topics.event-log) - =/ who=@ (decode-topics t.topics.event-log ~[%uint]) - =/ num=@ (decode-results data.event-log ~[%uint]) - `[who id %rift num] - ?: =(changed-keys i.topics.event-log) - =/ who=@ (decode-topics t.topics.event-log ~[%uint]) - =+ ^- [enc=octs aut=octs sut=@ud rev=@ud] - %+ decode-results data.event-log - ~[[%bytes-n 32] [%bytes-n 32] %uint %uint] - `[who id %keys rev sut (pass-from-eth:azimuth enc aut sut)] - ?: =(lost-sponsor i.topics.event-log) - =+ ^- [who=@ pos=@] - (decode-topics t.topics.event-log ~[%uint %uint]) - `[who id %spon ~] - ?: =(escape-accepted i.topics.event-log) - =+ ^- [who=@ wer=@] - (decode-topics t.topics.event-log ~[%uint %uint]) - `[who id %spon `wer] - ~& [%bad-topic event-log] - ~ - :: - ++ jael-update - |= =udiffs:point - =/ m (async:stdio ,~) - |- ^- form:m - =* loop $ - ?~ udiffs - (pure:m ~) - =/ =path /(scot %p ship.i.udiffs) - ;< ~ bind:m (give-result:stdio / %azimuth-udiff i.udiffs) - ;< ~ bind:m (give-result:stdio path %azimuth-udiff i.udiffs) - loop(udiffs t.udiffs) - -- -:: -:: Main loop -:: -=> |% - :: - :: Send %listen to jael - :: - ++ listen - |= [state=app-state whos=(list ship) =source:jael] - =/ m (async:stdio ,app-state) - ^- form:m - ;< ~ bind:m (send-effect:stdio %listen /lo (silt whos) source) - (pure:m state) - :: - :: Start watching a node - :: - ++ start - |= [state=app-state our=ship dap=term] - =/ m (async:stdio ,app-state) - ^- form:m - ;< ~ bind:m - %+ poke-app:stdio - [our %eth-watcher] - :+ %eth-watcher-poke %watch - :- /[dap] - :* url.state - launch:contracts:azimuth - ~[azimuth:contracts:azimuth] - (topics whos.state) - == - (pure:m state) - :: - :: +history: Tell subscribers about many changes - :: - ++ history - |= =loglist:eth-watcher - =/ m (async:stdio ,~) - |- ^- form:m - %- jael-update - (event-logs-to-udiffs loglist) - :: - :: +log: Tell subscribers about a new change - :: - ++ log - |= =event-log:rpc:ethereum - =/ m (async:stdio ,~) - (history [event-log ~]) - :: - :: +disavow: Tell subscribers there was a deep reorg - :: - ++ disavow - |= =id:block - =/ m (async:stdio ,~) - ^- form:m - (jael-update [*ship id %disavow ~]~) - -- -:: -:: Main -:: -=* default-tapp default-tapp:tapp -%- create-tapp-all:tapp -^- tapp-core-all:tapp -|_ [=bowl:gall state=app-state] -++ handle-init - =/ m tapp-async - ^- form:m - :: set up subscription once, listen forever - :: - ;< ~ bind:m - %+ peer-app:stdio - [our.bowl %eth-watcher] - /logs/[dap.bowl] - (pure:m state) -:: -++ handle-peek handle-peek:default-tapp -++ handle-take handle-take:default-tapp -:: -++ handle-poke - |= in=in-poke-data - =/ m tapp-async - ^- form:m - ?- +<.in - %listen (listen state +>.in) - %watch (start state(url url.in) [our dap]:bowl) - == -:: -++ handle-diff - |= [=dock =path in=in-peer-data] - =/ m tapp-async - ^- form:m - ;< ~ bind:m - ?- +<.in - %history (history +>.in) - %log (log +>.in) - %disavow (disavow +>.in) - == - (pure:m state) -:: -:: +handle-peer: handle incoming subscriptions (generally from jael) -:: -:: /~some-ship: listen to events for this ship -:: /: listen to events for all ships azimuth-tracker is observing -:: -:: note that incoming subscriptions affect application state. -:: -++ handle-peer - |= =path - =/ m tapp-async - ^- form:m - ?. ?=(?(~ [@ ~]) path) !! - =/ who=(unit ship) - ?~ path ~ - `(slav %p i.path) - =. whos.state - ?~ who - ~ - (~(put in whos.state) u.who) - (start state [our dap]:bowl) --- diff --git a/pkg/arvo/app/chat-cli.hoon b/pkg/arvo/app/chat-cli.hoon deleted file mode 100644 index a0d75c588..000000000 --- a/pkg/arvo/app/chat-cli.hoon +++ /dev/null @@ -1,1221 +0,0 @@ -:: chat-cli: cli chat client using chat-store and friends -:: -:: pulls all known messages into a single stream. -:: type ;help for usage instructions. -:: -:: note that while the chat-store only cares about paths, -:: we mostly deal with [ship path] (aka target) here. -:: when sending messages (through the chat hook), -:: we concat the ship onto the head of the path, -:: and trust it to take care of the rest. -:: -/- *chat-store, *chat-view, *chat-hook, - *permission-store, *group-store, - sole-sur=sole -/+ sole-lib=sole, chat-eval -:: -|% -+$ state - $: grams=(list mail) :: all messages - known=(set [target serial]) :: known message lookup - count=@ud :: (lent grams) - bound=(map target glyph) :: bound circle glyphs - binds=(jug glyph target) :: circle glyph lookup - audience=(set target) :: active targets - settings=(set term) :: frontend flags - width=@ud :: display width - timez=(pair ? @ud) :: timezone adjustment - cli=[=bone state=sole-share:sole-sur] :: console id & state - == -:: -+$ mail [source=target envelope] -+$ target [=ship =path] -:: -+$ glyph char -++ glyphs "!@#$%^&()-=_+[]\{};'\\:\",.<>?" -:: -+$ command - $% [%target (set target)] :: set messaging target - [%say letter] :: send message - [%eval cord hoon] :: send #-message - :: - [%create chat-security path (unit glyph)] :: create chat - [%delete path] :: delete chat - [%invite ?(%r %w %rw) path (set ship)] :: allow - [%banish ?(%r %w %rw) path (set ship)] :: disallow - :: - [%join target (unit glyph)] :: join target - [%leave target] :: nuke target - :: - [%bind glyph target] :: bind glyph - [%unbind glyph (unit target)] :: unbind glyph - [%what (unit $@(char target))] :: glyph lookup - :: - [%settings ~] :: show active settings - [%set term] :: set settings flag - [%unset term] :: unset settings flag - [%width @ud] :: adjust display width - [%timezone ? @ud] :: adjust time printing - :: - [%select $@(rel=@ud [zeros=@u abs=@ud])] :: rel/abs msg selection - [%chats ~] :: list available chats - [%help ~] :: print usage info - == :: -:: -+$ move [bone card] -+$ card - $% [%diff %sole-effect sole-effect:sole-sur] - [%poke wire dock out-action] - [%peer wire dock path] - == -:: -+$ out-action - $% [%chat-action chat-action] - [%chat-view-action chat-view-action] - [%chat-hook-action chat-hook-action] - [%group-action group-action] - == --- -:: -|_ [=bowl:gall state] -++ this . -:: +prep: setup & state adapter -:: -++ prep - |= old=(unit state) - ?^ old - [~ this(+<+ u.old)] - =^ moves this - %_ catch-up - audience [[our-self /] ~ ~] - settings (sy %showtime %notify ~) - width 80 - == - [[connect moves] this] -:: +catch-up: process all chat-store state -:: -++ catch-up - ^- (quip move _this) - =/ =inbox - .^ inbox - %gx - (scot %p our.bowl) - %chat-store - (scot %da now.bowl) - /all/noun - == - |- ^- (quip move _this) - ?~ inbox [~ this] - =* path p.n.inbox - =* mailbox q.n.inbox - =/ =target (path-to-target path) - =^ moves-n this (read-envelopes target envelopes.mailbox) - =^ moves-l this $(inbox l.inbox) - =^ moves-r this $(inbox r.inbox) - [:(weld moves-n moves-l moves-r) this] -:: +connect: connect to the chat-store -:: -++ connect - ^- move - [ost.bowl %peer /chat-store [our-self %chat-store] /updates] -:: +true-self: moons to planets -:: -++ true-self - |= who=ship - ^- ship - ?. ?=(%earl (clan:title who)) who - (sein:title our.bowl now.bowl who) -++ our-self (true-self our.bowl) -:: +target-to-path: prepend ship to the path -:: -++ target-to-path - |= target - [(scot %p ship) path] -:: +path-to-target: deduces a target from a mailbox path -:: -++ path-to-target - |= =path - ^- target - ?. ?=([@ @ *] path) - ::TODO can we safely assert the above? - ~& [%path-without-host path] - [our-self path] - =+ who=(slaw %p i.path) - ?~ who [our-self path] - [u.who t.path] -:: +poke-noun: debug helpers -:: -++ poke-noun - |= a=* - ^- (quip move _this) - ?: ?=(%connect a) - [[connect ~] this] - ?: ?=(%catch-up a) - catch-up - [~ this] -:: +poke-sole-action: handle cli input -:: -++ poke-sole-action - |= act=sole-action:sole-sur - ^- (quip move _this) - ?. =(bone.cli ost.bowl) - ~|(%strange-sole !!) - (sole:sh-in act) -:: +peer: accept only cli subscriptions from ourselves -:: -++ peer - |= =path - ^- (quip move _this) - ?. (team:title our-self src.bowl) - ~| [%peer-talk-stranger src.bowl] - !! - ?. ?=([%sole *] path) - ~| [%peer-talk-strange path] - !! - =. bone.cli ost.bowl - :: display a fresh prompt - :- [prompt:sh-out ~] - :: start with fresh sole state - this(state.cli *sole-share:sole-sur) -:: +diff-chat-update: get new mailboxes & messages -:: -++ diff-chat-update - |= [=wire upd=chat-update] - ^- (quip move _this) - ?+ -.upd [~ this] - %create (notice-create +.upd) - %delete [[(show-delete:sh-out (path-to-target path.upd)) ~] this] - %message (read-envelope (path-to-target path.upd) envelope.upd) - == -:: -++ read-envelopes - |= [=target envs=(list envelope)] - ^- (quip move _this) - ?~ envs [~ this] - =^ moves-i this (read-envelope target i.envs) - =^ moves-t this $(envs t.envs) - [(weld moves-i moves-t) this] -:: -++ notice-create - |= =target - ^- (quip move _this) - =^ moves this - ?: (~(has by bound) target) - [~ this] - (bind-default-glyph target) - [[(show-create:sh-out target) moves] this] -:: +bind-default-glyph: bind to default, or random available -:: -++ bind-default-glyph - |= =target - ^- (quip move _this) - =; =glyph (bind-glyph glyph target) - |^ =/ g=glyph (choose glyphs) - ?. (~(has by binds) g) g - =/ available=(list glyph) - %~ tap in - (~(dif in `(set glyph)`(sy glyphs)) ~(key by binds)) - ?~ available g - (choose available) - ++ choose - |= =(list glyph) - =; i=@ud (snag i list) - (mod (mug target) (lent list)) - -- -:: +bind-glyph: add binding for glyph -:: -++ bind-glyph - |= [=glyph =target] - ^- (quip move _this) - ::TODO should send these to settings store eventually - :: if the target was already bound to another glyph, un-bind that - :: - =? binds (~(has by bound) target) - (~(del ju binds) (~(got by bound) target) target) - =. bound (~(put by bound) target glyph) - =. binds (~(put ju binds) glyph target) - [(show-glyph:sh-out glyph `target) this] -:: +unbind-glyph: remove all binding for glyph -:: -++ unbind-glyph - |= [=glyph targ=(unit target)] - ^- (quip move _this) - ?^ targ - =. binds (~(del ju binds) glyph u.targ) - =. bound (~(del by bound) u.targ) - [(show-glyph:sh-out glyph ~) this] - =/ ole=(set target) - (~(get ju binds) glyph) - =. binds (~(del by binds) glyph) - =. bound - |- - ?~ ole bound - =. bound $(ole l.ole) - =. bound $(ole r.ole) - (~(del by bound) n.ole) - [(show-glyph:sh-out glyph ~) this] -:: +decode-glyph: find the target that matches a glyph, if any -:: -++ decode-glyph - |= =glyph - ^- (unit target) - =+ lax=(~(get ju binds) glyph) - :: no circle - ?: =(~ lax) ~ - %- some - :: single circle - ?: ?=([* ~ ~] lax) n.lax - :: in case of multiple audiences, pick the most recently active one - |- ^- target - ?~ grams -:~(tap in lax) - =* source source.i.grams - ?: (~(has in lax) source) - source - $(grams t.grams) -:: +read-envelope: add envelope to state and show it to user -:: -++ read-envelope - |= [=target =envelope] - ^- (quip move _this) - ?: (~(has in known) [target uid.envelope]) - ::NOTE we no-op only because edits aren't possible - [~ this] - :- (show-envelope:sh-out target envelope) - %_ this - known (~(put in known) [target uid.envelope]) - grams [[target envelope] grams] - count +(count) - == -:: -:: +sh-in: handle user input -:: -++ sh-in - ::NOTE interestingly, adding =, sh-out breaks compliation - |% - :: +sole: apply sole action - :: - ++ sole - |= act=sole-action:sole-sur - ^- (quip move _this) - ?- -.act - %det (edit +.act) - %clr [~ this] - %ret obey - %tab [~ this] - == - :: +edit: apply sole edit - :: - :: called when typing into the cli prompt. - :: applies the change and does sanitizing. - :: - ++ edit - |= cal=sole-change:sole-sur - ^- (quip move _this) - =^ inv state.cli (~(transceive sole-lib state.cli) cal) - =+ fix=(sanity inv buf.state.cli) - ?~ lit.fix - [~ this] - :: just capital correction - ?~ err.fix - (slug fix) - :: allow interior edits and deletes - ?. &(?=($del -.inv) =(+(p.inv) (lent buf.state.cli))) - [~ this] - (slug fix) - :: +sanity: check input sanity - :: - :: parses cli prompt using +read. - :: if invalid, produces error correction description, for use with +slug. - :: - ++ sanity - |= [inv=sole-edit:sole-sur buf=(list @c)] - ^- [lit=(list sole-edit:sole-sur) err=(unit @u)] - =+ res=(rose (tufa buf) read) - ?: ?=(%& -.res) [~ ~] - [[inv]~ `p.res] - :: +slug: apply error correction to prompt input - :: - ++ slug - |= [lit=(list sole-edit:sole-sur) err=(unit @u)] - ^- (quip move _this) - ?~ lit [~ this] - =^ lic state.cli - %- ~(transmit sole-lib state.cli) - ^- sole-edit:sole-sur - ?~(t.lit i.lit [%mor lit]) - :_ this - :_ ~ - %+ effect:sh-out %mor - :- [%det lic] - ?~(err ~ [%err u.err]~) - :: +read: command parser - :: - :: parses the command line buffer. - :: produces commands which can be executed by +work. - :: - ++ read - |^ - %+ knee *command |. ~+ - =- ;~(pose ;~(pfix mic -) message) - ;~ pose - (stag %target tars) - :: - ;~ (glue ace) - (tag %create) - security - ;~(plug path (punt ;~(pfix ace glyph))) - == - ;~((glue ace) (tag %delete) path) - ;~((glue ace) (tag %invite) rw path ships) - ;~((glue ace) (tag %banish) rw path ships) - :: - ;~((glue ace) (tag %join) ;~(plug targ (punt ;~(pfix ace glyph)))) - ;~((glue ace) (tag %leave) targ) - :: - ;~((glue ace) (tag %bind) glyph targ) - ;~((glue ace) (tag %unbind) ;~(plug glyph (punt ;~(pfix ace targ)))) - ;~(plug (perk %what ~) (punt ;~(pfix ace ;~(pose glyph targ)))) - :: - ;~(plug (tag %settings) (easy ~)) - ;~((glue ace) (tag %set) flag) - ;~((glue ace) (tag %unset) flag) - ;~(plug (cold %width (jest 'set width ')) dem:ag) - ;~ plug - (cold %timezone (jest 'set timezone ')) - ;~ pose - (cold %| (just '-')) - (cold %& (just '+')) - == - %+ sear - |= a=@ud - ^- (unit @ud) - ?:(&((gte a 0) (lte a 14)) `a ~) - dem:ag - == - :: - ;~(plug (tag %chats) (easy ~)) - ;~(plug (tag %help) (easy ~)) - :: - (stag %select nump) - == - :: - ::TODO - :: ++ cmd - :: |* [cmd=term req=(list rule) opt=(list rule)] - :: |^ ;~ plug - :: (tag cmd) - :: :: - :: ::TODO this feels slightly too dumb - :: ?~ req - :: ?~ opt (easy ~) - :: (opt-rules opt) - :: ?~ opt (req-rules req) - :: ;~(plug (req-rules req) (opt-rules opt)) ::TODO rest-loop - :: == - :: ++ req-rules - :: |* req=(lest rule) - :: =- ;~(pfix ace -) - :: ?~ t.req i.req - :: ;~(plug i.req $(req t.req)) - :: ++ opt-rules - :: |* opt=(lest rule) - :: =- (punt ;~(pfix ace -)) - :: ?~ t.opt ;~(pfix ace i.opt) - :: ;~(pfix ace ;~(plug i.opt $(opt t.opt))) - :: -- - :: - ++ tag |*(a=@tas (cold a (jest a))) ::TODO into stdlib - ++ ship ;~(pfix sig fed:ag) - ++ path ;~(pfix net (most net urs:ab)) - :: +tarl: local target, as /path - :: - ++ tarl (stag our-self path) - :: +tarp: sponsor target, as ^/path - :: - ++ tarp - =- ;~(pfix ket (stag - path)) - (sein:title our.bowl now.bowl our-self) - :: +targ: any target, as tarl, tarp, ~ship/path or glyph - :: - ++ targ - ;~ pose - tarl - tarp - ;~(plug ship path) - (sear decode-glyph glyph) - == - :: +tars: set of comma-separated targs - :: - ++ tars - %+ cook ~(gas in *(set target)) - (most ;~(plug com (star ace)) targ) - :: +ships: set of comma-separated ships - :: - ++ ships - %+ cook ~(gas in *(set ^ship)) - (most ;~(plug com (star ace)) ship) - :: - :: +security: security mode - :: - ++ security - (perk %channel %village %journal %mailbox ~) - :: +rw: read, write, or read-write - :: - ++ rw - (perk %rw %r %w ~) - :: - :: +glyph: shorthand character - :: - ++ glyph (mask glyphs) - :: +flag: valid flag - :: - ++ flag - %- perk :~ - %notify - %showtime - == - :: +nump: message number reference - :: - ++ nump - ;~ pose - ;~(pfix hep dem:ag) - ;~ plug - (cook lent (plus (just '0'))) - ;~(pose dem:ag (easy 0)) - == - (stag 0 dem:ag) - (cook lent (star mic)) - == - :: +message: all messages - :: - ++ message - ;~ pose - ;~(plug (cold %eval hax) expr) - (stag %say letter) - == - :: +letter: simple messages - :: - ++ letter - ;~ pose - (stag %url turl) - (stag %me ;~(pfix vat text)) - (stag %text ;~(less mic hax text)) - == - :: +turl: url parser - :: - ++ turl - =- (sear - text) - |= t=cord - ^- (unit cord) - ?~((rush t aurf:de-purl:html) ~ `t) - :: +text: text message body - :: - ++ text - %+ cook crip - (plus ;~(less (jest '•') next)) - :: +expr: parse expression into [cord hoon] - :: - ++ expr - |= tub=nail - %. tub - %+ stag (crip q.tub) - wide:(vang & [&1:% &2:% (scot %da now.bowl) |3:%]) - -- - :: +obey: apply result - :: - :: called upon hitting return in the prompt. - :: if input is invalid, +slug is called. - :: otherwise, the appropriate work is done and - :: the command (if any) gets echoed to the user. - :: - ++ obey - ^- (quip move _this) - =+ buf=buf.state.cli - =+ fix=(sanity [%nop ~] buf) - ?^ lit.fix - (slug fix) - =+ jub=(rust (tufa buf) read) - ?~ jub [[(effect:sh-out %bel ~) ~] this] - =^ cal state.cli (~(transmit sole-lib state.cli) [%set ~]) - =^ moves this (work u.jub) - :_ this - %+ weld - ^- (list move) - :: echo commands into scrollback - ?. =(`0 (find ";" buf)) ~ - [(note:sh-out (tufa `(list @)`buf)) ~] - :_ moves - %+ effect:sh-out %mor - :~ [%nex ~] - [%det cal] - == - :: +work: run user command - :: - ++ work - |= job=command - ^- (quip move _this) - |^ ?- -.job - %target (set-target +.job) - %say (say +.job) - %eval (eval +.job) - :: - %create (create +.job) - %delete (delete +.job) - %invite (change-permission & +.job) - %banish (change-permission | +.job) - :: - %join (join +.job) - %leave (leave +.job) - :: - %bind (bind-glyph +.job) - %unbind (unbind-glyph +.job) - %what (lookup-glyph +.job) - :: - %settings show-settings - %set (set-setting +.job) - %unset (unset-setting +.job) - %width (set-width +.job) - %timezone (set-timezone +.job) - :: - %select (select +.job) - %chats chats - %help help - == - :: +act: build action move - :: - ++ act - |= [what=term app=term =out-action] - ^- move - :* ost.bowl - %poke - /cli-command/[what] - [our-self app] - out-action - == - :: +set-target: set audience, update prompt - :: - ++ set-target - |= tars=(set target) - ^- (quip move _this) - =. audience tars - [[prompt:sh-out ~] this] - :: +create: new local mailbox - :: - ++ create - |= [security=chat-security =path gyf=(unit char)] - ^- (quip move _this) - ::TODO check if already exists - =/ =target [our-self path] - =. audience [target ~ ~] - =^ moz this - ?. ?=(^ gyf) [~ this] - (bind-glyph u.gyf target) - =- [[- moz] this] - %^ act %do-create %chat-view - :- %chat-view-action - :^ %create path security - :: ensure we can read from/write to our own chats - :: - :- :: read - ?- security - ?(%channel %journal) ~ - ?(%village %mailbox) [our-self ~ ~] - == - :: write - ?- security - ?(%channel %mailbox) ~ - ?(%village %journal) [our-self ~ ~] - == - :: +delete: delete local chats - :: - ++ delete - |= =path - ^- (quip move _this) - =- [[- ~] this] - %^ act %do-delete %chat-view - :- %chat-view-action - [%delete (target-to-path our-self path)] - :: +change-permission: modify permissions on a local chat - :: - ++ change-permission - |= [allow=? rw=?(%r %w %rw) =path ships=(set ship)] - ^- (quip move _this) - :_ this - %+ murn - ^- (list term) - ?- rw - %r [%read ~] - %w [%write ~] - %rw [%read %write ~] - == - |= =term - ^- (unit move) - =. path - =- (snoc `^path`- term) - [%chat (target-to-path our-self path)] - :: whitelist: empty if no matching permission, else true if whitelist - :: - =/ whitelist=(unit ?) - =; perm=(unit permission) - ?~(perm ~ `?=(%white kind.u.perm)) - ::TODO +permission-of-target? - .^ (unit permission) - %gx - (scot %p our-self) - %permission-store - (scot %da now.bowl) - %permission - (snoc path %noun) - == - ?~ whitelist - ~& [%weird-no-permission path] - ~ - %- some - %^ act %do-permission %group-store - ^- out-action - :- %group-action - ?: =(u.whitelist allow) - [%add ships path] - [%remove ships path] - :: +join: sync with remote mailbox - :: - ++ join - |= [=target gyf=(unit char)] - ^- (quip move _this) - =^ moz this - ?. ?=(^ gyf) [~ this] - (bind-glyph u.gyf target) - =. audience [target ~ ~] - =; =move - [[move prompt:sh-out moz] this] - ::TODO ideally we'd check permission first. attempting this and failing - :: gives ugly %chat-hook-reap - %^ act %do-join %chat-view - :- %chat-view-action - [%join target] - :: +leave: unsync & destroy mailbox - :: - ::TODO allow us to "mute" local chats using this - ++ leave - |= =target - =- [[- ~] this] - ?: =(our-self ship.target) - %- print:sh-out - "can't ;leave local chats, maybe use ;delete instead" - %^ act %do-leave %chat-hook - :- %chat-hook-action - [%remove (target-to-path target)] - :: +say: send messages - :: - ++ say - |= =letter - ^- (quip move _this) - =/ =serial (shaf %msg-uid eny.bowl) - :_ this(eny.bowl (shax eny.bowl)) - ^- (list move) - %+ turn ~(tap in audience) - |= =target - %^ act %out-message %chat-hook - :- %chat-action - :+ %message (target-to-path target) - [serial *@ our-self now.bowl letter] - :: +eval: run hoon, send code and result as message - :: - :: this double-virtualizes and clams to disable .^ for security reasons - :: - ++ eval - |= [txt=cord exe=hoon] - (say %code txt (eval:chat-eval bowl exe)) - :: +lookup-glyph: print glyph info for all, glyph or target - :: - ++ lookup-glyph - |= qur=(unit $@(glyph target)) - ^- (quip move _this) - =- [[- ~] this] - ?^ qur - ?^ u.qur - =+ gyf=(~(get by bound) u.qur) - (print:sh-out ?~(gyf "none" [u.gyf]~)) - =+ pan=~(tap in (~(get ju binds) `@t`u.qur)) - ?: =(~ pan) (print:sh-out "~") - =< (effect:sh-out %mor (turn pan .)) - |=(t=target [%txt ~(phat tr t)]) - %- print-more:sh-out - %- ~(rep by binds) - |= $: [=glyph tars=(set target)] - lis=(list tape) - == - %+ weld lis - ^- (list tape) - %- ~(rep in tars) - |= [t=target l=(list tape)] - %+ weld l - ^- (list tape) - [glyph ' ' ~(phat tr t)]~ - :: +show-settings: print enabled flags, timezone and width settings - :: - ++ show-settings - ^- (quip move _this) - :_ this - :~ %- print:sh-out - %- zing - ^- (list tape) - :- "flags: " - %+ ^join ", " - (turn `(list @t)`~(tap in settings) trip) - :: - %- print:sh-out - %+ weld "timezone: " - ^- tape - :- ?:(p.timez '+' '-') - (scow %ud q.timez) - :: - (print:sh-out "width: {(scow %ud width)}") - == - :: +set-setting: enable settings flag - :: - ++ set-setting - |= =term - ^- (quip move _this) - [~ this(settings (~(put in settings) term))] - :: +unset-setting: disable settings flag - :: - ++ unset-setting - |= =term - ^- (quip move _this) - [~ this(settings (~(del in settings) term))] - :: +set-width: configure cli printing width - :: - ++ set-width - |= w=@ud - [~ this(width w)] - :: +set-timezone: configure timestamp printing adjustment - :: - ++ set-timezone - |= tz=[? @ud] - [~ this(timez tz)] - :: +select: expand message from number reference - :: - ++ select - ::NOTE rel is the nth most recent message, - :: abs is the last message whose numbers ends in n - :: (with leading zeros used for precision) - :: - |= num=$@(rel=@ud [zeros=@u abs=@ud]) - ^- (quip move _this) - |^ ?@ num - =+ tum=(scow %s (new:si | +(num))) - ?: (gte rel.num count) - %- just-print - "{tum}: no such telegram" - (activate tum rel.num) - ?. (gte abs.num count) - ?: =(count 0) - (just-print "0: no messages") - =+ msg=(index (dec count) num) - (activate (scow %ud msg) (sub count +(msg))) - %- just-print - "…{(reap zeros.num '0')}{(scow %ud abs.num)}: no such telegram" - :: +just-print: full [moves state] output with a single print move - :: - ++ just-print - |= txt=tape - [[(print:sh-out txt) ~] this] - :: +index: get message index from absolute reference - :: - ++ index - |= [max=@ud nul=@u fin=@ud] - ^- @ud - =+ dog=|-(?:(=(0 fin) 1 (mul 10 $(fin (div fin 10))))) - =. dog (mul dog (pow 10 nul)) - =- ?:((lte - max) - (sub - dog)) - (add fin (sub max (mod max dog))) - :: +activate: echo message selector and print details - :: - ++ activate - |= [number=tape index=@ud] - ^- (quip move _this) - =+ gam=(snag index grams) - =. audience [source.gam ~ ~] - :_ this - ^- (list move) - :~ (print:sh-out ['?' ' ' number]) - (effect:sh-out ~(render-activate mr gam)) - prompt:sh-out - == - -- - :: +chats: display list of local mailboxes - :: - ++ chats - ^- (quip move _this) - :_ this - :_ ~ - %- print-more:sh-out - =/ all - ::TODO refactor - ::TODO remote scries fail... but moon support? - .^ (set path) - %gx - /(scot %p our-self)/chat-store/(scot %da now.bowl)/keys/noun - == - %+ turn ~(tap in all) - %+ cork path-to-target - |= target - (weld (scow %p ship) (spud path)) - :: +help: print (link to) usage instructions - :: - ++ help - ^- (quip move _this) - =- [[- ~] this] - (print:sh-out "see https://urbit.org/using/operations/using-your-ship/#messaging") - -- - -- -:: -:: +sh-out: output to the cli -:: -++ sh-out - |% - :: +effect: console effect move - :: - ++ effect - |= fec=sole-effect:sole-sur - ^- move - [bone.cli %diff %sole-effect fec] - :: +print: puts some text into the cli as-is - :: - ++ print - |= txt=tape - ^- move - (effect %txt txt) - :: +print-more: puts lines of text into the cli - :: - ++ print-more - |= txs=(list tape) - ^- move - %+ effect %mor - (turn txs |=(t=tape [%txt t])) - :: +note: prints left-padded ---| txt - :: - ++ note - |= txt=tape - ^- move - =+ lis=(simple-wrap txt (sub width 16)) - %- print-more - =+ ?:((gth (lent lis) 0) (snag 0 lis) "") - :- (runt [14 '-'] '|' ' ' -) - %+ turn (slag 1 lis) - |=(a=tape (runt [14 ' '] '|' ' ' a)) - :: +prompt: update prompt to display current audience - :: - ++ prompt - ^- move - %+ effect %pro - :+ & %talk-line - ^- tape - =- ?: =(1 (lent -)) "{-} " - "[{-}] " - =/ all - %+ sort ~(tap in audience) - |= [a=target b=target] - (~(beat tr a) b) - =+ fir=& - |- ^- tape - ?~ all ~ - ;: welp - ?:(fir "" " ") - ~(show tr i.all) - $(all t.all, fir |) - == - :: +show-envelope: print incoming message - :: - :: every five messages, prints the message number also. - :: if the message mentions the user's (shortened) ship name, - :: and the %notify flag is set, emit a bell. - :: - ++ show-envelope - |= [=target =envelope] - ^- (list move) - %+ weld - ^- (list move) - ?. =(0 (mod count 5)) ~ - :_ ~ - =+ num=(scow %ud count) - %- print - (runt [(sub 13 (lent num)) '-'] "[{num}]") - =+ lis=~(render-inline mr target envelope) - ?~ lis ~ - :_ ~ - %+ effect %mor - %+ turn `(list tape)`lis - =+ nom=(scag 7 (cite:title our-self)) - |= t=tape - ?. ?& (~(has in settings) %notify) - ?=(^ (find nom (slag 15 t))) - == - [%txt t] - [%mor [%txt t] [%bel ~] ~] - :: +show-create: print mailbox creation notification - :: - ++ show-create - |= =target - ^- move - (note "new: {~(phat tr target)}") - :: +show-delete: print mailbox deletion notification - :: - ++ show-delete - |= =target - ^- move - (note "del: {~(phat tr target)}") - :: +show-glyph: print glyph un/bind notification - :: - ++ show-glyph - |= [=glyph target=(unit target)] - ^- (list move) - :_ [prompt ~] - %- note - %+ weld "set: {[glyph ~]} " - ?~ target "unbound" - ~(phat tr u.target) - -- -:: -:: +tr: render targets -:: -++ tr - |_ :: one: the target. - :: - one=target - :: +beat: true if one is more "relevant" than two - :: - ++ beat - |= two=target - ^- ? - :: the target that's ours is better. - ?: =(our-self ship.one) - ?. =(our-self ship.two) & - ?< =(path.one path.two) - :: if both targets are ours, the main story is better. - ?: =(%inbox path.one) & - ?: =(%inbox path.two) | - :: if neither are, pick the "larger" one. - (lth (lent path.one) (lent path.two)) - :: if one isn't ours but two is, two is better. - ?: =(our-self ship.two) | - ?: =(ship.one ship.two) - :: if they're from the same ship, pick the "larger" one. - (lth (lent path.one) (lent path.two)) - :: if they're from different ships, neither ours, pick hierarchically. - (lth (xeb ship.one) (xeb ship.two)) - :: +phat: render target fully - :: - :: renders as ~ship/path. - :: for local mailboxes, renders just /path. - :: for sponsor's mailboxes, renders ^/path. - :: - ::NOTE but, given current implementation, all will be local - :: - ++ phat - ^- tape - %+ weld - ?: =(our-self ship.one) ~ - ?: =((sein:title our.bowl now.bowl our-self) ship.one) "^" - (scow %p ship.one) - (spud path.one) - :: +show: render as tape, as glyph if we can - :: - ++ show - ^- tape - =+ cha=(~(get by bound) one) - ?~(cha phat "{u.cha ~}") - :: +glyph: tape for glyph of target, defaulting to * - :: - ++ glyph - ^- tape - [(~(gut by bound) one '*') ~] - -- -:: -:: +mr: render messages -:: -++ mr - |_ $: source=target - envelope - == - :: +activate: produce sole-effect for printing message details - :: - ++ render-activate - ^- sole-effect:sole-sur - ~[%mor [%tan meta] body] - :: +meta: render message metadata (serial, timestamp, author, target) - :: - ++ meta - ^- tang - =. when (sub when (mod when (div when ~s0..0001))) :: round - =+ hed=leaf+"{(scow %uv uid)} at {(scow %da when)}" - =/ src=tape ~(phat tr source) - [%rose [" " ~ ~] [hed >author< [%rose [", " "to " ~] [leaf+src]~] ~]]~ - :: +body: long-form render of message contents - :: - ++ body - |- ^- sole-effect:sole-sur - ?- -.letter - ?(%text %me) - =/ pre=tape ?:(?=(%me -.letter) "@ " "") - tan+~[leaf+"{pre}{(trip +.letter)}"] - :: - %url - url+url.letter - :: - %code - =/ texp=tape ['>' ' ' (trip expression.letter)] - :- %mor - |- ^- (list sole-effect:sole-sur) - ?: =("" texp) [tan+output.letter ~] - =/ newl (find "\0a" texp) - ?~ newl [txt+texp $(texp "")] - =+ (trim u.newl texp) - :- txt+(scag u.newl texp) - $(texp [' ' ' ' (slag +(u.newl) texp)]) - == - :: +render-inline: produces lines to display message body in scrollback - :: - ++ render-inline - ^- (list tape) - =/ wyd - :: termwidth, - %+ sub width - :: minus autor, - %+ add 14 - :: minus timestamp. - ?:((~(has in settings) %showtime) 10 0) - =+ txs=(line wyd) - ?~ txs ~ - :: nom: rendered author - :: den: regular indent - :: tam: timestamp, if desired - :: - =/ nom=tape (nome author) - =/ den=tape (reap (lent nom) ' ') - =/ tam=tape - ?. (~(has in settings) %showtime) "" - =. when - %. [when (mul q.timez ~h1)] - ?:(p.timez add sub) - =+ dat=(yore when) - =/ t - |= a/@ - %+ weld - ?:((lth a 10) "0" ~) - (scow %ud a) - =/ time - ;: weld - "~" (t h.t.dat) - "." (t m.t.dat) - "." (t s.t.dat) - == - %+ weld - (reap (sub +(wyd) (min wyd (lent (tuba i.txs)))) ' ') - time - %- flop - %+ roll `(list tape)`txs - |= [t=tape l=(list tape)] - ?~ l [:(weld nom t tam) ~] - [(weld den t) l] - :: +nome: prints a ship name in 14 characters, left-padding with spaces - :: - ++ nome - |= =ship - ^- tape - =+ raw=(cite:title ship) - (runt [(sub 14 (lent raw)) ' '] raw) - :: +line: renders most important contents, tries to fit one line - :: - ::TODO this should probably be rewritten someday - ++ line - :: pre: replace/append line prefix - :: - =| pre=(unit (pair ? tape)) - |= wyd=@ud - ^- (list tape) - ?- -.letter - %code - =+ texp=(trip expression.letter) - =+ newline=(find "\0a" texp) - =? texp ?=(^ newline) - (weld (scag u.newline texp) " ...") - :- (truncate wyd '#' ' ' texp) - ?~ output.letter ~ - =- [' ' (truncate (dec wyd) ' ' -)]~ - ~(ram re (snag 0 `(list tank)`output.letter)) - :: - %url - :_ ~ - =+ ful=(trip url.letter) - =+ pef=q:(fall pre [p=| q=""]) - :: clean up prefix if needed. - =? pef =((scag 1 (flop pef)) " ") - (scag (dec (lent pef)) pef) - =. pef (weld "/" pef) - =. wyd (sub wyd +((lent pef))) :: account for prefix. - :: if the full url fits, just render it. - ?: (gte wyd (lent ful)) :(weld pef " " ful) - :: if it doesn't, prefix with _ and render just (the tail of) the domain. - %+ weld (weld pef "_") - =+ prl=(rust ful aurf:de-purl:html) - ?~ prl (weld (scag (dec wyd) ful) "…") - =+ hok=r.p.p.u.prl - =- (swag [a=(sub (max wyd (lent -)) wyd) b=wyd] -) - ^- tape - =< ?: ?=(%& -.hok) - (reel p.hok .) - +:(scow %if p.hok) - |= [a=knot b=tape] - ?~ b (trip a) - (welp b '.' (trip a)) - :: - ?(%text %me) - :: glyph prefix - =/ pef=tape - ?: &(?=(^ pre) p.u.pre) q.u.pre - ?: ?=(%me -.letter) " " - =- (weld - q:(fall pre [p=| q=" "])) - ~(glyph tr source) - =/ lis=(list tape) - %+ simple-wrap - `tape``(list @)`(tuba (trip +.letter)) - (sub wyd (min (div wyd 2) (lent pef))) - =+ lef=(lent pef) - =+ ?:((gth (lent lis) 0) (snag 0 lis) "") - :- (weld pef -) - %+ turn (slag 1 lis) - |=(a=tape (runt [lef ' '] a)) - == - :: +truncate: truncate txt to fit len, indicating truncation with _ or … - :: - ++ truncate - |= [len=@u txt=tape] - ^- tape - ?: (gth len (lent txt)) txt - =. txt (scag len txt) - |- - ?~ txt txt - ?: =(' ' i.txt) - |- - :- '_' - ?. ?=([%' ' *] t.txt) - t.txt - $(txt t.txt) - ?~ t.txt "…" - [i.txt $(txt t.txt)] - -- -:: -++ simple-wrap - |= [txt=tape wid=@ud] - ^- (list tape) - ?~ txt ~ - =+ ^- [end=@ud nex=?] - ?: (lte (lent txt) wid) [(lent txt) &] - =+ ace=(find " " (flop (scag +(wid) `tape`txt))) - ?~ ace [wid |] - [(sub wid u.ace) &] - :- (tufa (scag end `(list @)`txt)) - $(txt (slag ?:(nex +(end) end) `tape`txt)) --- diff --git a/pkg/arvo/app/chat-store.hoon b/pkg/arvo/app/chat-store.hoon deleted file mode 100644 index b80d794fd..000000000 --- a/pkg/arvo/app/chat-store.hoon +++ /dev/null @@ -1,234 +0,0 @@ -:: chat-store: data store that holds linear sequences of chat messages -:: -/+ *chat-json, *chat-eval -|% -+$ move [bone card] -:: -+$ card - $% [%diff diff] - [%quit ~] - == -:: -+$ state - $% [%0 state-zero] - == -:: -+$ state-zero - $: =inbox - == -:: -+$ diff - $% [%chat-initial inbox] - [%chat-configs chat-configs] - [%chat-update chat-update] - == --- -:: -|_ [bol=bowl:gall state] -:: -++ this . -:: -++ prep - |= old=(unit state) - ^- (quip move _this) - [~ ?~(old this this(+<+ u.old))] -:: -++ peek-x-all - |= pax=path - ^- (unit (unit [%noun (map path mailbox)])) - [~ ~ %noun inbox] -:: -++ peek-x-configs - |= pax=path - ^- (unit (unit [%noun chat-configs])) - :^ ~ ~ %noun - (inbox-to-configs inbox) -:: -++ peek-x-keys - |= pax=path - ^- (unit (unit [%noun (set path)])) - [~ ~ %noun ~(key by inbox)] -:: -++ peek-x-mailbox - |= pax=path - ^- (unit (unit [%noun (unit mailbox)])) - ?~ pax ~ - =/ mailbox=(unit mailbox) (~(get by inbox) pax) - [~ ~ %noun mailbox] -:: -++ peek-x-config - |= pax=path - ^- (unit (unit [%noun config])) - ?~ pax ~ - =/ mailbox (~(get by inbox) pax) - ?~ mailbox ~ - :^ ~ ~ %noun - config.u.mailbox -:: -++ peek-x-envelopes - |= pax=path - ^- (unit (unit [%noun (list envelope)])) - ?+ pax ~ - [@ @ *] - =/ mail-path t.t.pax - =/ mailbox (~(get by inbox) mail-path) - ?~ mailbox - [~ ~ %noun ~] - =* envelopes envelopes.u.mailbox - =/ sign-test=[?(%neg %pos) @] - %- need - %+ rush i.pax - ;~ pose - %+ cook - |= n=@ - [%neg n] - ;~(pfix hep dem:ag) - :: - %+ cook - |= n=@ - [%pos n] - dem:ag - == - =* length length.config.u.mailbox - =* start +.sign-test - ?: =(-.sign-test %neg) - ?: (gth start length) - [~ ~ %noun envelopes] - [~ ~ %noun (swag [(sub length start) start] envelopes)] - :: - =/ end (slav %ud i.t.pax) - ?. (lte start end) - ~ - =. end ?:((lth end length) end length) - [~ ~ %noun (swag [start (sub end start)] envelopes)] - == -:: -++ peer-keys - |= pax=path - ^- (quip move _this) - ?> (team:title our.bol src.bol) - :: we send the list of keys then send events when they change - :_ this - [ost.bol %diff %chat-update [%keys ~(key by inbox)]]~ -:: -++ peer-all - |= pax=path - ^- (quip move _this) - ?> (team:title our.bol src.bol) - :_ this - [ost.bol %diff %chat-initial inbox]~ -:: -++ peer-configs - |= pax=path - ^- (quip move _this) - ?> (team:title our.bol src.bol) - :_ this - [ost.bol %diff %chat-configs (inbox-to-configs inbox)]~ -:: -++ peer-updates - |= pax=path - ^- (quip move _this) - ?> (team:title our.bol src.bol) - :: we now proxy all events to this path - [~ this] -:: -++ peer-mailbox - |= pax=path - ^- (quip move _this) - ?> (team:title our.bol src.bol) - ?> (~(has by inbox) pax) - =^ =ship pax - ?> ?=([* ^] pax) - [(slav %p i.pax) t.pax] - :_ this - [ost.bol %diff %chat-update [%create ship pax]]~ -:: -++ poke-json - |= jon=json - ^- (quip move _this) - ?> (team:title our.bol src.bol) - (poke-chat-action (json-to-action jon)) -:: -++ poke-chat-action - |= action=chat-action - ^- (quip move _this) - ?> (team:title our.bol src.bol) - ?- -.action - %create (handle-create action) - %delete (handle-delete action) - %message (handle-message action) - %read (handle-read action) - == -:: -++ handle-create - |= act=chat-action - ^- (quip move _this) - ?> ?=(%create -.act) - =/ pax [(scot %p ship.act) path.act] - ?: (~(has by inbox) pax) - [~ this] - :- (send-diff pax act) - this(inbox (~(put by inbox) pax *mailbox)) -:: -++ handle-delete - |= act=chat-action - ^- (quip move _this) - ?> ?=(%delete -.act) - =/ mailbox=(unit mailbox) (~(get by inbox) path.act) - ?~ mailbox - [~ this] - :- (send-diff path.act act) - this(inbox (~(del by inbox) path.act)) -:: -++ handle-message - |= act=chat-action - ^- (quip move _this) - ?> ?=(%message -.act) - =/ mailbox=(unit mailbox) (~(get by inbox) path.act) - ?~ mailbox - [~ this] - =* letter letter.envelope.act - =? letter &(?=(%code -.letter) ?=(~ output.letter)) - =/ =hoon (ream expression.letter) - letter(output (eval bol hoon)) - =: length.config.u.mailbox +(length.config.u.mailbox) - number.envelope.act +(length.config.u.mailbox) - envelopes.u.mailbox (snoc envelopes.u.mailbox envelope.act) - == - :- (send-diff path.act act) - this(inbox (~(put by inbox) path.act u.mailbox)) -:: -++ handle-read - |= act=chat-action - ^- (quip move _this) - ?> ?=(%read -.act) - =/ mailbox=(unit mailbox) (~(get by inbox) path.act) - ?~ mailbox - [~ this] - =. read.config.u.mailbox length.config.u.mailbox - :- (send-diff path.act act) - this(inbox (~(put by inbox) path.act u.mailbox)) -:: -++ update-subscribers - |= [pax=path act=chat-action] - ^- (list move) - %+ turn (prey:pubsub:userlib pax bol) - |= [=bone *] - [bone %diff %chat-update act] -:: -++ send-diff - |= [pax=path act=chat-action] - ^- (list move) - %- zing - :~ (update-subscribers /all act) - (update-subscribers /updates act) - (update-subscribers [%mailbox pax] act) - ?. |(=(%read -.act) =(%message -.act)) - ~ - (update-subscribers /configs act) - ?. |(=(%create -.act) =(%delete -.act)) - ~ - (update-subscribers /keys act) - == -:: --- diff --git a/pkg/arvo/app/clock.hoon b/pkg/arvo/app/clock.hoon deleted file mode 100644 index d2cc05002..000000000 --- a/pkg/arvo/app/clock.hoon +++ /dev/null @@ -1,80 +0,0 @@ -/+ *server -/= tile-js - /^ octs - /; as-octs:mimes:html - /: /===/app/clock/js/tile - /| /js/ - /~ ~ - == -=, format -:: -|% -:: +move: output effect -:: -+$ move [bone card] -:: +card: output effect payload -:: -+$ poke - $% [%launch-action [@tas path @t]] - == -:: -+$ card - $% [%poke wire dock poke] - [%http-response =http-event:http] - [%connect wire binding:eyre term] - [%diff %json json] - == -:: --- -:: -|_ [bol=bowl:gall ~] -:: -++ this . -:: -++ bound - |= [wir=wire success=? binding=binding:eyre] - ^- (quip move _this) - [~ this] -:: -++ prep - |= old=(unit ~) - ^- (quip move _this) - =/ launcha - [%launch-action [%clock /tile '/~clock/js/tile.js']] - :_ this - :~ - [ost.bol %connect / [~ /'~clock'] %clock] - [ost.bol %poke /clock [our.bol %launch] launcha] - == -:: -++ peer-tile - |= pax=path - ^- (quip move _this) - [[ost.bol %diff %json *json]~ this] -:: -++ send-tile-diff - |= jon=json - ^- (list move) - %+ turn (prey:pubsub:userlib /tile bol) - |= [=bone ^] - [bone %diff %json jon] -:: -++ poke-handle-http-request - %- (require-authorization:app ost.bol move this) - |= =inbound-request:eyre - ^- (quip move _this) - =/ request-line (parse-request-line url.request.inbound-request) - =/ back-path (flop site.request-line) - =/ name=@t - =/ back-path (flop site.request-line) - ?~ back-path - '' - i.back-path - :: - ?~ back-path - [[ost.bol %http-response not-found:app]~ this] - ?: =(name 'tile') - [[ost.bol %http-response (js-response:app tile-js)]~ this] - [[ost.bol %http-response not-found:app]~ this] -:: --- diff --git a/pkg/arvo/app/dns-collector.hoon b/pkg/arvo/app/dns-collector.hoon deleted file mode 100644 index d2614b39c..000000000 --- a/pkg/arvo/app/dns-collector.hoon +++ /dev/null @@ -1,174 +0,0 @@ -/- dns -:: -:: app types and boilerplate -:: -=> |% - +$ app-state - $: %0 - requested=(map ship address:dns) - completed=(map ship binding:dns) - == - +$ peek-data - $% [%requested (list (pair ship address:dns))] - [%completed (list (pair ship binding:dns))] - == - +$ in-poke-data - $% [%dns-address =address:dns] - [%dns-complete =ship =binding:dns] - [%noun noun=*] - == - +$ out-poke-data - $% [%drum-unlink =dock] - == - +$ out-peer-data - $% [%dns-binding =binding:dns] - [%dns-request =request:dns] - == - +$ card - $% [%diff out-peer-data] - [%poke wire =dock out-poke-data] - == - +$ move [bone card] - -- -:: -=| moves=(list move) -|_ [=bowl:gall state=app-state] -:: -++ this . -:: -++ abet - ^- (quip move _this) - [(flop moves) this(moves ~)] -:: -++ emit - |= mov=move - ^+ this - this(moves [mov moves]) -:: -++ emil - |= moz=(list move) - |- ^+ this - ?~ moz - this - $(moz t.moz, ..this (emit i.moz)) -:: -++ poke-app - |= [=wire =dock =out-poke-data] - ^+ this - (emit [ost.bowl %poke wire dock out-poke-data]) -:: -++ give-result - |= [=the=path =out-peer-data] - ^+ this - %- emil - %+ turn - ^- (list bone) - %+ murn ~(tap by sup.bowl) - |= [ost=bone =ship =sub=path] - `(unit bone)`?.(=(the-path sub-path) ~ (some ost)) - |= =bone - [bone %diff out-peer-data] -:: -++ prep - |= old=(unit app-state) - ^- (quip move _this) - =< abet - ?~ old - (poke-app /unlink [[our %hood] [%drum-unlink our dap]]:bowl) - this(state u.old) -:: -++ poke - |= =in-poke-data - ^- (quip move _this) - =< abet - ?- -.in-poke-data - %noun - ?: ?=(%debug noun.in-poke-data) - ~& bowl - ~& state - this - :: - ~& %poke-unknown - this - :: - %dns-address - =* who src.bowl - =* adr address.in-poke-data - =/ rac (clan:title who) - ?. ?=(?(%king %duke) rac) - ~| [%dns-collector-bind-invalid who] !! - ?: (reserved:eyre if.adr) - ~| [%dns-collector-reserved-address who if.adr] !! - :: - =/ req=(unit address:dns) (~(get by requested.state) who) - =/ dun=(unit binding:dns) (~(get by completed.state) who) - ?: &(?=(^ dun) =(adr address.u.dun)) - =. requested.state (~(del by requested.state) who) - (give-result /(scot %p who) %dns-binding u.dun) - :: - ?: &(?=(^ req) =(adr u.req)) - this - :: XX check address? - =/ =request:dns [who adr] - =. requested.state (~(put by requested.state) request) - (give-result /requests %dns-request request) - :: - %dns-complete - :: XX or confirm valid binding? - :: - ?. (team:title [our src]:bowl) - ~| %complete-yoself !! - =* who ship.in-poke-data - =* adr address.binding.in-poke-data - =* tuf turf.binding.in-poke-data - =/ req=(unit address:dns) (~(get by requested.state) who) - :: ignore established bindings that don't match requested - :: - ?: ?| ?=(~ req) - !=(adr u.req) - == - ~& %unknown-complete - this - =: requested.state (~(del by requested.state) who) - completed.state (~(put by completed.state) who [adr tuf]) - == - (give-result /(scot %p who) %dns-binding adr tuf) - == -:: -++ peek - |= =path - ^- (unit (unit peek-data)) - ?+ path [~ ~] - [%x %requested ~] - [~ ~ %requested ~(tap by requested.state)] - :: - [%x %completed ~] - [~ ~ %completed ~(tap by completed.state)] - == -:: -++ peer - |= =path - ^- (quip move _this) - =< abet - :: will be immediately unlinked, see +prep - :: - ?: ?=([%sole *] path) - this - ?. ?=([@ ~] path) - ~| %invalid-path !! - ?: ?=(%requests i.path) - =/ requests ~(tap by requested.state) - |- ^+ this - =* loop $ - ?~ requests - this - =. ..this (give-result path %dns-request i.requests) - loop(requests t.requests) - :: - =/ who=(unit @p) (slaw %p i.path) - ?~ who - ~| %invalid-path !! - ?~ dun=(~(get by completed.state) u.who) - this - (give-result path %dns-binding u.dun) --- diff --git a/pkg/arvo/app/dns.hoon b/pkg/arvo/app/dns.hoon deleted file mode 100644 index 3093f480b..000000000 --- a/pkg/arvo/app/dns.hoon +++ /dev/null @@ -1,303 +0,0 @@ -/- dns, hall -/+ tapp, stdio -:: -:: tapp types and boilerplate -:: -=> |% - ++ collector-app `dock`[~zod %dns-collector] - +$ app-state - $: %0 - requested=(unit address:dns) - completed=(unit binding:dns) - == - +$ peek-data _!! - +$ in-poke-data - $% :: XX ames-domains unused, remove - :: - [%dns-auto ames-domains=(list turf)] - [%dns-address =address:dns] - == - +$ out-poke-data - $% [%dns-address =address:dns] - [%hall-action %phrase audience:hall (list speech:hall)] - == - +$ in-peer-data - $% [%dns-binding =binding:dns] - == - +$ out-peer-data ~ - ++ tapp - %: ^tapp - app-state - peek-data - in-poke-data - out-poke-data - in-peer-data - out-peer-data - == - ++ stdio (^stdio out-poke-data out-peer-data) - -- -:: -:: monadic helpers (XX move to stdio?) -:: -=> |% - :: +backoff: exponential backoff timer - :: - ++ backoff - |= [try=@ud limit=@dr] - =/ m (async:stdio ,~) - ^- form:m - ;< eny=@uvJ bind:m get-entropy:stdio - ;< now=@da bind:m get-time:stdio - %- wait:stdio - %+ add now - %+ min limit - ?: =(0 try) ~s0 - %+ add - (mul ~s1 (bex (dec try))) - (mul ~s0..0001 (~(rad og eny) 1.000)) - :: - ++ request - |= =hiss:eyre - =/ m (async:stdio (unit httr:eyre)) - ^- form:m - ;< ~ bind:m (send-hiss:stdio hiss) - take-maybe-sigh:stdio - :: - :: +self-check-http: confirm our availability at .host on port 80 - :: - :: XX needs better success/failure predicates - :: XX bind route to self and handle request inside tx? - :: - ++ self-check-http - |= [=host:eyre max=@ud] - =/ m (async:stdio ?) - ^- form:m - :: XX also scry into eyre - :: q:.^(hart:eyre %e /(scot %p our)/host/real) - =/ =hiss:eyre - =/ url=purl:eyre - [[sec=| por=~ host] [ext=`~.udon path=/static] query=~] - [url %get ~ ~] - =/ try=@ud 0 - |- ^- form:m - =* loop $ - ?: =(try max) - (pure:m |) - ;< ~ bind:m (backoff try ~h1) - ;< rep=(unit httr:eyre) bind:m (request hiss) - ?: ?& ?=(^ rep) - |(=(200 p.u.rep) =(307 p.u.rep)) - == - (pure:m &) - ?. ?| ?=(~ rep) - =(504 p.u.rep) - == - (pure:m |) - loop(try +(try)) - :: - ++ app-message - |= [app=term =cord =tang] - =/ m (async:stdio ,~) - ^- form:m - =/ msg=tape :(weld (trip app) ": " (trip cord)) - ;< ~ bind:m (flog-text:stdio msg) - (flog-tang:stdio tang) - :: - :: XX disabled due to :hall's status - :: - ++ hall-app-message-disabled - |= [app=term =cord =tang] - =/ m (async:stdio ,~) - ^- form:m - =/ msg=speech:hall - :+ %app app - =/ line [%lin & cord] - ?~(tang line [%fat [%tank tang] line]) - ;< our=@p bind:m get-identity:stdio - =/ act - [%phrase (sy [our %inbox] ~) [msg ~]] - (poke-app:stdio [our %hall] %hall-action act) - -- -:: -:: application actions -:: -=> |% - :: +turf-confirm-install: self check and install domain - :: - ++ turf-confirm-install - |= =turf - =/ m (async:stdio ?) - ^- form:m - ;< good=? bind:m (self-check-http &+turf 5) - ?. good - (pure:m |) - ;< ~ bind:m (install-domain:stdio turf) - (pure:m &) - :: - :: +galaxy-domains - :: - ++ galaxy-domains - =/ m (async:stdio ,~) - ^- form:m - ;< our=@p bind:m get-identity:stdio - ;< now=@da bind:m get-time:stdio - =/ ames-domains=(list turf) - .^((list turf) %j /(scot %p our)/turf/(scot %da now)) - |- ^- form:m - =* loop $ - ?~ ames-domains - (pure:m ~) - =/ =turf - (weld i.ames-domains /(crip +:(scow %p our))) - ;< good=? bind:m (turf-confirm-install turf) - =/ msg=(pair cord tang) - ?: good - [(cat 3 'confirmed access via ' (en-turf:html turf)) ~] - :- (cat 3 'unable to access via ' (en-turf:html turf)) - :~ leaf+"XX check via nslookup" - leaf+"XX confirm port 80" - == - ;< ~ bind:m (app-message %dns msg) - loop(ames-domains t.ames-domains) - :: - :: +request-by-ip - :: - ++ request-by-ip - |= if=@if - =/ m (async:stdio ?) - ^- form:m - ;< good=? bind:m (self-check-http |+if 5) - ?. good - :: XX details - ~& %bail-early - (pure:m |) - ;< ~ bind:m (poke-app:stdio collector-app [%dns-address %if if]) - ;< our=@p bind:m get-identity:stdio - ;< ~ bind:m (peer-app:stdio collector-app /(scot %p our)) - (pure:m &) - -- -:: -=* tapp-async tapp-async:tapp -=* default-tapp default-tapp:tapp -%- create-tapp-all:tapp -^- tapp-core-all:tapp -|_ [=bowl:gall state=app-state] -:: -++ handle-init handle-init:default-tapp -++ handle-peek handle-peek:default-tapp -++ handle-peer handle-peer:default-tapp -:: -++ handle-poke - |= =in-poke-data - =/ m tapp-async - ^- form:m - ?. (team:title [our src]:bowl) - ~| %configure-yoself !! - ?- -.in-poke-data - :: - :: "automatic" dns binding -- currently only for galaxies - :: - :: XX could be in +handle-init - :: XX use ip reflection for other classes - :: - %dns-auto - ?. ?=(%czar (clan:title our.bowl)) - :: XX details - :: - ~& %galaxy-only - (pure:m state) - ;< ~ bind:m galaxy-domains - (pure:m state) - :: - :: manual dns binding -- by explicit ipv4 - :: - %dns-address - =* adr address.in-poke-data - =/ rac (clan:title our.bowl) - ?. ?=(?(%king %duke) rac) - ~| [%dns-collector-bind-invalid rac] !! - ?: (reserved:eyre if.adr) - ~| [%dns-collector-reserved-address if.adr] !! - ;< requested=? bind:m (request-by-ip if.adr) - :: XX save failure? - :: - ~? =(requested.state (some address.in-poke-data)) - %re-requesting - =? requested.state requested - (some address.in-poke-data) - (pure:m state) - == -:: -++ handle-diff - |= [=dock =path =in-peer-data] - =/ m tapp-async - ^- form:m - ?. =(dock collector-app) - ~| [%unexpected-diff-dock-wat-do dock] !! - ?. =(path /(scot %p our.bowl)) - ~| [%unexpected-diff-path-wat-do path] !! - ?- -.in-peer-data - %dns-binding - =* binding binding.in-peer-data - ?~ requested.state - ~| %unexpected-binding-wat-do !! - ?. =(u.requested.state address.binding) - ~| %mismatch-binding-wat-do !! - ;< good=? bind:m (turf-confirm-install turf.binding) - =/ msg=(pair cord tang) - ?: good - [(cat 3 'confirmed access via ' (en-turf:html turf.binding)) ~] - :- (cat 3 'unable to access via ' (en-turf:html turf.binding)) - :~ leaf+"XX check via nslookup" - leaf+"XX confirm port 80" - == - ;< ~ bind:m (app-message %dns msg) - =? completed.state good (some binding) - :: XX save failure?s - :: XX unsubscribe? - (pure:m state) - == -:: -++ handle-take - |= =sign:tapp - =/ m tapp-async - ^- form:m - ?+ -.sign - ~| [%unexpected-sign sign] !! - :: print %poke nacks - :: - %coup - ?. =(collector-app dock.sign) - (pure:m state) - ?~ error.sign - =/ msg=cord - (cat 3 'request for DNS sent to ' (scot %p p:collector-app)) - ;< ~ bind:m (app-message %dns msg ~) - (pure:m state) - :: XX details - ~& %dns-ip-request-failed - %- (slog u.error.sign) - (pure:m state(requested ~)) - :: re-subscribe if (involuntarily) unsubscribed - :: - %quit - ?. =(path.sign /(scot %p our.bowl)) - ~| [%unexpected-quit-path-wat-do path.sign] !! - ;< ~ bind:m (peer-app:stdio collector-app /(scot %p our.bowl)) - (pure:m state) - :: print %peer nacks - :: - %reap - ?. =(path.sign /(scot %p our.bowl)) - ~| [%unexpected-reap-path-wat-do path.sign] !! - ?~ error.sign - =/ msg=cord - (cat 3 'awaiting response from ' (scot %p p:collector-app)) - ;< ~ bind:m (app-message %dns msg ~) - (pure:m state) - :: XX details - ~& %dns-domain-subscription-failed - %- (slog u.error.sign) - (pure:m state) - == --- diff --git a/pkg/arvo/app/dojo.hoon b/pkg/arvo/app/dojo.hoon deleted file mode 100644 index a11679f39..000000000 --- a/pkg/arvo/app/dojo.hoon +++ /dev/null @@ -1,1271 +0,0 @@ -:: :: :: -:::: /hoon/dojo/app :: :::: - :: :: :: -/? 309 :: arvo kelvin -/- *sole, lens :: -/+ sole, pprint, :: - auto=language-server-complete, :: - easy-print=language-server-easy-print :: -:: :: :: -:::: :: :::: - :: :: :: -=> |% :: external structures - ++ house :: all state - $: $5 - egg/@u :: command count - hoc/(map bone session) :: conversations - == :: - ++ session :: per conversation - $: say/sole-share :: command-line state - dir/beam :: active path - poy/(unit dojo-project) :: working - $: :: sur: structure imports - :: - sur=(list cable:ford) - :: lib: library imports - :: - lib=(list cable:ford) - == - var/(map term cage) :: variable state - old/(set term) :: used TLVs - buf/tape :: multiline buffer - == :: - ++ monkey :: per conversation - $: say/sole-share :: command-line state - dir/beam :: active path - poy/(unit dojo-project) :: working - var/(map term cage) :: variable state - old/(set term) :: used TLVs - buf/tape :: multiline buffer - == :: - ++ dojo-command :: - $^ (pair dojo-sink dojo-source) :: route value - {$brev p/term} :: unbind variable - :: - ++ dojo-sink :: - $% {$flat p/path} :: atom to unix - {$pill p/path} :: noun to unix pill - :: {$tree p/path} :: noun to unix tree - {$file p/beam} :: save to clay - $: $http :: http outbound - p/?($post $put) - r/@t - == - {$poke p/goal} :: poke app - {$show p/?($0 $1 $2 $3 $4 $5)} :: val/type/hoon/xray - {$verb p/term} :: store variable - == :: - ++ dojo-source :: construction node - $: p/@ud :: assembly index - q/dojo-build :: general build - == :: - ++ dojo-build :: one arvo step - $~ [%ex *hoon] - $% {$ur p/@t} :: http GET request - {$ge p/dojo-model} :: generator - {$dv p/path} :: core from source - {$ex p/hoon} :: hoon expression - {$sa p/mark} :: example mark value - {$as p/mark q/dojo-source} :: simple transmute - {$do p/hoon q/dojo-source} :: gate apply - {$tu p/(list dojo-source)} :: tuple - == :: - ++ dojo-model :: data construction - $: p/dojo-server :: core source - q/dojo-config :: configuration - == :: - ++ dojo-server :: numbered device - $: p/@ud :: assembly index - q/path :: gate path - == :: - ++ dojo-config :: configuration - $: p/(list dojo-source) :: by order - q/(map term (unit dojo-source)) :: by keyword - == :: - ++ dojo-project :: construction state - $: mad/dojo-command :: operation - num/@ud :: number of tasks - cud/(unit dojo-source) :: now solving - pux/(unit path) :: ford working - pro/(unit vase) :: prompting loop - per/(unit sole-edit) :: pending reverse - job/(map @ud dojo-build) :: problems - rez/(map @ud cage) :: results - == :: - ++ bead {p/(set beam) q/cage} :: computed result - ++ goal {p/ship q/term} :: flat application - ++ clap :: action, user - $% {$peer p/path} :: subscribe - {$poke p/(cask)} :: apply - {$pull ~} :: unsubscribe - == :: - ++ club :: action, system - $% {$peer p/path} :: subscribe - {$poke p/cage} :: apply - {$pull ~} :: unsubscribe - == :: - ++ card :: general card - $% {$diff $sole-effect sole-effect} :: - {$send wire {ship term} clap} :: - [%request wire request:http outbound-config:iris] :: %l - [%build wire ? schematic:ford] - [%kill wire ~] - {$deal wire sock term club} :: - {$info wire toro:clay} :: - == :: - ++ move (pair bone card) :: user-level move - ++ sign :: - $% :: %made: build result; response to %build +task - :: - $: %made - :: date: formal date of the build - :: - date=@da - :: result: result of the build; either complete build, or error - :: - $= result - $% :: %complete: contains the result of the completed build - :: - [%complete build-result=build-result:ford] - :: %incomplete: couldn't finish build; contains error message - :: - [%incomplete =tang] - == == - {$unto p/internal-gift:gall} - == - -- -=> -|% -:: |parser-at: parsers for dojo expressions using :dir as working directory -:: -++ parser-at - |= [our=ship dir=beam] - |% - ++ default-app %hood - ++ hoon-parser (vang | (en-beam:format dir)) - ++ our p.dir - :: - ++ parse-command-line ;~(sfix parse-command (star ace) (just '\0a')) - :: - ++ to-command - |= [gol=goal mod=dojo-model] - ^- dojo-command - [[%poke gol] [0 [%ge mod(q.p [q.gol q.p.mod])]]] - :: - ++ parse-variable - |* [sym=rule src=rule] - %+ cook - |= {a/term b/(unit dojo-source)} - ^- dojo-command - ?~(b [%brev a] [[%verb a] u.b]) - ;~(plug sym (punt src)) - :: - ++ parse-command - :: =< ;~(less |-(;~(pose (jest '|*') ;~(pfix next (knee ** |.(^$))))) .) - %+ knee *dojo-command |. ~+ - ;~ pose - ;~ pfix bar - %+ cook to-command - (stag `goal`[our default-app] parse-model) - == - :: - ;~ pfix col - %+ cook - |= {a/goal b/$^(dojo-model dojo-source)} - ?@ -.b [[%poke a] b] - (to-command a b) - ;~ plug - parse-goal - ;~ pose - ;~(pfix bar parse-model) - ;~(pfix ace parse-source) - == - == - == - :: - ;~ pfix tis - ;~ pose - (parse-variable (jest %dir) ;~(pfix ace :(stag 0 %ex parse-rood))) - (parse-variable sym ;~(pfix ace parse-source)) - == - == - :: - ;~ pfix net - ;~ pose - (parse-variable (cold %sur hep) ;~(pfix gap parse-cables)) - (parse-variable (cold %lib lus) ;~(pfix gap parse-cables)) - == - == - :: - ;~((glue ace) parse-sink parse-source) - (stag [%show %0] parse-source) - == - :: - ++ parse-sink - ;~ pose - ;~(plug (cold %file tar) parse-beam) - ;~(plug (cold %flat vat) (most net sym)) - ;~(plug (cold %pill dot) (most net sym)) - ;~(plug (cold %http lus) (stag %post parse-url)) - ;~(plug (cold %http hep) (stag %put parse-url)) - (stag %show (cook $?($1 $2 $3 $4 $5) (cook lent (stun [1 5] wut)))) - == - :: - ++ parse-cables - %+ cook - |= cables=(list cable:ford) - :+ 0 %ex - ^- hoon - :: - :- %clsg - %+ turn cables - |= cable=cable:ford - ^- hoon - :: - :+ %clhp - ?~ face.cable - [%rock %n ~] - [%clhp [%rock %n ~] [%sand %tas u.face.cable]] - [%sand %tas file-path.cable] - (most ;~(plug com gaw) parse-cable) - :: - ++ parse-cable - %+ cook |=(a=cable:ford a) - ;~ pose - (stag ~ ;~(pfix tar sym)) - (cook |=([face=term tis=@ file=term] [`face file]) ;~(plug sym tis sym)) - (cook |=(a=term [`a a]) sym) - == - ++ parse-source (stag 0 parse-build) - ++ parse-build - %+ knee *dojo-build |. ~+ - ;~ pose - ;~(plug (cold %ur lus) parse-url) - ;~(plug (cold %ge lus) parse-model) - ;~(plug (cold %as pad) sym ;~(pfix ace parse-source)) - ;~(plug (cold %do cab) parse-hoon ;~(pfix ace parse-source)) - parse-value - == - :: - ++ parse-goal - %+ cook |=(a/goal a) - ;~ pose - ;~ plug - ;~(pfix sig fed:ag) - ;~(pose ;~(pfix net sym) (easy default-app)) - == - %+ stag our - ;~(pose sym (easy default-app)) - == - :: - ++ parse-beam - %+ cook - |= a=path - :: hack: fixup paths that come out of the hoon parser - :: - :: We currently invoke the hoon parser to read relative paths from - :: the command line, and this parser will produce leading ~ path - :: components with paths that start with a `/`. - :: - :: This entire path is nuts and we shouldn't be representing paths - :: as arbitrary hoons. - :: - =? a &(?=(^ a) =('' i.a)) - t.a - (fall (de-beam:format a) [`beak`[p q r]:dir (flop a)]) - =+ vez=hoon-parser - (sear plex:vez (stag %clsg poor:vez)) - :: - ++ parse-iden-url - %+ cook - |=([a=(unit knot) b=purl:eyre] [`(fall a *knot) b]) - auru:de-purl:html - :: - ++ parse-url - %+ cook - |=(a=purl:eyre (crip (en-purl:html a))) - auri:de-purl:html - :: - ++ parse-model ;~(plug parse-server parse-config) - ++ parse-server (stag 0 (most net sym)) - ++ parse-hoon tall:hoon-parser - :: - ++ parse-rood - :: XX should this use +hoon-parser instead to normalize the case? - :: - => (vang | (en-beam:format dir)) - ;~ pose - rood - :: - :: XX refactor ++scat - :: - =- ;~(pfix cen (stag %clsg -)) - %+ sear |=([a=@ud b=tyke] (posh ~ ~ a b)) - ;~ pose - porc - (cook |=(a=(list) [(lent a) ~]) (star cen)) - == - == - ++ parse-value - ;~ pose - (stag %sa ;~(pfix tar pad sym)) - (stag %ex parse-hoon) - (stag %tu (ifix [lac rac] (most ace parse-source))) - == - :: - ++ parse-config - ;~ plug - (star ;~(pfix ace (stag 0 parse-value))) - %+ cook - ~(gas by *(map term (unit dojo-source))) - %- star - ;~ plug - ;~(pfix com ace tis sym) - (punt ;~(pfix ace (stag 0 parse-value))) - == - == - -- --- -:: :: -:::: :: - :: :: -=, gall -=+ foo=*monkey -|_ $: hid/bowl :: system state - house :: program state - == :: -:: -:: pretty-printer aliases -:: -++ xskol `$-(type tank)`type-to-tank:pprint -++ xsell `$-(vase tank)`vase-to-tank:pprint -:: -++ he :: per session - |_ {moz/(list move) session} :: - :: - ++ he-beam - ^- beam - ?. =([%ud 0] r.dir) - dir - dir(r [%da now.hid]) - :: - ++ he-disc `disc:ford`[p q]:he-beam - ++ he-beak `beak`[p q r]:he-beam - ++ he-rail `rail:ford`[[p q] s]:he-beam - ++ he-parser (parser-at our.hid he-beam) - :: - ++ dy :: project work - |_ dojo-project :: - ++ dy-abet +>(poy `+<) :: resolve - ++ dy-amok +>(poy ~) :: terminate - ++ dy-ford :: send work to ford - |= [way=wire schematic=schematic:ford] - ^+ +>+> - ?> ?=($~ pux) - :: pin all builds to :now.hid so they don't get cached forever - :: - (he-card(poy `+>+<(pux `way)) %build way live=%.n schematic) - :: - ++ dy-request - |= [way=wire =request:http] - ^+ +>+> - ?> ?=(~ pux) - (he-card(poy `+>+<(pux `way)) %request way request *outbound-config:iris) - :: - ++ dy-stop :: stop work - ^+ +> - =. poy ~ - ?~ pux +> - %. [%txt "! cancel {}"] - he-diff:(he-card [%kill u.pux ~]) - :: - ++ dy-slam :: call by ford - |= {way/wire gat/vase sam/vase} - ^+ +>+> - (dy-ford way `schematic:ford`[%call [%$ %noun gat] [%$ %noun sam]]) - :: - ++ dy-errd :: reject change, abet - |= {rev/(unit sole-edit) err/@u} - ^+ +>+> - (he-errd(poy `+>+<) rev err) - :: - ++ dy-diff :: send effects, abet - |= fec/sole-effect - ^+ +>+> - (he-diff(poy `+>+<) fec) - :: - ++ dy-rash :: send effects, amok - |= fec/sole-effect - ^+ +>+> - (he-diff(poy ~) fec) - :: - ++ dy-init-command :: ++dojo-command - |= mad/dojo-command - ^+ [mad +>] - ?@ -.mad [mad +>.$] - =. q.mad - ?+(-.p.mad q.mad $http [0 %as %mime q.mad]) - =^ src +>.$ (dy-init-source q.mad) - [mad(q src) +>.$] - :: - ++ dy-init-source :: ++dojo-source - |= src/dojo-source - ^+ [src +>] - =^ bul +> (dy-init-build q.src) - =: p.src num - q.src bul - == - [src +>.$(num +(num), job (~(put by job) -.src +.src))] - :: - ++ dy-init-source-unit :: (unit dojo-source) - |= urc/(unit dojo-source) - ^+ [urc +>] - ?~ urc [~ +>] - =^ src +> (dy-init-source u.urc) - [`src +>.$] - :: - ++ dy-init-build :: ++dojo-build - |= bul/dojo-build - ^+ [bul +>] - ?- -.bul - $ex [bul +>.$] - $dv [bul +>.$] - $sa [bul +>.$] - $as =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$]) - $do =^(mor +>.$ (dy-init-source q.bul) [bul(q mor) +>.$]) - $ge =^(mod +>.$ (dy-init-model p.bul) [[%ge mod] +>.$]) - $ur [bul +>.$] - $tu =^ dof +>.$ - |- ^+ [p.bul +>.^$] - ?~ p.bul [~ +>.^$] - =^ dis +>.^$ (dy-init-source i.p.bul) - =^ mor +>.^$ $(p.bul t.p.bul) - [[dis mor] +>.^$] - [[%tu dof] +>.$] - == - :: - ++ dy-init-model :: ++dojo-model - |= mol/dojo-model - ^+ [mol +>] - =^ one +>.$ (dy-init-server p.mol) - =^ two +>.$ (dy-init-config q.mol) - [[one two] +>.$] - :: - ++ dy-init-server :: ++dojo-server - |= srv/dojo-server - =. p.srv num - [srv +>.$(num +(num), job (~(put by job) num [%dv [%gen q.srv]]))] - :: - ++ dy-init-config :: prepare config - |= cig/dojo-config - ^+ [cig +>] - =^ ord +>.$ (dy-init-ordered p.cig) - =^ key +>.$ (dy-init-named q.cig) - [[ord key] +>.$] - :: - ++ dy-init-ordered :: (list dojo-source) - |= ord/(list dojo-source) - ^+ [ord +>] - ?~ ord [~ +>.$] - =^ fir +>.$ (dy-init-source i.ord) - =^ mor +>.$ $(ord t.ord) - [[fir mor] +>.$] - :: - ++ dy-init-named :: (map @tas dojo-src) - |= key/(map term (unit dojo-source)) - ^+ [key +>.$] - ?~ key [~ +>.$] - =^ top +>.$ (dy-init-source-unit q.n.key) - =^ lef +>.$ $(key l.key) - =^ rit +>.$ $(key r.key) - [[[p.n.key top] lef rit] +>.$] - :: - ++ dy-init :: full initialize - ^+ . - =^(dam . (dy-init-command mad) +(mad dam)) - :: - ++ dy-hand :: complete step - |= cag/cage - ^+ +>+> - ?> ?=(^ cud) - (dy-step(cud ~, rez (~(put by rez) p.u.cud cag)) +(p.u.cud)) - :: - ++ dy-meal :: vase to cage - |= vax/vase - ?. &(?=(@ -.q.vax) ((sane %tas) -.q.vax)) - ~& %dy-meal-cage - (dy-rash %bel ~) - (dy-hand -.q.vax (slot 3 vax)) - :: - ++ dy-made-edit :: sole edit - |= cag/cage - ^+ +>+> - ?> ?=(^ per) - ?: ?| ?=(^ q.q.cag) - =((lent buf.say) q.q.cag) - !&(?=($del -.u.per) =(+(p.u.per) (lent buf.say))) - == - dy-abet(per ~) - (dy-errd(per ~) per q.q.cag) - :: - ++ dy-done :: dialog submit - |= txt/tape - ?: |(?=(^ per) ?=(^ pux) ?=(~ pro)) - ~& %dy-no-prompt - (dy-diff %bel ~) - (dy-slam /dial u.pro !>(txt)) - :: - ++ dy-cast - |* {typ/_* bun/vase} - |= a/vase ^- typ - ~| [p.bun p.a] - ?> (~(nest ut p.bun) & p.a) - ;;(typ q.a) - :: - ++ dy-over :: finish construction - ^+ +> - :: XX needs filter - :: - :: ?: ?=({$show $3} -.mad) - :: (dy-rash %tan (dy-show-source q.mad) ~) :: XX separate command - ?: ?=($brev -.mad) - =. var (~(del by var) p.mad) - =< dy-amok - ?+ p.mad . - $?($eny $now $our) !! - $lib .(lib ~) - $sur .(sur ~) - $dir .(dir [[our.hid %home ud+0] /]) - == - =+ cay=(~(got by rez) p.q.mad) - ?- -.p.mad - $verb - =. var (~(put by var) p.p.mad cay) - ~| bad-set+[p.p.mad p.q.cay] - =< dy-amok - ?+ p.p.mad . - $eny ~|(%entropy-is-eternal !!) - $now ~|(%time-is-immutable !!) - $our ~|(%self-is-immutable !!) - $lib - %_ . - lib - ((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay) - == - :: - $sur - %_ . - sur - ((dy-cast (list cable:ford) !>(*(list cable:ford))) q.cay) - == - :: - $dir =+ ^= pax ^- path - =+ pax=((dy-cast path !>(*path)) q.cay) - ?: ?=(~ pax) ~[(scot %p our.hid) %home '0'] - ?: ?=({@ ~} pax) ~[i.pax %home '0'] - ?: ?=({@ @ ~} pax) ~[i.pax i.t.pax '0'] - pax - =. dir (need (de-beam:format pax)) - =- +>(..dy (he-diff %tan - ~)) - rose+[" " `~]^~[leaf+"=%" (smyt (en-beam:format he-beak s.dir))] - == - :: - $poke - %- he-card(poy ~) - :* %deal - /poke - [our.hid p.p.p.mad] - q.p.p.mad - %poke - cay - == - :: - $file - %- he-card(poy ~) :* - %info - /file - (foal:space:userlib (en-beam:format p.p.mad) cay) - == - :: - $flat - ?^ q.q.cay - (dy-rash %tan [%leaf "not an atom"]~) - (dy-rash %sav p.p.mad q.q.cay) - :: - $pill - (dy-rash %sag p.p.mad q.q.cay) - :: - $http - ?> ?=($mime p.cay) - =+ mim=;;(mime q.q.cay) - %+ dy-request /show - :* ?:(=(%put p.p.mad) %'PUT' %'POST') - r.p.mad - ~[['content-type' (en-mite:mimes:html p.mim)]] - `q.mim - == - :: - $show - |^ (prnt cay note) - ++ prnt ?: (gte p.p.mad 4) - dy-xprint - dy-print - ++ note ^- tang - ?- p.p.mad - %0 ~ - %1 [[%rose [~ " " ~] (skol p.q.cay) ~] maar] - :: XX actually print something meaningful here - :: - %2 [[%rose [~ " " ~] *tank ~] maar] - %3 ~ - %4 ~ - %5 [[%rose [~ " " ~] (xskol p.q.cay) ~] maar] - == - ++ maar ?: =(%noun p.cay) ~ - [[%rose [~ " " ~] >p.cay< ~] ~] - -- - == - :: - ++ dy-show |=(cay/cage (dy-print cay ~)) - :: - :: Print a value (given as a cage) and a note (given as a tang). - :: - ++ dy-xprint - |= {cay/cage tan/tang} - %+ dy-rash %tan - %- welp :_ tan - ?+ p.cay [(xsell q.cay)]~ - $tang ;;(tang q.q.cay) - $httr - =+ hit=;;(httr:eyre q.q.cay) - =- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '' ~)))) - :- "HTTP {}" - %+ weld - (turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}")) - :- i="" - t=(turn `wain`?~(r.hit ~ (to-wain:format q.u.r.hit)) trip) - == - :: - :: Print a value (given as a cage) and a note (given as a tang). - :: - ++ dy-print - |= {cay/cage tan/tang} - %+ dy-rash %tan - %- welp :_ tan - ?+ p.cay [(sell q.cay)]~ - $tang ;;(tang q.q.cay) - $httr - =+ hit=;;(httr:eyre q.q.cay) - =- (flop (turn `wall`- |=(a/tape leaf+(dash:us a '' ~)))) - :- "HTTP {}" - %+ weld - (turn q.hit |=({a/@t b/@t} "{(trip a)}: {(trip b)}")) - :- i="" - t=(turn `wain`?~(r.hit ~ (to-wain:format q.u.r.hit)) trip) - == - :: - ++ dy-edit :: handle edit - |= cal/sole-change - ^+ +>+> - =^ dat say (~(transceive sole say) cal) - ?: |(?=(^ per) ?=(^ pux) ?=(~ pro)) - ~& %dy-edit-busy - =^ lic say (~(transmit sole say) dat) - (dy-diff %mor [%det lic] [%bel ~] ~) - (dy-slam(per `dat) /edit u.pro !>((tufa buf.say))) - :: - ++ dy-type :: sole action - |= act/sole-action - ?- -.act - $det (dy-edit +.act) - $ret (dy-done (tufa buf.say)) - $clr dy-stop - $tab +>+> - == - :: - ++ dy-cage |=(num/@ud (~(got by rez) num)) :: known cage - ++ dy-vase |=(num/@ud q:(dy-cage num)) :: known vase - ++ dy-silk-vase |=(vax/vase [%$ %noun vax]) :: vase to silk - ++ dy-silk-sources :: arglist to silk - |= src/(list dojo-source) - ^- schematic:ford - :: - :+ %$ %noun - |- - ?~ src !>(~) - (slop (dy-vase p.i.src) $(src t.src)) - :: - ++ dy-silk-config :: configure - |= {cay/cage cig/dojo-config} - ^- [wire schematic:ford] - ?. (~(nest ut [%cell [%atom %$ ~] %noun]) | p.q.cay) - :: - :: naked gate - :: - ?. &(?=({* ~} p.cig) ?=(~ q.cig)) - ~|(%one-argument !!) - :- /noun - :+ %call [%$ %noun q.cay] - [%$ %noun (dy-vase p.i.p.cig)] - :: - :: normal generator - :: - :- ?+ -.q.q.cay ~|(%bad-gen ~_((sell (slot 2 q.cay)) !!)) - $say /gent - $ask /dial - == - =+ gat=(slot 3 q.cay) - :+ %call [%$ %noun gat] - :+ [%$ %noun !>([now=now.hid eny=eny.hid bec=he-beak])] - (dy-silk-sources p.cig) - :+ %mute [%$ %noun (fall (slew 27 gat) !>(~))] - ^- (list [wing schematic:ford]) - %+ turn ~(tap by q.cig) - |= {a/term b/(unit dojo-source)} - ^- [wing schematic:ford] - :- [a ~] - :+ %$ %noun - ?~(b !>([~ ~]) (dy-vase p.u.b)) - :: - ++ dy-made-dial :: dialog product - |= cag/cage - ^+ +>+> - ?. ?=(^ q.q.cag) - (dy-errd ~ q.q.cag) - =+ tan=((list tank) +2.q.q.cag) - =. +>+>.$ (he-diff %tan tan) - =+ vax=(sped (slot 3 q.cag)) - ?+ -.q.vax !! - %& - ?~ +.q.vax - ~& %dy-made-dial-abort - (dy-rash %bel ~) - (dy-meal (slot 7 vax)) - :: - %| - =< he-pone - %- dy-diff(pro `(slap (slot 7 vax) [%limb %q])) - =+ pom=(sole-prompt +<.q.vax) - [%pro pom(cad [':' ' ' cad.pom])] - == - :: - ++ dy-made-gent :: generator product - |= cag/cage - (dy-meal q.cag) - :: - ++ dy-made-noun :: generator product - |= cag/cage - (dy-hand %noun q.cag) - :: - ++ dy-make :: build step - ^+ +> - ?> ?=(^ cud) - =+ bil=q.u.cud :: XX =* - ?: ?=($ur -.bil) - (dy-request /hand `request:http`[%'GET' p.bil ~ ~]) - %- dy-ford - ^- [path schematic:ford] - ?- -.bil - $ge (dy-silk-config (dy-cage p.p.p.bil) q.p.bil) - $dv [/hand [%core [he-disc (weld /hoon (flop p.bil))]]] - $ex [/hand (dy-mare p.bil)] - $sa [/hand [%bunt he-disc p.bil]] - $as [/hand [%cast he-disc p.bil [%$ (dy-cage p.q.bil)]]] - $do [/hand [%call (dy-mare p.bil) [%$ (dy-cage p.q.bil)]]] - $tu :- /hand - :+ %$ %noun - |- ^- vase - ?~ p.bil !! - =+ hed=(dy-vase p.i.p.bil) - ?~ t.p.bil hed - (slop hed $(p.bil t.p.bil)) - == - :: - ++ dy-hoon-mark :: XX architect - =+ ^= ope - |= gen/hoon ^- hoon - ?: ?=(?($sgld $sgbn) -.gen) - $(gen q.gen) - =+ ~(open ap gen) - ?.(=(gen -) $(gen -) gen) - |= gen/hoon ^- (unit mark) - =. gen (ope gen) - ?: ?=({$cnts {@ ~} ~} gen) - (bind (~(get by var) i.p.gen) head) - ~ - :: - ++ dy-mare :: build expression - |= gen/hoon - ^- schematic:ford - =+ too=(dy-hoon-mark gen) - =- ?~(too - [%cast he-disc u.too -]) - :+ %ride gen - :- [%$ he-hoon-head] - :^ %plan he-rail `coin`blob+** - `scaffold:ford`[he-rail zuse sur lib ~ ~] - :: - ++ dy-step :: advance project - |= nex/@ud - ^+ +>+> - ?> ?=(~ cud) - ?: =(nex num) - dy-over - dy-make(cud `[nex (~(got by job) nex)]) - -- - :: - ++ he-dope - |= txt/tape :: - ^- (each (unit (each dojo-command tape)) hair) :: prefix+result - =+ len=+((lent txt)) :: line length - =. txt (weld buf `tape`(weld txt "\0a")) :: - =+ vex=((full parse-command-line:he-parser) [1 1] txt) - ?: =(q.p.vex len) :: matched to line end - [%& ~] :: - ?: =(p.p.vex +((lent (skim txt |=(a/@ =(10 a)))))) :: parsed all lines - [%& ~ ?~(q.vex [%| txt] [%& p.u.q.vex])] :: new buffer+complete - [%| p.p.vex (dec q.p.vex)] :: syntax error - :: - ++ he-duke :: ++he-dope variant - |= txt/tape - ^- (each (unit (each dojo-command tape)) @ud) - =+ foy=(he-dope txt) - ?- -.foy - %| [%| q.p.foy] - %& [%& p.foy] - == - :: - ++ he-abet :: resolve - [(flop moz) %_(+> hoc (~(put by hoc) ost.hid +<+))] - :: - ++ he-abut :: discard - => he-stop - [(flop moz) %_(+> hoc (~(del by hoc) ost.hid))] - :: - ++ he-card :: emit gift - |= cad/card - ^+ +> - %_(+> moz [[ost.hid cad] moz]) - :: - ++ he-send - |= {way/wire him/ship dap/term cop/clap} - ^+ +> - (he-card %send way [him dap] cop) - :: - ++ he-diff :: emit update - |= fec/sole-effect - ^+ +> - (he-card %diff %sole-effect fec) - :: - ++ he-stop :: abort work - ^+ . - ?~(poy . ~(dy-stop dy u.poy)) - :: - ++ he-peer :: subscribe to - |=(pax/path ?>(=(~ pax) he-prom)) - :: - ++ he-pine :: restore prompt - ^+ . - ?^ poy . - he-prom:he-pone - :: - ++ he-errd :: reject update - |= {rev/(unit sole-edit) err/@u} ^+ +> - =+ red=(fall rev [%nop ~]) :: required for error location sync - =^ lic say (~(transmit sole say) red) - (he-diff %mor [%det lic] [%err err] ~) - :: - ++ he-pone :: clear prompt - ^+ . - =^ cal say (~(transmit sole say) [%set ~]) - (he-diff %mor [%det cal] ~) - :: - ++ he-prow :: where we are - ^- tape - ?: &(=(our.hid p.dir) =(%home q.dir) =([%ud 0] r.dir) =(~ s.dir)) ~ - %+ weld - ?: &(=(our.hid p.dir) =([%ud 0] r.dir)) - (weld "/" (trip q.dir)) - ;: weld - "/" ?:(=(our.hid p.dir) "=" (scow %p p.dir)) - "/" ?:(=(%home q.dir) "=" (trip q.dir)) - "/" ?:(=([%ud 0] r.dir) "=" (scow r.dir)) - == - ?:(=(~ s.dir) "" (spud (flop s.dir))) - :: - ++ he-prom :: send prompt - %- he-diff - :- %pro - [& %$ (weld he-prow ?~(buf "> " "< "))] - :: - ++ he-made :: result from ford - |= $: way=wire - date=@da - $= result - $% [%complete build-result=build-result:ford] - [%incomplete =tang] - == == - ^+ +> - ?> ?=(^ poy) - =< he-pine - ?- -.result - %incomplete - (he-diff(poy ~) %tan tang.result) - :: - %complete - ?- -.build-result.result - :: - %success - :: - %. (result-to-cage:ford build-result.result) - =+ dye=~(. dy u.poy(pux ~)) - ?+ way !! - {$hand ~} dy-hand:dye - {$dial ~} dy-made-dial:dye - {$gent ~} dy-made-gent:dye - {$noun ~} dy-made-noun:dye - {$edit ~} dy-made-edit:dye - == - :: - %error - (he-diff(poy ~) %tan message.build-result.result) - == == - :: - ++ he-unto :: result from behn - |= {way/wire cit/internal-gift:gall} - ^+ +> - ?. ?=($coup -.cit) - ~& [%strange-unto cit] - +> - ?~ p.cit - (he-diff %txt ">=") - (he-diff %tan u.p.cit) - :: +he-http-response: result from http-client - :: - ++ he-http-response - |= [way=wire response=client-response:iris] - ^+ +> - ?> ?=(^ poy) - =< he-pine - ?. ?=(%finished -.response) - ~& %dojo-received-http-progress - +> - :: - ~! response - %. [%httr !>((to-httr:iris response-header.response full-file.response))] - =+ dye=~(. dy u.poy(pux ~)) - ?+ way !! - {$hand ~} dy-hand:dye - {$show ~} dy-show:dye - == - :: - ++ he-lens - |= com/command:lens - ^+ +> - =+ ^- source/dojo-source - =| num/@ - =- ?. ?=($send-api -.sink.com) :: XX num is incorrect - sor - :- 0 - :+ %as `mark`(cat 3 api.sink.com '-poke') - :- 1 - :+ %do - ^- hoon - :+ %brtr [%base %noun] - :^ %clls [%rock %tas %post] - [%rock %$ endpoint.sink.com] - [%cnts [%& 6]~ ~] - sor - ^= sor - |- ^- dojo-source - :- num - ?- -.source.com - $data [%ex %sand %t data.source.com] - $dojo - %+ rash command.source.com - (ifix [(punt gap) (punt gap)] parse-build:he-parser) - :: - $clay - :- %ex - ^- hoon - :+ %dtkt - [%base %noun] - :+ %clhp - [%rock %tas %cx] - %+ rash pax.source.com - rood:(vang | /(scot %p our.hid)/home/(scot %da now.hid)) - :: - $url [%ur (crip (en-purl:html url.source.com))] - $api !! - $get-api - :- %ex - ^- hoon - :+ %dtkt - [%like ~[%json] ~] - :* %clsg - [%rock %tas %gx] - [%sand %ta (scot %p our.hid)] - [%sand %tas api.source.com] - [%sand %ta (scot %da now.hid)] - (turn endpoint.source.com |=(a/@t [%sand %ta a])) - == - :: - $listen-api !! - $export !! - $import !! - $as - :* %as mar.source.com - $(num +(num), source.com next.source.com) - == - :: - $hoon - :* %do - %+ rash code.source.com - tall:(vang | /(scot %p our.hid)/home/(scot %da now.hid)) - $(num +(num), source.com next.source.com) - == - :: - $tuple - :- %tu - |- ^- (list dojo-source) - ?~ next.source.com - ~ - =. num +(num) - :- ^$(source.com i.next.source.com) - $(next.source.com t.next.source.com) - == - =+ |- ^- sink/dojo-sink - ?- -.sink.com - $stdout [%show %0] - $output-file $(sink.com [%command (cat 3 '@' pax.sink.com)]) - $output-pill $(sink.com [%command (cat 3 '.' pax.sink.com)]) - $output-clay [%file (need (de-beam:format pax.sink.com))] - $url [%http %post (crip (en-purl:html url.sink.com))] - $to-api !! - $send-api [%poke our.hid api.sink.com] - $command (rash command.sink.com parse-sink:he-parser) - $app [%poke our.hid app.sink.com] - == - (he-plan sink source) - :: - ++ he-like :: accept line - |= buf/(list @c) - =(%& -:(he-dope (tufa buf))) - :: - ++ he-stir :: apply change - |= cal/sole-change - ^+ +> - :: ~& [%his-clock ler.cal] - :: ~& [%our-clock ven.say] - =^ dat say (~(transceive sole say) cal) - ?. ?& ?=($del -.dat) - =(+(p.dat) (lent buf.say)) - == - +>.$ - =+ foy=(he-dope (tufa buf.say)) - ?: ?=(%& -.foy) +>.$ - :: ~& [%bad-change dat ted.cal] - :: ~& [%our-leg leg.say] - (he-errd `dat q.p.foy) - :: - ++ he-plan :: execute command - |= mad/dojo-command - ^+ +> - ?> ?=(~ poy) - he-pine:(dy-step:~(dy-init dy %*(. *dojo-project mad mad)) 0) - :: - ++ he-done :: parse command - |= txt/tape - ^+ +> - ?~ txt - =< he-prom(buf ~) - %- he-diff - :~ %mor - [%txt "> "] - [%nex ~] - == - =+ doy=(he-duke txt) - ?- -.doy - %| (he-errd ~ p.doy) - %& - ?~ p.doy - (he-errd ~ (lent txt)) - =+ old=(weld ?~(buf "> " " ") (tufa buf.say)) - =^ cal say (~(transmit sole say) [%set ~]) - =. +>.$ (he-diff %mor txt+old nex+~ det+cal ~) - ?- -.u.p.doy - %& (he-plan(buf ~) p.u.p.doy) - %| he-prom(buf p.u.p.doy) - == - == - :: - ++ he-tab - |= pos=@ud - ^+ +> - =* res +> - =+ ^- [back-pos=@ud fore-pos=@ud txt=tape] - (insert-magic:auto (add (lent buf) pos) :(weld buf (tufa buf.say))) - =/ id-len (sub fore-pos back-pos) - =/ fore-pos-diff (sub fore-pos pos) - =+ vex=((full parse-command-line:he-parser) [1 1] txt) - ?. ?=([* ~ [* @ %ex *] *] vex) - res - =/ typ p:(slop q:he-hoon-head !>(..dawn)) - =/ tl (tab-list-hoon:auto typ p.q.q.p.u.q.vex) - =/ advance (advance-hoon:auto typ p.q.q.p.u.q.vex) - =? res ?=(^ advance) - =/ to-send - (trip (rsh 3 (sub pos back-pos) u.advance)) - =| fxs=(list sole-effect) - =. . - |- ^+ +.$ - ?. (gth fore-pos-diff 0) - +.$ - =^ lic say (~(transmit sole say) %del pos) - %= $ - fxs [det+lic fxs] - fore-pos-diff (dec fore-pos-diff) - == - :: =. pos (add pos fore-pos-diff) - |- ^+ res - ?~ to-send - (he-diff %mor (flop fxs)) - =^ lic say (~(transmit sole say) %ins pos `@c`i.to-send) - $(to-send t.to-send, fxs [`sole-effect`det+lic fxs], pos +(pos)) - :: If couldn't search (eg cursor not in appropriate position), do - :: nothing. - :: - ?: ?=(~ tl) - res - :: If no options, ring the bell - :: - ?: =([~ ~] tl) - (he-diff %bel ~) - :: If only one option, don't print unless the option is already - :: typed in. - :: - ?: &(?=([* ~] u.tl) !=((met 3 (need advance)) id-len)) - res - :: Else, print results - :: - =/ lots (gth (lent u.tl) 10) - %+ he-diff %tab - %+ turn u.tl - |= [=term =type] - ~| term - :- term - ?: lots - *tank - :: +perk is broken because *perk crashes. - :: - ?: =(%perk term) - *tank - ~(duck easy-print type) - :: - ++ he-type :: apply input - |= act/sole-action - ^+ +> - ?^ poy - he-pine:(~(dy-type dy u.poy) act) - ?- -.act - $det (he-stir +.act) - $ret (he-done (tufa buf.say)) - $clr he-pine(buf "") - $tab (he-tab +.act) - == - :: - ++ he-lame :: handle error - |= {wut/term why/tang} - ^+ +> - %- (slog (flop `tang`[>%dojo-lame wut< why])) - ?^ poy - he-pine:~(dy-amok dy u.poy) - he-pine :: XX give mean to original keystroke - :: - ++ he-hoon-head :: dynamic state - :: todo: how do i separate the toplevel 'dojo state' comment? - :: dojo state - :: - :: our: the name of this urbit - :: now: the current time - :: eny: a piece of random entropy - :: - ^- cage - :- %noun - =+ sloop=|=({a/vase b/vase} ?:(=(*vase a) b ?:(=(*vase b) a (slop a b)))) - %+ sloop - %- ~(rep by var) - |= {{a/term @ b/vase} c/vase} ^- vase - (sloop b(p face+[a p.b]) c) - !>([our=our now=now eny=eny]:hid) - -- -:: -++ prep - |= old/(unit house) - ^+ [~ ..prep] - ?~ old `..prep - `..prep(+<+ u.old) -:: -:: pattern: ++ foo |=(data he-abet:(~(he-foo he (~(got by hoc) ost)) data)) -++ arm (arm-session ~ (~(got by hoc) ost.hid)) -++ arm-session - |= {moz/(list move) ses/session} - => ~(. he moz ses) - =- [wrap=- +] - =+ he-arm=he-type - |@ ++ $ - |: +<.he-arm - ^- (quip move _..he) - he-abet:(he-arm +<) - -- -:: -++ peer-sole - ~? !=(our.hid src.hid) [%dojo-peer-stranger ost.hid src.hid] - ?> (team:title our.hid src.hid) - =^ moz . - ?. (~(has by hoc) ost.hid) [~ .] - ~& [%dojo-peer-replaced ost.hid] - ~(he-abut he ~ (~(got by hoc) ost.hid)) - =+ ses=%*(. *session -.dir [our.hid %home ud+0]) - (wrap he-peer):(arm-session moz ses) -:: -++ poke-sole-action - |= act/sole-action ~| poke+act %. act - (wrap he-type):arm -:: -++ poke-lens-command - |= com/command:lens ~| poke-lens+com %. com - (wrap he-lens):arm -:: -++ poke-json - |= jon=json - ^- [(list move) _+>.$] - ~& jon=jon - [~ +>.$] -:: +poke-wipe: clear all dojo sessions -:: -++ poke-wipe - |= * - ^- [(list move) _+>.$] - ~& %dojo-wipe - =. hoc - %- ~(run by hoc) - |= =session - %_ session - sur ~ - lib ~ - var ~ - old ~ - == - :: - [~ +>.$] -:: -++ made (wrap he-made):arm -++ http-response (wrap he-http-response):arm -++ lame (wrap he-lame):arm -++ unto (wrap he-unto):arm -++ pull - |= {pax/path} - ^- (quip move _+>) - =^ moz +> ~(he-abut he ~ (~(got by hoc) ost.hid)) - [moz +>.$(hoc (~(del by hoc) ost.hid))] --- diff --git a/pkg/arvo/app/example-tapp-fetch.hoon b/pkg/arvo/app/example-tapp-fetch.hoon deleted file mode 100644 index 203964c66..000000000 --- a/pkg/arvo/app/example-tapp-fetch.hoon +++ /dev/null @@ -1,147 +0,0 @@ -:: Little app to demonstrate the structure of programs written with the -:: transaction monad. -:: -:: Fetches the top comment of each of the top 10 stories from Hacker News -:: -/+ tapp, stdio -:: -:: Preamble -:: -=> - |% - +$ state - $: top-comments=(list tape) - == - +$ peek-data _!! - +$ in-poke-data [%noun =cord] - +$ out-poke-data ~ - +$ in-peer-data ~ - +$ out-peer-data - $% [%comments (list tape)] - == - ++ tapp (^tapp state peek-data in-poke-data out-poke-data in-peer-data out-peer-data) - ++ stdio (^stdio out-poke-data out-peer-data) - -- -=> - |% - :: Helper function to print a comment - :: - ++ comment-to-tang - |= =tape - ^- tang - %+ welp - %+ turn (rip 10 (crip tape)) - |= line=cord - leaf+(trip line) - [leaf+""]~ - :: - :: All the URLs we fetch from - :: - ++ urls - =/ base "https://hacker-news.firebaseio.com/v0/" - :* top-stories=(weld base "topstories.json") - item=|=(item=@ud `tape`:(welp base "item/" +>:(scow %ui item) ".json")) - == - -- -=, async=async:tapp -=, tapp-async=tapp-async:tapp -=, stdio -:: -:: The app -:: -%- create-tapp-poke-peer-take:tapp -^- tapp-core-poke-peer-take:tapp -|_ [=bowl:gall state] -:: -:: Main function -:: -++ handle-poke - |= =in-poke-data - =/ m tapp-async - ^- form:m - :: - :: If requested to print, just print what we have in our state - :: - ?: =(cord.in-poke-data 'print') - ~& 'drumroll please...' - ;< now=@da bind:m get-time - ;< ~ bind:m (wait (add now ~s3)) - ~& 'Top comments:' - %- (slog (zing (turn top-comments comment-to-tang))) - (pure:m top-comments) - ?: =(cord.in-poke-data 'poll') - ;< ~ bind:m (wait-effect (add now.bowl ~s15)) - (pure:m top-comments) - :: - :: Otherwise, fetch the top HN stories - :: - =. top-comments ~ - :: - :: If this whole thing takes more than 15 seconds, cancel it - :: - %+ (set-timeout _top-comments) (add now.bowl ~s15) - ;< =top-stories=json bind:m (fetch-json top-stories:urls) - =/ top-stories=(list @ud) - ((ar ni):dejs:format top-stories-json) - :: - :: Loop through the first 5 stories - :: - =. top-stories (scag 5 top-stories) - |- ^- form:m - =* loop $ - :: - :: If done, tell subscribers and print the results - :: - ?~ top-stories - ;< ~ bind:m (give-result /comments %comments top-comments) - (handle-poke %noun 'print') - :: - :: Else, fetch the story info - :: - ~& "fetching item #{+>:(scow %ui i.top-stories)}" - ;< =story-info=json bind:m (fetch-json (item:urls i.top-stories)) - =/ story-comments=(unit (list @ud)) - ((ot kids+(ar ni) ~):dejs-soft:format story-info-json) - :: - :: If no comments, say so - :: - ?: |(?=(~ story-comments) ?=(~ u.story-comments)) - =. top-comments ["" top-comments] - loop(top-stories t.top-stories) - :: - :: Else, fetch comment info - :: - ;< =comment-info=json bind:m (fetch-json (item:urls i.u.story-comments)) - =/ comment-text=(unit tape) - ((ot text+sa ~):dejs-soft:format comment-info-json) - :: - :: If no text (eg comment deleted), record that - :: - ?~ comment-text - =. top-comments ["" top-comments] - loop(top-stories t.top-stories) - :: - :: Else, add text to state - :: - =. top-comments [u.comment-text top-comments] - loop(top-stories t.top-stories) -:: -++ handle-peer - |= =path - =/ m tapp-async - ^- form:m - ~& [%tapp-fetch-take-peer path] - (pure:m top-comments) -:: -++ handle-take - |= =sign:tapp - =/ m tapp-async - ^- form:m - :: ignore %poke/peer acknowledgements - :: - ?. ?=(%wake -.sign) - (pure:m top-comments) - ;< =state bind:m (handle-poke %noun 'fetch') - =. top-comments state - (pure:m top-comments) --- diff --git a/pkg/arvo/app/example-tapp-subscribe.hoon b/pkg/arvo/app/example-tapp-subscribe.hoon deleted file mode 100644 index 42b10f86f..000000000 --- a/pkg/arvo/app/example-tapp-subscribe.hoon +++ /dev/null @@ -1,50 +0,0 @@ -/+ tapp, stdio -=> - |% - +$ subscription-state - $: target=[her=ship app=term] - =path - == - +$ state - $: subscription=(unit subscription-state) - == - +$ peek-data _!! - +$ in-poke-data [%noun =cord] - +$ out-poke-data [%noun =cord] - +$ out-peer-data ~ - +$ in-peer-data - $% [%comments comments=(list tape)] - == - ++ tapp (^tapp state peek-data in-poke-data out-poke-data in-peer-data out-peer-data) - ++ stdio (^stdio out-poke-data out-peer-data) - -- -=, async=async:tapp -=, tapp-async=tapp-async:tapp -=, stdio -%- create-tapp-poke-diff:tapp -^- tapp-core-poke-diff:tapp -|_ [=bowl:gall state] -++ handle-poke - |= =in-poke-data - =/ m tapp-async - ^- form:m - ?: =(cord.in-poke-data 'pull') - ?~ subscription - (async-fail %no-subscription ~) - ;< ~ bind:m (pull-app [target path]:u.subscription) - (pure:m ~) - =/ target [our.bowl %example-tapp-fetch] - ;< ~ bind:m (poke-app target %noun 'print') - ;< ~ bind:m (peer-app target /comments) - =. subscription `[target /comments] - ;< ~ bind:m (wait (add now.bowl ~s3)) - (pure:m subscription) -:: -++ handle-diff - |= [[her=ship app=term] =path data=in-peer-data] - =/ m tapp-async - ^- form:m - ?> ?=(%comments -.data) - ~& subscriber-got-data=(lent comments.data) - (pure:m subscription) --- diff --git a/pkg/arvo/app/hood.hoon b/pkg/arvo/app/hood.hoon deleted file mode 100644 index 98ac66515..000000000 --- a/pkg/arvo/app/hood.hoon +++ /dev/null @@ -1,205 +0,0 @@ -:: :: :: -:::: /hoon/hood/app :: :: - :: :: :: -/? 310 :: zuse version -/+ sole, :: libraries - :: XX these should really be separate apps, as - :: none of them interact with each other in - :: any fashion; however, to reduce boot-time - :: complexity and work around the current - :: non-functionality of end-to-end acknowledgments, - :: they have been bundled into :hood - :: - :: |command handlers - hood-helm, hood-kiln, hood-drum, hood-write -:: :: :: -:::: :: :: - :: :: :: -|% -++ hood-module - :: each hood module follows this general shape - => |% - +$ part [%module %0 pith] - +$ pith ~ - :: - +$ move [bone card] - +$ card $% [%fake ~] - == - -- - |= [bowl:gall own=part] - |_ moz=(list move) - ++ abet [(flop moz) own] - -- --- -:: :: :: -:::: :: :: state handling - :: :: :: -!: -=> |% :: - ++ hood-old :: unified old-state - {?($0 $1) lac/(map @tas hood-part-old)} :: - ++ hood-1 :: unified state - {$1 lac/(map @tas hood-part)} :: - ++ hood-good :: extract specific - =+ hed=$:hood-head - |@ ++ $ - |: paw=$:hood-part - ?- hed - $drum ?>(?=($drum -.paw) `part:hood-drum`paw) - $helm ?>(?=($helm -.paw) `part:hood-helm`paw) - $kiln ?>(?=($kiln -.paw) `part:hood-kiln`paw) - $write ?>(?=($write -.paw) `part:hood-write`paw) - == - -- - ++ hood-head _-:$:hood-part :: initialize state - ++ hood-make :: - =+ $:{our/@p hed/hood-head} :: - |@ ++ $ - ?- hed - $drum (make:hood-drum our) - $helm *part:hood-helm - $kiln *part:hood-kiln - $write *part:hood-write - == - -- - ++ hood-part-old hood-part :: old state for ++prep - ++ hood-port :: state transition - |: paw=$:hood-part-old ^- hood-part :: - paw :: - :: :: - ++ hood-part :: current module state - $% {$drum $2 pith-2:hood-drum} :: - {$helm $0 pith:hood-helm} :: - {$kiln $0 pith:hood-kiln} :: - {$write $0 pith:hood-write} :: - == :: - -- :: -:: :: :: -:::: :: :: app proper - :: :: :: -=, gall -|_ $: hid/bowl :: gall environment - hood-1 :: module states - == :: -++ able :: find+make part - =+ hed=$:hood-head - |@ ++ $ - =+ rep=(~(get by lac) hed) - =+ par=?^(rep u.rep `hood-part`(hood-make our.hid hed)) - ((hood-good hed) par) - -- -:: -++ ably :: save part - =+ $:{(list) hood-part} - |@ ++ $ - [(flop +<-) %_(+> lac (~(put by lac) +<+< +<+))] - -- -:: :: :: -:::: :: :: generic handling - :: :: :: -++ prep - |= old/(unit hood-old) ^- (quip _!! _+>) - :- ~ - ?~ old +> - +>(lac (~(run by lac.u.old) hood-port)) -:: -++ poke-hood-load :: recover lost brain - |= dat/hood-part - ?> =(our.hid src.hid) - ~& loaded+-.dat - [~ %_(+> lac (~(put by lac) -.dat dat))] -:: -:: -++ from-module :: create wrapper - |* _[identity=%module start=..$ finish=_abet]:(hood-module) - =- [wrap=- *start] :: usage (wrap handle-arm):from-foo - |* handle/_finish - |= a=_+<.handle - =. +>.handle (start hid (able identity)) - (ably (handle a)) -:: -:: per-module interface wrappers -++ from-drum (from-module %drum [..$ _se-abet]:(hood-drum)) -++ from-helm (from-module %helm [..$ _abet]:(hood-helm)) -++ from-kiln (from-module %kiln [..$ _abet]:(hood-kiln)) -++ from-write (from-module %write [..$ _abet]:(hood-write)) -:: -:: :: :: -:::: :: :: switchboard - :: :: :: -++ coup-drum-phat (wrap take-coup-phat):from-drum -++ coup-helm-hi (wrap coup-hi):from-helm -++ coup-kiln-fancy (wrap take-coup-fancy):from-kiln -++ coup-kiln-reload (wrap take-coup-reload):from-kiln -++ coup-kiln-spam (wrap take-coup-spam):from-kiln -++ diff-sole-effect-drum-phat (wrap diff-sole-effect-phat):from-drum -++ init-helm |=({way/wire *} [~ +>]) -++ mack-kiln (wrap mack):from-kiln -++ made-write (wrap made):from-write -++ made-kiln (wrap take-made):from-kiln -++ mere-kiln (wrap take-mere):from-kiln -++ mere-kiln-sync (wrap take-mere-sync):from-kiln -++ wake-kiln-autocommit (wrap take-wake-autocommit):from-kiln -++ wake-kiln-overload (wrap take-wake-overload):from-kiln -++ wake-helm-automass (wrap take-wake-automass):from-helm -++ onto-drum (wrap take-onto):from-drum -++ peer-drum (wrap peer):from-drum -++ poke-atom (wrap poke-atom):from-helm -++ poke-dill-belt (wrap poke-dill-belt):from-drum -++ poke-dill-blit (wrap poke-dill-blit):from-drum -++ poke-drum-put (wrap poke-put):from-drum -++ poke-drum-link (wrap poke-link):from-drum -++ poke-drum-unlink (wrap poke-unlink):from-drum -++ poke-drum-exit (wrap poke-exit):from-drum -++ poke-drum-start (wrap poke-start):from-drum -++ poke-drum-set-boot-apps (wrap poke-set-boot-apps):from-drum -++ poke-helm-hi (wrap poke-hi):from-helm -++ poke-helm-knob (wrap poke-knob):from-helm -++ poke-helm-mass (wrap poke-mass):from-helm -++ poke-helm-reload (wrap poke-reload):from-helm -++ poke-helm-reload-desk (wrap poke-reload-desk):from-helm -++ poke-helm-reset (wrap poke-reset):from-helm -++ poke-helm-serve (wrap poke-serve):from-helm -++ poke-helm-send-hi (wrap poke-send-hi):from-helm -++ poke-helm-verb (wrap poke-verb):from-helm -++ poke-helm-rekey (wrap poke-rekey):from-helm -++ poke-helm-moon (wrap poke-moon):from-helm -++ poke-helm-nuke (wrap poke-nuke):from-helm -++ poke-helm-automass (wrap poke-automass):from-helm -++ poke-helm-cancel-automass (wrap poke-cancel-automass):from-helm -++ poke-helm-bonk (wrap poke-bonk):from-helm -++ poke-hood-sync (wrap poke-sync):from-kiln -++ poke-kiln-commit (wrap poke-commit):from-kiln -++ poke-kiln-info (wrap poke-info):from-kiln -++ poke-kiln-label (wrap poke-label):from-kiln -++ poke-kiln-merge (wrap poke-merge):from-kiln -++ poke-kiln-cancel (wrap poke-cancel):from-kiln -++ poke-kiln-cancel-autocommit (wrap poke-cancel-autocommit):from-kiln -++ poke-kiln-mount (wrap poke-mount):from-kiln -++ poke-kiln-rm (wrap poke-rm):from-kiln -++ poke-kiln-schedule (wrap poke-schedule):from-kiln -++ poke-kiln-track (wrap poke-track):from-kiln -++ poke-kiln-sync (wrap poke-sync):from-kiln -++ poke-kiln-syncs (wrap poke-syncs):from-kiln -++ poke-kiln-start-autoload (wrap poke-start-autoload):from-kiln -++ poke-kiln-wipe-ford (wrap poke-wipe-ford):from-kiln -++ poke-kiln-keep-ford (wrap poke-keep-ford):from-kiln -++ poke-kiln-autoload (wrap poke-autoload):from-kiln -++ poke-kiln-overload (wrap poke-overload):from-kiln -++ poke-kiln-goad-gall (wrap poke-goad-gall):from-kiln -++ poke-kiln-wash-gall (wrap poke-wash-gall):from-kiln -++ poke-kiln-unmount (wrap poke-unmount):from-kiln -++ poke-kiln-unsync (wrap poke-unsync):from-kiln -++ poke-kiln-permission (wrap poke-permission):from-kiln -++ poke-write-sec-atom (wrap poke-sec-atom):from-write -++ poke-write-paste (wrap poke-paste):from-write -++ poke-write-tree (wrap poke-tree):from-write -++ poke-write-wipe (wrap poke-wipe):from-write -++ quit-drum-phat (wrap quit-phat):from-drum -++ reap-drum-phat (wrap reap-phat):from-drum -++ woot-helm (wrap take-woot):from-helm -++ writ-kiln-autoload (wrap take-writ-autoload):from-kiln -++ writ-kiln-find-ship (wrap take-writ-find-ship):from-kiln -++ writ-kiln-sync (wrap take-writ-sync):from-kiln -++ bound (wrap take-bound):from-helm --- diff --git a/pkg/arvo/app/ph.hoon b/pkg/arvo/app/ph.hoon deleted file mode 100644 index 8a1d1331d..000000000 --- a/pkg/arvo/app/ph.hoon +++ /dev/null @@ -1,615 +0,0 @@ -:: Test the pH of your aquarium. See if it's safe to put in real fish. -:: -:: usage: -:: :aqua [%run-test %test-add] -:: -/- aquarium, ph -/+ ph, ph-tests, ph-azimuth, ph-philter -=, ph-sur=^ph -=, aquarium -=, ph -=, ph-philter -=> $~ |% - +$ move (pair bone card) - +$ card - $% [%poke wire dock poke-type] - [%peer wire dock path] - [%pull wire dock ~] - [%diff diff-type] - == - :: - +$ poke-type - $% [%aqua-events (list aqua-event)] - [%drum-start term term] - [%aqua-vane-control ?(%subscribe %unsubscribe)] - == - :: - +$ diff-type - $% [%aqua-effects aqua-effects] - == - :: - +$ state - $: %0 - test-core=(unit test-core-state) - tests=(map term [(list ship) _*form:(ph ,~)]) - other-state - == - :: - +$ test-core-state - $: lab=term - hers=(list ship) - test=_*form:(ph ,~) - == - :: - +$ other-state - $: test-qeu=(qeu term) - results=(list (pair term ?)) - effect-log=(list [who=ship uf=unix-effect]) - == - -- -=, gall -=/ vane-apps=(list term) - ~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre] -|_ $: hid=bowl - state - == -++ this . -++ manual-tests - ^- (list (pair term [(list ship) _*form:(ph ,~)])) - =+ (ph-tests our.hid) - =+ ph-azimuth=(ph-azimuth our.hid) - =/ eth-node (spawn:ph-azimuth ~bud) - =/ m (ph ,~) - :~ :+ %boot-bud - ~[~bud] - (raw-ship ~bud ~) - :: - :+ %add - ~[~bud] - ;< ~ bind:m (raw-ship ~bud ~) - |= pin=ph-input - ?: =(%init -.q.uf.pin) - [& (dojo ~bud "[%test-result (add 2 3)]") %wait ~] - ?: (is-dojo-output ~bud who.pin uf.pin "[%test-result 5]") - [& ~ %done ~] - [& ~ %wait ~] - :: - :+ %hi - ~[~bud ~dev] - ;< ~ bind:m (raw-ship ~bud ~) - ~& > "BUD DONE" - ;< ~ bind:m (raw-ship ~dev ~) - ~& > "DEV DONE" - (send-hi ~bud ~dev) - :: - :+ %boot-planet - ~[~bud ~marbud ~linnup-torsyx] - (planet ~linnup-torsyx) - :: - :+ %second-cousin-hi - ~[~bud ~marbud ~linnup-torsyx ~dev ~mardev ~mitnep-todsut] - ;< ~ bind:m (planet ~linnup-torsyx) - ;< ~ bind:m (planet ~mitnep-todsut) - (send-hi ~linnup-torsyx ~mitnep-todsut) - :: - :+ %change-file - ~[~bud] - ;< ~ bind:m (raw-ship ~bud ~) - ;< file=@t bind:m (touch-file ~bud %home) - (check-file-touched ~bud %home file) - :: - :+ %child-sync - ~[~bud ~marbud] - ;< ~ bind:m (star ~marbud) - ;< file=@t bind:m (touch-file ~bud %base) - (check-file-touched ~marbud %home file) - :: - :+ %boot-az - ~[~bud] - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - (raw-real-ship:eth-node ~bud) - (pure:m ~) - :: - :+ %hi-az - ~[~bud ~dev] - =. eth-node (spawn:eth-node ~dev) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > %dev-done - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > %bud-done - (send-hi ~bud ~dev) - (pure:m ~) - :: - :+ %moon-az - ~[~bud ~marbud ~linnup-torsyx ~linnup-torsyx-linnup-torsyx ~dev] - =. eth-node (spawn:eth-node ~marbud) - =. eth-node (spawn:eth-node ~linnup-torsyx) - =. eth-node (spawn:eth-node ~dev) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ~& > 'MARBUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~linnup-torsyx) - ~& > 'LINNUP DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~linnup-torsyx-linnup-torsyx) - ~& > 'MOON LINNUP DONE' - ;< ~ bind:m (send-hi ~bud ~linnup-torsyx-linnup-torsyx) - ~& > 'HI DOWN DONE' - ;< ~ bind:m (send-hi ~linnup-torsyx-linnup-torsyx ~marbud) - ~& > 'HI UP DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > 'DEV DONE' - ;< ~ bind:m (send-hi ~linnup-torsyx-linnup-torsyx ~dev) - ~& > 'HI OVER UP DONE' - ;< ~ bind:m (send-hi ~dev ~linnup-torsyx-linnup-torsyx) - ~& > 'HI OVER DOWN DONE' - (pure:m ~) - (pure:m ~) - :: - :+ %breach-hi - ~[~bud ~dev] - =. eth-node (spawn:eth-node ~dev) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > 'DEV DONE' - (send-hi ~bud ~dev) - ~& > 'HI DONE' - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~dev ~bud) - ~& > 'BREACH DONE' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (send-hi-not-responding ~bud ~dev) - ~& > 'HI NOT RESPONDING DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > 'REBOOT DEV DONE' - (wait-for-dojo ~bud "hi ~dev successful") - ~& > 'DONE' - (pure:m ~) - :: - :+ %breach-hi-cousin - ~[~bud ~dev ~marbud ~mardev] - =. eth-node (spawn:eth-node ~dev) - =. eth-node (spawn:eth-node ~marbud) - =. eth-node (spawn:eth-node ~mardev) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ;< ~ bind:m (raw-real-ship:eth-node ~mardev) - (send-hi ~marbud ~mardev) - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~mardev ~marbud) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (send-hi-not-responding ~marbud ~mardev) - ;< ~ bind:m (raw-real-ship:eth-node ~mardev) - (wait-for-dojo ~marbud "hi ~mardev successful") - (pure:m ~) - :: - :+ %breach-sync - ~[~bud ~marbud] - =. eth-node (spawn:eth-node ~marbud) - =. eth-node (spawn:eth-node ~fipfes) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ~& > 'MARBUD DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH FILE DONE' - (check-file-touched ~marbud %home file) - ~& > 'TOUCH FILE CHECK DONE' - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~bud ~marbud) - ~& > 'BREACH DONE' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD RE DONE' - ;< ~ bind:m (just-events (dojo ~bud "|merge %base ~marbud %kids, =gem %this")) - ~& > 'THIS MERGE STARTED DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-1 DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-2 DONE' - (check-file-touched ~marbud %home file) - ~& > 'DONE DONE' - (pure:m ~) - :: - :+ %breach-multiple - ~[~bud ~marbud] - =. eth-node (spawn:eth-node ~marbud) - =. eth-node (spawn:eth-node ~fipfes) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ~& > 'MARBUD DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH DONE' - (check-file-touched ~marbud %home file) - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~bud ~marbud) - ~& > 'BREACH-1 DONE' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - (raw-real-ship:eth-node ~bud) - ~& > 'BUD RE DONE' - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~marbud ~bud) - ~& > 'BREACH-2 DONE' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ~& > 'MARBUD RE DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-1 DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-2 DONE' - (check-file-touched ~marbud %home file) - ~& > 'DONE DONE' - (pure:m ~) - :: - :+ %breach-sudden - ~[~bud ~marbud] - =. eth-node (spawn:eth-node ~marbud) - =. eth-node (spawn:eth-node ~fipfes) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~marbud) - ~& > 'MARBUD DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH FILE DONE' - (check-file-touched ~marbud %home file) - ~& > 'TOUCH FILE CHECK DONE' - =. eth-node (breach:eth-node ~bud) - ~& > 'BREACH EXECUTED' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD RE DONE' - ;< ~ bind:m (just-events (dojo ~bud "|merge %base ~marbud %kids, =gem %this")) - ~& > 'THIS MERGE STARTED DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-1 DONE' - ;< file=@t bind:m (touch-file ~bud %base) - ~& > 'TOUCH-2 DONE' - (check-file-touched ~marbud %home file) - ~& > 'DONE DONE' - (pure:m ~) - :: - :: Doesn't succeed because success is hard to define, just make - :: sure it doesn't crash in Gall - :: - :+ %breach-gall - ~[~bud ~dev] - =. eth-node (spawn:eth-node ~dev) - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~bud) - ~& > 'BUD DONE' - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > 'DEV DONE' - ;< ~ bind:m (just-events (dojo ~bud "|start %hall")) - ;< ~ bind:m (just-events (dojo ~bud "|start %talk")) - ;< ~ bind:m (just-events (dojo ~dev "|start %hall")) - ;< ~ bind:m (just-events (dojo ~dev "|start %talk")) - ;< ~ bind:m (just-events (dojo ~bud ";create channel %hi 'desc'")) - ;< ~ bind:m (just-events (dojo ~dev ";join ~bud/hi")) - ;< ~ bind:m (just-events (dojo ~bud "heyya")) - (wait-for-dojo ~dev "heyya") - ~& > 'CHANNEL DONE' - ;< eth-node=_eth-node bind:m - (breach-and-hear:eth-node our.hid ~dev ~bud) - ~& > 'BREACH DONE' - ;< [eth-node=_eth-node ~] bind:m - %+ (wrap-philter ,_eth-node ,~) - router:eth-node - ;< ~ bind:m (raw-real-ship:eth-node ~dev) - ~& > 'REBOOT DEV DONE' - (send-hi ~bud ~dev) - ~& > 'DONE' - stall - == -:: -++ install-tests - ^+ this - =. tests (malt manual-tests) - this -:: -++ prep - |= old=(unit [@ tests=* rest=*]) - ^- (quip move _this) - ~& prep=%ph - =. this install-tests - `this - :: ?~ old - :: `this - :: =/ new ((soft other-state) rest.u.old) - :: ?~ new - :: `this - :: `this(+<+>+> u.new) -:: -++ publish-aqua-effects - |= afs=aqua-effects - ^- (list move) - %+ murn ~(tap by sup.hid) - |= [b=bone her=ship pax=path] - ^- (unit move) - ?. ?=([%effects ~] pax) - ~ - `[b %diff %aqua-effects afs] -:: -++ run-events - |= [lab=term what=(list ph-event)] - ^- (quip move _this) - ?: =(~ what) - `this - =/ res - |- ^- (each (list aqua-event) ?) - ?~ what - [%& ~] - ?: ?=(%test-done -.i.what) - [%| p.i.what] - =/ nex $(what t.what) - ?: ?=(%| -.nex) - nex - [%& `aqua-event`i.what p.nex] - ?: ?=(%| -.res) - =^ moves-1 this (finish-test lab p.res) - =^ moves-2 this run-test - [(weld moves-1 moves-2) this] - [[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this] -:: -:: Cancel subscriptions to ships -:: -++ finish-test - |= [lab=term success=?] - ^- (quip move _this) - ?~ test-core - `this - ~& ?: success - "TEST {(trip lab)} SUCCESSFUL" - "TEST {(trip lab)} FAILED" - :_ this(test-core ~, results [[lab success] results]) - %- zing - %+ turn hers.u.test-core - |= her=ship - ^- (list move) - :~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~] - :* ost.hid - %poke - /cancelling - [our.hid %aqua] - %aqua-events - [%pause-events her]~ - == - == -:: -:: Start another test if one is in the queue -:: -++ run-test - ^- (quip move _this) - ?^ test-core - `this - ?: =(~ test-qeu) - ?~ results - `this - =/ throw-away print-results - `this(results ~) - =^ lab test-qeu ~(get to test-qeu) - ~& [running-test=lab test-qeu] - =. effect-log ~ - =+ ^- [ships=(list ship) test=_*form:(ph ,~)] - (~(got by tests) lab) - => .(test-core `(unit test-core-state)`test-core) - =. test-core `[lab ships test] - =^ moves-1 this (subscribe-to-effects lab ships) - =^ moves-2 this - (diff-aqua-effects /[lab]/(scot %p -.ships) -.ships [/ %init ~]~) - [:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this] -:: -:: Print results with ~& -:: -++ print-results - ~& "TEST REPORT:" - =/ throw-away - %+ turn - results - |= [lab=term success=?] - ~& "{?:(success "SUCCESS" "FAILURE")}: {(trip lab)}" - ~ - ~& ?: (levy results |=([term s=?] s)) - "ALL TESTS SUCCEEDED" - "FAILURES" - ~ -:: -:: Should check whether we're already subscribed -:: -++ subscribe-to-effects - |= [lab=@tas hers=(list ship)] - :_ this - %+ turn hers - |= her=ship - ^- move - :* ost.hid - %peer - /[lab]/(scot %p her) - [our.hid %aqua] - /effects/(scot %p her) - == -:: -:: Start the vane drivers -:: -++ init-vanes - ^- (list move) - %+ murn - `(list term)`[%aqua vane-apps] - |= vane-app=term - ^- (unit move) - =/ app-started - .^(? %gu /(scot %p our.hid)/[vane-app]/(scot %da now.hid)) - ?: app-started - ~ - `[ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app] -:: -:: Restart the vane drivers' subscriptions -:: -++ subscribe-vanes - ^- (list move) - %+ turn - vane-apps - |= vane-app=term - [ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe] -:: -:: Pause all existing ships -:: -++ pause-fleet - ^- (list move) - :_ ~ - :* ost.hid %poke /pause-fleet [our.hid %aqua] %aqua-events - %+ turn - .^((list ship) %gx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun) - |= who=ship - [%pause-events who] - == -:: -:: User interface -:: -++ poke-ph-command - |= com=cli:ph-sur - ^- (quip move _this) - ?- -.com - %init [init-vanes this] - %run - ?. (~(has by tests) lab.com) - ~& [%no-test lab.com] - `this - =. test-qeu (~(put to test-qeu) lab.com) - run-test - :: - %cancel - =^ moves-1 this (finish-test %last |) - =. test-qeu ~ - =^ moves-2 this run-test - [:(weld moves-1 moves-2) this] - :: - %run-all - =. test-qeu - %- ~(gas to test-qeu) - (turn manual-tests head) - run-test - :: - %print - ~& lent=(lent effect-log) - ~& %+ roll effect-log - |= [[who=ship uf=unix-effect] ~] - ?: ?=(?(%blit %doze) -.q.uf) - ~ - ?: ?=(%ergo -.q.uf) - ~& [who [- +<]:uf %omitted-by-ph] - ~ - ~& [who uf] - ~ - `this - == -:: -:: Receive effects back from aqua -:: -++ diff-aqua-effects - |= [way=wire afs=aqua-effects] - ^- (quip move _this) - :: ~& [%diff-aqua-effect way who.afs] - ?> ?=([@tas @ ~] way) - =/ lab i.way - ?~ test-core - ~& [%ph-dropping-done lab] - [[ost.hid %pull way [our.hid %aqua] ~]~ this] - ?. =(lab lab.u.test-core) - ~& [%ph-dropping-strange lab] - [[ost.hid %pull way [our.hid %aqua] ~]~ this] - =+ |- ^- $: thru-effects=(list unix-effect) - events=(list ph-event) - log=_effect-log - done=(unit ?) - test=_test.u.test-core - == - ?~ ufs.afs - [~ ~ ~ ~ test.u.test-core] - =/ m-res=_*output:(ph ,~) - (test.u.test-core now.hid who.afs i.ufs.afs) - =? ufs.afs =(%cont -.next.m-res) - [i.ufs.afs [/ %init ~] t.ufs.afs] - =^ done=(unit ?) test.u.test-core - ?- -.next.m-res - %wait [~ test.u.test-core] - %cont [~ self.next.m-res] - %fail [`| test.u.test-core] - %done [`& test.u.test-core] - == - =+ ^- _$ - ?~ done - $(ufs.afs t.ufs.afs) - [~ ~ ~ done test.u.test-core] - :^ ?: thru.m-res - [i.ufs.afs thru-effects] - thru-effects - (weld events.m-res events) - [[who i.ufs]:afs log] - [done test] - =. test.u.test-core test - =. effect-log (weld log effect-log) - => .(test-core `(unit test-core-state)`test-core) - ?^ done - =^ moves-1 this (finish-test lab u.done) - =^ moves-2 this run-test - [(weld moves-1 moves-2) this] - =/ moves-1 (publish-aqua-effects who.afs thru-effects) - =^ moves-2 this (run-events lab events) - [(weld moves-1 moves-2) this] -:: -:: Subscribe to effects -:: -++ peer-effects - |= pax=path - ^- (quip move _this) - ?. ?=(~ pax) - ~& [%ph-bad-peer-effects pax] - `this - `this -:: -:: Subscription cancelled -:: -++ pull - |= pax=path - `+>.$ --- diff --git a/pkg/arvo/sys/vane/gall.hoon b/pkg/arvo/sys/vane/gall.hoon deleted file mode 100644 index 643be31ec..000000000 --- a/pkg/arvo/sys/vane/gall.hoon +++ /dev/null @@ -1,2638 +0,0 @@ -!: :: %gall, agent execution -!? 163 -!: -:::: -|= pit=vase -=, gall -=> =~ -|% -:: +coke: cook -:: -++ coke - $? %inn - %out - %cay - == -:: +reverse-ames: reverse ames message -:: -++ reverse-ames - $% :: diff - :: - [%d p=mark q=*] - :: etc. - :: - [%x ~] - == -:: +forward-ames: forward ames message -:: -++ forward-ames - $% :: message - :: - [%m =mark noun=*] - :: "peel" subscribe - :: - [%l =mark =path] - :: subscribe - :: - [%s =path] - :: cancel+unsubscribe - :: - [%u ~] - == -:: +foreign-response: foreign response -:: -++ foreign-response - $? %peer - %peel - %poke - %pull - == --- -|% -:: +internal-note: +ap note -:: -++ internal-note - $% [%meta =term =vase] - [%send =ship =internal-task] - == -:: +internal-move: agent-level move -:: -:: Analogous to an Arvo move, except these are routed by bone, instead of -:: duct. -:: -++ internal-move - $: =bone - move=(wind internal-note internal-gift) - == -:: +move: Arvo-level move -:: -++ move - $: =duct - move=(wind note-arvo gift-arvo) - == --- -|% -:: +state: all state -:: -++ state - $: :: state version - :: - %1 - :: agents by ship - :: - =agents - == -:: +subscribers: subscriber data -:: -++ subscribers - $: :: incoming subscribers - :: - incoming=bitt - :: outgoing subscribers - :: - outgoing=boat - :: queue meter - :: - meter=(map bone @ud) - == -:: +agents: ship state -:: -++ agents - $: :: system duct - :: - system-duct=duct - :: foreign contacts - :: - contacts=(map ship foreign) - :: running agents - :: - running=(map term agent) - :: waiting queue - :: - blocked=(map term blocked) - == -:: +routes: new cuff -:: -++ routes - $: :: disclosing to - :: - disclosing=(unit (set ship)) - :: attributed to - :: - attributing=ship - == -:: +foreign: foreign connections -:: -++ foreign - $: :: index - :: - index=@ud - :: by duct - :: - index-map=(map duct @ud) - :: by index - :: - duct-map=(map @ud duct) - == -:: +ducts: opaque input -:: -++ ducts - $: :: bone sequence - :: - bone=@ud - :: by duct - :: - bone-map=(map duct bone) - :: by bone - :: - duct-map=(map bone duct) - == -:: +misvale-data: subscribers with bad marks -:: -:: XX a hack, required to break a subscription loop -:: which arises when an invalid mark crashes a diff. -:: See usage in ap-misvale. -:: -++ misvale-data (set wire) -:: +agent: agent state -:: -++ agent - $: :: bad reqs - :: - misvale=misvale-data - :: cache - :: - cache=worm - :: ap-find-arm cache - :: - arm-cache=(map [term path] (unit (pair @ud term))) - :: control duct - :: - control-duct=duct - :: unstopped - :: - live=? - :: statistics - :: - =stats - :: subscribers - :: - =subscribers - :: running state - :: - running-state=vase - :: update control - :: - =beak - :: req'd translations - :: - marks=(map bone mark) - :: opaque ducts - :: - =ducts - == -:: +blocked: blocked tasks -:: -++ blocked (qeu (trel duct routes agent-action)) -:: +stats: statistics -:: -++ stats - $: :: change number - :: - change=@ud - :: entropy - :: - eny=@uvJ - :: time - :: - time=@da - == --- -. == -=| =state -|= $: :: identity - :: - our=ship - :: urban time - :: - now=@da - :: entropy - :: - eny=@uvJ - :: activate - :: - ska=sley - == -~% %gall-top ..is ~ -|% -:: +gall-payload: gall payload -:: -++ gall-payload + -:: +mo: Arvo-level move handling -:: -:: An outer core responsible for routing moves to and from Arvo; it calls -:: an inner core, +ap, to route internal moves to and from agents. -:: -++ mo - ~% %gall-mo +> ~ - |_ - $: hen=duct - moves=(list move) - == - ++ mo-core . - :: +mo-abed: initialise state with the provided duct. - :: - ++ mo-abed - |= =duct - ^+ mo-core - :: - mo-core(hen duct) - :: +mo-abet: resolve moves. - :: - ++ mo-abet - ^- [(list move) _gall-payload] - :: - =/ resolved (flop moves) - [resolved gall-payload] - :: - :: +mo-boot: ask %ford to build us a core for the specified agent. - :: - ++ mo-boot - |= [=term =ship =desk] - ^+ mo-core - :: - =/ =case [%da now] - =/ =path - =/ ship (scot %p ship) - =/ case (scot case) - /sys/core/[term]/[ship]/[desk]/[case] - :: - =/ =note-arvo - =/ =schematic:ford [%core [ship desk] /hoon/[term]/app] - [%f %build live=%.y schematic] - :: - =/ pass [path note-arvo] - (mo-pass pass) - :: - :: +mo-reboot: ask %ford to rebuild the specified agent - :: - ++ mo-reboot - |= [force=? =term =ship] - ^+ mo-core - =/ gent (~(got by running.agents.state) term) - =. hen control-duct.gent - =* desk q.beak.gent - :: if we're forcing a reboot, we don't try to %kill the old build - :: - ?: force - (mo-boot term ship desk) - :: - =/ =wire - =/ ship (scot %p ship) - =/ case (scot r.beak.gent) - /sys/core/[term]/[ship]/[desk]/[case] - %. [term ship desk] - =< mo-boot - =/ =note-arvo [%f %kill ~] - (mo-pass wire note-arvo) - :: - :: - :: +mo-goad: rebuild agent(s) - :: - ++ mo-goad - |= [force=? agent=(unit dude)] - ^+ mo-core - ?^ agent - ~| goad-gone+u.agent - (mo-reboot force u.agent our) - :: - =/ agents=(list term) - ~(tap in ~(key by running.agents.state)) - |- ^+ mo-core - ?~ agents - mo-core - %= $ - agents t.agents - ..mo-core (mo-reboot force i.agents our) - == - :: - :: +mo-pass: prepend a standard %pass to the current list of moves. - :: - ++ mo-pass - |= pass=(pair path note-arvo) - ^+ mo-core - :: - =/ =move [hen [%pass pass]] - mo-core(moves [move moves]) - :: +mo-give: prepend a standard %give to the current list of moves. - :: - ++ mo-give - |= =gift:able - ^+ mo-core - :: - =/ =move [hen [%give gift]] - mo-core(moves [move moves]) - :: +mo-contains-valid-bowl: check that a vase contains a valid bowl. - :: - ++ mo-contains-valid-bowl - ~/ %mo-contains-valid-bowl - |= =vase - ^- ? - :: - =/ maybe-vase (slew 12 vase) - ?~ maybe-vase - %.n - =/ =type p.u.maybe-vase - (~(nest ut type) %.n -:!>(*bowl)) - :: +mo-receive-core: receives an app core built by %ford. - :: - :: Presuming we receive a good core, we first check to see if the agent - :: is already running. If so, we update its beak in %gall's state, - :: initialise an +ap core for the agent, install the core we got from - :: %ford, and then resolve any moves associated with it. - :: - :: If we're dealing with a new agent, we create one using the result we - :: got from %ford, add it to the collection of agents %gall is keeping - :: track of, and then do more or less the same procedure as we did for the - :: running agent case. - :: - ++ mo-receive-core - ~/ %mo-receive-core - |= [=term =beak =made-result:ford] - ^+ mo-core - :: - ?: ?=([%incomplete *] made-result) - (mo-give %onto %.n tang.made-result) - :: - =/ build-result build-result.made-result - :: - ?: ?=([%error *] build-result) - (mo-give %onto %.n message.build-result) - :: - =/ =cage (result-to-cage:ford build-result) - =/ result-vase q.cage - =/ maybe-agent=(unit agent) - (~(get by running.agents.state) term) - :: - ?^ maybe-agent - =/ agent u.maybe-agent(beak beak) - =. running.agents.state - (~(put by running.agents.state) term agent) - =/ =routes [disclosing=~ attributing=our] - =/ app (ap-abed:ap term routes) - =. app (ap-reinstall:app result-vase) - ap-abet:app - :: - ?. (mo-contains-valid-bowl result-vase) - =/ err [[%leaf "{}: bogus core"] ~] - (mo-give %onto %.n err) - :: - =. mo-core (mo-new-agent term beak result-vase) - =/ old mo-core - =/ wag - =/ =routes [disclosing=~ attributing=our] - =/ app (ap-abed:ap term routes) - (ap-prep:app ~) - :: - =/ maybe-tang -.wag - =/ app +.wag - ?^ maybe-tang - =. mo-core old - (mo-give %onto %.n u.maybe-tang) - :: - =. mo-core ap-abet:app - =. mo-core (mo-clear-queue term) - =/ =suss [term %boot now] - (mo-give %onto [%.y suss]) - :: +mo-new-agent: create a new agent and add it to %gall's state. - :: - :: %gall maintains a collection of running agents. This arm creates a - :: new one with the provided name, beak, and state (held in a vase). - :: - ++ mo-new-agent - |= [=term =beak =vase] - ^+ mo-core - :: - =/ =ducts - :+ bone=1 - bone-map=[[[~ ~] 0] ~ ~] - duct-map=[[0 [~ ~]] ~ ~] - :: - =/ agent - =/ default-agent *agent - %_ default-agent - control-duct hen - beak beak - running-state vase - ducts ducts - == - :: - %_ mo-core - running.agents.state (~(put by running.agents.state) term agent) - == - :: +mo-handle-foreign-request: handle a foreign request. - :: - :: Handles tasks received on a +call that have come from another ship. - :: - ++ mo-handle-foreign-request - ~/ %mo-handle-foreign-request - |= [=ship =internal-task] - ^+ mo-core - :: - =/ =term p.internal-task - =/ =agent-action q.internal-task - ?: ?=(%pump -.agent-action) - :: - :: you'd think this would send an ack for the diff - :: that caused this pump. it would, but we already - :: sent it when we got the diff in +mo-handle-sys-rep. - :: then we'd have to save the network duct and connect - :: it to this returning pump. - :: - mo-core - :: - ?: ?=(%peer-not -.agent-action) - =/ =tang p.agent-action - (mo-give %unto %reap (some tang)) - :: - =^ bone mo-core (mo-assign-bone ship) - =/ =forward-ames - ?- -.agent-action - %poke [%m p.p.agent-action q.q.p.agent-action] - %pull [%u ~] - %puff !! - %punk !! - %peel [%l agent-action] - %peer [%s p.agent-action] - == - :: - =/ sys-path - =/ action -.agent-action - /sys/way/[action] - :: - =/ =note-arvo - =/ =path /g/ge/[term] - =/ =noun [bone forward-ames] - [%a %want ship path noun] - :: - (mo-pass sys-path note-arvo) - :: +mo-handle-foreign-response: handle foreign response. - :: - :: Handle a received %woot from %ames. - :: - ++ mo-handle-foreign-response - |= [=foreign-response art=(unit ares)] - ^+ mo-core - :: - =/ to-tang - |= =ares - ^- tang - ?~ ares - ~ - =/ tape (trip p.u.ares) - [[%leaf tape] q.u.ares] - :: - =/ result (bind art to-tang) - ?- foreign-response - %peel (mo-give %unto %reap result) - %peer (mo-give %unto %reap result) - %poke (mo-give %unto %coup result) - %pull mo-core - == - :: +mo-assign-bone: assign an outbone to a ship. - :: - :: If we know about the ship, we simply use its existing bone. Otherwise - :: we register a new entry for the ship, and use a default bone for it. - :: - ++ mo-assign-bone - |= =ship - ^- [bone _mo-core] - :: - =? mo-core !(~(has by contacts.agents.state) ship) - =/ =note-arvo [%j %public-keys (silt ship ~)] - =. moves [[system-duct.agents.state %pass /sys/jael note-arvo] moves] - =/ =foreign [1 ~ ~] - =. contacts.agents.state - (~(put by contacts.agents.state) ship foreign) - mo-core - :: - =/ =foreign (~(got by contacts.agents.state) ship) - =/ existing (~(get by index-map.foreign) hen) - ?^ existing - [u.existing mo-core] - :: - =/ index index.foreign - =/ contacts - =/ new-foreign - %_ foreign - index +(index) - index-map (~(put by index-map.foreign) hen index) - duct-map (~(put by duct-map.foreign) index hen) - == - (~(put by contacts.agents.state) ship new-foreign) - :: - =/ next mo-core(contacts.agents.state contacts) - [index next] - :: +mo-retrieve-duct: retrieve a duct by index. - :: - ++ mo-retrieve-duct - |= [=ship index=@ud] - ^- (unit duct) - :: - =/ contact=(unit foreign) (~(get by contacts.agents.state) ship) - ?~ contact - ~ - `(~(got by duct-map.u.contact) index) - :: +mo-cancel-jael: cancel jael subscription - :: - ++ mo-cancel-jael - |= =ship - ^+ mo-core - =/ =note-arvo [%j %nuke (silt ship ~)] - =. moves - [[system-duct.agents.state %pass /sys/jael note-arvo] moves] - mo-core - :: +mo-breach: ship breached, so forget about them - :: - ++ mo-breach - |= =ship - ^+ mo-core - =/ agents=(list [name=term =agent]) ~(tap by running.agents.state) - |- ^+ mo-core - ?~ agents - mo-core - =. mo-core - =/ =routes [disclosing=~ attributing=ship] - =/ app (ap-abed:ap name.i.agents routes) - ap-abet:(ap-breach:app ship) - =. mo-core (mo-cancel-jael ship) - =. contacts.agents.state (~(del by contacts.agents.state) ship) - $(agents t.agents) - :: +mo-handle-sys: handle a +sign incoming over /sys. - :: - :: (Note that /sys implies the +sign should be routed to a vane.) - :: - ++ mo-handle-sys - ~/ %mo-handle-sys - |= [=path =sign-arvo] - ^+ mo-core - :: - ?+ -.path !! - %jael (mo-handle-sys-jael path sign-arvo) - %core (mo-handle-sys-core path sign-arvo) - %pel (mo-handle-sys-pel path sign-arvo) - %red (mo-handle-sys-red path sign-arvo) - %rep (mo-handle-sys-rep path sign-arvo) - %req (mo-handle-sys-req path sign-arvo) - %val (mo-handle-sys-val path sign-arvo) - %way (mo-handle-sys-way path sign-arvo) - == - :: +mo-handle-sys-jael: receive update about contact - :: - ++ mo-handle-sys-jael - |= [=path =sign-arvo] - ^+ mo-core - ?> ?=([%j %public-keys *] sign-arvo) - ?> ?=([%jael ~] path) - ?. ?=(%breach -.public-keys-result.sign-arvo) - mo-core - (mo-breach who.public-keys-result.sign-arvo) - :: +mo-handle-sys-core: receive a core from %ford. - :: - ++ mo-handle-sys-core - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([%f %made *] sign-arvo) - ?> ?=([@ @ @ @ @ ~] path) - =/ beak-path t.t.path - =/ =beak - =/ =ship (slav %p i.beak-path) - =/ =desk i.t.beak-path - =/ =case [%da (slav %da i.t.t.beak-path)] - [ship desk case] - (mo-receive-core i.t.path beak result.sign-arvo) - :: +mo-handle-sys-pel: translated peer. - :: - :: Validates a received %ford result and %gives an internal %diff. - :: - ++ mo-handle-sys-pel - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([%f %made *] sign-arvo) - ?> ?=([@ @ ~] path) - :: - ?: ?=([%incomplete *] result.sign-arvo) - =/ err (some tang.result.sign-arvo) - (mo-give %unto %coup err) - :: - =/ build-result build-result.result.sign-arvo - :: - ?: ?=([%error *] build-result) - =/ err (some message.build-result) - (mo-give %unto %coup err) - :: - =/ =cage (result-to-cage:ford build-result) - (mo-give %unto %diff cage) - :: +mo-handle-sys-red: diff ack. - :: - :: On receipt of a valid +sign from %ames, we simply pass a %pump - :: acknowledgement internally; otherwise we pass both an internal - :: unsubscribing %pull, plus a %want to %ames, before complaining about a - :: bad message acknowledgment. - :: - ++ mo-handle-sys-red - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([@ @ @ @ ~] path) - ?. ?=([%a %woot *] sign-arvo) - ~& [%red-want path] - mo-core - :: - =/ him (slav %p i.t.path) - =/ dap i.t.t.path - =/ num (slav %ud i.t.t.t.path) - =/ =coop q.+>.sign-arvo - =/ sys-path - =/ pax [%req t.path] - [%sys pax] - :: - ?~ coop - =/ =note-arvo - =/ =sock [him our] - =/ =internal-task [dap %pump ~] - =/ =task:able [%deal sock internal-task] - [%g task] - (mo-pass sys-path note-arvo) - :: - =/ gall-move=note-arvo - =/ =sock [him our] - =/ =internal-task [dap %pull ~] - =/ =task:able [%deal sock internal-task] - [%g task] - :: - =/ ames-move=note-arvo - =/ path [%g %gh dap ~] - =/ =noun [num %x ~] - =/ =task:able:ames [%want him path noun] - [%a task] - :: - =. mo-core (mo-pass sys-path gall-move) - =. mo-core (mo-pass sys-path ames-move) - :: - ?. ?=([~ ~ %mack *] coop) - ~& [%diff-bad-ack coop] - mo-core - :: - ~& [%diff-bad-ack %mack] - =/ print (slog (flop q.,.+>.coop)) - (print mo-core) - :: +mo-handle-sys-rep: reverse request. - :: - :: On receipt of a valid +sign from %ford, sets state to the appropriate - :: duct and gives an internal %diff containing the +sign payload. - :: - ++ mo-handle-sys-rep - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([@ @ @ @ ~] path) - ?> ?=([%f %made *] sign-arvo) - =/ him (slav %p i.t.path) - =/ dap i.t.t.path - =/ num (slav %ud i.t.t.t.path) - :: - ?: ?=([%incomplete *] result.sign-arvo) - =/ err (some tang.result.sign-arvo) - (mo-give %mack err) - :: - =/ build-result build-result.result.sign-arvo - ?: ?=([%error *] build-result) - :: XX should crash - =/ err (some message.build-result) - (mo-give %mack err) - :: XX pump should ack - =. mo-core (mo-give %mack ~) - =/ duct (mo-retrieve-duct him num) - ?~ duct - %- (slog leaf/"gall: sys-rep no index" ~) - mo-core - =. mo-core (mo-abed u.duct) - =/ =cage (result-to-cage:ford build-result) - =/ move [%unto [%diff cage]] - (mo-give move) - :: +mo-handle-sys-req: process an inbound request. - :: - ++ mo-handle-sys-req - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([@ @ @ @ ~] path) - =/ him (slav %p i.t.path) - =/ dap i.t.t.path - =/ num (slav %ud i.t.t.t.path) - :: - ?: ?=([%f %made *] sign-arvo) - ?: ?=([%incomplete *] result.sign-arvo) - =/ err (some tang.result.sign-arvo) - (mo-give %mack err) - :: - =/ build-result build-result.result.sign-arvo - ?: ?=([%error *] build-result) - =/ err (some message.build-result) - (mo-give %mack err) - :: - =/ sys-path [%sys path] - =/ =note-arvo - =/ =cage (result-to-cage:ford build-result) - [%g %deal [him our] i.t.t.path %poke cage] - (mo-pass sys-path note-arvo) - :: - ?: ?=([%a %woot *] sign-arvo) - mo-core - :: - ?> ?=([%g %unto *] sign-arvo) - =/ =internal-gift +>.sign-arvo - :: - ?- -.internal-gift - %coup - (mo-give %mack p.internal-gift) - :: - %diff - =/ sys-path [%sys %red t.path] - =/ =note-arvo - =/ path [%g %gh dap ~] - =/ noun [num %d p.p.internal-gift q.q.p.internal-gift] - [%a %want him path noun] - (mo-pass sys-path note-arvo) - :: - %quit - =/ sys-path [%sys path] - =/ =note-arvo - =/ path [%g %gh dap ~] - =/ noun [num %x ~] - [%a %want him path noun] - (mo-pass sys-path note-arvo) - :: - %reap - (mo-give %mack p.internal-gift) - :: - %http-response - !! - == - :: +mo-handle-sys-val: inbound validate. - :: - :: Validates an incoming +sign from %ford and applies it to the specified - :: agent. - :: - ++ mo-handle-sys-val - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([%f %made *] sign-arvo) - ?> ?=([@ @ @ ~] path) - =/ =ship (slav %p i.t.path) - =/ =term i.t.t.path - ?: ?=([%incomplete *] result.sign-arvo) - =/ err (some tang.result.sign-arvo) - (mo-give %unto %coup err) - :: - =/ build-result build-result.result.sign-arvo - ?: ?=([%error *] build-result) - =/ err (some message.build-result) - (mo-give %unto %coup err) - :: - =/ =routes [disclosing=~ attributing=ship] - =/ =cage (result-to-cage:ford build-result) - =/ =agent-action [%poke cage] - (mo-apply term routes agent-action) - :: +mo-handle-sys-way: outbound request. - :: - ++ mo-handle-sys-way - |= [=path =sign-arvo] - ^+ mo-core - :: - ?> ?=([%a %woot *] sign-arvo) - ?> ?=([@ @ ~] path) - =/ =foreign-response (foreign-response i.t.path) - =/ maybe-ares +>+.sign-arvo - (mo-handle-foreign-response foreign-response maybe-ares) - :: +mo-handle-use: handle a typed +sign incoming on /use. - :: - :: (Note that /use implies the +sign should be routed to an agent.) - :: - :: Initialises the specified agent and then performs an agent-level +take - :: on the supplied +sign. - :: - ++ mo-handle-use - ~/ %mo-handle-use - |= [=path hin=(hypo sign-arvo)] - ^+ mo-core - :: - ?. ?=([@ @ coke *] path) - ~& [%mo-handle-use-bad-path path] - !! - :: - =/ app - =/ =term i.path - =/ =ship (slav %p i.t.path) - =/ =routes [disclosing=~ attributing=ship] - (ap-abed:ap term routes) - :: - =/ =sign-arvo q.hin - ?- i.t.t.path - %inn - =/ =vase (slot 3 hin) - =. app (ap-generic-take:app t.t.t.path vase) - ap-abet:app - :: - %cay - ~& [%mo-handle-use-weird sign-arvo] - ~& [%mo-handle-use-weird-path path] - mo-core - :: - %out - ?. ?=([%g %unto *] sign-arvo) - ~& [%mo-handle-use-weird sign-arvo] - ~& [%mo-handle-use-weird-path path] - mo-core - =. app - =/ =internal-gift +>.sign-arvo - (ap-specific-take:app t.t.t.path internal-gift) - ap-abet:app - == - :: +mo-clear-queue: clear blocked tasks from the specified running agent. - :: - ++ mo-clear-queue - |= =term - ^+ mo-core - :: - ?. (~(has by running.agents.state) term) - mo-core - =/ maybe-blocked (~(get by blocked.agents.state) term) - ?~ maybe-blocked - mo-core - :: - =/ =blocked u.maybe-blocked - :: - |- ^+ mo-core - ?: =(~ blocked) - =/ blocked (~(del by blocked.agents.state) term) - %_ mo-core - blocked.agents.state blocked - == - =^ task blocked [p q]:~(get to blocked) - =/ =duct p.task - =/ =routes q.task - =/ =agent-action r.task - :: - =/ move - =/ =sock [attributing.routes our] - =/ =internal-task [term agent-action] - =/ card [%slip %g %deal sock internal-task] - [duct card] - $(moves [move moves]) - :: +mo-beak: assemble a beak for the specified agent. - :: - ++ mo-beak - |= =term - ^- beak - :: - ?~ running=(~(get by running.agents.state) term) - :: XX this fallback is necessary, as .term could be either the source - :: or the destination app. ie, it might not exist locally ... - :: - [our %home %da now] - beak.u.running - :: +mo-peek: call to +ap-peek (which is not accessible outside of +mo). - :: - ++ mo-peek - ~/ %mo-peek - |= [agent=term =routes =term =path] - ^- (unit (unit cage)) - :: - =/ app (ap-abed:ap agent routes) - (ap-peek:app term path) - :: +mo-apply: apply the supplied action to the specified agent. - :: - ++ mo-apply - |= [=term =routes =agent-action] - ^+ mo-core - :: - =/ =path - =/ ship (scot %p attributing.routes) - /sys/val/[ship]/[term] - :: - =/ ship-desk - =/ =beak (mo-beak term) - [p q]:beak - :: - ?: ?=(%puff -.agent-action) - =/ =schematic:ford [%vale ship-desk +.agent-action] - =/ =note-arvo [%f %build live=%.n schematic] - (mo-pass path note-arvo) - :: - ?: ?=(%punk -.agent-action) - =/ =schematic:ford [%cast ship-desk p.agent-action [%$ q.agent-action]] - =/ =note-arvo [%f %build live=%.n schematic] - (mo-pass path note-arvo) - :: - ?: ?=(%peer-not -.agent-action) - =/ err (some p.agent-action) - (mo-give %unto %reap err) - :: - =/ app (ap-abed:ap term routes) - =. app (ap-apply:app agent-action) - ap-abet:app - :: +mo-handle-local: handle locally. - :: - :: If the agent is running or blocked, assign it the supplied +task. - :: Otherwise simply apply the action to the agent. - :: - ++ mo-handle-local - |= [=ship =internal-task] - ^+ mo-core - :: - =/ =routes [disclosing=~ attributing=ship] - =/ =term p.internal-task - =/ =agent-action q.internal-task - =/ is-running (~(has by running.agents.state) term) - =/ is-blocked (~(has by blocked.agents.state) term) - :: - ?: |(!is-running is-blocked) - =/ =blocked - =/ waiting (~(get by blocked.agents.state) term) - =/ tasks (fall waiting *blocked) - =/ task [hen routes agent-action] - (~(put to tasks) task) - :: - ~& >> [%gall-not-running term -.agent-action] - %_ mo-core - blocked.agents.state (~(put by blocked.agents.state) term blocked) - == - (mo-apply term routes agent-action) - :: +mo-handle-forward: handle forward %ames message. - :: - ++ mo-handle-forward - |= [=ship =term =bone =forward-ames] - ^+ mo-core - :: - =. mo-core - ?. ?=(%u -.forward-ames) - mo-core - (mo-give %mack ~) - :: - =/ =path - =/ him (scot %p ship) - =/ num (scot %ud bone) - /sys/req/[him]/[term]/[num] - :: - =/ =sock [ship our] - =/ =note-arvo - ?- -.forward-ames - %m - =/ =task:able - =/ =internal-task [term %puff [mark noun]:forward-ames] - [%deal sock internal-task] - [%g task] - :: - %l - =/ =task:able - =/ =internal-task [term %peel [mark path]:forward-ames] - [%deal sock internal-task] - [%g task] - :: - %s - =/ =task:able - =/ =internal-task [term %peer path.forward-ames] - [%deal sock internal-task] - [%g task] - :: - %u - =/ =task:able - =/ =internal-task [term %pull ~] - [%deal sock internal-task] - [%g task] - == - (mo-pass path note-arvo) - :: +mo-handle-backward: handle reverse %ames message. - :: - ++ mo-handle-backward - |= [=ship =term =bone =reverse-ames] - ^+ mo-core - :: - ?- -.reverse-ames - %d - =/ =path - =/ him (scot %p ship) - =/ num (scot %ud bone) - /sys/rep/[him]/[term]/[num] - :: - =/ =note-arvo - =/ beak (mo-beak term) - =/ info [p q]:beak - =/ =schematic:ford [%vale info p.reverse-ames q.reverse-ames] - [%f %build live=%.n schematic] - :: - (mo-pass path note-arvo) - :: - %x - :: XX should crash - =. mo-core (mo-give %mack ~) - =/ out (mo-retrieve-duct ship bone) - ?~ out - %- (slog leaf/"gall: x no index" ~) - mo-core - =/ initialised - (mo-abed u.out) - (mo-give:initialised %unto %quit ~) - == - :: +ap: agent engine - :: - :: An inner, agent-level core. The sample refers to the agent we're - :: currently focused on. - :: - ++ ap - ~% %gall-ap +> ~ - |_ $: agent-name=term - agent-routes=routes - agent-bone=bone - agent-moves=(list internal-move) - agent-config=(list (each suss tang)) - current-agent=agent - == - ++ ap-core . - :: +ap-abed: initialise state for an agent, with the supplied routes. - :: - :: The agent must already be running in +gall -- here we simply update - :: +ap's state to focus on it. - :: - ++ ap-abed - ~/ %ap-abed - |= [=term =routes] - ^+ ap-core - :: - =/ =agent - =/ running (~(got by running.agents.state) term) - =/ =stats - :+ +(change.stats.running) - (shaz (mix (add term change.stats.running) eny)) - now - running(stats stats) - :: - =. agent-name term - =. agent-routes routes - =. current-agent agent - =/ maybe-bone (~(get by bone-map.ducts.agent) hen) - ?^ maybe-bone - ap-core(agent-bone u.maybe-bone) - :: - =/ =ducts - :+ +(bone.ducts.agent) - (~(put by bone-map.ducts.agent) hen bone.ducts.agent) - (~(put by duct-map.ducts.agent) bone.ducts.agent hen) - :: - %_ ap-core - agent-bone bone.ducts.agent - ducts.current-agent ducts - == - :: +ap-abet: resolve moves. - :: - ++ ap-abet - ^+ mo-core - :: - => ap-track-queue - =/ running (~(put by running.agents.state) agent-name current-agent) - =/ moves - =/ giver |=(report=(each suss tang) [hen %give %onto report]) - =/ from-internal (turn agent-moves ap-from-internal) - =/ from-suss (turn agent-config giver) - :(weld from-internal from-suss moves) - :: - %_ mo-core - running.agents.state running - moves moves - == - :: +ap-track-queue: track queue. - :: - ++ ap-track-queue - ^+ ap-core - :: - =/ internal-moves agent-moves - =/ bones *(set bone) - |- ^+ ap-core - ?^ internal-moves - =/ =internal-move i.internal-moves - ?. ?=([%give %diff *] move.internal-move) - $(internal-moves t.internal-moves) - :: - =^ filled ap-core ap-enqueue(agent-bone bone.internal-move) - =/ new-bones - ?: filled - bones - (~(put in bones) bone.internal-move) - $(internal-moves t.internal-moves, bones new-bones) - :: - =/ bones ~(tap in bones) - :: - |- ^+ ap-core - ?~ bones - ap-core - :: - => $(bones t.bones, agent-bone i.bones) - =/ incoming - (~(get by incoming.subscribers.current-agent) agent-bone) - ?~ incoming - ~& [%ap-track-queue-bad-bone agent-name agent-bone] - ap-core - :: - =/ =ship p.u.incoming - ap-kill(attributing.agent-routes ship) - :: +ap-from-internal: internal move to move. - :: - :: We convert from bone-indexed moves to duct-indexed moves when - :: resolving them in Arvo. - :: - ++ ap-from-internal - ~/ %ap-from-internal - |= =internal-move - ^- move - :: - ~| [%gall-move-conversion-failed internal-move] - =/ =duct - (~(got by duct-map.ducts.current-agent) bone.internal-move) - :: - =/ card - ?- -.move.internal-move - %slip !! - :: - %give - ?< =(0 bone.internal-move) - :: - =/ =internal-gift p.move.internal-move - ?. ?=(%diff -.internal-gift) - [%give %unto internal-gift] - :: - =/ =cage p.internal-gift - =/ =mark - =/ mark (~(get by marks.current-agent) bone.internal-move) - (fall mark p.cage) - :: - ?: =(mark p.cage) - [%give %unto internal-gift] - =/ =path /sys/pel/[agent-name] - =/ =note-arvo - =/ =schematic:ford - =/ =beak (mo-beak agent-name) - [%cast [p q]:beak mark [%$ cage]] - [%f %build live=%.n schematic] - :: - [%pass path note-arvo] - :: - %pass - =/ =path p.move.internal-move - =/ =internal-note q.move.internal-move - =/ use-path [%use agent-name path] - =/ =note-arvo - ?- -.internal-note - %send - =/ =task:able - =/ =sock [our ship.internal-note] - =/ =internal-task internal-task.internal-note - [%deal sock internal-task] - [%g task] - :: - %meta - =/ =term term.internal-note - =/ =vase vase.internal-note - [term %meta vase] - == - [%pass use-path note-arvo] - == - [duct card] - :: +ap-breach: ship breached, so forget about them - :: - ++ ap-breach - |= =ship - ^+ ap-core - =/ in=(list [=bone =^ship =path]) - ~(tap by incoming.subscribers.current-agent) - |- ^+ ap-core - ?^ in - =? ap-core =(ship ship.i.in) - =/ core ap-load-delete(agent-bone bone.i.in) - core(agent-bone agent-bone) - $(in t.in) - :: - =/ out=(list [[=bone =wire] =bean =^ship =path]) - ~(tap by outgoing.subscribers.current-agent) - |- ^+ ap-core - ?~ out - ap-core - =? ap-core =(ship ship.i.out) - =/ core (ap-specific-take(agent-bone bone.i.out) wire.i.out %quit ~) - core(agent-bone agent-bone) - $(out t.out) - :: +ap-call: call into server. - :: - ++ ap-call - ~/ %ap-call - |= [=term =vase] - ^- [(unit tang) _ap-core] - :: - =. ap-core ap-construct-bowl - =^ arm ap-core (ap-produce-arm term) - ?: ?=(%.n -.arm) - [(some p.arm) ap-core] - :: - =^ arm ap-core (ap-slam term p.arm vase) - ?: ?=(%.n -.arm) - [(some p.arm) ap-core] - (ap-handle-result p.arm) - :: +ap-peek: peek. - :: - ++ ap-peek - ~/ %ap-peek - |= [=term tyl=path] - ^- (unit (unit cage)) - :: - =/ marked - ?. ?=(%x term) - [mark=%$ tyl=tyl] - :: - =/ =path (flop tyl) - ?> ?=(^ path) - [mark=i.path tyl=(flop t.path)] - :: - =/ =mark mark.marked - =/ tyl tyl.marked - =^ maybe-arm ap-core (ap-find-arm %peek term tyl) - :: - ?~ maybe-arm - =/ =tank [%leaf "peek find fail"] - =/ print (slog tank >tyl< >mark< ~) - (print [~ ~]) - :: - =^ arm ap-core (ap-produce-arm q.u.maybe-arm) - :: - ?: ?=(%.n -.arm) - =/ =tank [%leaf "peek farm fail"] - =/ print (slog tank p.arm) - (print [~ ~]) - :: - =/ slammed - =/ index p.u.maybe-arm - =/ name q.u.maybe-arm - =/ =vase - =/ =path [term tyl] - !> (slag index path) - (ap-slam name p.arm vase) - :: - =^ possibly-vase ap-core slammed - ?: ?=(%.n -.possibly-vase) - =/ =tank [%leaf "peek slam fail"] - =/ print (slog tank p.possibly-vase) - (print [~ ~]) - :: - =/ slammed-vase p.possibly-vase - =/ vase-value q.slammed-vase - =/ err - |. - =/ =tank [%leaf "peek bad result"] - =/ print (slog tank ~) - (print [~ ~]) - :: - ?+ vase-value $:err - ~ - ~ - :: - [~ ~] - [~ ~] - :: - [~ ~ ^] - =/ =vase (sped (slot 7 slammed-vase)) - :: - ?. ?=([p=@ *] q.vase) - =/ =tank [%leaf "scry: malformed cage"] - =/ print (slog tank ~) - (print [~ ~]) - :: - ?. ((sane %tas) p.q.vase) - =/ =tank [%leaf "scry: malformed cage"] - =/ print (slog tank ~) - (print [~ ~]) - :: - ?. =(mark p.q.vase) - [~ ~] - :: - =/ =cage [p.q.vase (slot 3 vase)] - (some (some cage)) - == - :: +ap-apply: apply effect. - :: - ++ ap-apply - |= =agent-action - ^+ ap-core - :: - ?- -.agent-action - %peel (ap-peel +.agent-action) - %poke (ap-poke +.agent-action) - %peer (ap-peer +.agent-action) - %puff !! - %punk !! - %peer-not !! - %pull ap-load-delete - %pump ap-dequeue - == - :: +ap-diff: pour a diff. - :: - ++ ap-diff - ~/ %ap-diff - |= [=ship =path =cage] - ^+ ap-core - :: - =/ rest +.path - =/ pax [p.cage rest] - =^ maybe-arm ap-core (ap-find-arm %diff pax) - :: - ?~ maybe-arm - =/ target [%.n ship rest] - =/ =tang - =/ why "diff: no {<[p.cage rest]>}" - (ap-tang why) - :: - =. ap-core (ap-lame %diff tang) - (ap-update-subscription target) - :: - =/ arm u.maybe-arm - =/ =vase - =/ target - ?: =(0 p.arm) - =/ =vase (ap-cage cage) - [!>(rest) vase] - [!>((slag (dec p.arm) rest)) q.cage] - (slop target) - :: - =^ called ap-core (ap-call q.arm vase) - ?^ called - =. ap-core (ap-lame q.arm u.called) - (ap-update-subscription %.n ship path) - (ap-update-subscription %.y ship path) - :: +ap-cage: cage to tagged vase. - :: - ++ ap-cage - |= =cage - ^- vase - :: - =/ =type [%atom %tas (some p.cage)] - =/ =vase [type p.cage] - (slop vase q.cage) - :: +ap-update-subscription: update subscription. - :: - ++ ap-update-subscription - ~/ %ap-update-subscription - |= [is-ok=? =ship =path] - ^+ ap-core - :: - =/ way [(scot %p ship) %out path] - :: - ?: is-ok - =/ =internal-note [%send ship -.path %pump ~] - (ap-pass way internal-note) - =. ap-core (ap-give %quit ~) - =/ =internal-note [%send ship -.path %pull ~] - (ap-pass way internal-note) - :: +ap-dequeue: drop from queue. - :: - :: Dequeues along the current bone, deleting the queue entirely if it - :: drops to zero. - :: - ++ ap-dequeue - ^+ ap-core - :: - ?. (~(has by incoming.subscribers.current-agent) agent-bone) - ap-core - =/ level (~(get by meter.subscribers.current-agent) agent-bone) - ?: |(?=(~ level) =(0 u.level)) - ap-core - :: - =. u.level (dec u.level) - ?: =(0 u.level) - =/ deleted (~(del by meter.subscribers.current-agent) agent-bone) - ap-core(meter.subscribers.current-agent deleted) - :: - =/ dequeued - (~(put by meter.subscribers.current-agent) agent-bone u.level) - ap-core(meter.subscribers.current-agent dequeued) - :: +ap-produce-arm: produce arm. - :: - ++ ap-produce-arm - ~/ %ap-produce-arm - |= =term - ^- [(each vase tang) _ap-core] - :: - =/ virtual - =/ =type p.running-state.current-agent - =/ =hoon [%limb term] - %- mule - |. (~(mint wa cache.current-agent) type hoon) - :: - ?: ?=(%.n -.virtual) - =/ =tang p.virtual - [[%.n tang] ap-core] - :: - =/ possibly-vase=(each vase tang) - =/ value q.running-state.current-agent - =/ ton (mock [value q.+<.virtual] ap-namespace-view) - ?- -.ton - %0 [%.y p.+<.virtual p.ton] - %1 [%.n (turn p.ton |=(a=* (smyt (path a))))] - %2 [%.n p.ton] - == - :: - =/ next - =/ =worm +>.virtual - ap-core(cache.current-agent worm) - :: - [possibly-vase next] - :: +ap-enqueue: add to queue. - :: - :: Every agent has a 'meter', that tracks the number of incoming - :: subscribers by bone. We get both the meter and ship associated with - :: the current bone; if the meter has hit twenty for another ship, we - :: don't enqueue the subscriber. Otherwise we increment the meter for - :: the current bone and update the agent's state with it. - :: - :: Returns a yes if the meter has been incremented, and no otherwise. - :: - ++ ap-enqueue - ^- [? _ap-core] - :: - =/ meter (~(gut by meter.subscribers.current-agent) agent-bone 0) - =/ subscriber=(unit (pair ship path)) - (~(get by incoming.subscribers.current-agent) agent-bone) - :: - ?: ?& =(20 meter) - ?| ?=(~ subscriber) - !=(our p.u.subscriber) - == - == - =/ incoming (~(get by incoming.subscribers.current-agent) agent-bone) - =/ duct (~(get by duct-map.ducts.current-agent) agent-bone) - ~& [%gall-pulling-20 agent-bone incoming duct] - [%.n ap-core] - :: - =/ next - =/ meter - (~(put by meter.subscribers.current-agent) agent-bone +(meter)) - ap-core(meter.subscribers.current-agent meter) - :: - [%.y next] - :: +ap-find-arm: general arm. - :: - ++ ap-find-arm - ~/ %ap-find-arm - |= [=term =path] - ^- [(unit (pair @ud @tas)) _ap-core] - :: - =/ maybe-cached (~(get by arm-cache.current-agent) [term path]) - ?^ maybe-cached - [u.maybe-cached ap-core] - :: - =/ result - =/ dep 0 - |- ^- (unit (pair @ud @tas)) - =/ spu - ?~ path - ~ - =/ hyped (cat 3 term (cat 3 '-' i.path)) - $(path t.path, dep +(dep), term hyped) - :: - ?^ spu - spu - :: - ?. (ap-exists-arm term) - ~ - (some [dep term]) - :: - =. arm-cache.current-agent - (~(put by arm-cache.current-agent) [term path] result) - [result ap-core] - :: +ap-exists-arm: check for an arm in the running agent state. - :: - ++ ap-exists-arm - ~/ %ap-exists-arm - |= =term - ^- ? - :: - =/ =type p.running-state.current-agent - (slob term type) - :: +ap-give: return result. - :: - ++ ap-give - |= =internal-gift - ^+ ap-core - :: - =/ internal-moves - =/ move [%give internal-gift] - =/ =internal-move [agent-bone move] - [internal-move agent-moves] - ap-core(agent-moves internal-moves) - :: +ap-construct-bowl: set up bowl. - :: - ++ ap-construct-bowl - ^+ ap-core - :: - %_ ap-core - +12.q.running-state.current-agent - ^- bowl - :* :* our :: host - attributing.agent-routes :: guest - agent-name :: agent - == :: - :* :: NB (jtobin): see urbit/urbit#1466 - wex=~ :: outgoing - sup=incoming.subscribers.current-agent :: incoming - == :: - :* agent-bone=agent-bone :: cause - act=change.stats.current-agent :: tick - eny=eny.stats.current-agent :: nonce - now=time.stats.current-agent :: time - byk=beak.current-agent :: source - == == - == - :: +ap-move: process each move. - :: - ++ ap-move - ~/ %ap-move - |= =vase - ^- [(each internal-move tang) _ap-core] - :: - =/ noun q.vase - ?@ noun - =/ =tang (ap-tang "move: invalid move (atom)") - [[%.n tang] ap-core] - :: - ?^ -.noun - =/ =tang (ap-tang "move: invalid move (bone)") - [[%.n tang] ap-core] - :: - ?@ +.noun - =/ =tang (ap-tang "move: invalid move (card)") - [[%.n tang] ap-core] - :: - =/ =bone -.noun - =/ has-duct (~(has by duct-map.ducts.current-agent) bone) - ?. &(has-duct !=(0 bone)) - =/ =tang (ap-tang "move: invalid card (bone {})") - [[%.n tang] ap-core] - :: - =^ vase cache.current-agent (~(spot wa cache.current-agent) 3 vase) - =^ vase cache.current-agent (~(slot wa cache.current-agent) 3 vase) - ?+ +<.noun (ap-move-pass bone +<.noun vase) - %diff (ap-move-diff bone vase) - %peel (ap-move-peel bone vase) - %peer (ap-move-peer bone vase) - %pull (ap-move-pull bone vase) - %poke (ap-move-poke bone vase) - %send (ap-move-send bone vase) - %quit (ap-move-quit bone vase) - %http-response (ap-move-http-response bone vase) - == - :: +ap-move-quit: give quit move. - :: - ++ ap-move-quit - ~/ %quit - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =/ possibly-internal-move=(each internal-move tang) - ?^ q.vase - =/ =tang (ap-tang "quit: improper give") - [%.n tang] - :: - =/ =internal-move - =/ =internal-gift [%quit ~] - =/ move [%give internal-gift] - [bone move] - :: - [%.y internal-move] - :: - =/ next - =/ incoming (~(del by incoming.subscribers.current-agent) bone) - %_ ap-core - incoming.subscribers.current-agent incoming - == - [possibly-internal-move next] - :: +ap-move-diff: give diff move. - :: - ++ ap-move-diff - ~/ %diff - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =^ vase cache.current-agent (~(sped wa cache.current-agent) vase) - =/ value q.vase - ?. ?& ?=(^ value) - ?=(@ -.value) - ((sane %tas) -.value) - == - =/ =tang (ap-tang "diff: improper give") - [[%.n tang] ap-core] - :: - =^ vase cache.current-agent (~(slot wa cache.current-agent) 3 vase) - =/ =internal-move - =/ =cage [-.value vase] - =/ move [%give %diff cage] - [bone move] - [[%.y internal-move] ap-core] - :: +ap-move-http-response - :: - ++ ap-move-http-response - |= [sto=bone vax=vase] - ^- [(each internal-move tang) _ap-core] - :: TODO: Magic vase validation. I have no idea how malformed checking - :: works. - :: - :_ ap-core - [%& sto %give %http-response ;;(http-event:http q.vax)] - :: +ap-move-mess: extract path, target. - :: - ++ ap-move-mess - ~/ %mess - |= =vase - ^- [(each (trel path ship term) tang) _ap-core] - :: - =/ possibly-trel=(each (trel path ship term) tang) - ?. ?& ?=([p=* [q=@ r=@] s=*] q.vase) - (gte 1 (met 7 q.q.vase)) - == - =/ =tang (ap-tang "mess: malformed target") - [%.n tang] - :: - =/ pax ((soft path) p.q.vase) - :: - ?. ?& ?=(^ pax) - (levy u.pax (sane %ta)) - == - =/ =tang (ap-tang "mess: malformed path") - [%.n tang] - :: - =/ =path [(scot %p q.q.vase) %out r.q.vase u.pax] - =/ =ship q.q.vase - =/ =term r.q.vase - [%.y path ship term] - :: - [possibly-trel ap-core] - :: +ap-move-pass: pass general move. - :: - ++ ap-move-pass - ~/ %pass - |= [=bone =noun =vase] - ^- [(each internal-move tang) _ap-core] - :: - ?. ?& ?=(@ noun) - ((sane %tas) noun) - == - =/ =tang (ap-tang "pass: malformed card") - [[%.n tang] ap-core] - :: - =/ pax ((soft path) -.q.vase) - ?. ?& ?=(^ pax) - (levy u.pax (sane %ta)) - == - =/ =tang (ap-tang "pass: malformed path") - ~& [%bad-path pax] - [[%.n tang] ap-core] - :: - =/ maybe-vane (ap-vain noun) - ?~ maybe-vane - =/ =tang (ap-tang "move: unknown note {(trip noun)}") - [[%.n tang] ap-core] - :: - =/ vane u.maybe-vane - =^ at-slot cache.current-agent - (~(slot wa cache.current-agent) 3 vase) - =/ =internal-move - =/ =path [(scot %p attributing.agent-routes) %inn u.pax] - =/ vase (ap-atomic-vase %tas noun) - =/ combined (slop vase at-slot) - =/ =internal-note [%meta vane combined] - =/ card [%pass path internal-note] - [bone card] - [[%.y internal-move] ap-core] - :: +ap-move-poke: pass %poke. - :: - ++ ap-move-poke - ~/ %poke - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =^ possibly-target ap-core (ap-move-mess vase) - :: - ?: ?=(%.n -.possibly-target) - [possibly-target ap-core] - :: - =^ at-slot cache.current-agent - (~(slot wa cache.current-agent) 7 vase) - :: - ?. ?& ?=([p=@ q=*] q.at-slot) - ((sane %tas) p.q.at-slot) - == - =/ =tang (ap-tang "poke: malformed cage") - [[%.n tang] ap-core] - :: - =^ specialised cache.current-agent - (~(stop wa cache.current-agent) 3 at-slot) - =/ target p.possibly-target - =/ =path p.target - =/ =ship q.target - =/ =term r.target - :: - =/ =internal-move - =/ =internal-task [term %poke p.q.at-slot specialised] - =/ =internal-note [%send ship internal-task] - =/ card [%pass path internal-note] - [bone card] - :: - [[%.y internal-move] ap-core] - :: +ap-move-peel: pass %peel. - :: - ++ ap-move-peel - ~/ %peel - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =^ possibly-target ap-core (ap-move-mess vase) - ?: ?=(%.n -.possibly-target) - [possibly-target ap-core] - :: - =/ target p.possibly-target - =/ =ship q.target - =/ =term r.target - =/ mark ((soft mark) +>-.q.vase) - ?~ mark - =/ =tang (ap-tang "peel: malformed mark") - [[%.n tang] ap-core] - :: - =/ pax ((soft path) +>+.q.vase) - :: - ?. ?& ?=(^ pax) - (levy u.pax (sane %ta)) - == - =/ =tang (ap-tang "peel: malformed path") - [[%.n tang] ap-core] - :: - =/ move - ?: (~(has in misvale.current-agent) p.target) - =/ =internal-task - =/ =tang [[%leaf "peel: misvalidation encountered"] ~] - =/ =agent-action [%peer-not tang] - [term agent-action] - =/ =internal-note [%send ship internal-task] - =/ card [%pass p.target internal-note] - [bone card] - :: - =/ =agent-action [%peel u.mark u.pax] - =/ =internal-task [term agent-action] - =/ =internal-note [%send ship internal-task] - =/ card [%pass p.target internal-note] - [bone card] - [[%.y move] ap-core] - :: +ap-move-peer: pass %peer. - :: - ++ ap-move-peer - ~/ %peer - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =^ possibly-target ap-core (ap-move-mess vase) - ?: ?=(%.n -.possibly-target) - [possibly-target ap-core] - :: - =/ target p.possibly-target - =/ =ship q.target - =/ =term r.target - =/ pax ((soft path) +>.q.vase) - ?. ?& ?=(^ pax) - (levy u.pax (sane %ta)) - == - =/ =tang (ap-tang "peer: malformed path") - [[%.n tang] ap-core] - :: - =/ move - ?: (~(has in misvale.current-agent) p.target) - =/ err [[%leaf "peer: misvalidation encountered"] ~] - =/ =agent-action [%peer-not err] - =/ =internal-note [%send ship term agent-action] - =/ card [%pass p.target internal-note] - [bone card] - :: - =/ =agent-action [%peer u.pax] - =/ =internal-note [%send ship term agent-action] - =/ card [%pass p.target internal-note] - [bone card] - [[%.y move] ap-core] - :: +ap-move-pull: pass %pull. - :: - ++ ap-move-pull - ~/ %pull - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - =^ possibly-target ap-core (ap-move-mess vase) - ?: ?=(%.n -.possibly-target) - [possibly-target ap-core] - :: - =/ target p.possibly-target - =/ =ship q.target - =/ =term r.target - ?. =(~ +>.q.vase) - =/ =tang (ap-tang "pull: malformed card") - [[%.n tang] ap-core] - :: - =/ move - =/ =agent-action [%pull ~] - =/ =internal-note [%send ship term agent-action] - =/ card [%pass p.target internal-note] - [bone card] - :: - [[%.y move] ap-core] - :: +ap-move-send: pass gall action. - :: - ++ ap-move-send - ~/ %send - |= [=bone =vase] - ^- [(each internal-move tang) _ap-core] - :: - ?. ?& ?=([p=* [q=@ r=@] [s=@ t=*]] q.vase) - (gte 1 (met 7 q.q.vase)) - ((sane %tas) r.q.vase) - == - =/ =tang - (ap-tang "send: improper ask.[%send wire gill agent-action]") - [[%.n tang] ap-core] - :: - =/ pax ((soft path) p.q.vase) - ?. ?& ?=(^ pax) - (levy u.pax (sane %ta)) - == - =/ =tang (ap-tang "send: malformed path") - [[%.n tang] ap-core] - :: - ?: ?=($poke s.q.vase) - =^ specialised cache.current-agent - (~(spot wa cache.current-agent) 7 vase) - :: - ?> =(%poke -.q.specialised) - :: - ?. ?& ?=([p=@ q=*] t.q.vase) - ((sane %tas) p.t.q.vase) - == - =/ =tang (ap-tang "send: malformed poke") - [[%.n tang] ap-core] - :: - =^ specialised cache.current-agent - (~(spot wa cache.current-agent) 3 specialised) - =^ at-slot cache.current-agent - (~(slot wa cache.current-agent) 3 specialised) - :: - =/ move - =/ =agent-action [%poke p.t.q.vase at-slot] - =/ =internal-note [%send q.q.vase r.q.vase agent-action] - =/ =path [(scot %p q.q.vase) %out r.q.vase u.pax] - =/ card [%pass path internal-note] - [bone card] - :: - [[%.y move] ap-core] - :: - =/ maybe-action ((soft agent-action) [s t]:q.vase) - ?~ maybe-action - =/ =tang (ap-tang "send: malformed agent-action") - [[%.n tang] ap-core] - :: - =/ move - =/ =agent-action u.maybe-action - =/ =internal-note [%send q.q.vase r.q.vase agent-action] - =/ =path [(scot %p q.q.vase) %out r.q.vase u.pax] - =/ card [%pass path internal-note] - [bone card] - :: - [[%.y move] ap-core] - :: +ap-pass: request action. - :: - ++ ap-pass - |= [=path =internal-note] - ^+ ap-core - :: - =/ =internal-move - =/ move [%pass path internal-note] - [agent-bone move] - =/ internal-moves [internal-move agent-moves] - ap-core(agent-moves internal-moves) - :: +ap-reinstall: reinstall. - :: - ++ ap-reinstall - ~/ %ap-reinstall - |= =vase - ^+ ap-core - :: - =/ prep - =/ installed ap-install(running-state.current-agent vase) - =/ running (some running-state.current-agent) - (installed running) - :: - =^ maybe-tang ap-core prep - ?~ maybe-tang - ap-core - (ap-lame %prep-failed u.maybe-tang) - :: +ap-peel: apply %peel. - :: - ++ ap-peel - |= [=mark =path] - ^+ ap-core - :: - =. marks.current-agent (~(put by marks.current-agent) agent-bone mark) - (ap-peer path) - :: +ap-peer: apply %peer. - :: - ++ ap-peer - ~/ %ap-peer - |= pax=path - ^+ ap-core - :: - =/ incoming [attributing.agent-routes pax] - =. incoming.subscribers.current-agent - (~(put by incoming.subscribers.current-agent) agent-bone incoming) - :: - =^ maybe-arm ap-core (ap-find-arm %peer pax) - ?~ maybe-arm - ap-core - :: - =/ arm u.maybe-arm - =/ =vase !>((slag p.arm pax)) - =/ old agent-moves - =. agent-moves ~ - =^ maybe-tang ap-core (ap-call q.arm vase) - =/ internal-moves=(list internal-move) - =/ move [agent-bone %give %reap maybe-tang] - [move old] - :: - =. agent-moves (weld agent-moves internal-moves) - ?^ maybe-tang - ap-silent-delete - ap-core - :: +ap-poke: apply %poke. - :: - ++ ap-poke - ~/ %ap-poke - |= =cage - ^+ ap-core - :: - =^ maybe-arm ap-core (ap-find-arm %poke p.cage ~) - ?~ maybe-arm - =/ =tang (ap-tang "no poke arm for {(trip p.cage)}") - (ap-give %coup (some tang)) - :: - =/ arm u.maybe-arm - =/ =vase - =/ vas (ap-atomic-vase %tas p.cage) - ?. =(0 p.arm) - q.cage - (slop vas q.cage) - :: - =^ tur ap-core (ap-call q.arm vase) - (ap-give %coup tur) - :: +ap-lame: pour error. - :: - ++ ap-lame - |= [=term =tang] - ^+ ap-core - :: - =^ maybe-arm ap-core (ap-find-arm /lame) - =/ form |=(=tank [%rose [~ "! " ~] tank ~]) - ?~ maybe-arm - =/ tang [>%ap-lame agent-name term< (turn tang form)] - ~> %slog.`rose+[" " "[" "]"]^(flop tang) - ap-core - :: - =/ arm u.maybe-arm - =/ =vase !>([term tang]) - =^ maybe-tang ap-core (ap-call q.arm vase) - ?^ maybe-tang - =/ tang u.maybe-tang - =/ etc (flop [>%ap-lame-lame< (turn tang form)]) - ~> %slog.`rose+[" " "[" "]"]^(welp etc [%leaf "." (flop tang)]) - ap-core - :: - ap-core - :: +ap-misvale: broken vale. - :: - ++ ap-misvale - |= =wire - ^+ ap-core - :: - ~& [%ap-blocking-misvale wire] - =/ misvaled (~(put in misvale.current-agent) wire) - ap-core(misvale.current-agent misvaled) - :: +ap-generic-take: generic take. - :: - ++ ap-generic-take - ~/ %ap-generic-take - |= [=path =vase] - ^+ ap-core - :: - ?. &(?=([@ *] q.vase) ((sane %tas) -.q.vase)) - =/ =tang (ap-tang "pour: malformed card") - (ap-lame %pour tang) - :: - =/ =term -.q.vase - =^ maybe-arm ap-core (ap-find-arm [term path]) - ?~ maybe-arm - =/ =tang (ap-tang "pour: no {(trip -.q.vase)}: {}") - (ap-lame term tang) - :: - =/ arm u.maybe-arm - =^ at-slot cache.current-agent - (~(slot wa cache.current-agent) 3 vase) - =/ vase (slop !>((slag p.arm path)) at-slot) - :: - =^ maybe-tang ap-core (ap-call q.arm vase) - ?^ maybe-tang - (ap-lame term u.maybe-tang) - ap-core - :: +ap-unwrap-take: unwrap take. - :: - ++ ap-unwrap-take - ~/ %ap-unwrap-take - |= [=term pax=path =cage] - ^+ ap-core - :: - =^ maybe-arm ap-core (ap-find-arm [term p.cage pax]) - :: - ?~ maybe-arm - =/ =tang (ap-tang "{(trip term)}: no {<`path`[p.cage pax]>}") - (ap-lame term tang) - :: - =/ arm u.maybe-arm - =/ =vase - %- slop - ?: =(0 p.arm) - =/ =vase (ap-cage cage) - [!>(`path`pax) vase] - [!>((slag (dec p.arm) `path`pax)) q.cage] - :: - =^ maybe-tang ap-core (ap-call q.arm vase) - ?^ maybe-tang - (ap-lame q.arm u.maybe-tang) - ap-core - :: +ap-specific-take: specific take. - :: - ++ ap-specific-take - |= [=path =internal-gift] - ^+ ap-core - :: - =/ pax +.path - ?- -.internal-gift - %coup - =/ maybe-vase (some !>(p.internal-gift)) - (ap-non-diff-take %coup pax maybe-vase) - :: - %diff - =/ =ship attributing.agent-routes - =/ =cage p.internal-gift - (ap-diff ship path cage) - :: - %quit - (ap-non-diff-take %quit pax ~) - :: - %reap - =/ maybe-vase (some !>(p.internal-gift)) - (ap-non-diff-take %reap pax maybe-vase) - :: - %http-response - !! - == - :: +ap-install: install wrapper. - :: - ++ ap-install - |= maybe-vase=(unit vase) - ^- [(unit tang) _ap-core] - :: - =^ maybe-tang ap-core (ap-prep maybe-vase) - =/ new-misvale-data - ~? !=(misvale.current-agent *misvale-data) - [%misvale-drop misvale.current-agent] - :: new app might mean new marks - *misvale-data - :: - =/ new-agent-config - =/ =term ?~(maybe-vase %boot %bump) - =/ possibly-suss - ?~ maybe-tang - =/ =suss [agent-name term now] - [%.y suss] - [%.n u.maybe-tang] - [possibly-suss agent-config] - :: - =/ next - %= ap-core - misvale.current-agent new-misvale-data - agent-config new-agent-config - arm-cache.current-agent ~ - == - :: - [maybe-tang next] - :: +ap-prep: low-level install. - :: - ++ ap-prep - ~/ %ap-prep - |= maybe-vase=(unit vase) - ^- [(unit tang) _ap-core] - :: - ?. (ap-exists-arm %prep) - ?~ maybe-vase - [~ ap-core] - :: - =/ new-type - =/ new (slot 13 running-state.current-agent) - p.new - :: - =/ old-type - =/ old (slot 13 u.maybe-vase) - p.old - :: - ?. (~(nest ut new-type) %.n old-type) - =/ =tang (ap-tang "prep mismatch") - [(some tang) ap-core] - :: - =/ next - ap-core(+13.q.running-state.current-agent +13.q.u.maybe-vase) - [~ next] - :: - =/ =vase - ?~ maybe-vase - !>(~) - (slop !>(~) (slot 13 u.maybe-vase)) - :: - (ap-call %prep vase) - :: +ap-silent-delete: silent delete. - :: - ++ ap-silent-delete - ^+ ap-core - :: - ?~ (~(get by incoming.subscribers.current-agent) agent-bone) - ap-core - :: - =/ incoming (~(del by incoming.subscribers.current-agent) agent-bone) - =/ meter (~(del by meter.subscribers.current-agent) agent-bone) - %_ ap-core - incoming.subscribers.current-agent incoming - meter.subscribers.current-agent meter - == - :: +ap-load-delete: load delete. - :: - ++ ap-load-delete - ^+ ap-core - :: - =/ maybe-incoming - (~(get by incoming.subscribers.current-agent) agent-bone) - ?~ maybe-incoming - ap-core - :: - =/ incoming u.maybe-incoming - =. incoming.subscribers.current-agent - (~(del by incoming.subscribers.current-agent) agent-bone) - =. meter.subscribers.current-agent - (~(del by meter.subscribers.current-agent) agent-bone) - :: - =^ maybe-arm ap-core (ap-find-arm %pull q.incoming) - ?~ maybe-arm - ap-core - :: - =/ arm u.maybe-arm - =/ =vase !>((slag p.arm q.incoming)) - =^ maybe-tang ap-core (ap-call q.arm vase) - ?^ maybe-tang - (ap-lame q.arm u.maybe-tang) - ap-core - :: +ap-kill: queue kill. - :: - ++ ap-kill - ^+ ap-core - :: - => ap-load-delete - (ap-give %quit ~) - :: +ap-non-diff-take: non-diff gall take. - :: - ++ ap-non-diff-take - ~/ %ap-non-diff-take - |= [=term =path maybe-vase=(unit vase)] - ^+ ap-core - :: - =^ maybe-arm ap-core (ap-find-arm term path) - ?~ maybe-arm - ap-core - :: - =/ arm u.maybe-arm - =/ =vase - =/ vax !>((slag p.arm path)) - ?~ maybe-vase - vax - (slop vax u.maybe-vase) - :: - =^ maybe-tang ap-core (ap-call q.arm vase) - ?^ maybe-tang - (ap-lame q.arm u.maybe-tang) - ap-core - :: +ap-safe: process move list. - :: - ++ ap-safe - ~/ %ap-safe - |= =vase - ^- [(each (list internal-move) tang) _ap-core] - :: - ?~ q.vase - [[%.y ~] ap-core] - :: - ?@ q.vase - =/ =tang (ap-tang "move: malformed list") - [[%.n tang] ap-core] - :: - =^ hed cache.current-agent (~(slot wa cache.current-agent) 2 vase) - =^ possibly-internal-move ap-core (ap-move hed) - ?: ?=(%.n -.possibly-internal-move) - [possibly-internal-move ap-core] - :: - =/ =internal-move p.possibly-internal-move - =^ tel cache.current-agent (~(slot wa cache.current-agent) 3 vase) - =^ res ap-core $(vase tel) - =/ possibly-internal-moves - ?: ?=(%.n -.res) - res - [%.y [internal-move p.res]] - :: - [possibly-internal-moves ap-core] - :: +ap-handle-result: handle result. - :: - ++ ap-handle-result - ~/ %ap-handle-result - |= =vase - ^- [(unit tang) _ap-core] - :: - ?: ?=(@ q.vase) - =/ =tang (ap-tang "ap-handle-result: invalid product (atom)") - [(some tang) ap-core] - :: - =^ hed cache.current-agent (~(slot wa cache.current-agent) 2 vase) - =^ possibly-internal-moves ap-core (ap-safe hed) - ?: ?=(%.n -.possibly-internal-moves) - =/ =tang p.possibly-internal-moves - [(some tang) ap-core] - :: - =/ internal-moves p.possibly-internal-moves - =^ tel cache.current-agent (~(slot wa cache.current-agent) 3 vase) - =^ possibly-vase ap-core (ap-verify-core tel) - :: - ?: ?=(%.n -.possibly-vase) - =/ =tang p.possibly-vase - [(some tang) ap-core] - :: - =/ next - %_ ap-core - agent-moves (weld (flop internal-moves) agent-moves) - running-state.current-agent p.possibly-vase - == - :: - [~ next] - :: +ap-verify-core: verify core. - :: - ++ ap-verify-core - ~/ %ap-verify-core - |= vax=vase - ^- [(each vase tang) _ap-core] - :: - =/ received-type p.vax - =/ running-type p.running-state.current-agent - =^ nests cache.current-agent - (~(nest wa cache.current-agent) running-type received-type) - :: - =/ possibly-vase - ?. nests - =/ =tang (ap-tang "invalid core") - [%.n tang] - [%.y vax] - :: - [possibly-vase ap-core] - :: +ap-slam: virtual slam. - :: - ++ ap-slam - ~/ %ap-slam - |= [=term gat=vase arg=vase] - ^- [(each vase tang) _ap-core] - :: - =/ virtual - =/ =type [%cell p.gat p.arg] - =/ =hoon [%cnsg [%$ ~] [%$ 2] [%$ 3] ~] - %- mule - |. (~(mint wa cache.current-agent) type hoon) - :: - ?: ?=(%.n -.virtual) - =/ =tang (ap-tang "call: {}: type mismatch") - =/ sam (~(peek ut p.gat) %free 6) - =/ print - (slog >%ap-slam-mismatch< ~(duck ut p.arg) ~(duck ut sam) ~) - (print [[%.n tang] ap-core]) - :: - =/ =worm +>.virtual - =/ =vase +<.virtual - =/ =type p.vase - =/ nock q.vase - =/ ton (mock [[q.gat q.arg] nock] ap-namespace-view) - =/ possibly-vase - ?- -.ton - %0 [%.y type p.ton] - %1 [%.n (turn p.ton |=(a=* (smyt (path a))))] - %2 [%.n p.ton] - == - :: - =/ next ap-core(cache.current-agent worm) - [possibly-vase next] - :: +ap-namespace-view: namespace view. - :: - ++ ap-namespace-view (sloy ska) - :: +ap-tang: standard tang. - :: - ++ ap-tang - |= =tape - ^- tang - :: - =/ =tank [%leaf (weld "gall: {}: " tape)] - [tank ~] - :: +ap-atomic-vase: atomic vase. - :: - ++ ap-atomic-vase - |= [=term =atom] - ^- vase - :: - =/ =type [%atom term (some atom)] - [type atom] - :: +ap-vain: card to vane. - :: - ++ ap-vain - |= =term - ^- (unit @tas) - :: - ?+ term ~& [%ap-vain term] - ~ - %bonk `%a - %build `%f - %cash `%a - %conf `%g - %conf-mall `%m - %cred `%c - %crew `%c - %crow `%c - %deal `%g - %deal-mall `%m - %dirk `%c - %drop `%c - %flog `%d - %goad `%g - %info `%c - %init `%m - %keep `%f - %kill `%f - %knob `%d - %look `%j - %listen `%j - %merg `%c - %mont `%c - %moon `%j - %nuke `%a - %ogre `%c - %perm `%c - %rest `%b - %rekey `%j - %wait `%b - %want `%a - %warp `%c - %wash `%g - %wipe `%f - %request `%i - %cancel-request `%i - %serve `%e - %connect `%e - %disconnect `%e - %rule `%e - == - -- - -- -:: +call: request -:: -++ call - ~% %gall-call +> ~ - |= [=duct hic=(hypo (hobo task:able))] - ^- [(list move) _gall-payload] - :: - ~| [%gall-call-failed duct q.hic] - :: make sure our task is hard - :: - =/ =task:able - ?. ?=(%soft -.q.hic) - q.hic - ;; task:able p.q.hic - :: - =/ initialised (mo-abed:mo duct) - ?- -.task - %conf - =/ =dock p.task - =/ =ship p.dock - ?. =(our ship) - ~& [%gall-not-ours ship] - [~ gall-payload] - :: - => (mo-boot:initialised q.dock q.task) - mo-abet - :: - %deal - =/ =sock p.task - =/ =internal-task q.task - ?. =(q.sock our) - ?> =(p.sock our) - => (mo-handle-foreign-request:initialised q.sock internal-task) - mo-abet - :: - => (mo-handle-local:initialised p.sock internal-task) - mo-abet - :: - %goad - mo-abet:(mo-goad:initialised force.task agent.task) - :: - %init - =/ payload gall-payload(system-duct.agents.state duct) - [~ payload] - :: - %trim - :: reuse %wash task to clear caches on memory-pressure - :: - :: XX cancel subscriptions if =(0 trim-priority) ? - :: - ~> %slog.[0 leaf+"gall: trim: clearing caches"] - =/ =move [duct %pass / %g [%wash ~]] - [[move ~] gall-payload] - :: - %vega - [~ gall-payload] - :: - %west - =/ =ship p.task - =/ =path q.task - =/ =noun r.task - :: - ?> ?=([?(%ge %gh) @ ~] path) - =/ agent-name i.t.path - :: - ?: ?=(%ge i.path) - =/ mes ;;((pair @ud forward-ames) noun) - => (mo-handle-forward:initialised ship agent-name mes) - mo-abet - :: - =/ mes ;;((pair @ud reverse-ames) noun) - => (mo-handle-backward:initialised ship agent-name mes) - mo-abet - :: - %wash - =. running.agents.state - (~(run by running.agents.state) |=(=agent agent(cache *worm))) - [~ gall-payload] - :: - %wegh - =/ blocked - =/ queued (~(run by blocked.agents.state) |=(blocked [%.y +<])) - (sort ~(tap by queued) aor) - :: - =/ running - =/ active (~(run by running.agents.state) |=(agent [%.y +<])) - (sort ~(tap by active) aor) - :: - =/ =mass - :+ %gall %.n - :~ [%foreign %.y contacts.agents.state] - [%blocked %.n blocked] - [%active %.n running] - [%dot %.y state] - == - :: - =/ moves - =/ =move [duct %give %mass mass] - [move ~] - :: - [moves gall-payload] - == -:: +load: recreate vane -:: -++ load - => |% - +$ all-states - $% state-0 - state-1 - == - :: - +$ state-0 - $: %0 - =agents-0 - == - :: - +$ agents-0 - $: system-duct=duct - contacts=(map ship foreign-0) - running=(map term agent) - blocked=(map term blocked) - == - :: - +$ foreign-0 - $: =rift - index=@ud - index-map=(map duct @ud) - duct-map=(map @ud duct) - == - :: - ++ upgrade-0 - |= s=state-0 - ^- state-1 - :- %1 - %= +.s - contacts.agents-0 - %- ~(run by contacts.agents-0.s) - |= foreign-0 - ^- foreign - [index index-map duct-map] - == - :: - ++ state-1 ^state - -- - |= old=all-states - ^+ gall-payload - :: - =? old ?=(%0 -.old) - (upgrade-0 old) - ?> ?=(%1 -.old) - gall-payload(state old) -:: +scry: standard scry -:: -++ scry - ~/ %gall-scry - |= [fur=(unit (set monk)) =term =shop =desk =coin =path] - ^- (unit (unit cage)) - ?. ?=(%.y -.shop) - ~ - :: - =/ =ship p.shop - ?: ?& =(%u term) - =(~ path) - =([%$ %da now] coin) - =(our ship) - == - =/ =vase !>((~(has by running.agents.state) desk)) - =/ =cage [%noun vase] - (some (some cage)) - :: - ?. =(our ship) - ~ - :: - ?. =([%$ %da now] coin) - ~ - :: - ?. (~(has by running.agents.state) desk) - (some ~) - :: - ?. ?=(^ path) - ~ - :: - =/ initialised mo-abed:mo - =/ =routes [~ ship] - (mo-peek:initialised desk routes term path) -:: +stay: save without cache -:: -++ stay state -:: +take: response -:: -++ take - ~/ %gall-take - |= [=wire =duct hin=(hypo sign-arvo)] - ^- [(list move) _gall-payload] - :: - ~| [%gall-take-failed wire] - ?> ?=([?(%sys %use) *] wire) - =/ initialised (mo-abed:mo duct) - =/ =sign-arvo q.hin - => - ?- i.wire - %sys (mo-handle-sys:initialised t.wire sign-arvo) - %use (mo-handle-use:initialised t.wire hin) - == - mo-abet ---