diff --git a/.travis/test.js b/.travis/test.js index 996a10dc64..aff7302e28 100644 --- a/.travis/test.js +++ b/.travis/test.js @@ -82,6 +82,26 @@ function barMass(urb) { }) } +function aqua(urb) { + return urb.line("|start %ph") + .then(function(){ + return urb.line(":ph %init"); + }) + .then(function(){ + return urb.line(":aqua &pill +solid"); + }) + .then(function(){ + urb.every(/TEST [^ ]* FAILED/, function(arg){ + throw Error(arg); + }); + return urb.line(":ph %run-all-tests"); + }) + .then(function(){ + return urb.expectEcho("ALL TESTS SUCCEEDED") + .then(function(){ return urb.resetListeners(); }) + }) +} + Promise.resolve(urbit) .then(actions.safeBoot) .then(function(){ @@ -93,6 +113,9 @@ Promise.resolve(urbit) .then(function(){ return barMass(urbit); }) +.then(function(){ + return aqua(urbit); +}) .then(function(){ return rePill(urbit); }) diff --git a/README.md b/README.md new file mode 100644 index 0000000000..738b6b1f6c --- /dev/null +++ b/README.md @@ -0,0 +1,64 @@ +# Arvo + +A clean-slate operating system. + +## Usage + +To run Arvo, you'll need [Urbit](https://github.com/urbit/urbit/). To install Urbit and run Arvo please follow the instructions in the [getting started docs](https://urbit.org/docs/getting-started/). You'll be on the live network in a few minutes. + +If you're doing development on Arvo, keep reading. + +## Documentation + +Find Arvo's documentation [on urbit.org](https://urbit.org/docs/learn/arvo/). + +## Development + +To boot a fake ship from your development files, run `urbit` with the following arguments: + +``` +urbit -F zod -A /path/to/arvo -c fakezod +``` + +Mount Arvo's filesystem allows you to update its contents through Unix. To do so, run `|mount` in dojo. It is most common to `|mount /=home=`. + +To create a custom pill (bootstrapping object) from the files loaded into the home desk, run `.my/pill +solid`. Your pill will appear in `/path/to/fakezod/.urb/put/my.pill`. + +To boot a fake ship with a custom pill, use the `-B` flag: + +``` +urbit -F zod -A /path/to/arvo -B /path/to.pill -c fakezod +``` + +To run all tests in `/tests`, run `+test` in dojo. `+test /some/path` would only run all tests in `/tests/some/path`. + +## Contributing + +Contributions of any form are more than welcome! If something doesn't seem right, and there is no issue about it yet, feel free to open one. + +If you're looking to make code contributions, a good place to start might be the [good contributor issues](https://github.com/urbit/arvo/issues?q=is%3Aopen+is%3Aissue+label%3A%22good+contributor+issue%22). + +## Maintainers + +Most parts of Arvo have dedicated maintainers. + +* `/sys/hoon`: @pilfer-pandex (~pilfer-pandex) +* `/sys/zuse`: @pilfer-pandex (~pilfer-pandex) +* `/sys/arvo`: @jtobin (~nidsut-tomdun) +* `/sys/vane/ames`: @belisarius222 (~rovnys-ricfer) & @joemfb (~master-morzod) +* `/sys/vane/behn`: @belisarius222 (~rovnys-ricfer) +* `/sys/vane/clay`: @philipcmonk (~wicdev-wisryt) +* `/sys/vane/dill`: @bernardodelaplaz (~rigdyn-sondur) +* `/sys/vane/eyre`: @eglaysher (~littel-ponnys) +* `/sys/vane/ford`: @belisarius222 (~rovnys-ricfer) & @eglaysher (~littel-ponnys) +* `/sys/vane/gall`: @jtobin (~nidsut-tomdun) +* `/sys/vane/jael`: @fang- (~palfun-foslup) & @joemfb (~master-morzod) +* `/app/acme`: @joemfb (~master-morzod) +* `/app/dns`: @joemfb (~master-morzod) +* `/app/hall`: @fang- (~palfun-foslup) +* `/app/talk`: @fang- (~palfun-foslup) +* `/lib/test`: @eglaysher (~littel-ponnys) + +## Contact + +We are using our new UI, Landscape, to run a few experimental cities. If you have an Azimuth point, please send us your planet name at [support@urbit.org](mailto:support@urbit.org) to request access. \ No newline at end of file diff --git a/app/aqua-ames.hoon b/app/aqua-ames.hoon new file mode 100644 index 0000000000..96e77f8092 --- /dev/null +++ b/app/aqua-ames.hoon @@ -0,0 +1,83 @@ +:: 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/app/aqua-behn.hoon b/app/aqua-behn.hoon new file mode 100644 index 0000000000..ee65d4b51f --- /dev/null +++ b/app/aqua-behn.hoon @@ -0,0 +1,125 @@ +/- 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 ~] + ^- (quip move _this) + =. this apex =< abet + ?> ?=([@ *] way) + =/ who (,@p (slav %p i.way)) + abet-pe:(take-wake:(pe who) t.way ~) +:: +++ pe + |= who=ship + =+ (fall (~(get 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 ~] + ~? debug=| [who=who %aqua-behn-wake now] + =. next-timer ~ + =. this + %- emit-aqua-events + [%event who [//behn/0v1n.2m9vh %wake ~]]~ + ..abet-pe + -- +-- diff --git a/app/aqua-dill.hoon b/app/aqua-dill.hoon new file mode 100644 index 0000000000..c7b93b0e1b --- /dev/null +++ b/app/aqua-dill.hoon @@ -0,0 +1,78 @@ +:: 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 + this +-- diff --git a/app/aqua-eyre.hoon b/app/aqua-eyre.hoon new file mode 100644 index 0000000000..f40f5f8c4c --- /dev/null +++ b/app/aqua-eyre.hoon @@ -0,0 +1,157 @@ +:: 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 + =+ (fall (~(get 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 %they num 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/app/aqua.hoon b/app/aqua.hoon new file mode 100644 index 0000000000..0c15a412be --- /dev/null +++ b/app/aqua.hoon @@ -0,0 +1,546 @@ +:: 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 +=, 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 + =+ (fall (~(get 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 (slum poke tym ue) + =. snap +.poke-result + =. ..abet-pe (publish-event tym ue) + =. ..abet-pe (handle-effects ((list ovum) -.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 %ford + == + =/ 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) + :: + [%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/0v1n.2m9vh %born ~] + [//http/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] + (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) [%cx pax]) +:: +:: Get all created ships +:: +++ peek-x-ships + |= pax=path + ^- (unit (unit [%noun (list ship)])) + ?. ?=(~ pax) + ~ + :^ ~ ~ %noun + `(list ship)`(turn ~(tap by piers) head) +:: +:: 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/app/ph.hoon b/app/ph.hoon new file mode 100644 index 0000000000..b57b48dea9 --- /dev/null +++ b/app/ph.hoon @@ -0,0 +1,477 @@ +:: Test the pH of your aquarium. See if it's safe to put in real fish. +:: +:: usage: +:: :aqua [%run-test %test-add] +:: +:: TODO: +:: - Restore a fleet +:: - Compose tests +:: +/- aquarium +/+ ph +=, aquarium +=, ph +=> $~ |% + +$ 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 + raw-test-cores=(map term raw-test-core) + test-core=(unit test-core-state) + other-state + == + :: + +$ test-core-state + $: hers=(list ship) + cor=raw-test-core + effect-log=(list [who=ship uf=unix-effect]) + == + :: + +$ other-state + $: test-qeu=(qeu term) + results=(list (pair term ?)) + == + -- +=, gall +=/ vane-apps=(list term) + ~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre] +|_ $: hid=bowl + state + == +++ this . +++ test-lib ~(. ^test-lib our.hid) +:: +:: Tests that will be run automatically with :ph %run-all-tests +:: +++ auto-tests + =, test-lib + ^- (list (pair term raw-test-core)) + :~ + :- %boot-bud + (galaxy ~bud) + :: + :- %add + ^- raw-test-core + %+ compose-tests (galaxy ~bud) + %+ stateless-test + %add + |_ now=@da + ++ start + (dojo ~bud "[%test-result (add 2 3)]") + :: + ++ route + |= [who=ship uf=unix-effect] + (expect-dojo-output ~bud who uf "[%test-result 5]") + -- + :: + :- %hi + %+ compose-tests + %+ compose-tests + (galaxy ~bud) + (galaxy ~dev) + %+ stateless-test + %hi + |_ now=@da + ++ start + (dojo ~bud "|hi ~dev") + :: + ++ route + |= [who=ship uf=unix-effect] + (expect-dojo-output ~bud who uf "hi ~dev successful") + -- + :: + :- %boot-planet + (planet ~linnup-torsyx) + :: + :- %hi-grandparent + %+ compose-tests (planet ~linnup-torsyx) + %+ stateless-test + %hi-grandparent + |_ now=@da + ++ start + (dojo ~linnup-torsyx "|hi ~bud") + :: + ++ route + |= [who=ship uf=unix-effect] + (expect-dojo-output ~linnup-torsyx who uf "hi ~bud successful") + -- + :: + :- %second-cousin-hi + %+ compose-tests + %+ compose-tests (planet ~mitnep-todsut) + (planet ~haplun-todtus) + %+ stateless-test + %second-cousin-hi + |_ now=@da + ++ start + (dojo ~haplun-todtus "|hi ~mitnep-todsut") + :: + ++ route + |= [who=ship uf=unix-effect] + (expect-dojo-output ~haplun-todtus who uf "hi ~mitnep-todsut successful") + -- + :: + :- %change-file + %+ compose-tests (galaxy ~bud) + (touch-file ~bud %home) + :: + :- %child-sync + %+ compose-tests + %+ compose-tests + (star ~marbud) + (touch-file ~bud %base) + (check-file-touched ~marbud %home) + == +:: +:: Tests that will not be run automatically. +:: +:: Some valid reasons for not running a test automatically: +:: - Nondeterministic +:: - Depends on external services +:: - Is very slow +:: +++ manual-tests + =, test-lib + ^- (list (pair term raw-test-core)) + :~ :- %boot-from-azimuth + %+ compose-tests + %+ compose-tests + (raw-ship ~bud `(dawn:azimuth ~bud)) + (touch-file ~bud %home) + :: %- assert-happens + :: :~ + :: == + *raw-test-core + :: + :- %simple-add + %+ compose-tests (galaxy ~bud) + %+ stateless-test + %add + ^- stateless-test-core + |_ now=@da + ++ start + =/ command "[%test-result (add 2 3)]" + :~ [%event ~bud //term/1 %belt %txt ((list @c) command)] + [%event ~bud //term/1 %belt %ret ~] + == + :: + ++ route + |= [who=ship uf=unix-effect] + ?. (is-dojo-output ~bud who uf "[%test-result 5]") + ~ + [%test-done &]~ + -- + :: + :- %count + %+ compose-tests (galaxy ~bud) + %+ porcelain-test + %state + =| count=@ + |_ now=@da + ++ start + ^- (quip ph-event _..start) + [(dojo ~bud "\"count: {}\"") ..start] + :: + ++ route + |= [who=ship uf=unix-effect] + ^- (quip ph-event _..start) + ?. (is-dojo-output ~bud who uf "\"count: {}\"") + [~ ..start] + ?: (gte count 10) + [[%test-done &]~ ..start] + =. count +(count) + start + -- + :: + :- %break-behn + %+ compose-tests + %+ compose-tests + (galaxy ~bud) + (galaxy ~dev) + ^- raw-test-core + |_ now=@da + ++ label %break-behn + ++ ships ~ + ++ start + [(dojo ~bud "|hi ~dev") ..start] + :: + ++ route + |= [who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + ?: ?=(%doze -.q.uf) + [| ~ ..start] + :- & :_ ..start + (expect-dojo-output ~bud who uf "hi ~dev successful") + -- + == +:: +++ install-tests + ^+ this + =. raw-test-cores + (~(uni by (malt auto-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 + "TEST {(trip lab)} SUCCESSFUL" + "TEST {(trip lab)} FAILED" + [%| 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 + :_ 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] + =/ res=[events=(list ph-event) new-state=raw-test-core] + ~(start (~(got by raw-test-cores) lab) now.hid) + => .(test-core `(unit test-core-state)`test-core) + =. test-core `[ships . ~]:new-state.res + =^ moves-1 this (subscribe-to-effects lab ships.new-state.res) + =^ moves-2 this (run-events lab events.res) + [:(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-noun + |= arg=* + ^- (quip move _this) + ?+ arg ~|(%bad-noun-arg !!) + %init + [init-vanes this] + :: + %run-all-tests + =. test-qeu + %- ~(gas to test-qeu) + (turn auto-tests head) + run-test + :: + [%run-test lab=@tas] + ?. (~(has by raw-test-cores) lab.arg) + ~& [%no-test lab.arg] + `this + =. test-qeu (~(put to test-qeu) lab.arg) + run-test + :: + %cancel + =^ moves-1 this (finish-test %last |) + =. test-qeu ~ + =^ moves-2 this run-test + [:(weld moves-1 moves-2) this] + :: + %print + =/ log effect-log:(need test-core) + ~& lent=(lent log) + ~& %+ roll 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 lab] + `this + =+ |- ^- $: thru-effects=(list unix-effect) + events=(list ph-event) + cor=_u.test-core + == + ?~ ufs.afs + [~ ~ u.test-core] + =. effect-log.u.test-core + [[who i.ufs]:afs effect-log.u.test-core] + =+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-core] + (~(route cor.u.test-core now.hid) who.afs i.ufs.afs) + =. cor.u.test-core cor + =+ $(ufs.afs t.ufs.afs) + :+ ?: thru + [i.ufs.afs thru-effects] + thru-effects + (weld events-1 events) + cor + =. test-core `cor + => .(test-core `(unit test-core-state)`test-core) + =/ 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/gen/aqua/dojo.hoon b/gen/aqua/dojo.hoon new file mode 100644 index 0000000000..5d9fa23b03 --- /dev/null +++ b/gen/aqua/dojo.hoon @@ -0,0 +1,14 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship command=tape] ~] +:- %aqua-events +%+ turn + ^- (list unix-event) + :~ [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) command)] + [//term/1 %belt %ret ~] + == +|= ue=unix-event +[%event her ue] diff --git a/gen/aqua/file.hoon b/gen/aqua/file.hoon new file mode 100644 index 0000000000..f9d3c72837 --- /dev/null +++ b/gen/aqua/file.hoon @@ -0,0 +1,9 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship pax=path] ~] +:- %aqua-events :_ ~ +:+ %event her +?> ?=([@ @ @ *] pax) +=/ file [/text/plain (as-octs:mimes:html .^(@ %cx pax))] +[//sync/0v1n.2m9vh %into i.t.pax | [t.t.t.pax `file]~]~ diff --git a/gen/aqua/init.hoon b/gen/aqua/init.hoon new file mode 100644 index 0000000000..4a47a73b76 --- /dev/null +++ b/gen/aqua/init.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship] ~] +:- %aqua-events +[%init-ship her ~]~ diff --git a/gen/aqua/raw-event.hoon b/gen/aqua/raw-event.hoon new file mode 100644 index 0000000000..b6d53e65a2 --- /dev/null +++ b/gen/aqua/raw-event.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [her=ship ue=unix-event] ~] +:- %aqua-events +[%event her ue]~ diff --git a/gen/aqua/restore-fleet.hoon b/gen/aqua/restore-fleet.hoon new file mode 100644 index 0000000000..3a38cdaee1 --- /dev/null +++ b/gen/aqua/restore-fleet.hoon @@ -0,0 +1,6 @@ +/- aquarium +=, aquarium +:- %say +|= [* [label=@ta] ~] +:- %aqua-events +[%snap-ships label]~ diff --git a/gen/aqua/snap-fleet.hoon b/gen/aqua/snap-fleet.hoon new file mode 100644 index 0000000000..6fcdf0ab35 --- /dev/null +++ b/gen/aqua/snap-fleet.hoon @@ -0,0 +1,8 @@ +/- aquarium +=, aquarium +:- %say +|= [[now=@da eny=@uvJ bec=beak] [label=@ta] ships=(list ship)] +:- %aqua-events +=? ships ?=(~ ships) + .^((list ship) %gx /(scot %p p.bec)/aqua/(scot %da now)/ships/noun) +[%snap-ships label ships]~ diff --git a/lib/hood/kiln.hoon b/lib/hood/kiln.hoon index 69f0a8ce98..4368d2e8a7 100644 --- a/lib/hood/kiln.hoon +++ b/lib/hood/kiln.hoon @@ -382,10 +382,12 @@ ++ writ |= rot=riot ?~ rot - %^ spam - leaf+"bad %writ response" - (render "on sync" sud her syd) - ~ + =. +>.$ + %^ spam + leaf+"sync cancelled, retrying" + (render "on sync" sud her syd) + ~ + start-sync =. let ?. ?=($w p.p.u.rot) let ud:((hard cass:clay) q.q.r.u.rot) =/ =wire /kiln/sync/[syd]/(scot %p her)/[sud] :: germ: merge mode for sync merges @@ -414,6 +416,13 @@ :: ++ mere |= mes=(each (set path) (pair term tang)) + ?: ?=([%| %ali-sunk *] mes) + =. +>.$ + %^ spam + leaf+"merge cancelled because sunk, restarting" + (render "on sync" sud her syd) + ~ + start-sync:stop =. let +(let) =. +>.$ %- spam diff --git a/lib/ph.hoon b/lib/ph.hoon new file mode 100644 index 0000000000..ddf3e0921f --- /dev/null +++ b/lib/ph.hoon @@ -0,0 +1,473 @@ +:: +:::: /hoon/ph/lib + :: +/- aquarium +=, aquarium +|% +:: Defines a complete integration test. +:: +++ raw-test-core + $_ ^| + |_ now=@da + :: + :: Unique name, used as a cache label. + :: + ++ label *@ta + :: + :: List of ships that are part of the test. + :: + :: We'll only hear effects from these ships, and only these will + :: be in the cache points. + :: + ++ ships *(list ship) + :: + :: Called first to kick off the test. + :: + ++ start *(quip ph-event _^|(..start)) + :: + :: Called on every effect from a ship. + :: + :: The loobean in the return value says whether we should pass on + :: the effect to vane drivers. Usually this should be yes. + :: + ++ route |~([ship unix-effect] *[? (quip ph-event _^|(..start))]) + -- +:: +:: A simpler interface for when you don't need all the power. +:: +:: Doesn't allwow you to explicitly subscribe to certain ships or +:: blocking certain effects from going to their usual vane drivers. +:: +:: Use with +porcelain-test +:: +++ porcelain-test-core + $_ ^| + |_ now=@da + :: Called first to kick off the test. + :: + ++ start *(quip ph-event _^|(..start)) + :: + :: Called on every effect from a ship. + :: + ++ route |~([ship unix-effect] *(quip ph-event _^|(..start))) + -- +:: +:: A simpler interface for when you don't need test state. +:: +:: Use with +stateless-test +:: +++ stateless-test-core + $_ ^| + |_ now=@da + :: Called first to kick off the test. + :: + ++ start *(list ph-event) + :: + :: Called on every effect from a ship. + :: + ++ route |~([ship unix-effect] *(list ph-event)) + -- +:: +++ ph-event + $% [%test-done p=?] + aqua-event + == +:: +:: Call with a +porecelain-test-core create a stateless test. +:: +++ porcelain-test + |= [label=@ta porcelain=porcelain-test-core] + ^- raw-test-core + |_ now=@da + ++ label ^label + ++ ships ~ + ++ start + =^ events porcelain ~(start porcelain now) + [events ..start] + :: + ++ route + |= args=[ship unix-effect] + =^ events porcelain (~(route porcelain now) args) + [& events ..start] + -- +:: +:: Call with a +stateless-test-core create a stateless test. +:: +++ stateless-test + |= [label=@tas stateless=stateless-test-core] + %+ porcelain-test + label + ^- porcelain-test-core + |_ now=@da + ++ start + [~(start stateless now) ..start] + :: + ++ route + |= args=[ship unix-effect] + [(~(route stateless now) args) ..start] + -- +:: +:: Turn [ship (list unix-event)] into (list ph-event) +:: +++ send-events-to + |= [who=ship what=(list unix-event)] + ^- (list ph-event) + %+ turn what + |= ue=unix-event + [%event who ue] +:: +:: Start a ship (low-level; prefer +raw-ship) +:: +++ init + |= [who=ship keys=(unit dawn-event)] + ^- (list ph-event) + [%init-ship who keys]~ +:: +:: factor out send-events-to +:: +++ dojo + |= [who=ship what=tape] + ^- (list ph-event) + %+ send-events-to who + ^- (list unix-event) + :~ + [//term/1 %belt %ctl `@c`%e] + [//term/1 %belt %ctl `@c`%u] + [//term/1 %belt %txt ((list @c) what)] + [//term/1 %belt %ret ~] + == +:: +:: Inject a file into a ship +:: +++ insert-file + |= [who=ship des=desk pax=path txt=@t] + ^- (list ph-event) + ?> ?=([@ @ @ *] pax) + =/ file [/text/plain (as-octs:mimes:html txt)] + %+ send-events-to who + :~ + [//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~] + == +:: +:: Checks whether the given event is a dojo output blit containing the +:: given tape +:: +++ is-dojo-output + |= [who=ship her=ship uf=unix-effect what=tape] + ?& =(who her) + ?=(%blit -.q.uf) + :: + %+ lien p.q.uf + |= =blit:dill + ?. ?=(%lin -.blit) + | + !=(~ (find what p.blit)) + == +:: +:: Test is successful if +is-dojo-output +:: +++ expect-dojo-output + |= [who=ship her=ship uf=unix-effect what=tape] + ^- (list ph-event) + ?. (is-dojo-output who her uf what) + ~ + [%test-done &]~ +:: +:: Check whether the given event is an ergo +:: +++ is-ergo + |= [who=ship her=ship uf=unix-effect] + ?& =(who her) + ?=(%ergo -.q.uf) + == +:: +++ azimuth + |% + ++ dawn + |= who=ship + ^- dawn-event + :* (need (private-key who)) + (^sein:title who) + czar + ~[~['arvo' 'netw' 'ork']] + 0 + `(need (de-purl:html 'http://localhost:8545')) + ~ + == + :: + ++ czar + ^- (map ship [life pass]) + %- my + ^- (list (pair ship [life pass])) + %+ murn (gulf 0x0 0xff) + |= her=ship + ^- (unit [ship life pass]) + =/ pub (public-key her) + ?~ pub + ~ + `[her u.pub] + :: + ++ private-key + |= who=ship + =- (~(get by -) who) + ^- (map ship seed:able:jael) + %- my + :~ [~bud ~bud 1 'BbudB' ~] + [~dev ~dev 1 'Bdev' ~] + == + :: + ++ public-key + |= who=ship + ^- (unit [life pass]) + =/ priv (private-key who) + ?~ priv + ~ + =/ cub (nol:nu:crub:crypto key.u.priv) + `[lyf.u.priv pub:ex:cub] + -- +:: +++ test-lib + |_ our=ship + :: + :: Run one test, then the next. + :: + :: Caches the result of the first test. + :: + ++ compose-tests + |= [a=raw-test-core b=raw-test-core] + ^- raw-test-core + =/ done-with-a | + => + |% + ++ filter-a + |= [now=@da events=(list ph-event)] + ^- (quip ph-event _..filter-a) + =+ ^- [done=(list ph-event) other-events=(list ph-event)] + %+ skid events + |= e=ph-event + =(%test-done -.e) + ?~ done + [other-events ..filter-a] + ?> ?=(%test-done -.i.done) + ?. p.i.done + [[%test-done |]~ ..filter-a] + =. done-with-a & + =/ snap-event [%snap-ships label:a ships:a] + =^ events-start b ~(start b now) + [(welp other-events [snap-event events-start]) ..filter-a] + -- + |_ now=@da + :: + :: Cache lookup label + :: + ++ label `@tas`:((cury cat 3) label:a '--' label:b) + :: + :: Union of ships in a and b + :: + ++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b))) + :: + :: Start with start of a + :: + ++ start + ^- (quip ph-event _..start) + =/ have-cache + (scry-aqua ? now /fleet-snap/[label:a]/noun) + ?: have-cache + ~& [%caching-in label:a label] + =. done-with-a & + =/ restore-event [%restore-snap label:a] + =^ events-start b ~(start b now) + =^ events ..filter-a (filter-a now restore-event events-start) + [events ..start] + =^ events a ~(start a now) + [events ..start] + :: + :: Keep going on a until it's done. If success, go to b. + :: + :: In theory, we should be able to just swap out the whole core + :: for b, but in practice the types are hard, and we generally + :: try to avoid changing the structure of a core in the middle + :: like that. + :: + ++ route + |= [who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + ?: done-with-a + =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] + (~(route b now) who uf) + =. b cor + [thru events ..start] + =+ ^- [thru=? events=(list ph-event) cor=raw-test-core] + (~(route a now) who uf) + =. a cor + =^ events ..filter-a (filter-a now events) + [thru events ..start] + -- + :: + :: Don't use directly unless you've already started any parent. + :: + :: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors. + :: + ++ raw-ship + |= [her=ship keys=(unit dawn-event)] + ^- raw-test-core + |_ now=@da + ++ label :((cury cat 3) 'init-' (scot %p her) '-' (scot %uw (mug (fall keys *dawn-event)))) + ++ ships ~[her] + ++ start + ^- (quip ph-event _..start) + [(init her keys) ..start] + :: + ++ route + |= [who=ship uf=unix-effect] + ^- [? (quip ph-event _..start)] + :- & + :_ ..start + %- zing + :: This is a pretty bad heuristic, but in general galaxies will + :: hit the first of these cases, and other ships will hit the + :: second. + :: + :~ + ?. %^ is-dojo-output her who :- uf + "+ /{(scow %p her)}/base/2/web/testing/udon" + ~ + [%test-done &]~ + :: + ?. %^ is-dojo-output her who :- uf + "is your neighbor" + ~ + [%test-done &]~ + == + -- + :: + ++ galaxy + |= her=ship + ?> =(%czar (clan:title her)) + (raw-ship her ~) + :: + ++ star + |= her=ship + ?> =(%king (clan:title her)) + %+ compose-tests (galaxy (^sein:title her)) + (raw-ship her ~) + :: + ++ planet + |= her=ship + ?> =(%duke (clan:title her)) + %+ compose-tests (star (^sein:title her)) + (raw-ship her ~) + :: + ++ ship-with-ancestors + |= her=ship + %. her + ?- (clan:title her) + %czar galaxy + %king star + %duke planet + %earl ~|(%moon-not-implemented !!) + %pawn ~|(%comet-not-implemented !!) + == + :: + :: Touches /sur/aquarium/hoon on the given ship. + :: + ++ touch-file + |= [her=ship des=desk] + %+ porcelain-test + (cat 3 'touch-file-' (scot %p her)) + =| [warped=@t change-sent=_|] + ^- porcelain-test-core + |_ now=@da + ++ start + ^- (pair (list ph-event) _..start) + :_ ..start + (dojo her "|mount /={(trip des)}=") + :: + ++ route + |= [who=ship uf=unix-effect] + ^- (quip ph-event _..start) + ?. (is-ergo her who uf) + `..start + ?. change-sent + =/ host-pax + /(scot %p our)/home/(scot %da now)/sur/aquarium/hoon + =. warped (cat 3 '=> . ' .^(@t %cx host-pax)) + =. change-sent & + [(insert-file her des host-pax warped) ..start] + :_ ..start + =/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun + ?: =(warped (need (scry-aqua (unit @) now pax))) + [%test-done &]~ + ~ + -- + :: + :: Check that /sur/aquarium/hoon has been touched, as by ++touch-file + :: + ++ check-file-touched + |= [her=ship des=desk] + %+ stateless-test + (cat 3 'check-file-touched-' (scot %p her)) + |_ now=@da + ++ start + :: mounting is not strictly necessary since we check via scry, + :: but this way we don't have to check on every event, just + :: ergos (and dojo because we can't guarantee an ergo if the desk + :: is already mounted) + :: + (dojo her "|mount /={(trip des)}=") + :: + ++ route + |= [who=ship uf=unix-effect] + ^- (list ph-event) + ?. ?| (is-ergo her who uf) + (is-dojo-output her who uf ">=") + == + ~ + =/ pax /home/(scot %da now)/sur/aquarium/hoon + =/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax))) + =/ aqua-pax + ;: weld + /i/(scot %p her) + pax(- des) + /noun + == + ?: =(warped (need (scry-aqua (unit @) now aqua-pax))) + [%test-done &]~ + ~ + -- + :: + :: Reload vane from filesystem + :: + ++ reload-vane + |= [her=ship vane=term] + %+ stateless-test + :((cury cat 3) 'reload-vane-' (scot %p her) '-' vane) + |_ now=@da + ++ start + ^- (list ph-event) + =/ pax + /(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon + %- zing + :~ (dojo her "|mount /=home=") + (insert-file her %home pax .^(@t %cx pax)) + [%test-done &]~ + == + :: + ++ route + |= [who=ship uf=unix-effect] + ~ + -- + :: + :: Scry into a running aqua ship + :: + ++ scry-aqua + |* [a=mold now=@da pax=path] + .^ a + %gx + (scot %p our) + %aqua + (scot %da now) + pax + == + -- +-- diff --git a/mar/md.hoon b/mar/md.hoon new file mode 100644 index 0000000000..53051fe5b3 --- /dev/null +++ b/mar/md.hoon @@ -0,0 +1,20 @@ +:: +:::: /hoon/md/mar + :: +/? 310 +:: +=, format +=, mimes:html +|_ txt/wain +:: +++ grab :: convert from + |% + ++ mime |=({p/mite:eyre q/octs:eyre} (to-wain q.q)) + ++ noun wain :: clam from %noun + -- +++ grow + |% + ++ mime [/text/plain (as-octs (of-wain txt))] + -- +++ grad %mime +-- diff --git a/mar/pill.hoon b/mar/pill.hoon new file mode 100644 index 0000000000..15c0cdf6d5 --- /dev/null +++ b/mar/pill.hoon @@ -0,0 +1,36 @@ +:: +:::: /hoon/pill/mar + :: +/- aquarium +=, aquarium +=, mimes:html +|_ pil=pill +++ grow + |% + ++ mime [/application/octet-stream (as-octs (jam pil))] + -- +++ grab + |% + ++ noun pill + ++ mime + |= [p=mite:eyre q=octs:eyre] + =+ o=(pair ,* ,*) :: ,*) + =+ (,[boot-ova=* kernel-ova=(list o) userspace-ova=(list o)] (cue q.q)) + =/ convert + |= ova=(list o) + ^- (list unix-event) + %+ turn ova + |= ovo=o + =/ sof ((soft unix-event) ovo) + ?~ sof + ~& [%unknown-event p.ovo] + !! + ~& [%known-event (wire p.ovo) (@tas -.q.ovo)] + u.sof + :: =/ boot-ova (convert boot-ova) + =/ kernel-ova (convert kernel-ova) + =/ userspace-ova (convert userspace-ova) + [boot-ova kernel-ova userspace-ova] + -- +++ grad %mime +-- diff --git a/sur/aquarium.hoon b/sur/aquarium.hoon new file mode 100644 index 0000000000..4124088c46 --- /dev/null +++ b/sur/aquarium.hoon @@ -0,0 +1,96 @@ +:: +:: Traditionally, ovo refers to an ovum -- (pair wire card) -- and ova +:: refers to a list of them. We have several versions of each of these +:: depending on context, so we do away with that naming scheme and use +:: the following naming scheme. +:: +:: Every card is either an `event` or an `effect`. Prepended to this +:: is `unix` if it has no ship associated with it, or `aqua` if it +:: does. `timed` is added if it includes the time of the event. +:: +:: Short names are simply the first letter of each word plus `s` if +:: it's a list. +:: +|% ++$ aqua-event + $% [%init-ship who=ship keys=(unit dawn-event)] + [%pause-events who=ship] + [%snap-ships lab=term hers=(list ship)] + [%restore-snap lab=term] + [%event who=ship ue=unix-event] + == +:: ++$ aqua-effects + [who=ship ufs=(list unix-effect)] +:: ++$ aqua-events + [who=ship utes=(list unix-timed-event)] +:: ++$ aqua-boths + [who=ship ub=(list unix-both)] +:: ++$ unix-both + $% [%event unix-timed-event] + [%effect unix-effect] + == +:: ++$ unix-timed-event [tym=@da ue=unix-event] +:: ++$ unix-event + %+ pair wire + $% [%wack p=@] + [%whom p=ship] + [%live p=@ud q=(unit @ud)] + [%barn ~] + [%boot $%([%fake p=ship] [%dawn p=dawn-event])] + unix-task + == +:: ++$ unix-effect + %+ pair wire + $% [%blit p=(list blit:dill)] + [%send p=lane:ames q=@] + [%doze p=(unit @da)] + [%thus p=@ud q=(unit hiss:eyre)] + [%ergo p=@tas q=mode:clay] + [%sleep ~] + [%restore ~] + == ++$ pill + [boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)] +:: ++$ dawn-event + $: =seed:able:jael + spon=ship + czar=(map ship [=life =pass]) + turf=(list turf) + bloq=@ud + node=(unit purl:eyre) + snap=(unit snapshot:jael) + == +:: ++$ vane-move + %+ pair bone + $% [%peer wire dock path] + [%pull wire dock ~] + == +:: +++ aqua-vane-control-handler + |= [our=@p ost=bone subscribed=? command=?(%subscribe %unsubscribe)] + ^- (list vane-move) + ?- command + %subscribe + %+ weld + ^- (list vane-move) + ?. subscribed + ~ + [ost %pull /aqua [our %ph] ~]~ + ^- (list vane-move) + [ost %peer /aqua [our %ph] /effects]~ + :: + %unsubscribe + ?. subscribed + ~ + [ost %pull /aqua [our %ph] ~]~ + == +-- diff --git a/sys/arvo.hoon b/sys/arvo.hoon index ebfc0a2c8b..9ecd67a413 100644 --- a/sys/arvo.hoon +++ b/sys/arvo.hoon @@ -462,7 +462,7 @@ :: ++ hurl :: start loop |= {lac/? ovo/ovum} - ~? &(!lac !=(%belt -.q.ovo)) ["" %unix -.q.ovo p.ovo] + ~? &(!lac !=(%belt -.q.ovo)) ["" %unix -.q.ovo p.ovo now] :: ^- {p/(list ovum) q/(pair worm (list {p/@tas q/vase}))} ^- {p/(list ovum) q=(list [label=@tas =vane])} ?> ?=(^ p.ovo) @@ -643,7 +643,7 @@ :: =/ pit=vase !>(..is) :: =/ vil=vile (viol p.pit) :: cached reflexives -=| $: lac=? :: laconic bit +=| $: lac=_& :: laconic bit eny=@ :: entropy our=ship :: identity bud=vase :: %zuse diff --git a/sys/vane/clay.hoon b/sys/vane/clay.hoon index 44e7f47f88..588c9aa0e3 100644 --- a/sys/vane/clay.hoon +++ b/sys/vane/clay.hoon @@ -298,7 +298,10 @@ :: :: Foreign desk data. :: -+= rung rus/(map desk rede) :: neighbor desks +++ rung + $: rit=rift :: lyfe of 1st contact + rus=(map desk rede) :: neighbor desks + == :: :: Hash of a commit, for lookup in the object store (hut.ran) :: @@ -343,7 +346,9 @@ == == :: $: $f :: $% [%build live=? schematic=schematic:ford] :: - == == + [%keep compiler-cache=@ud build-cache=@ud] :: + [%wipe percent-to-remove=@ud] :: + == == :: $: $b :: $% {$wait p/@da} :: {$rest p/@da} :: @@ -368,6 +373,23 @@ $: @tas :: by any $% {$crud p/@tas q/(list tank)} :: == == == :: +-- +:: +:: Old state types for ++load +:: +=> |% +++ raft-1 + $: rom/room + hoy/(map ship rung-1) + ran/rang :: hashes + mon/(map term beam) + hez/(unit duct) + cez/(map @ta crew) + cue/(qeu [duct task:able]) + tip/@da + == ++= rung-1 rus/(map desk rede) +++ raft-2 raft -- => :: %utilities :: @@ -391,6 +413,7 @@ :: -- local urbit `our` :: -- current time `now` :: -- current duct `hen` +:: -- scry handler `ski` :: -- all vane state `++raft` (rarely used, except for the object store) :: -- target urbit `her` :: -- target desk `syd` @@ -428,11 +451,11 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: |% ++ de :: per desk - |= [our=ship now=@da hen=duct raft] + |= [our=ship now=@da ski=sley hen=duct raft] |= [her=ship syd=desk] :: XX ruf=raft crashes in the compiler :: - =* ruf |3.+6.^$ + =* ruf |4.+6.^$ :: =+ ^- [hun=(unit duct) rede] ?. =(our her) @@ -457,9 +480,11 @@ ?. =(our her) :: save foreign +rede :: - =/ rus rus:(fall (~(get by hoy.ruf) her) *rung) - =/ rug (~(put by rus) syd red) - ruf(hoy (~(put by hoy.ruf) her rug)) + =/ run (fall (~(get by hoy.ruf) her) *rung) + =? rit.run =(0 rit.run) + (fall (rift-scry her) *rift) + =/ rug (~(put by rus.run) syd red) + ruf(hoy (~(put by hoy.ruf) her run(rus rug))) :: save domestic +room :: %= ruf @@ -467,6 +492,20 @@ dos.rom (~(put by dos.rom.ruf) syd [qyx dom dok mer per pew]:red) == :: + :: +rift-scry: for a +rift + :: + ++ rift-scry + ~/ %rift-scry + |= who=ship + ^- (unit rift) + =; rit + ?~(rit ~ u.rit) + ;; (unit (unit rift)) + %- (sloy-light ski) + =/ pur=spur + /(scot %p who) + [[151 %noun] %j our %rift da+now pur] + :: :: Handle `%sing` requests :: ++ aver @@ -519,7 +558,8 @@ ~& [%clay-first-failure message.head.row] ~ ?: ?=([%success [%success *] [%error *]] row) - ~& [%clay-second-failure message.tail.row] + ~& %clay-second-failure + %- (slog message.tail.row) ~ ?. ?=([%success [%success *] [%success *]] row) ~ @@ -1757,8 +1797,6 @@ :* hen %pass [%foreign-x (scot %p our) (scot %p her) syd car (scot cas) pax] %f %build live=%.n %pin - :: See ++validate-plops to explain why it's not (case-to-date cas) - :: now (vale-page [her syd] peg) == @@ -2358,8 +2396,8 @@ ^+ bar ?- -.mys $ins :: insert if not exist - ?: (~(has by bar) pax) !! :: - ?: (~(has by hat) pax) !! :: + ?: (~(has by bar) pax) ~|([%ins-bar pax hen] !!) :: + ?: (~(has by hat) pax) ~|([%ins-hat pax hen] !!) :: %+ ~(put by bar) pax %- make-direct-blob ?: &(?=($mime -.p.mys) =([%hoon ~] (slag (dec (lent pax)) pax))) @@ -2823,12 +2861,14 @@ ++ me :: merge ali into bob |= {ali/(pair ship desk) alh/(unit dome) new/?} :: from =+ bob=`(pair ship desk)`[our syd] :: to + :: ?: &(?=(~ mer) !new) + :: ~& [%not-actually-merging ali=ali bob=bob hen=hen] + :: ..me =+ ^- dat/(each mery term) ?~ mer - ?: new - =+ *mery - [%& -(sor ali:+, hen hen:+, wat %null)] - [%| %not-actually-merging] + ?> new :: checked in ++take + =+ *mery + [%& -(sor ali:+, hen hen:+, wat %null)] ?. new ?: =(ali sor.u.mer) [%& u.mer] @@ -2947,7 +2987,9 @@ |= rot/riot ^+ +> ?~ rot - (error:he %bad-fetch-ali ~) + ?: (~(has by hoy) her) + (error:he %bad-fetch-ali ~) + (error:he %ali-sunk ~) =+ ^= dum :: construct an empty mime cache :: @@ -3181,7 +3223,7 @@ =+ (cat 3 %diff- nam) [%merge (scot %p p.bob) q.bob (scot %p p.ali) q.ali - ~] %f %build live=%.n %pin - (case-to-date:((de our now hen ruf) p.oth q.oth) r.oth) + (case-to-date:((de our now ski hen ruf) p.oth q.oth) r.oth) %list ^- (list schematic:ford) %+ murn ~(tap by q.bas.dat) @@ -3708,8 +3750,8 @@ :: :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: =| :: instrument state - $: $1 :: vane version - ruf/raft :: revision tree + $: ver=%2 :: vane version + ruf=raft :: revision tree == :: |= [our=ship now=@da eny=@uvJ ski=sley] :: current invocation ^? :: opaque core @@ -3725,6 +3767,18 @@ wrapped-task ((hard task:able) p.wrapped-task) :: + :: only one of these should be going at once, so queue + :: + ?: &(?=(?(%info %into %merg) -.req) |(=(now tip.ruf) ?=(^ cue.ruf))) + =/ wait=(list move) + ?^(cue.ruf ~ [hen %pass /queued-request %b %wait now]~) + =. cue.ruf (~(put to cue.ruf) [hen req]) + :: ~& [%enqueueing (turn ~(tap to cue.ruf) head)] + [wait ..^$] + (handle-task hen req) +:: +++ handle-task + |= [hen=duct req=task:able] ^+ [*(list move) ..^$] ?- -.req $boat @@ -3740,7 +3794,7 @@ =/ des ~(tap in ~(key by dos.rom.ruf)) |- ?~ des [[[hen %give %mack ~] mos] ..^^$] - =/ den ((de our now hen ruf) our i.des) + =/ den ((de our now ski hen ruf) our i.des) =^ mor ruf =< abet:wake ?: ?=(^ cew.req) den @@ -3775,30 +3829,25 @@ :: $drop =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:drop-me:den [mos ..^$] :: $info - :: second write at :now gets enqueued with a timer to be run in next event - :: - ?: =(now tip.ruf) - =. cue.ruf (~(put to cue.ruf) [hen req]) - =/ =move [hen %pass /queued-request %b %wait now] - :: - [~[move] ..^$] :: set the last date to now so we'll know to enqueue a second write :: =. tip.ruf now :: ?: =(%$ des.req) [~ ..^$] + => .(ruf `raft`ruf) :: TMI =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:(edit:den now dit.req) [mos ..^$] :: $init + ~& [%init hen] [~ ..^$(hun.rom.ruf hen)] :: $into @@ -3833,8 +3882,9 @@ $merg :: direct state up ?: =(%$ des.req) [~ ..^$] + => .(ruf `raft`ruf) :: TMI =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:abet:(start:(me:ze:den [her.req dem.req] ~ &) cas.req how.req) [mos ..^$] :: @@ -3851,7 +3901,7 @@ ?~ dos [~ ..^$] =^ mos ruf - =/ den ((de our now hen ruf) p.bem q.bem) + =/ den ((de our now ski hen ruf) p.bem q.bem) abet:(mont:den des.req bem) [mos ..^$] :: @@ -3889,11 +3939,59 @@ :: $perm =^ mos ruf - =/ den ((de our now hen ruf) our des.req) + =/ den ((de our now ski hen ruf) our des.req) abet:(perm:den pax.req rit.req) [mos ..^$] :: - $sunk [~ ..^$] + $sunk + ~& rift=[p.req q.req] + ~& desks=(turn ~(tap by dos.rom.ruf) head) + ~& hoy=(turn ~(tap by hoy.ruf) head) + :: + :: Don't clear state, because it doesn't quite work yet. + :: + ?: =(0 0) + `..^$ + :: if we sunk, don't clear clay + :: + ?: =(our p.req) + [~ ..^$] + :: cancel subscriptions + :: + =/ foreign-desk=(unit rung) + (~(get by hoy.ruf) p.req) + ?~ foreign-desk + ~& [%never-heard-of-her p.req q.req] + [~ ..^$] + ~& old-rift=rit.u.foreign-desk + ?: (gte rit.u.foreign-desk q.req) + ~& 'replaying sunk, so not clearing state' + [~ ..^$] + =/ cancel-ducts=(list duct) + %- zing ^- (list (list duct)) + %+ turn ~(tap by rus.u.foreign-desk) + |= [=desk =rede] + %+ weld + ^- (list duct) %- zing ^- (list (list duct)) + %+ turn ~(tap by qyx.rede) + |= [=wove ducts=(set duct)] + ~(tap in ducts) + ?~ ref.rede + ~ + (turn ~(tap by fod.u.ref.rede) head) + =/ cancel-moves=(list move) + %+ turn cancel-ducts + |= =duct + [duct %give %writ ~] + =/ clear-ford-cache-moves=(list move) + :~ [hen %pass /clear/keep %f %keep 0 1] + [hen %pass /clear/wipe %f %wipe 100] + [hen %pass /clear/kep %f %keep 2.048 64] + == + :: delete local state of foreign desk + :: + =. hoy.ruf (~(del by hoy.ruf) p.req) + [(weld clear-ford-cache-moves cancel-moves) ..^$] :: $vega [~ ..^$] :: @@ -3910,7 +4008,7 @@ ?> ?=($warp -.req) =* rif rif.req =^ mos ruf - =/ den ((de our now hen ruf) wer.req p.rif) + =/ den ((de our now ski hen ruf) wer.req p.rif) =< abet ?~ q.rif cancel-request:den @@ -3932,7 +4030,7 @@ =+ syd=(slav %tas i.t.pax) =+ inx=(slav %ud i.t.t.pax) =^ mos ruf - =/ den ((de our now hen ruf) wer syd) + =/ den ((de our now ski hen ruf) wer syd) abet:(take-foreign-update:den inx ((hard (unit rand)) res.req)) [[[hen %give %mack ~] mos] ..^$] :: @@ -3952,11 +4050,34 @@ :: ++ load => |% - ++ axle $%([%1 ruf=raft]) + ++ axle $% [%1 ruf-1=raft-1] + [%2 ruf-2=raft] + == -- |= old=axle ^+ ..^$ - ..^$(ruf ruf.old) + =? old ?=(%1 -.old) + ~& desks=(turn ~(tap by dos.rom.ruf-1.old) head) + ~& hoy=(turn ~(tap by hoy.ruf-1.old) head) + (load-1-2 old) + ~& hrm=[-.old ver] + ?> ?=(%2 -.old) + ~& desks=(turn ~(tap by dos.rom.ruf-2.old) head) + ~& hoy=(turn ~(tap by hoy.ruf-2.old) head) + %_(..^$ ruf ruf-2.old) +:: +++ load-1-2 + |= [%1 ruf-1=raft-1] + ^- [%2 ruf-2=raft] + :- %2 + %= ruf-1 + hoy + %- ~(rut by hoy.ruf-1) + |= [her=ship run-1=rung-1] + ^- rung + :- (fall (rift-scry her) *rift) + rus.run-1 + == :: ++ scry :: inspect |= {fur/(unit (set monk)) ren/@tas why/shop syd/desk lot/coin tyl/path} @@ -3979,14 +4100,14 @@ ?: ?=(%| -.m) ~ ?: =(p.m his) ~ `p.m - =/ den ((de our now [/scryduct ~] ruf) his syd) + =/ den ((de our now ski [/scryduct ~] ruf) his syd) =+ (aver:den for u.run u.luk tyl) ?~ - - ?~ u.- - ?: ?=(%& -.u.u.-) ``p.u.u.- ~ :: -++ stay [%1 ruf] +++ stay [%2 ruf] ++ take :: accept response |= {tea/wire hen/duct hin/(hypo sign)} ^+ [*(list move) ..^$] @@ -4001,7 +4122,10 @@ %+ bind (~(get by dos.rom.ruf) sud) |=(a=dojo dom.a) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) + ?~ mer.den + ~& [%not-actually-merging ali=[her sud] bob=[our syd] hen=hen] + [~ ruf] abet:abet:(route:(me:ze:den [her sud] kan |) sat dat) [mos ..^$] ?: ?=({$blab care @ @ *} tea) @@ -4031,7 +4155,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-inserting:den wen result.q.hin) [mos ..^$] :: @@ -4040,7 +4164,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-diffing:den wen result.q.hin) [mos ..^$] :: @@ -4049,7 +4173,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-castify:den wen result.q.hin) [mos ..^$] :: @@ -4058,7 +4182,7 @@ =+ syd=(slav %tas i.t.t.tea) =+ wen=(slav %da i.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-mutating:den wen result.q.hin) [mos ..^$] :: @@ -4066,7 +4190,7 @@ ?> ?=({@ @ ~} t.tea) =+ syd=(slav %tas i.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-patch:den result.q.hin) [mos ..^$] :: @@ -4074,7 +4198,7 @@ ?> ?=({@ @ ~} t.tea) =+ syd=(slav %tas i.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) our syd) + =/ den ((de our now ski hen ruf) our syd) abet:(take-ergo:den result.q.hin) [mos ..^$] :: @@ -4084,7 +4208,7 @@ =* syd i.t.t.t.tea =+ lem=(slav %da i.t.t.t.t.tea) =^ mos ruf - =/ den ((de our now hen ruf) her syd) + =/ den ((de our now ski hen ruf) her syd) abet:(take-foreign-plops:den ?~(lem ~ `lem) result.q.hin) [mos ..^$] :: @@ -4099,7 +4223,7 @@ ->+ =* pax t.t.t.t.t.t.tea =^ mos ruf - =/ den ((de our now hen ruf) her syd) + =/ den ((de our now ski hen ruf) her syd) abet:(take-foreign-x:den car cas pax result.q.hin) [mos ..^$] == @@ -4118,15 +4242,32 @@ :: $note [[hen %give +.q.hin]~ ..^$] $wake + ?: ?=([%tyme ~] tea) + ~& %out-of-tyme + `..^$ + :: dear reader, if it crashes here, check the wire. If it came + :: from ++bait, then I don't think we have any handling for that + :: sort of thing. + :: =^ queued cue.ruf ~(get to cue.ruf) :: =/ queued-duct=duct -.queued =/ queued-task=task:able +.queued :: + :: ~& :* %clay-waking + :: queued-duct + :: hen + :: ?~(cue.ruf /empty -:(need ~(top to cue.ruf))) + :: == ~| [%mismatched-ducts %queued queued-duct %timer hen] ?> =(hen queued-duct) :: - (call hen [-:!>(*task:able) queued-task]) + =/ wait + ?~ cue.ruf + ~ + [-:(need ~(top to cue.ruf)) %pass /queued-request %b %wait now]~ + =^ moves ..^$ (handle-task hen queued-task) + [(weld wait moves) ..^$] :: =^ mos=(list move) une :: wake:(un our now hen ruf) :: [mos ..^^$] @@ -4196,4 +4337,17 @@ ?~ - `[paf %ins %mime -:!>(*mime) u.mim] `[paf %mut %mime -:!>(*mime) u.mim] +:: +rift-scry: for a +rift +:: +++ rift-scry + ~/ %rift-scry + |= who=ship + ^- (unit rift) + =; lyf + ?~(lyf ~ u.lyf) + ;; (unit (unit rift)) + %- (sloy-light ski) + =/ pur=spur + /(scot %p who) + [[151 %noun] %j our %rift da+now pur] -- diff --git a/sys/vane/dill.hoon b/sys/vane/dill.hoon index 82113fd1a9..d71ad06998 100644 --- a/sys/vane/dill.hoon +++ b/sys/vane/dill.hoon @@ -298,10 +298,17 @@ ++ init :: initialize ~& [%dill-init our ram] ^+ . + =. moz + :_ moz + [hen %pass /merg/home %c %merg %home our %base da+now %init] + . + :: + ++ mere :: continue init + ~& [%dill-mere our ram] + ^+ . =/ myt (flop (need tem)) =/ can (clan:title our) =. tem ~ - =. moz :_(moz [hen %pass / %c %merg %home our %base da+now %init]) =. moz :_(moz [hen %pass ~ %g %conf [[our ram] %load our %home]]) =. +> (sync %home our %base) =. +> ?: ?=(?($czar $pawn) can) +> @@ -391,11 +398,6 @@ :: {$a $send *} +>(moz :_(moz [hen %give +.sih])) - :: - {$c $mere *} - ?: ?=(%& -.p.sih) - +>.$ - (mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih) :: {$g $onto *} :: ~& [%take-gall-onto +>.sih] @@ -420,6 +422,11 @@ :: {$c $writ *} init + :: + {$c $mere *} + ?: ?=(%& -.p.sih) + mere + (mean >%dill-mere-fail< >p.p.p.sih< q.p.p.sih) :: {$c $mack *} ?~ p.sih +>.$ diff --git a/sys/vane/ford.hoon b/sys/vane/ford.hoon index cde22f241f..796f69343e 100644 --- a/sys/vane/ford.hoon +++ b/sys/vane/ford.hoon @@ -5751,6 +5751,10 @@ :: =? state ?=(^ last-sent.live.duct-status) =/ old-build=^build build(date date.u.last-sent.live.duct-status) + ~? =(date.build date.old-build) + :+ "old and new builds have same date, will probably crash!" + (build-to-tape build) + (build-to-tape old-build) :: (remove-anchor-from-root old-build [%duct duct]) :: diff --git a/sys/vane/gall.hoon b/sys/vane/gall.hoon index 3fe010cfea..80519cf1c2 100644 --- a/sys/vane/gall.hoon +++ b/sys/vane/gall.hoon @@ -728,10 +728,16 @@ ++ ap-fill :: add to queue ^- {? _.} =+ suy=(fall (~(get by qel.ged) ost) 0) - ?: =(20 suy) - [%| +] - :: ~? !=(20 suy) [%ap-fill-add [[our dap] q.q.pry ost] +(suy)] - [%& +(qel.ged (~(put by qel.ged) ost +(suy)))] + =/ subscriber-ship p:(~(got by sup.ged) ost) + ?: &(=(20 suy) !=(our subscriber-ship)) + ~& [%gall-pulling-20 ost (~(get by sup.ged) ost) (~(get by r.zam) ost)] + [%| ..ap-fill] + :: ~& :* %gall-pushing-20 + :: ost + :: suy=suy + :: (~(get by r.zam) ost) + :: == + [%& ..ap-fill(qel.ged (~(put by qel.ged) ost +(suy)))] :: ++ ap-find :: general arm ~/ %ap-find @@ -1258,39 +1264,39 @@ ^- (unit @tas) ?+ sep ~& [%ap-vain sep] ~ - $bonk `%a - $build `%f - $cash `%a - $conf `%g - $cred `%c - $crew `%c - $crow `%c - $deal `%g - $dirk `%c - $drop `%c - $flog `%d - $info `%c - $keep `%f - $kill `%f - $look `%j - $merg `%c - $mint `%j - $mont `%c - $nuke `%a - $ogre `%c - $perm `%c - $rest `%b - $rule `%e - $serv `%e - $snap `%j - $them `%e - $wait `%b - $want `%a - $warp `%c - $well `%e - $well `%e - $wind `%j - $wipe `%f + %bonk `%a + %build `%f + %cash `%a + %conf `%g + %cred `%c + %crew `%c + %crow `%c + %deal `%g + %dirk `%c + %drop `%c + %flog `%d + %info `%c + %keep `%f + %kill `%f + %look `%j + %merg `%c + %mint `%j + %mont `%c + %nuke `%a + %ogre `%c + %perm `%c + %rest `%b + %rule `%e + %serv `%e + %snap `%j + %them `%e + %wait `%b + %want `%a + %warp `%c + %well `%e + %well `%e + %wind `%j + %wipe `%f == -- -- @@ -1363,9 +1369,8 @@ =(~ tyl) =([%$ %da now] lot) =(our his) - (~(has by bum.mast.all) syd) == - ``[%null !>(~)] + ``[%noun !>((~(has by bum.mast.all) syd))] ?. =(our his) ~ ?. =([%$ %da now] lot) diff --git a/sys/vane/jael.hoon b/sys/vane/jael.hoon index e41bf93ee5..134df09bc5 100644 --- a/sys/vane/jael.hoon +++ b/sys/vane/jael.hoon @@ -1432,20 +1432,22 @@ :: :- (file-discontinuity who) %= ..file - :: these must be appended here; +abet flops them - :: - moz =/ lyf=life + moz =/ rit=rift ~| sunk-unknown+who - life:(~(got by kyz.puk)) - %+ weld moz - ^- (list move) - :~ [hen %slip %a %sunk who lyf] - [hen %slip %c %sunk who lyf] - [hen %slip %d %sunk who lyf] - [hen %slip %e %sunk who lyf] - [hen %slip %f %sunk who lyf] - [hen %slip %g %sunk who lyf] - == + =< continuity-number + %+ fall + net:(fall (~(get by pos.eth) who) *point) + *[life pass continuity-number=@ud [? @p] (unit @p)] + %+ weld + ^- (list move) + :~ [hen %slip %a %sunk who rit] + [hen %slip %c %sunk who rit] + [hen %slip %d %sunk who rit] + [hen %slip %e %sunk who rit] + [hen %slip %f %sunk who rit] + [hen %slip %g %sunk who rit] + == + moz == :: pon: updated point :: new: new keypair or "kept continuity?" (yes is no-op) @@ -2312,6 +2314,23 @@ =/ pub (~(get by kyz.puk.sub.lex) u.who) ?~ pub ~ ``[%atom !>(life.u.pub)] + :: + %rift + ?. ?=([@ ~] tyl) [~ ~] + ?. ?& ?=(%& -.why) + (~(has by pry.urb.lex) p.why) + == + [~ ~] + =/ who (slaw %p i.tyl) + ?~ who [~ ~] + :: fake ships always have rift=1 + :: + ?: fak.own.sub.lex + ``[%atom !>(1)] + =/ pos (~(get by pos.eth.sub.lex) u.who) + ?~ pos ~ + ?~ net.u.pos ~ + ``[%atom !>(continuity-number.u.net.u.pos)] :: %deed ?. ?=([@ @ ~] tyl) [~ ~] diff --git a/sys/zuse.hoon b/sys/zuse.hoon index caf849407a..2acca52251 100644 --- a/sys/zuse.hoon +++ b/sys/zuse.hoon @@ -69,7 +69,8 @@ == :: ++ coop (unit ares) :: possible error -++ life @ud :: ship version +++ life @ud :: ship key revision +++ rift @ud :: ship continuity ++ mime {p/mite q/octs} :: mimetyped data ++ octs {p/@ud q/@t} :: octet-stream ++ sock {p/ship q/ship} :: outgoing [our his] @@ -252,7 +253,7 @@ [%init p=ship] :: report install {$kick p/@da} :: wake up {$nuke p/@p} :: toggle auto-block - {$sunk p=ship q=life} :: report death + {$sunk p=ship q=rift} :: report death {$vega ~} :: report upgrade {$wake ~} :: timer activate {$wegh ~} :: report memory @@ -487,7 +488,7 @@ {$dirk des/desk} :: mark mount dirty {$ogre pot/$@(desk beam)} :: delete mount point {$perm des/desk pax/path rit/rite} :: change permissions - {$sunk p=ship q=life} :: report death + {$sunk p=ship q=rift} :: report death {$vega ~} :: report upgrade {$warp wer/ship rif/riff} :: internal file req {$werp who/ship wer/ship rif/riff} :: external file req @@ -652,8 +653,8 @@ {$harm ~} :: all terms hung up {$init p/ship} :: after gall ready {$lyra p/@t q/@t} :: upgrade kernel - {$noop ~} :: no operation - {$sunk p=ship q=life} :: report death + {$noop ~} :: no operation + {$sunk p=ship q=rift} :: report death {$talk p/tank} :: {$text p/tape} :: {$veer p/@ta q/path r/@t} :: install vane @@ -750,7 +751,7 @@ [%live p=@ud q=(unit @ud)] :: http/s ports [%rule p=http-rule] :: update config [%serv p=$@(desk beam)] :: set serving root - [%sunk p=ship q=life] :: report death + [%sunk p=ship q=rift] :: report death [%them p=(unit hiss)] :: outbound request [%they p=@ud q=httr] :: inbound response [%chis p=? q=clip r=httq] :: IPC inbound request @@ -992,7 +993,7 @@ [%kill ~] :: %sunk: receive a report that a foreign ship has lost continuity :: - [%sunk =ship =life] + [%sunk =ship =rift] :: %vega: report kernel upgrade :: [%vega ~] @@ -1686,7 +1687,7 @@ $% {$conf p/dock q/culm} :: configure app {$init p/ship} :: set owner {$deal p/sock q/cush} :: full transmission - {$sunk p=ship q/life} :: report death + {$sunk p=ship q/rift} :: report death {$vega ~} :: report upgrade {$west p/ship q/path r/*} :: network request {$wegh ~} :: report memory @@ -1834,7 +1835,7 @@ == == :: $: @tas :: $% [%init p=ship] :: report install - [%sunk p=ship q=life] :: report death + [%sunk p=ship q=rift] :: report death == == == :: ++ public :: public key state $: life=life :: current key number @@ -7198,12 +7199,14 @@ |% :: azimuth: data contract :: - :: ++ azimuth 0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579 :: ropsten ++ azimuth 0x223c.067f.8cf2.8ae1.73ee.5caf.ea60.ca44.c335.fecb :: mainnet + :: ++ azimuth 0x308a.b6a6.024c.f198.b57e.008d.0ac9.ad02.1988.6579 :: ropsten + :: ++ azimuth 0x863d.9c2e.5c4c.1335.96cf.ac29.d552.55f0.d0f8.6381 :: local bridge :: :: launch: block number of azimuth deploy :: - ++ launch 6.784.800 + ++ launch 6.784.800 :: mainnet + :: ++ launch 0 :: local bridge -- :: :: hashes of ship event signatures