urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-14 20:02:51 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #1120 from urbit/philip/aquarium

Browse Source 
Aquarium and pH
This commit is contained in:
Philip Monk 2019-04-01 11:28:05 -07:00 committed by GitHub
commit 84e9837641
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
26 changed files with 2553 additions and 125 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
.travis/test.js
View File

@ -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);
})

64
README.md Normal file
View File

@ -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.

83
app/aqua-ames.hoon Normal file
View File

@ -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]
--

125
app/aqua-behn.hoon Normal file
View File

@ -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
--
--

78
app/aqua-dill.hoon Normal file
View File

@ -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 ~& "{<who>}: {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
--

157
app/aqua-eyre.hoon Normal file
View File

@ -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
--
--

546
app/aqua.hoon Normal file
View File

@ -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)
--

477
app/ph.hoon Normal file
View File

@ -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: {<count>}\"") ..start]
::
++ route
|= [who=ship uf=unix-effect]
^- (quip ph-event _..start)
?. (is-dojo-output ~bud who uf "\"count: {<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
`+>.$
--

14
gen/aqua/dojo.hoon Normal file
View File

@ -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]

9
gen/aqua/file.hoon Normal file
View File

@ -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]~]~

6
gen/aqua/init.hoon Normal file
View File

@ -0,0 +1,6 @@
/- aquarium
=, aquarium
:- %say
|= [* [her=ship] ~]
:- %aqua-events
[%init-ship her ~]~

6
gen/aqua/raw-event.hoon Normal file
View File

@ -0,0 +1,6 @@
/- aquarium
=, aquarium
:- %say
|= [* [her=ship ue=unix-event] ~]
:- %aqua-events
[%event her ue]~

6
gen/aqua/restore-fleet.hoon Normal file
View File

@ -0,0 +1,6 @@
/- aquarium
=, aquarium
:- %say
|= [* [label=@ta] ~]
:- %aqua-events
[%snap-ships label]~

8
gen/aqua/snap-fleet.hoon Normal file
View File

@ -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]~

17
lib/hood/kiln.hoon
View File

@ -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

473
lib/ph.hoon Normal file
View File

@ -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
==
--
--

20
mar/md.hoon Normal file
View File

@ -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
--

36
mar/pill.hoon Normal file
View File

@ -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
--

96
sur/aquarium.hoon Normal file
View File

@ -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] ~]~
==
--

4
sys/arvo.hoon
View File

@ -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

254
sys/vane/clay.hoon
View File

@ -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]
--

19
sys/vane/dill.hoon
View File

@ -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 +>.$

4
sys/vane/ford.hoon
View File

@ -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])
::

83
sys/vane/gall.hoon
View File

@ -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)

45
sys/vane/jael.hoon
View File

@ -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) [~ ~]

25
sys/zuse.hoon
View File

@ -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