mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 18:12:47 +03:00
Merge branch 'next' into lighter-than-eyre
* next: (133 commits) tweaks %crud error printing in %dill adds top-level arvo error notification event %warn Explicitly note %install-from-clay as temporary four minute ping to eth mainnet azimuth slow travis travis renames travis add docs for ph monad remove non-monadic ph tests and organize port ph tests to monadic style wrappable eth node mock Implement installing certs from clay using %acme Implement %pem mark Revert "add =%" add ;< add ;< wip ...
This commit is contained in:
Joe Bryan
commit
b3a9fad26c
@ -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 %hi");
|
||||
})
|
||||
.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);
|
||||
})
|
||||
|
||||
65
README.md
Normal file
65
README.md
Normal file
@ -0,0 +1,65 @@
|
||||
# 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)
|
||||
* `/app/aqua`: @philipcmonk (~wicdev-wisryt)
|
||||
* `/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.
|
||||
@ -1226,8 +1226,11 @@
|
||||
:: +wake: timer wakeup event
|
||||
::
|
||||
++ wake
|
||||
|= [wir=wire ~]
|
||||
|= [wir=wire error=(unit tang)]
|
||||
^- (quip move _this)
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
abet
|
||||
?> ?=([%acme *] wir)
|
||||
abet:(retry:event t.wir)
|
||||
:: +poke-acme-order: create new order for a set of domains
|
||||
@ -1265,6 +1268,15 @@
|
||||
~& [%config-history fig.hit]
|
||||
~& [%failed-order-history fal.hit]
|
||||
this
|
||||
::
|
||||
:: install privkey and cert .pem from /=home=/acme, ignores app state
|
||||
::TODO refactor this out of %acme, see also arvo#1151
|
||||
::
|
||||
%install-from-clay
|
||||
=/ bas=path /(scot %p our.bow)/home/(scot %da now.bow)/acme
|
||||
=/ key=wain .^(wain %cx (weld bas /privkey/pem))
|
||||
=/ cer=wain .^(wain %cx (weld bas /cert/pem))
|
||||
(emit %rule /install %cert `[key cer])
|
||||
::
|
||||
%init
|
||||
init
|
||||
|
||||
83
app/aqua-ames.hoon
Normal file
83
app/aqua-ames.hoon
Normal 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]
|
||||
--
|
||||
131
app/aqua-behn.hoon
Normal file
131
app/aqua-behn.hoon
Normal file
@ -0,0 +1,131 @@
|
||||
/- aquarium
|
||||
=, aquarium
|
||||
=> |%
|
||||
+$ move (pair bone card)
|
||||
+$ card
|
||||
$% [%poke wire dock %aqua-events (list aqua-event)]
|
||||
[%peer wire dock path]
|
||||
[%pull wire dock ~]
|
||||
[%wait wire p=@da]
|
||||
[%rest wire p=@da]
|
||||
==
|
||||
::
|
||||
+$ state
|
||||
$: %0
|
||||
subscribed=_|
|
||||
piers=(map ship pier)
|
||||
==
|
||||
::
|
||||
+$ pier next-timer=(unit @da)
|
||||
--
|
||||
=, gall
|
||||
=| moves=(list move)
|
||||
|_ $: bowl
|
||||
state
|
||||
==
|
||||
++ this .
|
||||
++ apex %_(this moves ~)
|
||||
++ abet [(flop moves) this]
|
||||
++ emit-moves
|
||||
|= ms=(list move)
|
||||
%_(this moves (weld ms moves))
|
||||
::
|
||||
++ emit-aqua-events
|
||||
|= aes=(list aqua-event)
|
||||
%- emit-moves
|
||||
[ost %poke /aqua-events [our %aqua] %aqua-events aes]~
|
||||
::
|
||||
++ poke-aqua-vane-control
|
||||
|= command=?(%subscribe %unsubscribe)
|
||||
:_ this(subscribed =(command %subscribe))
|
||||
(aqua-vane-control-handler our ost subscribed command)
|
||||
::
|
||||
++ diff-aqua-effects
|
||||
|= [way=wire afs=aqua-effects]
|
||||
^- (quip move _this)
|
||||
=. this apex =< abet
|
||||
|- ^+ this
|
||||
?~ ufs.afs
|
||||
this
|
||||
=. this
|
||||
?+ -.q.i.ufs.afs this
|
||||
%sleep abet-pe:handle-sleep:(pe who.afs)
|
||||
%restore abet-pe:handle-restore:(pe who.afs)
|
||||
%doze abet-pe:(handle-doze:(pe who.afs) i.ufs.afs)
|
||||
==
|
||||
$(ufs.afs t.ufs.afs)
|
||||
::
|
||||
:: Received timer wake
|
||||
::
|
||||
++ wake
|
||||
|= [way=wire error=(unit tang)]
|
||||
^- (quip move _this)
|
||||
=. this apex =< abet
|
||||
?> ?=([@ *] way)
|
||||
=/ who (,@p (slav %p i.way))
|
||||
abet-pe:(take-wake:(pe who) t.way error)
|
||||
::
|
||||
++ pe
|
||||
|= who=ship
|
||||
=+ (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 error=(unit tang)]
|
||||
~? debug=| [who=who %aqua-behn-wake now error=error]
|
||||
=. next-timer ~
|
||||
=. this
|
||||
%- emit-aqua-events
|
||||
:_ ~
|
||||
^- aqua-event
|
||||
:+ %event who
|
||||
:- //behn/0v1n.2m9vh
|
||||
?~ error
|
||||
[%wake ~]
|
||||
[%crud %fail u.error]
|
||||
..abet-pe
|
||||
--
|
||||
--
|
||||
78
app/aqua-dill.hoon
Normal file
78
app/aqua-dill.hoon
Normal 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
157
app/aqua-eyre.hoon
Normal 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
|
||||
--
|
||||
--
|
||||
551
app/aqua.hoon
Normal file
551
app/aqua.hoon
Normal file
@ -0,0 +1,551 @@
|
||||
:: 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 (mule |.((slum poke tym ue)))
|
||||
?: ?=(%| -.poke-result)
|
||||
%- (slog >%aqua-crash< p.poke-result)
|
||||
$
|
||||
=. snap +.p.poke-result
|
||||
=. ..abet-pe (publish-event tym ue)
|
||||
=. ..abet-pe (handle-effects ((list ovum) -.p.poke-result))
|
||||
$
|
||||
::
|
||||
:: Peek
|
||||
::
|
||||
++ peek
|
||||
|= p=*
|
||||
=/ res (mox +46.snap)
|
||||
?> ?=(%0 -.res)
|
||||
=/ peek p.res
|
||||
=/ pax (path p)
|
||||
?> ?=([@ @ @ @ *] pax)
|
||||
=. i.t.t.t.pax (scot %da tym)
|
||||
=/ pek (slum peek [tym pax])
|
||||
pek
|
||||
::
|
||||
:: Wish
|
||||
::
|
||||
++ wish
|
||||
|= txt=@t
|
||||
=/ res (mox +22.snap)
|
||||
?> ?=(%0 -.res)
|
||||
=/ wish p.res
|
||||
~& [who=who %wished (slum wish txt)]
|
||||
..abet-pe
|
||||
::
|
||||
++ mox |=(* (mock [snap +<] scry))
|
||||
::
|
||||
:: Start/stop processing events. When stopped, events are added to
|
||||
:: our queue but not processed.
|
||||
::
|
||||
++ start-processing-events .(processing-events &)
|
||||
++ stop-processing-events .(processing-events |)
|
||||
::
|
||||
:: Handle all the effects produced by a single event.
|
||||
::
|
||||
++ handle-effects
|
||||
|= effects=(list ovum)
|
||||
^+ ..abet-pe
|
||||
?~ effects
|
||||
..abet-pe
|
||||
=. ..abet-pe
|
||||
=/ sof ((soft unix-effect) i.effects)
|
||||
?~ sof
|
||||
~? aqua-debug=| [who=who %unknown-effect i.effects]
|
||||
..abet-pe
|
||||
(publish-effect u.sof)
|
||||
$(effects t.effects)
|
||||
::
|
||||
:: Give effect to our subscribers
|
||||
::
|
||||
++ publish-effect
|
||||
|= uf=unix-effect
|
||||
^+ ..abet-pe
|
||||
=. unix-effects (~(add ja unix-effects) who uf)
|
||||
=. unix-boths (~(add ja unix-boths) who [%effect uf])
|
||||
..abet-pe
|
||||
::
|
||||
:: Give event to our subscribers
|
||||
::
|
||||
++ publish-event
|
||||
|= ute=unix-timed-event
|
||||
^+ ..abet-pe
|
||||
=. event-log [ute event-log]
|
||||
=. unix-events (~(add ja unix-events) who ute)
|
||||
=. unix-boths (~(add ja unix-boths) who [%event ute])
|
||||
..abet-pe
|
||||
--
|
||||
::
|
||||
++ this .
|
||||
::
|
||||
:: ++apex-aqua and ++abet-aqua must bookend calls from gall
|
||||
::
|
||||
++ apex-aqua
|
||||
^+ this
|
||||
=: moves ~
|
||||
unix-effects ~
|
||||
unix-events ~
|
||||
unix-boths ~
|
||||
==
|
||||
this
|
||||
::
|
||||
++ abet-aqua
|
||||
^- (quip move _this)
|
||||
=. this
|
||||
%- emit-moves
|
||||
%- zing ^- (list (list move))
|
||||
%+ turn ~(tap by sup.hid)
|
||||
|= [b=bone her=ship pax=path]
|
||||
^- (list move)
|
||||
?+ pax ~
|
||||
[%effects @ ~]
|
||||
=/ who (slav %p i.t.pax)
|
||||
=/ ufs (~(get ja unix-effects) who)
|
||||
?~ ufs
|
||||
~
|
||||
[b %diff %aqua-effects who (flop ufs)]~
|
||||
::
|
||||
[%effects ~]
|
||||
%+ turn
|
||||
~(tap by unix-effects)
|
||||
|= [who=ship ufs=(list unix-effect)]
|
||||
[b %diff %aqua-effects who (flop ufs)]
|
||||
::
|
||||
[%events @ ~]
|
||||
=/ who (slav %p i.t.pax)
|
||||
=/ ve (~(get ja unix-events) who)
|
||||
?~ ve
|
||||
~
|
||||
[b %diff %aqua-events who (flop ve)]~
|
||||
::
|
||||
[%boths @ ~]
|
||||
=/ who (slav %p i.t.pax)
|
||||
=/ bo (~(get ja unix-boths) who)
|
||||
?~ bo
|
||||
~
|
||||
[b %diff %aqua-boths who (flop bo)]~
|
||||
==
|
||||
[(flop moves) this]
|
||||
::
|
||||
++ emit-moves
|
||||
|= ms=(list move)
|
||||
=. moves (weld ms moves)
|
||||
this
|
||||
::
|
||||
::
|
||||
:: Run all events on all ships until all queues are empty
|
||||
::
|
||||
++ plow-all
|
||||
|- ^+ this
|
||||
=/ who
|
||||
=/ pers ~(tap by piers)
|
||||
|- ^- (unit ship)
|
||||
?~ pers
|
||||
~
|
||||
?: &(?=(^ next-events.q.i.pers) processing-events.q.i.pers)
|
||||
`p.i.pers
|
||||
$(pers t.pers)
|
||||
~? aqua-debug=| plowing=who
|
||||
?~ who
|
||||
this
|
||||
=. this abet-pe:plow:(pe u.who)
|
||||
$
|
||||
::
|
||||
:: Subscribe to effects from a ship
|
||||
::
|
||||
++ peer-effects
|
||||
|= pax=path
|
||||
^- (quip move _this)
|
||||
?. ?=([@ *] pax)
|
||||
~& [%aqua-bad-peer-effects pax]
|
||||
`this
|
||||
?~ (slaw %p i.pax)
|
||||
~& [%aqua-bad-peer-effects-ship pax]
|
||||
!!
|
||||
`this
|
||||
::
|
||||
:: Subscribe to events to a ship
|
||||
::
|
||||
++ peer-events
|
||||
|= pax=path
|
||||
^- (quip move _this)
|
||||
?. ?=([@ ~] pax)
|
||||
~& [%aqua-bad-peer-events pax]
|
||||
`this
|
||||
?~ (slaw %p i.pax)
|
||||
~& [%aqua-bad-peer-events-ship pax]
|
||||
!!
|
||||
`this
|
||||
::
|
||||
:: Subscribe to both events and effects of a ship
|
||||
::
|
||||
++ peer-boths
|
||||
|= pax=path
|
||||
^- (quip move _this)
|
||||
?. ?=([@ ~] pax)
|
||||
~& [%aqua-bad-peer-boths pax]
|
||||
`this
|
||||
?~ (slaw %p i.pax)
|
||||
~& [%aqua-bad-peer-boths-ship pax]
|
||||
!!
|
||||
`this
|
||||
::
|
||||
:: Load a pill and assemble arvo. Doesn't send any of the initial
|
||||
:: events.
|
||||
::
|
||||
++ poke-pill
|
||||
|= p=pill
|
||||
^- (quip move _this)
|
||||
=. this apex-aqua =< abet-aqua
|
||||
=. pil p
|
||||
~& lent=(met 3 (jam boot-ova.pil))
|
||||
=/ res=toon :: (each * (list tank))
|
||||
(mock [boot-ova.pil [2 [0 3] [0 2]]] scry)
|
||||
=. fleet-snaps ~
|
||||
?- -.res
|
||||
%0
|
||||
~& %suc
|
||||
=. assembled +7.p.res
|
||||
this
|
||||
::
|
||||
%1
|
||||
~& [%vere-blocked p.res]
|
||||
this
|
||||
::
|
||||
%2
|
||||
~& %vere-fail
|
||||
%- (slog p.res)
|
||||
this
|
||||
==
|
||||
::
|
||||
:: Handle commands from CLI
|
||||
::
|
||||
:: Should put some thought into arg structure, maybe make a mark.
|
||||
::
|
||||
:: Should convert some of these to just rewrite into ++poke-events.
|
||||
::
|
||||
++ poke-noun
|
||||
|= val=*
|
||||
^- (quip move _this)
|
||||
=. this apex-aqua =< abet-aqua
|
||||
^+ this
|
||||
:: Could potentially factor out the three lines of turn-ships
|
||||
:: boilerplate
|
||||
::
|
||||
?+ val ~|(%bad-noun-arg !!)
|
||||
[%swap-vanes vs=*]
|
||||
?> ?=([[%7 * %1 installed=*] ~] boot-ova.pil)
|
||||
=. installed.boot-ova.pil
|
||||
%+ roll (,(list term) vs.val)
|
||||
|= [v=term _installed.boot-ova.pil]
|
||||
%^ slum installed.boot-ova.pil now.hid
|
||||
=/ vane
|
||||
?+ v ~|([%unknown-vane v] !!)
|
||||
%a %ames
|
||||
%b %behn
|
||||
%c %clay
|
||||
%d %dill
|
||||
%e %eyre
|
||||
%f %ford
|
||||
%g %gall
|
||||
%j %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]
|
||||
~? &(debug=& ?=(%they -.q.ue.ae))
|
||||
raw-event=[who.ae ue.ae]
|
||||
(push-events:(pe who.ae) [ue.ae]~)
|
||||
==
|
||||
::
|
||||
:: Run a callback function against a list of ships, aggregating state
|
||||
:: and plowing all ships at the end.
|
||||
::
|
||||
:: I think we should use patterns like this more often. Because we
|
||||
:: don't, here's some points to be aware.
|
||||
::
|
||||
:: `fun` must take `this` as a parameter, since it needs to be
|
||||
:: downstream of previous state changes. You could use `state` as
|
||||
:: the state variable, but it muddles the code and it's not clear
|
||||
:: whether it's better. You could use the `_(pe)` core if you're
|
||||
:: sure you'll never need to refer to anything outside of your pier,
|
||||
:: but I don't think we can guarantee that.
|
||||
::
|
||||
:: The callback function must start with `=. this thus`, or else
|
||||
:: you don't get the new state. Would be great if you could hot-swap
|
||||
:: that context in here, but we don't know where to put it unless we
|
||||
:: restrict the callbacks to always have `this` at a particular axis,
|
||||
:: and that doesn't feel right
|
||||
::
|
||||
++ turn-plow
|
||||
|* arg=mold
|
||||
|= [hers=(list arg) fun=$-([arg _this] _(pe))]
|
||||
|- ^+ this
|
||||
?~ hers
|
||||
plow-all
|
||||
=. this
|
||||
abet-pe:plow:(fun i.hers this)
|
||||
$(hers t.hers, this this)
|
||||
::
|
||||
++ turn-ships (turn-plow ship)
|
||||
++ turn-events (turn-plow aqua-event)
|
||||
::
|
||||
:: Check whether we have a snapshot
|
||||
::
|
||||
++ peek-x-fleet-snap
|
||||
|= pax=path
|
||||
^- (unit (unit [%noun noun]))
|
||||
?. ?=([@ ~] pax)
|
||||
~
|
||||
:^ ~ ~ %noun
|
||||
(~(has by fleet-snaps) i.pax)
|
||||
::
|
||||
:: Pass scry into child ship
|
||||
::
|
||||
++ peek-x-i
|
||||
|= pax=path
|
||||
^- (unit (unit [%noun noun]))
|
||||
?. ?=([@ @ @ *] pax)
|
||||
~
|
||||
=/ who (slav %p i.pax)
|
||||
=/ pier (~(get by piers) who)
|
||||
?~ pier
|
||||
~
|
||||
:^ ~ ~ %noun
|
||||
(peek:(pe who) [%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)
|
||||
--
|
||||
@ -619,8 +619,11 @@
|
||||
:: +wake: timer callback
|
||||
::
|
||||
++ wake
|
||||
|= [=wire ~]
|
||||
|= [=wire error=(unit tang)]
|
||||
^- (quip move _this)
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
[~ this]
|
||||
?+ wire
|
||||
~& [%strange-wake wire]
|
||||
[~ this]
|
||||
|
||||
@ -113,8 +113,11 @@
|
||||
done:(put-snapshot-diff:(open:watcher i.pax) ost)
|
||||
::
|
||||
++ wake
|
||||
|= [wir=wire ~]
|
||||
|= [wir=wire error=(unit tang)]
|
||||
^- (quip move _+>)
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
[~ ..wake]
|
||||
?> ?=([@ %poll ~] wir)
|
||||
done:poll-filter:(open:watcher i.wir)
|
||||
::
|
||||
|
||||
393
app/ph.hoon
Normal file
393
app/ph.hoon
Normal file
@ -0,0 +1,393 @@
|
||||
:: 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
|
||||
/+ ph, ph-tests, ph-azimuth, ph-philter
|
||||
=, ph-sur=^ph
|
||||
=, aquarium
|
||||
=, ph
|
||||
=, ph-philter
|
||||
=> $~ |%
|
||||
+$ move (pair bone card)
|
||||
+$ card
|
||||
$% [%poke wire dock poke-type]
|
||||
[%peer wire dock path]
|
||||
[%pull wire dock ~]
|
||||
[%diff diff-type]
|
||||
==
|
||||
::
|
||||
+$ poke-type
|
||||
$% [%aqua-events (list aqua-event)]
|
||||
[%drum-start term term]
|
||||
[%aqua-vane-control ?(%subscribe %unsubscribe)]
|
||||
==
|
||||
::
|
||||
+$ diff-type
|
||||
$% [%aqua-effects aqua-effects]
|
||||
==
|
||||
::
|
||||
+$ state
|
||||
$: %0
|
||||
test-core=(unit test-core-state)
|
||||
tests=(map term [(list ship) _*form:(ph ,~)])
|
||||
other-state
|
||||
==
|
||||
::
|
||||
+$ test-core-state
|
||||
$: lab=term
|
||||
hers=(list ship)
|
||||
test=_*form:(ph ,~)
|
||||
==
|
||||
::
|
||||
+$ other-state
|
||||
$: test-qeu=(qeu term)
|
||||
results=(list (pair term ?))
|
||||
effect-log=(list [who=ship uf=unix-effect])
|
||||
==
|
||||
--
|
||||
=, gall
|
||||
=/ vane-apps=(list term)
|
||||
~[%aqua-ames %aqua-behn %aqua-dill %aqua-eyre]
|
||||
|_ $: hid=bowl
|
||||
state
|
||||
==
|
||||
++ this .
|
||||
++ manual-tests
|
||||
^- (list (pair term [(list ship) _*form:(ph ,~)]))
|
||||
=+ (ph-tests our.hid)
|
||||
=/ eth-node (spawn-galaxy:ph-azimuth ~rel)
|
||||
=/ m (ph ,~)
|
||||
:~ :+ %boot-bud
|
||||
~[~bud]
|
||||
(raw-ship ~bud ~)
|
||||
::
|
||||
:+ %add
|
||||
~[~bud]
|
||||
;< ~ bind:m (raw-ship ~bud ~)
|
||||
|= pin=ph-input
|
||||
?: =(%init -.q.uf.pin)
|
||||
[& (dojo ~bud "[%test-result (add 2 3)]") %wait ~]
|
||||
?: (is-dojo-output ~bud who.pin uf.pin "[%test-result 5]")
|
||||
[& ~ %done ~]
|
||||
[& ~ %wait ~]
|
||||
::
|
||||
:+ %hi
|
||||
~[~bud ~dev]
|
||||
;< ~ bind:m (raw-ship ~bud ~)
|
||||
;< ~ bind:m (raw-ship ~dev ~)
|
||||
(send-hi ~bud ~dev)
|
||||
::
|
||||
:+ %boot-planet
|
||||
~[~bud ~marbud ~linnup-torsyx]
|
||||
(planet ~linnup-torsyx)
|
||||
::
|
||||
:+ %second-cousin-hi
|
||||
~[~bud ~marbud ~linnup-torsyx ~dev ~mardev ~mitnep-todsut]
|
||||
;< ~ bind:m (planet ~linnup-torsyx)
|
||||
;< ~ bind:m (planet ~mitnep-todsut)
|
||||
(send-hi ~linnup-torsyx ~mitnep-todsut)
|
||||
::
|
||||
:+ %change-file
|
||||
~[~bud]
|
||||
;< ~ bind:m (raw-ship ~bud ~)
|
||||
;< file=@t bind:m (touch-file ~bud %home)
|
||||
(check-file-touched ~bud %home file)
|
||||
::
|
||||
:+ %child-sync
|
||||
~[~bud ~marbud]
|
||||
;< ~ bind:m (star ~marbud)
|
||||
;< file=@t bind:m (touch-file ~bud %base)
|
||||
(check-file-touched ~marbud %home file)
|
||||
::
|
||||
:+ %boot-az
|
||||
~[~bud]
|
||||
;< [node=_eth-node ~] bind:m
|
||||
%+ (wrap-philter ,_eth-node ,~)
|
||||
router:eth-node
|
||||
(raw-ship ~bud `(dawn:legacy:ph-azimuth ~bud))
|
||||
=. node (spawn-galaxy:node ~pem)
|
||||
;< [node=_eth-node ~] bind:m
|
||||
%+ (wrap-philter ,_eth-node ,~)
|
||||
router:node
|
||||
(pure:m ~)
|
||||
(pure:m ~)
|
||||
==
|
||||
::
|
||||
++ install-tests
|
||||
^+ this
|
||||
=. tests (malt manual-tests)
|
||||
this
|
||||
::
|
||||
++ prep
|
||||
|= old=(unit [@ tests=* rest=*])
|
||||
^- (quip move _this)
|
||||
~& prep=%ph
|
||||
=. this install-tests
|
||||
`this
|
||||
:: ?~ old
|
||||
:: `this
|
||||
:: =/ new ((soft other-state) rest.u.old)
|
||||
:: ?~ new
|
||||
:: `this
|
||||
:: `this(+<+>+> u.new)
|
||||
::
|
||||
++ publish-aqua-effects
|
||||
|= afs=aqua-effects
|
||||
^- (list move)
|
||||
%+ murn ~(tap by sup.hid)
|
||||
|= [b=bone her=ship pax=path]
|
||||
^- (unit move)
|
||||
?. ?=([%effects ~] pax)
|
||||
~
|
||||
`[b %diff %aqua-effects afs]
|
||||
::
|
||||
++ run-events
|
||||
|= [lab=term what=(list ph-event)]
|
||||
^- (quip move _this)
|
||||
?: =(~ what)
|
||||
`this
|
||||
=/ res
|
||||
|- ^- (each (list aqua-event) ?)
|
||||
?~ what
|
||||
[%& ~]
|
||||
?: ?=(%test-done -.i.what)
|
||||
[%| p.i.what]
|
||||
=/ nex $(what t.what)
|
||||
?: ?=(%| -.nex)
|
||||
nex
|
||||
[%& `aqua-event`i.what p.nex]
|
||||
?: ?=(%| -.res)
|
||||
=^ moves-1 this (finish-test lab p.res)
|
||||
=^ moves-2 this run-test
|
||||
[(weld moves-1 moves-2) this]
|
||||
[[ost.hid %poke /running [our.hid %aqua] %aqua-events p.res]~ this]
|
||||
::
|
||||
:: Cancel subscriptions to ships
|
||||
::
|
||||
++ finish-test
|
||||
|= [lab=term success=?]
|
||||
^- (quip move _this)
|
||||
?~ test-core
|
||||
`this
|
||||
~& ?: success
|
||||
"TEST {(trip lab)} SUCCESSFUL"
|
||||
"TEST {(trip lab)} FAILED"
|
||||
:_ this(test-core ~, results [[lab success] results])
|
||||
%- zing
|
||||
%+ turn hers.u.test-core
|
||||
|= her=ship
|
||||
^- (list move)
|
||||
:~ [ost.hid %pull /[lab]/(scot %p her) [our.hid %aqua] ~]
|
||||
:* ost.hid
|
||||
%poke
|
||||
/cancelling
|
||||
[our.hid %aqua]
|
||||
%aqua-events
|
||||
[%pause-events her]~
|
||||
==
|
||||
==
|
||||
::
|
||||
:: Start another test if one is in the queue
|
||||
::
|
||||
++ run-test
|
||||
^- (quip move _this)
|
||||
?^ test-core
|
||||
`this
|
||||
?: =(~ test-qeu)
|
||||
?~ results
|
||||
`this
|
||||
=/ throw-away print-results
|
||||
`this(results ~)
|
||||
=^ lab test-qeu ~(get to test-qeu)
|
||||
~& [running-test=lab test-qeu]
|
||||
=. effect-log ~
|
||||
=+ ^- [ships=(list ship) test=_*form:(ph ,~)]
|
||||
(~(got by tests) lab)
|
||||
=> .(test-core `(unit test-core-state)`test-core)
|
||||
=. test-core `[lab ships test]
|
||||
=^ moves-1 this (subscribe-to-effects lab ships)
|
||||
=^ moves-2 this
|
||||
(diff-aqua-effects /[lab]/(scot %p -.ships) -.ships [/ %init ~]~)
|
||||
[:(weld init-vanes pause-fleet subscribe-vanes moves-1 moves-2) this]
|
||||
::
|
||||
:: Print results with ~&
|
||||
::
|
||||
++ print-results
|
||||
~& "TEST REPORT:"
|
||||
=/ throw-away
|
||||
%+ turn
|
||||
results
|
||||
|= [lab=term success=?]
|
||||
~& "{?:(success "SUCCESS" "FAILURE")}: {(trip lab)}"
|
||||
~
|
||||
~& ?: (levy results |=([term s=?] s))
|
||||
"ALL TESTS SUCCEEDED"
|
||||
"FAILURES"
|
||||
~
|
||||
::
|
||||
:: Should check whether we're already subscribed
|
||||
::
|
||||
++ subscribe-to-effects
|
||||
|= [lab=@tas hers=(list ship)]
|
||||
:_ this
|
||||
%+ turn hers
|
||||
|= her=ship
|
||||
^- move
|
||||
:* ost.hid
|
||||
%peer
|
||||
/[lab]/(scot %p her)
|
||||
[our.hid %aqua]
|
||||
/effects/(scot %p her)
|
||||
==
|
||||
::
|
||||
:: Start the vane drivers
|
||||
::
|
||||
++ init-vanes
|
||||
^- (list move)
|
||||
%+ murn
|
||||
`(list term)`[%aqua vane-apps]
|
||||
|= vane-app=term
|
||||
^- (unit move)
|
||||
=/ app-started
|
||||
.^(? %gu /(scot %p our.hid)/[vane-app]/(scot %da now.hid))
|
||||
?: app-started
|
||||
~
|
||||
`[ost.hid %poke /start [our.hid %hood] %drum-start %home vane-app]
|
||||
::
|
||||
:: Restart the vane drivers' subscriptions
|
||||
::
|
||||
++ subscribe-vanes
|
||||
^- (list move)
|
||||
%+ turn
|
||||
vane-apps
|
||||
|= vane-app=term
|
||||
[ost.hid %poke /init [our.hid vane-app] %aqua-vane-control %subscribe]
|
||||
::
|
||||
:: Pause all existing ships
|
||||
::
|
||||
++ pause-fleet
|
||||
^- (list move)
|
||||
:_ ~
|
||||
:* ost.hid %poke /pause-fleet [our.hid %aqua] %aqua-events
|
||||
%+ turn
|
||||
.^((list ship) %gx /(scot %p our.hid)/aqua/(scot %da now.hid)/ships/noun)
|
||||
|= who=ship
|
||||
[%pause-events who]
|
||||
==
|
||||
::
|
||||
:: User interface
|
||||
::
|
||||
++ poke-ph-command
|
||||
|= com=cli:ph-sur
|
||||
^- (quip move _this)
|
||||
?- -.com
|
||||
%init [init-vanes this]
|
||||
%run
|
||||
?. (~(has by tests) lab.com)
|
||||
~& [%no-test lab.com]
|
||||
`this
|
||||
=. test-qeu (~(put to test-qeu) lab.com)
|
||||
run-test
|
||||
::
|
||||
%cancel
|
||||
=^ moves-1 this (finish-test %last |)
|
||||
=. test-qeu ~
|
||||
=^ moves-2 this run-test
|
||||
[:(weld moves-1 moves-2) this]
|
||||
::
|
||||
%run-all
|
||||
=. test-qeu
|
||||
%- ~(gas to test-qeu)
|
||||
(turn manual-tests head)
|
||||
run-test
|
||||
::
|
||||
%print
|
||||
~& lent=(lent effect-log)
|
||||
~& %+ roll effect-log
|
||||
|= [[who=ship uf=unix-effect] ~]
|
||||
?: ?=(?(%blit %doze) -.q.uf)
|
||||
~
|
||||
?: ?=(%ergo -.q.uf)
|
||||
~& [who [- +<]:uf %omitted-by-ph]
|
||||
~
|
||||
~& [who uf]
|
||||
~
|
||||
`this
|
||||
==
|
||||
::
|
||||
:: Receive effects back from aqua
|
||||
::
|
||||
++ diff-aqua-effects
|
||||
|= [way=wire afs=aqua-effects]
|
||||
^- (quip move _this)
|
||||
:: ~& [%diff-aqua-effect way who.afs]
|
||||
?> ?=([@tas @ ~] way)
|
||||
=/ lab i.way
|
||||
?~ test-core
|
||||
~& [%ph-dropping-done lab]
|
||||
[[ost.hid %pull way [our.hid %aqua] ~]~ this]
|
||||
?. =(lab lab.u.test-core)
|
||||
~& [%ph-dropping-strange lab]
|
||||
[[ost.hid %pull way [our.hid %aqua] ~]~ this]
|
||||
=+ |- ^- $: thru-effects=(list unix-effect)
|
||||
events=(list ph-event)
|
||||
log=_effect-log
|
||||
done=(unit ?)
|
||||
test=_test.u.test-core
|
||||
==
|
||||
?~ ufs.afs
|
||||
[~ ~ ~ ~ test.u.test-core]
|
||||
=/ m-res=_*output:(ph ,~)
|
||||
(test.u.test-core now.hid who.afs i.ufs.afs)
|
||||
=? ufs.afs =(%cont -.next.m-res)
|
||||
[i.ufs.afs [/ %init ~] t.ufs.afs]
|
||||
=^ done=(unit ?) test.u.test-core
|
||||
?- -.next.m-res
|
||||
%wait [~ test.u.test-core]
|
||||
%cont [~ self.next.m-res]
|
||||
%fail [`| test.u.test-core]
|
||||
%done [`& test.u.test-core]
|
||||
==
|
||||
=+ ^- _$
|
||||
?~ done
|
||||
$(ufs.afs t.ufs.afs)
|
||||
[~ ~ ~ done test.u.test-core]
|
||||
:^ ?: thru.m-res
|
||||
[i.ufs.afs thru-effects]
|
||||
thru-effects
|
||||
(weld events.m-res events)
|
||||
[[who i.ufs]:afs log]
|
||||
[done test]
|
||||
=. test.u.test-core test
|
||||
=. effect-log (weld log effect-log)
|
||||
=> .(test-core `(unit test-core-state)`test-core)
|
||||
?^ done
|
||||
=^ moves-1 this (finish-test lab u.done)
|
||||
=^ moves-2 this run-test
|
||||
[(weld moves-1 moves-2) this]
|
||||
=/ moves-1 (publish-aqua-effects who.afs thru-effects)
|
||||
=^ moves-2 this (run-events lab events)
|
||||
[(weld moves-1 moves-2) this]
|
||||
::
|
||||
:: Subscribe to effects
|
||||
::
|
||||
++ peer-effects
|
||||
|= pax=path
|
||||
^- (quip move _this)
|
||||
?. ?=(~ pax)
|
||||
~& [%ph-bad-peer-effects pax]
|
||||
`this
|
||||
`this
|
||||
::
|
||||
:: Subscription cancelled
|
||||
::
|
||||
++ pull
|
||||
|= pax=path
|
||||
`+>.$
|
||||
--
|
||||
@ -1604,7 +1604,7 @@
|
||||
::
|
||||
:: prints help message
|
||||
::
|
||||
(sh-fact %txt "see https://urbit.org/docs/learn/arvo/arvo-internals/messaging/")
|
||||
(sh-fact %txt "see https://urbit.org/docs/using/messaging/")
|
||||
--
|
||||
::
|
||||
++ sh-pact
|
||||
@ -2098,7 +2098,7 @@
|
||||
:: render circle (as glyph if we can).
|
||||
?~ moy
|
||||
=+ cha=(~(get by bound) one ~ ~)
|
||||
=- ?~(cha - "{u.cha ~} {-}")
|
||||
=- ?~(cha - "{u.cha ~}")
|
||||
~(cr-phat cr one)
|
||||
(~(cr-curt cr one) u.moy)
|
||||
--
|
||||
|
||||
@ -12,8 +12,12 @@
|
||||
[ost %wait /(scot %da now) +(now)]
|
||||
::
|
||||
++ wake
|
||||
|= {wir/wire ~}
|
||||
|= {wir/wire error=(unit tang)}
|
||||
?> ?=({@ ~} wir)
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
~& %time-behn-failed
|
||||
[~ +>.$]
|
||||
~& [%took `@dr`(sub now (slav %da i.wir))]
|
||||
[~ +>.$]
|
||||
--
|
||||
|
||||
14
gen/aqua/dojo.hoon
Normal file
14
gen/aqua/dojo.hoon
Normal 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
9
gen/aqua/file.hoon
Normal 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
6
gen/aqua/init.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- aquarium
|
||||
=, aquarium
|
||||
:- %say
|
||||
|= [* [her=ship] ~]
|
||||
:- %aqua-events
|
||||
[%init-ship her ~]~
|
||||
6
gen/aqua/raw-event.hoon
Normal file
6
gen/aqua/raw-event.hoon
Normal 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
6
gen/aqua/restore-fleet.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- aquarium
|
||||
=, aquarium
|
||||
:- %say
|
||||
|= [* [label=@ta] ~]
|
||||
:- %aqua-events
|
||||
[%snap-ships label]~
|
||||
8
gen/aqua/snap-fleet.hoon
Normal file
8
gen/aqua/snap-fleet.hoon
Normal 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]~
|
||||
6
gen/ph/cancel.hoon
Normal file
6
gen/ph/cancel.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- ph
|
||||
:- %say
|
||||
|= [* ~ ~]
|
||||
:- %ph-command
|
||||
^- cli:ph
|
||||
[%cancel ~]
|
||||
6
gen/ph/init.hoon
Normal file
6
gen/ph/init.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- ph
|
||||
:- %say
|
||||
|= [* ~ ~]
|
||||
:- %ph-command
|
||||
^- cli:ph
|
||||
[%init ~]
|
||||
6
gen/ph/print.hoon
Normal file
6
gen/ph/print.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- ph
|
||||
:- %say
|
||||
|= [* ~ ~]
|
||||
:- %ph-command
|
||||
^- cli:ph
|
||||
[%print ~]
|
||||
6
gen/ph/run-all.hoon
Normal file
6
gen/ph/run-all.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- ph
|
||||
:- %say
|
||||
|= [* ~ ~]
|
||||
:- %ph-command
|
||||
^- cli:ph
|
||||
[%run-all ~]
|
||||
6
gen/ph/run.hoon
Normal file
6
gen/ph/run.hoon
Normal file
@ -0,0 +1,6 @@
|
||||
/- ph
|
||||
:- %say
|
||||
|= [* [lab=term ~] ~]
|
||||
:- %ph-command
|
||||
^- cli:ph
|
||||
[%run lab]
|
||||
@ -114,7 +114,11 @@
|
||||
abet:(emit %bonk /bonk ~)
|
||||
::
|
||||
++ take-wake-automass
|
||||
|= [way=wire ~]
|
||||
|= [way=wire error=(unit tang)]
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
~& %helm-wake-automass-fail
|
||||
abet
|
||||
=. nex.mass-timer.sez (add now tim.mass-timer.sez)
|
||||
=< abet
|
||||
%- emil
|
||||
|
||||
@ -338,7 +338,11 @@
|
||||
abet:writ:autoload
|
||||
::
|
||||
++ take-wake-overload
|
||||
|= {way/wire ~}
|
||||
|= {way/wire error=(unit tang)}
|
||||
?^ error
|
||||
%- (slog u.error)
|
||||
~& %kiln-take-wake-overload-fail
|
||||
abet
|
||||
?> ?=({@ ~} way)
|
||||
=+ tym=(slav %dr i.way)
|
||||
~& %wake-overload-deprecated
|
||||
@ -383,10 +387,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
|
||||
@ -415,6 +421,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
|
||||
|
||||
@ -15,7 +15,7 @@
|
||||
;div#root
|
||||
;+ inner
|
||||
==
|
||||
;script@"/~~/landscape/js/index.js";
|
||||
;script@"/~~/landscape/js/index-min.js";
|
||||
==
|
||||
::
|
||||
==
|
||||
|
||||
86
lib/ph.hoon
Normal file
86
lib/ph.hoon
Normal file
@ -0,0 +1,86 @@
|
||||
:: Defines the ph monad.
|
||||
::
|
||||
:: A complete ph test has type data:(ph ,~). This is a function that
|
||||
:: accepts a new unix-effect and produces a list of ph-events to inject
|
||||
:: back into the system. It also produces one of four "next steps":
|
||||
::
|
||||
:: %wait: no change; on next unix-effect call this same function.
|
||||
:: %cont: swap out this test for another one. Mainly useful for
|
||||
:: the implementation of +bind.
|
||||
:: %fail: the test has failed.
|
||||
:: %done: the test has finished successfully.
|
||||
::
|
||||
:: When producing %done, you may specify a value. The ph app assumes
|
||||
:: the value of each whole test will be ~. During the test, though, it
|
||||
:: may be useful to produce intermediate values.
|
||||
::
|
||||
:: We define two additional functions. +return takes a value and
|
||||
:: produces a test which immediately produces a %done with that value.
|
||||
::
|
||||
:: +bind takes a test and a function from the output type of that test
|
||||
:: to another test. This is useful to link tests together. See
|
||||
:: lib/ph/tests.hoon for examples of usage.
|
||||
::
|
||||
:: You may recognize monad terminology. These functions satisfy the
|
||||
:: monad laws: If `f` and `g` are the sort of function that go in the
|
||||
:: second argument to bind and `m` is a test, then:
|
||||
::
|
||||
:: (cork pure (curr bind f)) = f
|
||||
:: (bind m pure) = m
|
||||
:: ((bind m f) g) = (bind m (bind f g))
|
||||
::
|
||||
:: Maintaining these laws requires a particular interpretation of the
|
||||
:: monad, which the ph app implements in +diff-aqua-effects. Thus,
|
||||
:: within the ph app the monad laws hold.
|
||||
::
|
||||
/- aquarium
|
||||
=, aquarium
|
||||
|%
|
||||
+$ ph-input
|
||||
[now=@da who=ship uf=unix-effect]
|
||||
::
|
||||
++ ph-output-raw
|
||||
|* a=mold
|
||||
$~ [& ~ %done *a]
|
||||
$: thru=?
|
||||
events=(list ph-event)
|
||||
$= next
|
||||
$% [%wait ~]
|
||||
[%cont self=(ph-form-raw a)]
|
||||
[%fail ~]
|
||||
[%done value=a]
|
||||
==
|
||||
==
|
||||
::
|
||||
++ ph-form-raw
|
||||
|* a=mold
|
||||
$-(ph-input (ph-output-raw a))
|
||||
::
|
||||
++ ph
|
||||
|* a=mold
|
||||
|%
|
||||
++ output (ph-output-raw a)
|
||||
++ form (ph-form-raw a)
|
||||
++ pure
|
||||
|= arg=a
|
||||
^- form
|
||||
|= ph-input
|
||||
[& ~ %done arg]
|
||||
::
|
||||
++ bind
|
||||
|* b=mold
|
||||
|= [m-b=(ph-form-raw b) fun=$-(b form)]
|
||||
^- form
|
||||
|= input=ph-input
|
||||
=/ b-res=(ph-output-raw b)
|
||||
(m-b input)
|
||||
^- output
|
||||
:+ thru.b-res events.b-res
|
||||
?- -.next.b-res
|
||||
%wait [%wait ~]
|
||||
%cont [%cont ..$(m-b self.next.b-res)]
|
||||
%fail [%fail ~]
|
||||
%done [%cont (fun value.next.b-res)]
|
||||
==
|
||||
--
|
||||
--
|
||||
235
lib/ph/azimuth.hoon
Normal file
235
lib/ph/azimuth.hoon
Normal file
@ -0,0 +1,235 @@
|
||||
:: Mock Azimuth
|
||||
::
|
||||
/+ ph, ph-util, ph-philter
|
||||
=, ph
|
||||
=, ph-util
|
||||
=, ph-philter
|
||||
=> |%
|
||||
+$ az-log [topics=(lest @) data=@t]
|
||||
--
|
||||
=| logs=(list az-log) :: oldest logs first
|
||||
=| eth-filter=(unit [from-block=@ud last-block=@ud address=@ux])
|
||||
=, azimuth-events:azimuth
|
||||
|%
|
||||
++ this-az .
|
||||
++ add-logs
|
||||
|= new-logs=(list az-log)
|
||||
^+ this-az
|
||||
=. logs (weld logs new-logs)
|
||||
this-az
|
||||
::
|
||||
++ router
|
||||
=/ n (philter ,_this-az)
|
||||
^- form:n
|
||||
|%
|
||||
++ stay this-az
|
||||
++ run
|
||||
|= pin=ph-input
|
||||
^- output:n
|
||||
=, enjs:format
|
||||
=/ thus (extract-thus-to uf.pin 'http://localhost:8545')
|
||||
?~ thus
|
||||
[& ~ %wait ~]
|
||||
?~ r.mot.u.thus
|
||||
[& ~ %wait ~]
|
||||
=/ req q.u.r.mot.u.thus
|
||||
|^ ^- output:n
|
||||
=/ method (get-method req)
|
||||
?: =(method 'eth_blockNumber')
|
||||
:- | :_ [%wait ~]
|
||||
%+ answer-request req
|
||||
s+(crip (num-to-hex:ethereum latest-block))
|
||||
?: =(method 'eth_getLogs')
|
||||
:- | :_ [%wait ~]
|
||||
%+ answer-request req
|
||||
%+ logs-to-json
|
||||
(get-param-obj req 'fromBlock')
|
||||
(get-param-obj req 'toBlock')
|
||||
?: =(method 'eth_newFilter')
|
||||
:+ |
|
||||
(answer-request req s+'0xa')
|
||||
=. eth-filter
|
||||
:^ ~
|
||||
(get-param-obj req 'fromBlock')
|
||||
(get-param-obj req 'fromBlock')
|
||||
(get-param-obj req 'address')
|
||||
[%cont ..stay]
|
||||
?: =(method 'eth_getFilterLogs')
|
||||
~& [%filter-logs latest-block eth-filter]
|
||||
?~ eth-filter
|
||||
~|(%no-filter-not-implemented !!)
|
||||
:+ |
|
||||
%+ answer-request req
|
||||
~| [eth-filter latest-block]
|
||||
(logs-to-json from-block.u.eth-filter latest-block)
|
||||
=. last-block.u.eth-filter latest-block
|
||||
[%cont ..stay]
|
||||
?: =(method 'eth_getFilterChanges')
|
||||
~& [%filter-changes latest-block eth-filter]
|
||||
?~ eth-filter
|
||||
~|(%no-filter-not-implemented !!)
|
||||
:+ |
|
||||
%+ answer-request req
|
||||
(logs-to-json last-block.u.eth-filter latest-block)
|
||||
=. last-block.u.eth-filter latest-block
|
||||
[%cont ..stay]
|
||||
[& ~ %wait ~]
|
||||
::
|
||||
++ latest-block
|
||||
(add launch:contracts:azimuth (lent logs))
|
||||
::
|
||||
++ get-id
|
||||
|= req=@t
|
||||
=, dejs:format
|
||||
%. (need (de-json:html req))
|
||||
(ot id+so ~)
|
||||
::
|
||||
++ get-method
|
||||
|= req=@t
|
||||
=, dejs:format
|
||||
%. (need (de-json:html req))
|
||||
(ot method+so ~)
|
||||
::
|
||||
++ get-param-obj
|
||||
|= [req=@t param=@t]
|
||||
=, dejs:format
|
||||
%- hex-to-num:ethereum
|
||||
=/ array
|
||||
%. (need (de-json:html req))
|
||||
(ot params+(ar (ot param^so ~)) ~)
|
||||
?> ?=([* ~] array)
|
||||
i.array
|
||||
::
|
||||
++ answer-request
|
||||
|= [req=@t result=json]
|
||||
^- (list ph-event)
|
||||
=/ resp
|
||||
%- crip
|
||||
%- en-json:html
|
||||
%- pairs
|
||||
:~ id+s+(get-id req)
|
||||
jsonrpc+s+'2.0'
|
||||
result+result
|
||||
==
|
||||
:_ ~
|
||||
:* %event
|
||||
who.pin
|
||||
//http/0v1n.2m9vh
|
||||
%they
|
||||
num.u.thus
|
||||
[200 ~ `(as-octs:mimes:html resp)]
|
||||
==
|
||||
::
|
||||
++ logs-to-json
|
||||
|= [from-block=@ud to-block=@ud]
|
||||
^- json
|
||||
:- %a
|
||||
=/ selected-logs
|
||||
%+ swag
|
||||
[(sub from-block launch:contracts:azimuth) (sub to-block from-block)]
|
||||
logs
|
||||
=/ count from-block
|
||||
|- ^- (list json)
|
||||
?~ selected-logs
|
||||
~
|
||||
:_ $(selected-logs t.selected-logs, count +(count))
|
||||
%- pairs
|
||||
:~ 'logIndex'^s+'0x0'
|
||||
'transactionIndex'^s+'0x0'
|
||||
:+ 'transactionHash' %s
|
||||
(crip (prefix-hex:ethereum (render-hex-bytes:ethereum 32 `@`0x5362)))
|
||||
::
|
||||
:+ 'blockHash' %s
|
||||
(crip (prefix-hex:ethereum (render-hex-bytes:ethereum 32 `@`0x5363)))
|
||||
::
|
||||
:+ 'blockNumber' %s
|
||||
(crip (num-to-hex:ethereum count))
|
||||
::
|
||||
:+ 'address' %s
|
||||
(crip (address-to-hex:ethereum azimuth:contracts:azimuth))
|
||||
::
|
||||
'type'^s+'mined'
|
||||
::
|
||||
'data'^s+data.i.selected-logs
|
||||
:+ 'topics' %a
|
||||
%+ turn topics.i.selected-logs
|
||||
|= topic=@ux
|
||||
^- json
|
||||
:- %s
|
||||
%- crip
|
||||
%- prefix-hex:ethereum
|
||||
(render-hex-bytes:ethereum 32 `@`topic)
|
||||
==
|
||||
--
|
||||
--
|
||||
::
|
||||
++ spawn-galaxy
|
||||
|= who=@p
|
||||
%- add-logs
|
||||
:~ [~[activated who] '']
|
||||
[~[owner-changed who 0xdead.beef] '']
|
||||
:- ~[changed-keys who]
|
||||
%- crip
|
||||
%- prefix-hex:ethereum
|
||||
;: welp
|
||||
(get-keys who 1 %auth)
|
||||
(get-keys who 1 %crypt)
|
||||
(render-hex-bytes:ethereum 32 `@`1)
|
||||
(render-hex-bytes:ethereum 32 `@`1)
|
||||
==
|
||||
==
|
||||
::
|
||||
++ get-keys
|
||||
|= [who=@p life=@ud typ=?(%auth %crypt)]
|
||||
%+ render-hex-bytes:ethereum 32
|
||||
%- keccak-256:keccak:crypto
|
||||
%- as-octs:mimes:html
|
||||
:((cury cat 3) (scot %p who) (scot %ud life) typ)
|
||||
::
|
||||
:: XX replace
|
||||
::
|
||||
++ legacy
|
||||
|%
|
||||
++ 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]
|
||||
--
|
||||
--
|
||||
76
lib/ph/philter.hoon
Normal file
76
lib/ph/philter.hoon
Normal file
@ -0,0 +1,76 @@
|
||||
:: Wrap tests in stateful philters
|
||||
::
|
||||
/+ ph
|
||||
=, ph
|
||||
|%
|
||||
::
|
||||
:: A philter is similar to a test in structure, but they don't
|
||||
:: terminate and have a ++stay arm for saving their state.
|
||||
::
|
||||
:: They may be wrappped around a test with +wrap-philter.
|
||||
::
|
||||
++ philter
|
||||
|* o=mold
|
||||
|%
|
||||
++ output
|
||||
$~ [& ~ %wait ~]
|
||||
$: thru=?
|
||||
events=(list ph-event)
|
||||
$= next
|
||||
$% [%wait ~]
|
||||
[%cont self=form]
|
||||
==
|
||||
==
|
||||
++ form
|
||||
$_ ^?
|
||||
|%
|
||||
++ stay *o
|
||||
++ run |~(ph-input *output)
|
||||
--
|
||||
--
|
||||
::
|
||||
:: Run the inner test wrapped in the outer philter. The philter may
|
||||
:: respond to any event that the test didn't consume. One use is to
|
||||
:: mock outside services, like an Ethereum node or LetsEncrypt.
|
||||
::
|
||||
++ wrap-philter
|
||||
|* [o=mold i=mold]
|
||||
|= [outer=_*form:(philter o) inner=_*form:(ph i)]
|
||||
^+ *form:(ph ,[o i])
|
||||
|= input=ph-input
|
||||
=/ res-i=_*output:(ph i)
|
||||
(inner input)
|
||||
?. thru.res-i
|
||||
:+ thru.res-i events.res-i
|
||||
?- -.next.res-i
|
||||
%wait [%wait ~]
|
||||
%cont [%cont ..$(inner self.next.res-i)]
|
||||
%fail [%fail ~]
|
||||
%done [%done stay:outer value.next.res-i]
|
||||
==
|
||||
=/ res-o=_*output:(philter o)
|
||||
(run:outer input)
|
||||
^+ *output:(ph ,[o i])
|
||||
:+ thru.res-o (welp events.res-i events.res-o)
|
||||
?- -.next.res-i
|
||||
%wait
|
||||
?- -.next.res-o
|
||||
%wait [%wait ~]
|
||||
%cont [%cont ..$(outer self.next.res-o)]
|
||||
==
|
||||
::
|
||||
%cont
|
||||
=. inner self.next.res-i
|
||||
?- -.next.res-o
|
||||
%wait [%cont ..$]
|
||||
%cont [%cont ..$(outer self.next.res-o)]
|
||||
==
|
||||
::
|
||||
%fail [%fail ~]
|
||||
%done
|
||||
?- -.next.res-o
|
||||
%wait [%done stay:outer value.next.res-i]
|
||||
%cont [%done stay:self.next.res-o value.next.res-i]
|
||||
==
|
||||
==
|
||||
--
|
||||
163
lib/ph/tests.hoon
Normal file
163
lib/ph/tests.hoon
Normal file
@ -0,0 +1,163 @@
|
||||
:: Useful tests for testing things
|
||||
::
|
||||
/+ ph, ph-util
|
||||
=, ph
|
||||
=, ph-util
|
||||
|= our=ship
|
||||
=> :: Helper functions, not tests
|
||||
::
|
||||
|%
|
||||
:: Scry into a running aqua ship
|
||||
::
|
||||
++ scry-aqua
|
||||
|* [a=mold now=@da pax=path]
|
||||
.^ a
|
||||
%gx
|
||||
(scot %p our)
|
||||
%aqua
|
||||
(scot %da now)
|
||||
pax
|
||||
==
|
||||
::
|
||||
--
|
||||
::
|
||||
:: Useful tests
|
||||
::
|
||||
|%
|
||||
::
|
||||
:: Never-ending test, for development.
|
||||
::
|
||||
++ stall
|
||||
|= ph-input
|
||||
[& ~ %wait ~]
|
||||
::
|
||||
:: Test to produce events unconditionally.
|
||||
::
|
||||
++ just-events
|
||||
|= events=(list ph-event)
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
|= ph-input
|
||||
[& events %done ~]
|
||||
::
|
||||
:: Boot ship; don't check it succeeded.
|
||||
::
|
||||
++ boot-ship
|
||||
|= [her=ship keys=(unit dawn-event)]
|
||||
^+ *form:(ph ,~)
|
||||
|= ph-input
|
||||
[& (init her keys) %done ~]
|
||||
::
|
||||
:: Wait until ship has finished booting.
|
||||
::
|
||||
++ check-ship-booted
|
||||
|= her=ship
|
||||
^+ *form:(ph ,~)
|
||||
|= ph-input
|
||||
=; done=?
|
||||
:+ & ~
|
||||
?: done
|
||||
[%done ~]
|
||||
[%wait ~]
|
||||
:: 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
|
||||
"clay: committed initial filesystem (all)"
|
||||
::
|
||||
%^ is-dojo-output her who :- uf
|
||||
"is your neighbor"
|
||||
==
|
||||
::
|
||||
:: Send "|hi" from one ship to another
|
||||
::
|
||||
++ send-hi
|
||||
|= [from=@p to=@p]
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m
|
||||
^- form:m
|
||||
|= ph-input
|
||||
[& (dojo from "|hi {(scow %p to)}") %done ~]
|
||||
^- form:m
|
||||
|= input=ph-input
|
||||
^- output:m
|
||||
:+ & ~
|
||||
?. (is-dojo-output from who.input uf.input "hi {(scow %p to)} successful")
|
||||
[%wait ~]
|
||||
[%done ~]
|
||||
::
|
||||
:: Boot a ship and verify it booted. Parent must already be booted.
|
||||
::
|
||||
++ raw-ship
|
||||
|= [her=ship keys=(unit dawn-event)]
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (boot-ship her keys)
|
||||
(check-ship-booted her)
|
||||
::
|
||||
:: Boot a fake star and its parent.
|
||||
::
|
||||
++ star
|
||||
|= her=ship
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (raw-ship (^sein:title her) ~)
|
||||
(raw-ship her ~)
|
||||
::
|
||||
:: Boot a fake planet, its parent, and its grandparent.
|
||||
::
|
||||
++ planet
|
||||
|= her=ship
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (star (^sein:title her))
|
||||
(raw-ship her ~)
|
||||
::
|
||||
:: Mount a desk.
|
||||
::
|
||||
++ mount
|
||||
|= [her=ship des=desk]
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
;< ~ bind:m (just-events (dojo her "|mount /={(trip des)}="))
|
||||
|= pin=ph-input
|
||||
?: (is-ergo her who.pin uf.pin)
|
||||
[& ~ %done ~]
|
||||
[& ~ %wait ~]
|
||||
::
|
||||
:: Modify /sur/aquarium/hoon on the given ship
|
||||
::
|
||||
++ touch-file
|
||||
|= [her=ship des=desk]
|
||||
=/ m (ph ,@t)
|
||||
^- form:m
|
||||
;< ~ bind:m (mount her des)
|
||||
|= pin=ph-input
|
||||
=/ host-pax
|
||||
/(scot %p our)/home/(scot %da now.pin)/sur/aquarium/hoon
|
||||
=/ warped (cat 3 '=> . ' .^(@t %cx host-pax))
|
||||
[& (insert-file her des host-pax warped) %done warped]
|
||||
::
|
||||
:: Check /sur/aquarium/hoon on the given has the given contents.
|
||||
::
|
||||
++ check-file-touched
|
||||
|= [her=ship des=desk warped=@t]
|
||||
=/ m (ph ,~)
|
||||
^- form:m
|
||||
|= pin=ph-input
|
||||
?. &(=(her who.pin) ?=(?(%init %ergo) -.q.uf.pin))
|
||||
[& ~ %wait ~]
|
||||
=/ pax /home/(scot %da now.pin)/sur/aquarium/hoon
|
||||
=/ aqua-pax
|
||||
;: weld
|
||||
/i/(scot %p her)
|
||||
pax(- des)
|
||||
/noun
|
||||
==
|
||||
?: =(warped (need (scry-aqua (unit @) now.pin aqua-pax)))
|
||||
[& ~ %done ~]
|
||||
[& ~ %wait ~]
|
||||
--
|
||||
90
lib/ph/util.hoon
Normal file
90
lib/ph/util.hoon
Normal file
@ -0,0 +1,90 @@
|
||||
:: Utility functions for constructing tests
|
||||
::
|
||||
/+ ph
|
||||
=, ph
|
||||
|%
|
||||
::
|
||||
:: 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]~
|
||||
::
|
||||
:: Send dojo command
|
||||
::
|
||||
++ 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)
|
||||
==
|
||||
::
|
||||
:: Check if given effect is an http request; extract
|
||||
::
|
||||
++ extract-thus-to
|
||||
|= [uf=unix-effect dest=@t]
|
||||
^- (unit [num=@ud mot=moth:eyre])
|
||||
?. ?=(%thus -.q.uf) ~
|
||||
?~ q.q.uf ~
|
||||
?. =(p.u.q.q.uf (rash dest auri:de-purl:html)) ~
|
||||
`[p.q.uf q.u.q.q.uf]
|
||||
--
|
||||
20
mar/md.hoon
Normal file
20
mar/md.hoon
Normal 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
|
||||
--
|
||||
19
mar/pem.hoon
Normal file
19
mar/pem.hoon
Normal file
@ -0,0 +1,19 @@
|
||||
:: .pem file to list of lines
|
||||
::
|
||||
=, format
|
||||
=, mimes:html
|
||||
|_ pem=wain
|
||||
::
|
||||
++ grab :: convert from
|
||||
|%
|
||||
++ mime |=([p=mite:eyre q=octs:eyre] (to-wain q.q))
|
||||
++ noun wain :: clam from %noun
|
||||
--
|
||||
++ grow
|
||||
=> v=.
|
||||
|%
|
||||
++ mime => v [/text/plain (as-octs (of-wain pem))]
|
||||
++ elem => v ;pre: {(trip (of-wain pem))}
|
||||
--
|
||||
++ grad %mime
|
||||
--
|
||||
36
mar/pill.hoon
Normal file
36
mar/pill.hoon
Normal 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
|
||||
--
|
||||
101
sur/aquarium.hoon
Normal file
101
sur/aquarium.hoon
Normal file
@ -0,0 +1,101 @@
|
||||
:: 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.
|
||||
::
|
||||
|%
|
||||
++ ph-event
|
||||
$% [%test-done p=?]
|
||||
aqua-event
|
||||
==
|
||||
::
|
||||
+$ 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 ~]
|
||||
[%init ~]
|
||||
==
|
||||
+$ 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] ~]~
|
||||
==
|
||||
--
|
||||
9
sur/ph.hoon
Normal file
9
sur/ph.hoon
Normal file
@ -0,0 +1,9 @@
|
||||
|%
|
||||
++ cli
|
||||
$% [%init ~]
|
||||
[%cancel ~]
|
||||
[%run lab=term]
|
||||
[%run-all ~]
|
||||
[%print ~]
|
||||
==
|
||||
--
|
||||
@ -473,7 +473,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)
|
||||
@ -655,7 +655,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
|
||||
@ -760,7 +760,7 @@
|
||||
:: In either case, they fall through here to be handled
|
||||
:: after the fact in +feck.
|
||||
::
|
||||
?: ?=(?(%veer %verb %wack) -.q.ovo)
|
||||
?: ?=(?(%veer %verb %wack %warn) -.q.ovo)
|
||||
[[ovo ~] +>.$]
|
||||
::
|
||||
=^ zef vanes
|
||||
@ -811,6 +811,21 @@
|
||||
?> ?=(@ q.q.ovo)
|
||||
=. eny (shaz (cat 3 eny q.q.ovo))
|
||||
[~ +>.$]
|
||||
:: learn of event-replacement failure
|
||||
::
|
||||
%warn
|
||||
:_ +>.$
|
||||
?. ?=(^ +.q.ovo)
|
||||
~
|
||||
=/ msg=tape
|
||||
:(weld "(for %" (trip (symp +<.q.ovo)) ") failed")
|
||||
~> %slog.[0 leaf+(weld "arvo: replacement event " msg)]
|
||||
?: lac
|
||||
~
|
||||
=/ rep
|
||||
%- mule |.
|
||||
((slog (tang +>.q.ovo)) ~)
|
||||
?.(?=(%& -.rep) ~ p.rep)
|
||||
==
|
||||
::
|
||||
++ vega :: reboot kernel
|
||||
|
||||
230
sys/hoon.hoon
230
sys/hoon.hoon
@ -615,7 +615,7 @@
|
||||
:: ::
|
||||
:: ::
|
||||
::
|
||||
:: +snoc Append an element to the end of a list.
|
||||
:: +snoc: append an element to the end of a list
|
||||
::
|
||||
++ snoc
|
||||
|* [a/(list) b/*]
|
||||
@ -674,6 +674,13 @@
|
||||
--
|
||||
a
|
||||
::
|
||||
:: +bake: convert wet gate to dry gate by specifying argument mold
|
||||
::
|
||||
++ bake
|
||||
|* [f=gate a=mold]
|
||||
|= arg=a
|
||||
(f arg)
|
||||
::
|
||||
++ lent :: length
|
||||
~/ %lent
|
||||
|= a/(list)
|
||||
@ -3750,65 +3757,185 @@
|
||||
::
|
||||
++ ob
|
||||
|%
|
||||
++ feen :: conceal structure v2
|
||||
:: +fein: conceal structure, v3.
|
||||
::
|
||||
:: +fein conceals planet-sized atoms. The idea is that it should not be
|
||||
:: trivial to tell which planet a star has spawned under.
|
||||
::
|
||||
++ fein
|
||||
|= pyn/@ ^- @
|
||||
?: &((gte pyn 0x1.0000) (lte pyn 0xffff.ffff))
|
||||
(add 0x1.0000 (fice (sub pyn 0x1.0000)))
|
||||
(add 0x1.0000 (feis (sub pyn 0x1.0000)))
|
||||
?: &((gte pyn 0x1.0000.0000) (lte pyn 0xffff.ffff.ffff.ffff))
|
||||
=+ lo=(dis pyn 0xffff.ffff)
|
||||
=+ hi=(dis pyn 0xffff.ffff.0000.0000)
|
||||
=/ lo (dis pyn 0xffff.ffff)
|
||||
=/ hi (dis pyn 0xffff.ffff.0000.0000)
|
||||
%+ con hi
|
||||
$(pyn lo)
|
||||
pyn
|
||||
::
|
||||
++ fend :: restore structure v2
|
||||
:: +fynd: restore structure, v3.
|
||||
::
|
||||
:: Restores obfuscated values that have been enciphered with +fein.
|
||||
::
|
||||
++ fynd
|
||||
|= cry/@ ^- @
|
||||
?: &((gte cry 0x1.0000) (lte cry 0xffff.ffff))
|
||||
(add 0x1.0000 (teil (sub cry 0x1.0000)))
|
||||
(add 0x1.0000 (tail (sub cry 0x1.0000)))
|
||||
?: &((gte cry 0x1.0000.0000) (lte cry 0xffff.ffff.ffff.ffff))
|
||||
=+ lo=(dis cry 0xffff.ffff)
|
||||
=+ hi=(dis cry 0xffff.ffff.0000.0000)
|
||||
=/ lo (dis cry 0xffff.ffff)
|
||||
=/ hi (dis cry 0xffff.ffff.0000.0000)
|
||||
%+ con hi
|
||||
$(cry lo)
|
||||
cry
|
||||
::
|
||||
++ fice :: adapted from
|
||||
|= nor/@ :: black and rogaway
|
||||
^- @ :: "ciphers with
|
||||
=+ ^= sel :: arbitrary finite
|
||||
%+ rynd 3 :: domains", 2002
|
||||
%+ rynd 2
|
||||
%+ rynd 1
|
||||
%+ rynd 0
|
||||
[(mod nor 65.535) (div nor 65.535)]
|
||||
(add (mul 65.535 -.sel) +.sel)
|
||||
:: +feis: a four-round generalised Feistel cipher over the domain
|
||||
:: [0, 2^32 - 2^16 - 1].
|
||||
::
|
||||
++ teil :: reverse ++fice
|
||||
|= vip/@
|
||||
:: See: Black & Rogaway (2002), Ciphers for arbitrary finite domains.
|
||||
::
|
||||
++ feis
|
||||
|= m=@
|
||||
^- @
|
||||
=+ ^= sel
|
||||
%+ rund 0
|
||||
%+ rund 1
|
||||
%+ rund 2
|
||||
%+ rund 3
|
||||
[(mod vip 65.535) (div vip 65.535)]
|
||||
(add (mul 65.535 -.sel) +.sel)
|
||||
(fee 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
|
||||
::
|
||||
++ rynd :: feistel round
|
||||
|= {n/@ l/@ r/@}
|
||||
^- {@ @}
|
||||
:- r
|
||||
?~ (mod n 2)
|
||||
(~(sum fo 65.535) l (muk (snag n raku) 2 r))
|
||||
(~(sum fo 65.536) l (muk (snag n raku) 2 r))
|
||||
:: +tail: reverse +feis.
|
||||
::
|
||||
++ rund :: reverse round
|
||||
|= {n/@ l/@ r/@}
|
||||
^- {@ @}
|
||||
:- r
|
||||
?~ (mod n 2)
|
||||
(~(dif fo 65.535) l (muk (snag n raku) 2 r))
|
||||
(~(dif fo 65.536) l (muk (snag n raku) 2 r))
|
||||
++ tail
|
||||
|= m=@
|
||||
^- @
|
||||
(feen 4 0xffff 0x1.0000 (mul 0xffff 0x1.0000) eff m)
|
||||
::
|
||||
:: +fee: "Fe" in B&R (2002).
|
||||
::
|
||||
:: A Feistel cipher given the following parameters:
|
||||
::
|
||||
:: r: number of Feistel rounds
|
||||
:: a, b: parameters such that ab >= k
|
||||
:: k: value such that the domain of the cipher is [0, k - 1]
|
||||
:: prf: a gate denoting a family of pseudorandom functions indexed by
|
||||
:: its first argument and taking its second argument as input
|
||||
:: m: an input value in the domain [0, k - 1]
|
||||
::
|
||||
++ fee
|
||||
|= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
|
||||
^- @
|
||||
=/ c (fe r a b prf m)
|
||||
?: (lth c k)
|
||||
c
|
||||
(fe r a b prf c)
|
||||
::
|
||||
:: +feen: "Fe^-1" in B&R (2002).
|
||||
::
|
||||
:: Reverses a Feistel cipher constructed with parameters as described in
|
||||
:: +fee.
|
||||
::
|
||||
++ feen
|
||||
|= [r=@ a=@ b=@ k=@ prf=$-([j=@ r=@] @) m=@]
|
||||
^- @
|
||||
=/ c (fen r a b prf m)
|
||||
?: (lth c k)
|
||||
c
|
||||
(fen r a b prf c)
|
||||
::
|
||||
:: +fe: "fe" in B&R (2002).
|
||||
::
|
||||
:: An internal function to +fee.
|
||||
::
|
||||
:: Note that this implementation differs slightly from the reference paper
|
||||
:: to support some legacy behaviour. See urbit/arvo#1105.
|
||||
::
|
||||
++ fe
|
||||
|= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
|
||||
=/ j 1
|
||||
=/ ell (mod m a)
|
||||
=/ arr (div m a)
|
||||
|- ^- @
|
||||
::
|
||||
?: (gth j r)
|
||||
?. =((mod r 2) 0)
|
||||
(add (mul arr a) ell)
|
||||
::
|
||||
:: Note that +fe differs from B&R (2002)'s "fe" below, as a previous
|
||||
:: implementation of this cipher contained a bug such that certain inputs
|
||||
:: could encipher to the same output.
|
||||
::
|
||||
:: To correct these problem cases while also preserving the cipher's
|
||||
:: legacy behaviour on most inputs, we check for a problem case (which
|
||||
:: occurs when 'arr' is equal to 'a') and, if detected, use an alternate
|
||||
:: permutation instead.
|
||||
::
|
||||
?: =(arr a)
|
||||
(add (mul arr a) ell)
|
||||
(add (mul ell a) arr)
|
||||
::
|
||||
=/ f (prf (sub j 1) arr)
|
||||
::
|
||||
=/ tmp
|
||||
?. =((mod j 2) 0)
|
||||
(mod (add f ell) a)
|
||||
(mod (add f ell) b)
|
||||
::
|
||||
$(j +(j), ell arr, arr tmp)
|
||||
::
|
||||
:: +fen: "fe^-1" in B&R (2002).
|
||||
::
|
||||
:: Note that this implementation differs slightly from the reference paper
|
||||
:: to support some legacy behaviour. See urbit/arvo#1105.
|
||||
::
|
||||
++ fen
|
||||
|= [r=@ a=@ b=@ prf=$-([j=@ r=@] @) m=@]
|
||||
=/ j r
|
||||
::
|
||||
=/ ahh
|
||||
?. =((mod r 2) 0)
|
||||
(div m a)
|
||||
(mod m a)
|
||||
::
|
||||
=/ ale
|
||||
?. =((mod r 2) 0)
|
||||
(mod m a)
|
||||
(div m a)
|
||||
::
|
||||
:: Similar to the comment in +fe, +fen differs from B&R (2002)'s "fe^-1"
|
||||
:: here in order to preserve the legacy cipher's behaviour on most inputs.
|
||||
::
|
||||
:: Here problem cases can be identified by 'ahh' equating with 'a'; we
|
||||
:: correct those cases by swapping the values of 'ahh' and 'ale'.
|
||||
::
|
||||
=/ ell
|
||||
?: =(ale a)
|
||||
ahh
|
||||
ale
|
||||
::
|
||||
=/ arr
|
||||
?: =(ale a)
|
||||
ale
|
||||
ahh
|
||||
::
|
||||
|- ^- @
|
||||
?: (lth j 1)
|
||||
(add (mul arr a) ell)
|
||||
=/ f (prf (sub j 1) ell)
|
||||
::
|
||||
:: Note that there is a slight deviation here to avoid dealing with
|
||||
:: negative values. We add 'a' or 'b' to arr as appropriate and reduce
|
||||
:: 'f' modulo the same number before performing subtraction.
|
||||
::
|
||||
=/ tmp
|
||||
?. =((mod j 2) 0)
|
||||
(mod (sub (add arr a) (mod f a)) a)
|
||||
(mod (sub (add arr b) (mod f b)) b)
|
||||
::
|
||||
$(j (sub j 1), ell tmp, arr ell)
|
||||
::
|
||||
:: +eff: a murmur3-based pseudorandom function. 'F' in B&R (2002).
|
||||
::
|
||||
++ eff
|
||||
|= [j=@ r=@]
|
||||
^- @
|
||||
(muk (snag j raku) 2 r)
|
||||
::
|
||||
:: +raku: seeds for eff.
|
||||
::
|
||||
++ raku
|
||||
^- (list @ux)
|
||||
@ -3817,6 +3944,7 @@
|
||||
0x85bc.ae01
|
||||
0x4b38.7af7
|
||||
==
|
||||
::
|
||||
--
|
||||
::
|
||||
:::: 3g: molds and mold builders
|
||||
@ -5617,7 +5745,7 @@
|
||||
++ dim (ape dip)
|
||||
++ dip (bass 10 ;~(plug sed:ab (star sid:ab)))
|
||||
++ dum (bass 10 (plus sid:ab))
|
||||
++ fed %+ cook fend:ob
|
||||
++ fed %+ cook fynd:ob
|
||||
;~ pose
|
||||
%+ bass 0x1.0000.0000.0000.0000 :: oversized
|
||||
;~ plug
|
||||
@ -5729,7 +5857,7 @@
|
||||
==
|
||||
::
|
||||
$p
|
||||
=+ sxz=(feen:ob q.p.lot)
|
||||
=+ sxz=(fein:ob q.p.lot)
|
||||
=+ dyx=(met 3 sxz)
|
||||
:- '~'
|
||||
?: (lte dyx 1)
|
||||
@ -6566,6 +6694,7 @@
|
||||
{$mcts p/marl:hoot} :: ;= list templating
|
||||
{$mccl p/hoon q/(list hoon)} :: ;: binary to nary
|
||||
{$mcnt p/hoon} :: ;/ [%$ [%$ p ~] ~]
|
||||
{$mcgl p/spec q/hoon r/hoon s/hoon} :: ;< bind
|
||||
{$mcsg p/hoon q/(list hoon)} :: ;~ kleisli arrow
|
||||
{$mcmc p/hoon q/hoon} :: ;; normalize
|
||||
:: :::::: compositions
|
||||
@ -8643,6 +8772,16 @@
|
||||
==
|
||||
::
|
||||
{$mcnt *} =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
|
||||
{$mcgl *}
|
||||
:^ %cnls
|
||||
:+ %cnhp
|
||||
q.gen
|
||||
[%ktcl p.gen]
|
||||
r.gen
|
||||
:+ %brts
|
||||
p.gen
|
||||
s.gen
|
||||
::
|
||||
{$mcsg *} :: ;~
|
||||
|- ^- hoon
|
||||
?- q.gen
|
||||
@ -13909,6 +14048,7 @@
|
||||
[%mcts *] %ast-node-mcts
|
||||
[%mccl *] (rune ';:' `'==' `[':(' spc ')'] (hoons [p q]:x))
|
||||
[%mcnt *] (rune ';/' ~ ~ (hoons ~[p]:x))
|
||||
[%mcgl *] (rune ';<' ~ ~ (spec p.x) (hoons ~[q r s]:x))
|
||||
[%mcsg *] (rune ';~' `'==' ~ (hoons [p q]:x))
|
||||
[%mcmc *] (rune ';;' ~ ~ (hoons ~[p q]:x))
|
||||
[%tsbr *] (rune ';;' ~ ~ ~[(spec p.x) (hn q.x)])
|
||||
@ -16517,6 +16657,7 @@
|
||||
^. stet ^. limo
|
||||
:~ [':' (rune col %mccl expi)]
|
||||
['/' (rune net %mcnt expa)]
|
||||
['<' (rune gal %mcgl exp1)]
|
||||
['~' (rune sig %mcsg expi)]
|
||||
[';' (rune mic %mcmc expb)]
|
||||
==
|
||||
@ -16787,6 +16928,7 @@
|
||||
++ expx |.(;~(gunk loaf wisp)) :: hoon and core tail
|
||||
++ expy |.(;~(gunk ropa loaf loaf)) :: wings and two hoons
|
||||
++ expz |.(loaf(bug &)) :: hoon with tracing
|
||||
++ exp1 |.(;~(gunk loan loaf loaf loaf)) :: spec and three hoons
|
||||
:: spec contents
|
||||
::
|
||||
++ exqa |.(loan) :: one hoon
|
||||
|
||||
@ -6,7 +6,7 @@
|
||||
=, ames
|
||||
:: this number needs to be below 8
|
||||
::
|
||||
=+ protocol-version=2
|
||||
=+ protocol-version=3
|
||||
|%
|
||||
+= move [p=duct q=(wind note:able gift:able)] :: local move
|
||||
:: |pact: internal packet structures
|
||||
@ -26,7 +26,8 @@
|
||||
::
|
||||
|%
|
||||
++ bite :: packet to cake
|
||||
|= pac=rock ^- cake
|
||||
|= pac=rock
|
||||
^- (unit cake)
|
||||
=+ [mag=(end 5 1 pac) bod=(rsh 5 1 pac)]
|
||||
=+ :* vez=(end 0 3 mag) :: protocol version
|
||||
chk=(cut 0 [3 20] mag) :: checksum
|
||||
@ -34,8 +35,12 @@
|
||||
vix=(bex +((cut 0 [25 2] mag))) :: width of sender
|
||||
tay=(cut 0 [27 5] mag) :: message type
|
||||
==
|
||||
?> =(protocol-version vez)
|
||||
?> =(chk (end 0 20 (mug bod)))
|
||||
:: XX these packets should be firewalled in vere so that they don't
|
||||
:: make it into the event log
|
||||
::
|
||||
?. =(protocol-version vez) ~
|
||||
?. =(chk (end 0 20 (mug bod))) ~
|
||||
%- some
|
||||
:+ [(end 3 wix bod) (cut 3 [wix vix] bod)]
|
||||
(kins tay)
|
||||
(rsh 3 (add wix vix) bod)
|
||||
@ -554,6 +559,14 @@
|
||||
%- need %- need
|
||||
%- (sloy-light ski)
|
||||
[[151 %noun] %j our %saxo da+now /(scot %p who)]
|
||||
:: +turf-scry: for network domains
|
||||
::
|
||||
++ turf-scry
|
||||
~/ %turf
|
||||
;; (list turf)
|
||||
%- need %- need
|
||||
%- (sloy-light ski)
|
||||
[[151 %noun] %j our %turf da+now ~]
|
||||
::
|
||||
++ vein :: vein:am
|
||||
~/ %vein
|
||||
@ -598,19 +611,19 @@
|
||||
~/ %gnaw
|
||||
|= [kay=cape ryn=lane pac=rock] :: process packet
|
||||
^- [p=(list boon) q=fort]
|
||||
?. =(protocol-version (end 0 3 pac)) [~ fox]
|
||||
=+ kec=(bite pac)
|
||||
?: (goop p.p.kec)
|
||||
=/ kec=(unit cake) (bite pac)
|
||||
?~ kec [~ fox]
|
||||
?: (goop p.p.u.kec)
|
||||
[~ fox]
|
||||
?. =(our q.p.kec)
|
||||
?. =(our q.p.u.kec)
|
||||
[~ fox]
|
||||
=; zap=[p=(list boon) q=fort]
|
||||
[(weld p.zap next) q.zap]
|
||||
=< zork
|
||||
=< zank
|
||||
:: ~& [%hear p.p.kec ryn `@p`(mug (shaf %flap pac))]
|
||||
%- ~(chew la:(ho:um p.p.kec) kay ryn %none (shaf %flap pac))
|
||||
[q.kec r.kec]
|
||||
:: ~& [%hear p.p.u.kec ryn `@p`(mug (shaf %flap pac))]
|
||||
%- ~(chew la:(ho:um p.p.u.kec) kay ryn %none (shaf %flap pac))
|
||||
[q.u.kec r.u.kec]
|
||||
::
|
||||
++ goop :: blacklist
|
||||
|= him=ship
|
||||
@ -1300,7 +1313,14 @@
|
||||
:_ fox [hen [%pass wire %j %pubs p.bon]]~
|
||||
::
|
||||
%bock
|
||||
:_ fox [hen %give %turf tuf.fox]~
|
||||
:: ignore %turf if we haven't yet learned a unix duct
|
||||
::
|
||||
:: Only happens during first boot.
|
||||
::
|
||||
?~ gad.fox
|
||||
[~ fox]
|
||||
:_ fox
|
||||
[gad.fox %give %turf tuf.fox]~
|
||||
::
|
||||
%brew
|
||||
:_ fox [hen [%pass / %j %turf ~]]~
|
||||
@ -1323,9 +1343,13 @@
|
||||
:_ fox [hen %pass wire i.q.q.bon %west p.bon t.q.q.bon r.bon]~
|
||||
::
|
||||
%ouzo
|
||||
:: drop packet if we haven't yet learned a unix duct
|
||||
::
|
||||
:: Only happens during first boot.
|
||||
::
|
||||
?~ gad.fox
|
||||
[~ fox]
|
||||
:: ~& [%send now p.bon `@p`(mug (shaf %flap q.bon))]
|
||||
~| [%ames-bad-duct duct=gad.fox lane=p.bon]
|
||||
?> ?=(^ gad.fox)
|
||||
:_ fox
|
||||
[[gad.fox [%give %send p.bon q.bon]] ~]
|
||||
::
|
||||
@ -1333,6 +1357,12 @@
|
||||
:_ fox(tim `p.bon)
|
||||
%- flop
|
||||
^- (list move)
|
||||
:: XX should this be the unix duct (gad.fox)?
|
||||
::
|
||||
:: It seems far more important that the duct be always
|
||||
:: predictable than that it be the unix duct, which
|
||||
:: may change, or be unset during first boot.
|
||||
::
|
||||
:- [gad.fox %pass /ames %b %wait p.bon]
|
||||
?~ tim.fox ~
|
||||
[gad.fox %pass /ames %b %rest u.tim.fox]~
|
||||
@ -1374,15 +1404,17 @@
|
||||
~/ %knap
|
||||
|= [tea=wire hen=duct sih=sign:able]
|
||||
^- [(list move) _+>]
|
||||
:: if we got an error from behn, report it to %dill; TODO handle errors
|
||||
::
|
||||
?: ?=([%wake ^] +.sih)
|
||||
=/ =flog:dill [%crud %wake u.error.sih]
|
||||
[[hen %slip %d %flog flog]~ +>.$]
|
||||
::
|
||||
?- +<.sih
|
||||
%crud [[[hen [%slip %d %flog +.sih]] ~] +>]
|
||||
::
|
||||
%mack ?~ +>.sih $(sih [%g %nice ~]) :: XX using old code
|
||||
$(sih [%g %mean `[%mack +>+.sih]])
|
||||
::
|
||||
%turf
|
||||
=. tuf.fox turf.sih
|
||||
[~ +>.$]
|
||||
::
|
||||
%pubs
|
||||
?. ?=([%pubs @ ~] tea)
|
||||
@ -1421,8 +1453,16 @@
|
||||
^- [p=(list boon) q=fort]
|
||||
?- +<.sih
|
||||
::
|
||||
:: only handles the non-error %wake case; error case above
|
||||
::
|
||||
%wake
|
||||
(~(wake am [our now fox ski]) hen)
|
||||
::
|
||||
%turf
|
||||
?: =(tuf.fox turf.sih)
|
||||
[~ fox]
|
||||
=. tuf.fox turf.sih
|
||||
[[%bock ~]~ fox]
|
||||
::
|
||||
?(%mean %nice) :: XX obsolete
|
||||
?: ?=([%ye ~] tea)
|
||||
@ -1471,8 +1511,10 @@
|
||||
^- [p=(list boon) q=fort]
|
||||
?- -.kyz
|
||||
%barn
|
||||
:_ fox(gad hen)
|
||||
[%bock ~]~
|
||||
=: gad.fox hen
|
||||
tuf.fox ~(turf-scry am [our now fox ski])
|
||||
==
|
||||
[[%bock ~]~ fox]
|
||||
::
|
||||
%bonk
|
||||
:_ fox
|
||||
|
||||
@ -28,12 +28,25 @@
|
||||
:: +born: urbit restarted; refresh :next-wake and store wakeup timer duct
|
||||
::
|
||||
++ born set-unix-wake(next-wake.state ~, unix-duct.state duct)
|
||||
:: +crud: error report; hand off to %dill to be printed
|
||||
:: +crud: handle failure of previous arvo event
|
||||
::
|
||||
++ crud
|
||||
|= [p=@tas q=tang]
|
||||
|= [tag=@tas error=tang]
|
||||
^+ [moves state]
|
||||
[[duct %slip %d %flog %crud p q]~ state]
|
||||
:: behn must get activated before other vanes in a %wake
|
||||
::
|
||||
:: TODO: uncomment this case after switching %crud tags
|
||||
::
|
||||
:: We don't know how to handle other errors, so relay them to %dill
|
||||
:: to be printed and don't treat them as timer failures.
|
||||
::
|
||||
:: ?. =(%wake tag)
|
||||
:: ~& %behn-crud-not-first-activation^tag
|
||||
:: [[duct %slip %d %flog %crud tag error]~ state]
|
||||
::
|
||||
?: =(~ timers.state) ~| %behn-crud-no-timer^tag^error !!
|
||||
::
|
||||
(wake `error)
|
||||
:: +rest: cancel the timer at :date, then adjust unix wakeup
|
||||
:: +wait: set a new timer at :date, then adjust unix wakeup
|
||||
::
|
||||
@ -45,9 +58,15 @@
|
||||
:: +wake: unix says wake up; process the elapsed timer and set :next-wake
|
||||
::
|
||||
++ wake
|
||||
|= error=(unit tang)
|
||||
^+ [moves state]
|
||||
::
|
||||
?~ timers.state ~|(%behn-wake-no-timer !!)
|
||||
?~ timers.state ~| %behn-wake-no-timer^error !!
|
||||
:: if we errored, pop the timer and notify the client vane of the error
|
||||
::
|
||||
?^ error
|
||||
=< set-unix-wake
|
||||
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state error)
|
||||
:: if unix woke us too early, retry by resetting the unix wakeup timer
|
||||
::
|
||||
?: (gth date.i.timers.state now)
|
||||
@ -56,7 +75,7 @@
|
||||
:: pop first timer, tell vane it has elapsed, and adjust next unix wakeup
|
||||
::
|
||||
=< set-unix-wake
|
||||
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state)
|
||||
(emit-vane-wake(timers.state t.timers.state) duct.i.timers.state ~)
|
||||
:: +wegh: produce memory usage report for |mass
|
||||
::
|
||||
++ wegh
|
||||
@ -74,7 +93,9 @@
|
||||
++ event-core .
|
||||
:: +emit-vane-wake: produce a move to wake a vane; assumes no prior moves
|
||||
::
|
||||
++ emit-vane-wake |=(=^duct event-core(moves [duct %give %wake ~]~))
|
||||
++ emit-vane-wake
|
||||
|= [=^duct error=(unit tang)]
|
||||
event-core(moves [duct %give %wake error]~)
|
||||
:: +emit-doze: set new unix wakeup timer in state and emit move to unix
|
||||
::
|
||||
:: We prepend the unix %doze event so that it is handled first. Arvo must
|
||||
@ -88,6 +109,10 @@
|
||||
++ emit-doze
|
||||
|= =date=(unit @da)
|
||||
^+ event-core
|
||||
:: no-op if .unix-duct has not yet been set
|
||||
::
|
||||
?~ unix-duct.state
|
||||
event-core
|
||||
:: make sure we don't try to wake up in the past
|
||||
::
|
||||
=? date-unit ?=(^ date-unit) `(max now u.date-unit)
|
||||
@ -182,11 +207,11 @@
|
||||
=^ moves state
|
||||
?- -.task
|
||||
%born born:event-core
|
||||
%crud (crud:event-core [p q]:task)
|
||||
%crud (crud:event-core [tag tang]:task)
|
||||
%rest (rest:event-core date=p.task)
|
||||
%vega vega:event-core
|
||||
%wait (wait:event-core date=p.task)
|
||||
%wake wake:event-core
|
||||
%wake (wake:event-core error=~)
|
||||
%wegh wegh:event-core
|
||||
==
|
||||
[moves behn-gate]
|
||||
|
||||
@ -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)
|
||||
::
|
||||
@ -338,12 +341,17 @@
|
||||
{$warp p/ship q/riff} ::
|
||||
{$werp p/ship q/ship r/riff} ::
|
||||
== == ::
|
||||
$: $d ::
|
||||
$% {$flog p/{$crud p/@tas q/(list tank)}} :: to %dill
|
||||
$: $d :: to %dill
|
||||
$% $: $flog ::
|
||||
$% {$crud p/@tas q/(list tank)} ::
|
||||
{$text p/tape} ::
|
||||
== == ::
|
||||
== == ::
|
||||
$: $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} ::
|
||||
@ -363,11 +371,28 @@
|
||||
$% [%made date=@da result=made-result:ford] ::
|
||||
== == ::
|
||||
$: $b ::
|
||||
$% {$wake ~} :: timer activate
|
||||
$% {$wake error=(unit tang)} :: timer activate
|
||||
== == ::
|
||||
$: @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 +416,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 +454,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 +483,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 +495,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 +561,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)
|
||||
~
|
||||
@ -1043,6 +1086,18 @@
|
||||
++ print-changes
|
||||
|= {wen/@da lem/nuri}
|
||||
^+ +>
|
||||
:: skip full change output for initial filesystem
|
||||
::
|
||||
?: ?& =(%base syd)
|
||||
|(=(1 let.dom) =(2 let.dom))
|
||||
?=([%& ^] lem)
|
||||
==
|
||||
=/ msg=tape
|
||||
%+ weld
|
||||
"clay: committed initial filesystem"
|
||||
?:(=(1 let.dom) " (hoon)" " (all)")
|
||||
(emit (need hun) %pass / %d %flog %text msg)
|
||||
::
|
||||
=+ pre=`path`~[(scot %p her) syd (scot %ud let.dom)]
|
||||
?- -.lem
|
||||
%| (print-to-dill '=' %leaf :(weld (trip p.lem) " " (spud pre)))
|
||||
@ -1757,8 +1812,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 +2411,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 +2876,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 +3002,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 +3238,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 +3765,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 +3782,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 +3809,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 +3844,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 +3897,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 +3916,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 +3954,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 +4023,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 +4045,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 +4065,29 @@
|
||||
::
|
||||
++ load
|
||||
=> |%
|
||||
++ axle $%([%1 ruf=raft])
|
||||
++ axle $% [%1 ruf-1=raft-1]
|
||||
[%2 ruf-2=raft]
|
||||
==
|
||||
--
|
||||
|= old=axle
|
||||
^+ ..^$
|
||||
..^$(ruf ruf.old)
|
||||
=? old ?=(%1 -.old)
|
||||
(load-1-2 old)
|
||||
?> ?=(%2 -.old)
|
||||
%_(..^$ 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 +4110,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 +4132,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 +4165,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 +4174,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 +4183,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 +4192,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 +4200,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 +4208,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 +4218,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 +4233,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 +4252,37 @@
|
||||
::
|
||||
$note [[hen %give +.q.hin]~ ..^$]
|
||||
$wake
|
||||
:: TODO: handle behn errors
|
||||
::
|
||||
?^ error.q.hin
|
||||
[[hen %slip %d %flog %crud %wake u.error.q.hin]~ ..^$]
|
||||
::
|
||||
?: ?=([%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 +4352,17 @@
|
||||
?~ -
|
||||
`[paf %ins %mime -:!>(*mime) u.mim]
|
||||
`[paf %mut %mime -:!>(*mime) u.mim]
|
||||
:: +rift-scry: for a +rift
|
||||
::
|
||||
++ rift-scry
|
||||
~% %rift-scry ..is ~
|
||||
|= 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]
|
||||
--
|
||||
|
||||
@ -175,7 +175,7 @@
|
||||
++ crud
|
||||
|= {err/@tas tac/(list tank)}
|
||||
=+ ^= wol ^- wall
|
||||
:- (trip err)
|
||||
:- :(weld "%" (trip err) " event failed:")
|
||||
(zing (turn (flop tac) |=(a/tank (~(win re a) [0 wid]))))
|
||||
|- ^+ +>.^$
|
||||
?~ wol +>.^$
|
||||
@ -308,10 +308,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) +>
|
||||
@ -401,11 +408,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]
|
||||
@ -431,6 +433,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 +>.$
|
||||
|
||||
@ -2678,7 +2678,7 @@
|
||||
:_ message.u.input-result
|
||||
:- %leaf
|
||||
;: weld
|
||||
"ford: %cast " (trip mark) "on [" (trip (scot %p ship.disc))
|
||||
"ford: %cast " (trip mark) " on [" (trip (scot %p ship.disc))
|
||||
" " (trip desk.disc) "] failed on input:"
|
||||
==
|
||||
::
|
||||
@ -2699,7 +2699,7 @@
|
||||
:_ message.u.translation-path-result
|
||||
:- %leaf
|
||||
;: weld
|
||||
"ford: %cast " (trip mark) "on [" (trip (scot %p ship.disc))
|
||||
"ford: %cast " (trip mark) " on [" (trip (scot %p ship.disc))
|
||||
" " (trip desk.disc) "] failed:"
|
||||
==
|
||||
::
|
||||
@ -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])
|
||||
::
|
||||
|
||||
@ -737,10 +737,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
|
||||
@ -1297,40 +1303,40 @@
|
||||
^- (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
|
||||
$snap `%j
|
||||
$wait `%b
|
||||
$want `%a
|
||||
$warp `%c
|
||||
$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
|
||||
%snap `%j
|
||||
%wait `%b
|
||||
%want `%a
|
||||
%warp `%c
|
||||
%wind `%j
|
||||
%wipe `%f
|
||||
::
|
||||
$request `%l
|
||||
$serve `%r
|
||||
$connect `%r
|
||||
$disconnect `%r
|
||||
$rule `%r
|
||||
%request `%l
|
||||
%serve `%r
|
||||
%connect `%r
|
||||
%disconnect `%r
|
||||
%rule `%r
|
||||
==
|
||||
--
|
||||
--
|
||||
@ -1403,9 +1409,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)
|
||||
|
||||
@ -987,6 +987,12 @@
|
||||
?. ?=([%init ~] wir)
|
||||
abet:~(wake et hen our now urb.lex sub.lex etn.lex sap.lex)
|
||||
abet:(~(init et hen our now [urb sub etn sap]:lex) our (sein our))
|
||||
::
|
||||
[%b %wake ^]
|
||||
:: TODO: handle behn error
|
||||
::
|
||||
~& %jael-wake-bad^u.error.hin
|
||||
+>.$
|
||||
::
|
||||
[%j %vent *]
|
||||
%+ cute hen =< abet
|
||||
@ -1437,19 +1443,21 @@
|
||||
::
|
||||
:- (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 %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 %f %sunk who rit]
|
||||
[hen %slip %g %sunk who rit]
|
||||
==
|
||||
moz
|
||||
==
|
||||
:: pon: updated point
|
||||
:: new: new keypair or "kept continuity?" (yes is no-op)
|
||||
@ -2251,6 +2259,7 @@
|
||||
eny=@uvJ
|
||||
ski=sley
|
||||
==
|
||||
^?
|
||||
|%
|
||||
:: :: ++call
|
||||
++ call :: request
|
||||
@ -2331,6 +2340,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) [~ ~]
|
||||
|
||||
172
sys/zuse.hoon
172
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
|
||||
::
|
||||
::
|
||||
@ -378,7 +379,7 @@
|
||||
== ::
|
||||
++ sign :: in result _<-
|
||||
$% $: $b :: to %behn
|
||||
$% {$wake ~} :: timer activate
|
||||
$% {$wake error=(unit tang)} :: timer activate
|
||||
== == ::
|
||||
$: %j :: from %jael
|
||||
$% [%pubs public:able:jael] :: public keys
|
||||
@ -405,7 +406,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
|
||||
@ -576,23 +577,23 @@
|
||||
++ able ^?
|
||||
|%
|
||||
++ note :: out request $->
|
||||
$% $: $d :: to %dill
|
||||
$% {$flog p/flog:dill} ::
|
||||
== == == ::
|
||||
$% $: %d :: to %dill
|
||||
$% [$flog =flog:dill]
|
||||
== == ==
|
||||
++ gift :: out result <-$
|
||||
$% {$doze p/(unit @da)} :: next alarm
|
||||
{$mass p/mass} :: memory usage
|
||||
{$wake ~} :: wakeup
|
||||
== ::
|
||||
$% [%doze p=(unit @da)] :: next alarm
|
||||
[%mass p=mass] :: memory usage
|
||||
[%wake error=(unit tang)] :: wakeup or failed
|
||||
==
|
||||
++ task :: in request ->$
|
||||
$% {$born ~} :: new unix process
|
||||
{$crud p/@tas q/(list tank)} :: error with trace
|
||||
{$rest p/@da} :: cancel alarm
|
||||
{$vega ~} :: report upgrade
|
||||
{$wait p/@da} :: set alarm
|
||||
{$wake ~} :: timer activate
|
||||
{$wegh ~} :: report memory
|
||||
== ::
|
||||
$% [%born ~] :: new unix process
|
||||
[%crud tag=@tas =tang] :: error with trace
|
||||
[%rest p=@da] :: cancel alarm
|
||||
[%vega ~] :: report upgrade
|
||||
[%wait p=@da] :: set alarm
|
||||
[%wake ~] :: timer activate
|
||||
[%wegh ~] :: report memory
|
||||
==
|
||||
-- ::able
|
||||
-- ::behn
|
||||
:: ::::
|
||||
@ -640,7 +641,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
|
||||
@ -805,8 +806,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
|
||||
@ -1077,7 +1078,7 @@
|
||||
[%kill ~]
|
||||
:: %sunk: receive a report that a foreign ship has lost continuity
|
||||
::
|
||||
[%sunk =ship =life]
|
||||
[%sunk =ship =rift]
|
||||
:: %vega: report kernel upgrade
|
||||
::
|
||||
[%vega ~]
|
||||
@ -1771,7 +1772,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
|
||||
@ -1919,7 +1920,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
|
||||
@ -1933,7 +1934,7 @@
|
||||
+$ seed [who=ship lyf=life key=ring sig=(unit oath:pki)]
|
||||
::
|
||||
++ sign :: in result $<-
|
||||
$% {$b $wake ~} :: wakeup
|
||||
$% {$b $wake error=(unit tang)} :: wakeup
|
||||
[%j %vent p=vent-result] :: ethereum changes
|
||||
[%a %woot p=ship q=coop] :: message result
|
||||
[%l %http-response =client-response:http-client]
|
||||
@ -7261,28 +7262,33 @@
|
||||
:: :: ++lef:yu:chrono:
|
||||
++ lef :: leapsecond dates
|
||||
^- (list @da)
|
||||
:~ ~2015.6.30..23.59.59 ~2012.6.30..23.59.59
|
||||
~2008.12.31..23.59.58 ~2005.12.31..23.59.57
|
||||
~1998.12.31..23.59.56 ~1997.6.30..23.59.55
|
||||
~1995.12.31..23.59.54 ~1994.6.30..23.59.53
|
||||
~1993.6.30..23.59.52 ~1992.6.30..23.59.51
|
||||
~1990.12.31..23.59.50 ~1989.12.31..23.59.49
|
||||
~1987.12.31..23.59.48 ~1985.6.30..23.59.47
|
||||
~1983.6.30..23.59.46 ~1982.6.30..23.59.45
|
||||
~1981.6.30..23.59.44 ~1979.12.31..23.59.43
|
||||
~1978.12.31..23.59.42 ~1977.12.31..23.59.41
|
||||
~1976.12.31..23.59.40 ~1975.12.31..23.59.39
|
||||
~1974.12.31..23.59.38 ~1973.12.31..23.59.37
|
||||
~1972.12.31..23.59.36 ~1972.6.30..23.59.35
|
||||
:~ ~2016.12.31..23.59.59 ~2015.6.30..23.59.59
|
||||
~2012.6.30..23.59.59 ~2008.12.31..23.59.58
|
||||
~2005.12.31..23.59.57 ~1998.12.31..23.59.56
|
||||
~1997.6.30..23.59.55 ~1995.12.31..23.59.54
|
||||
~1994.6.30..23.59.53 ~1993.6.30..23.59.52
|
||||
~1992.6.30..23.59.51 ~1990.12.31..23.59.50
|
||||
~1989.12.31..23.59.49 ~1987.12.31..23.59.48
|
||||
~1985.6.30..23.59.47 ~1983.6.30..23.59.46
|
||||
~1982.6.30..23.59.45 ~1981.6.30..23.59.44
|
||||
~1979.12.31..23.59.43 ~1978.12.31..23.59.42
|
||||
~1977.12.31..23.59.41 ~1976.12.31..23.59.40
|
||||
~1975.12.31..23.59.39 ~1974.12.31..23.59.38
|
||||
~1973.12.31..23.59.37 ~1972.12.31..23.59.36
|
||||
~1972.6.30..23.59.35
|
||||
==
|
||||
:: :: ++les:yu:chrono:
|
||||
++ les :: leapsecond days
|
||||
::
|
||||
:: +les:yu:chrono: leapsecond days
|
||||
::
|
||||
:: https://www.ietf.org/timezones/data/leap-seconds.list
|
||||
::
|
||||
++ les
|
||||
^- (list @da)
|
||||
:~ ~2015.7.1 ~2012.7.1 ~2009.1.1 ~2006.1.1 ~1999.1.1 ~1997.7.1
|
||||
~1996.1.1 ~1994.7.1 ~1993.7.1 ~1992.7.1 ~1991.1.1 ~1990.1.1
|
||||
~1988.1.1 ~1985.7.1 ~1983.7.1 ~1982.7.1 ~1981.7.1 ~1980.1.1
|
||||
~1979.1.1 ~1978.1.1 ~1977.1.1 ~1976.1.1 ~1975.1.1 ~1974.1.1
|
||||
~1973.1.1 ~1972.7.1
|
||||
:~ ~2017.1.1 ~2015.7.1 ~2012.7.1 ~2009.1.1 ~2006.1.1 ~1999.1.1
|
||||
~1997.7.1 ~1996.1.1 ~1994.7.1 ~1993.7.1 ~1992.7.1 ~1991.1.1
|
||||
~1990.1.1 ~1988.1.1 ~1985.7.1 ~1983.7.1 ~1982.7.1 ~1981.7.1
|
||||
~1980.1.1 ~1979.1.1 ~1978.1.1 ~1977.1.1 ~1976.1.1 ~1975.1.1
|
||||
~1974.1.1 ~1973.1.1 ~1972.7.1
|
||||
==
|
||||
-- ::yu
|
||||
-- ::chrono
|
||||
@ -7481,13 +7487,14 @@
|
||||
++ unix-task :: input from unix
|
||||
$% {$belt p/belt:dill} :: dill: keyboard
|
||||
{$blew p/blew:dill} :: dill: configure
|
||||
{$boat ~} :: clay: reboot
|
||||
{$born ~} :: eyre: new process
|
||||
{$hail ~} :: dill: refresh
|
||||
{$boat ~} :: clay: reboot
|
||||
{$born ~} :: eyre: new process
|
||||
[%crud tag=@tas =tang] :: any vane: error report
|
||||
{$hail ~} :: dill: refresh
|
||||
{$hear p/lane:ames q/@} :: ames: input packet
|
||||
{$hook ~} :: dill: hangup
|
||||
{$hook ~} :: dill: hangup
|
||||
{$into p/desk q/? r/mode:clay} :: clay: external edit
|
||||
{$wake ~} :: behn: wakeup
|
||||
{$wake ~} :: behn: wakeup
|
||||
==
|
||||
:: ::
|
||||
:::: ++azimuth :: (2az) azimuth
|
||||
@ -7578,12 +7585,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
|
||||
@ -8093,6 +8102,7 @@
|
||||
:: enc(X) is the sequence of bytes in X padded with zero-bytes to a
|
||||
:: length of 32.
|
||||
:: Note that for any X, len(enc(X)) is a multiple of 32.
|
||||
~| [%bytes-n-too-long max=32 actual=p.p.dat]
|
||||
?> (lte p.p.dat 32)
|
||||
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
|
||||
::
|
||||
@ -8102,7 +8112,7 @@
|
||||
:: by the minimum number of zero-bytes such that len(enc(X)) is a
|
||||
:: multiple of 32.
|
||||
%+ weld $(dat [%uint p.p.dat])
|
||||
$(dat [%bytes-n p.dat])
|
||||
(pad-to-multiple (render-hex-bytes p.dat) 64 %right)
|
||||
::
|
||||
%string
|
||||
:: enc(X) = enc(enc_utf8(X)), i.e. X is utf-8 encoded and this value is
|
||||
@ -8134,24 +8144,19 @@
|
||||
::
|
||||
:: decoding
|
||||
::
|
||||
++ decode-topics
|
||||
:: tox: list of hex words
|
||||
|* [tox=(lest @ux) tys=(list etyp)]
|
||||
=- (decode-arguments (crip -) tys)
|
||||
%+ render-hex-bytes (mul 32 (lent tox))
|
||||
%+ roll `(list @ux)`tox
|
||||
|= [top=@ux tos=@]
|
||||
(cat 8 top tos)
|
||||
++ decode-topics decode-arguments
|
||||
::
|
||||
++ decode-results
|
||||
:: rex: string of hex bytes with leading 0x.
|
||||
|* [rex=@t tys=(list etyp)]
|
||||
(decode-arguments (rsh 3 2 rex) tys)
|
||||
=- (decode-arguments - tys)
|
||||
%+ turn (rip 9 (rsh 3 2 rex))
|
||||
(curr rash hex)
|
||||
::
|
||||
++ decode-arguments
|
||||
|* [res=@t tys=(list etyp)]
|
||||
|* [wos=(list @) tys=(list etyp)]
|
||||
=/ wos=(list @) wos :: get rid of tmi
|
||||
=| win=@ud
|
||||
=/ wos=(list @t) (rip 9 res)
|
||||
=< (decode-from 0 tys)
|
||||
|%
|
||||
++ decode-from
|
||||
@ -8176,22 +8181,21 @@
|
||||
?(%address %bool %uint) :: %int %real %ureal
|
||||
:- +(win)
|
||||
?- typ
|
||||
%address `@ux`(rash wor hex)
|
||||
%uint `@ud`(rash wor hex)
|
||||
%bool =(1 (rash wor hex))
|
||||
%address `@ux`wor
|
||||
%uint `@ud`wor
|
||||
%bool =(1 wor)
|
||||
==
|
||||
::
|
||||
%string
|
||||
=+ $(tys ~[%bytes])
|
||||
~! -
|
||||
[nin (trip (swp 3 q.dat))]
|
||||
::
|
||||
%bytes
|
||||
:- +(win)
|
||||
:: find the word index of the actual data.
|
||||
=/ lic=@ud (div (rash wor hex) 32)
|
||||
=/ lic=@ud (div wor 32)
|
||||
:: learn the bytelength of the data.
|
||||
=/ len=@ud (rash (snag lic wos) hex)
|
||||
=/ len=@ud (snag lic wos)
|
||||
(decode-bytes-n +(lic) len)
|
||||
::
|
||||
[%bytes-n *]
|
||||
@ -8201,11 +8205,11 @@
|
||||
[%array *]
|
||||
:- +(win)
|
||||
:: find the word index of the actual data.
|
||||
=. win (div (rash wor hex) 32)
|
||||
=. win (div wor 32)
|
||||
:: read the elements from their location.
|
||||
%- tail
|
||||
%^ decode-array-n ~[t.typ] +(win)
|
||||
(rash (snag win wos) hex)
|
||||
(snag win wos)
|
||||
::
|
||||
[%array-n *]
|
||||
(decode-array-n ~[t.typ] win n.typ)
|
||||
@ -8215,18 +8219,20 @@
|
||||
|= [fro=@ud bys=@ud]
|
||||
^- octs
|
||||
:: parse {bys} bytes from {fro}.
|
||||
=- [bys (rash - hex)]
|
||||
%^ end 3 (mul 2 bys)
|
||||
%+ can 9
|
||||
%+ turn
|
||||
(swag [fro +((div (dec bys) 32))] wos)
|
||||
|=(a=@t [1 a])
|
||||
:- bys
|
||||
%^ rsh 3
|
||||
=+ (mod bys 32)
|
||||
?:(=(0 -) - (sub 32 -))
|
||||
%+ rep 8
|
||||
%- flop
|
||||
=- (swag [fro -] wos)
|
||||
+((div (dec bys) 32))
|
||||
::
|
||||
++ decode-array-n
|
||||
::NOTE we take (list etyp) even though we only operate on
|
||||
:: a single etyp as a workaround for urbit/arvo#673
|
||||
::NOTE careful! produces lists without type info
|
||||
=| res=(list)
|
||||
~& %watch-out--arrays-without-typeinfo
|
||||
|* [tys=(list etyp) fro=@ud len=@ud]
|
||||
^- [@ud (list)]
|
||||
?~ tys !!
|
||||
@ -8591,6 +8597,8 @@
|
||||
|= n=@
|
||||
^- tape
|
||||
%- prefix-hex
|
||||
?: =(0 n)
|
||||
"0"
|
||||
%- render-hex-bytes
|
||||
(as-octs:mimes:html n)
|
||||
::
|
||||
@ -8615,8 +8623,10 @@
|
||||
|= [wat=tape mof=@ud wer=?(%left %right)]
|
||||
^- tape
|
||||
=+ len=(lent wat)
|
||||
?: =(len mof) wat
|
||||
=+ tad=(reap (sub mof (mod len mof)) '0')
|
||||
?: =(0 len) (reap mof '0')
|
||||
=+ mad=(mod len mof)
|
||||
?: =(0 mad) wat
|
||||
=+ tad=(reap (sub mof mad) '0')
|
||||
%- weld
|
||||
?:(?=(%left wer) [tad wat] [wat tad])
|
||||
::
|
||||
|
||||
@ -1,5 +1,109 @@
|
||||
/+ *test
|
||||
|%
|
||||
++ test-parse-p
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> ~zod
|
||||
!> `@p`0
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~lex
|
||||
!> `@p`200
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~binzod
|
||||
!> `@p`512
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~samzod
|
||||
!> `@p`1.024
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~poldec-tonteg
|
||||
!> `@p`9.896.704
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~nidsut-tomdun
|
||||
!> `@p`15.663.360
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~morlyd-mogmev
|
||||
!> `@p`3.108.299.008
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~fipfes-morlyd
|
||||
!> `@p`479.733.505
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~dilwes-fadnel
|
||||
!> `@p`23.554.048
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~fipfes-dilwes
|
||||
!> `@p`529.511.092
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~hossev-roppec
|
||||
!> `@p`1.859.915.444
|
||||
::
|
||||
%+ expect-eq
|
||||
!> ~fipfes-hossev
|
||||
!> `@p`145.391.618
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-render-p
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> '~zod'
|
||||
!> (scot %p 0)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~lex'
|
||||
!> (scot %p 200)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~binzod'
|
||||
!> (scot %p 512)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~samzod'
|
||||
!> (scot %p 1.024)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~poldec-tonteg'
|
||||
!> (scot %p 9.896.704)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~nidsut-tomdun'
|
||||
!> (scot %p 15.663.360)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~morlyd-mogmev'
|
||||
!> (scot %p 3.108.299.008)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~fipfes-morlyd'
|
||||
!> (scot %p 479.733.505)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~dilwes-fadnel'
|
||||
!> (scot %p 23.554.048)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~fipfes-dilwes'
|
||||
!> (scot %p 529.511.092)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~hossev-roppec'
|
||||
!> (scot %p 1.859.915.444)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> '~fipfes-hossev'
|
||||
!> (scot %p 145.391.618)
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-parse-q
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
|
||||
140
tests/sys/hoon/ob.hoon
Normal file
140
tests/sys/hoon/ob.hoon
Normal file
@ -0,0 +1,140 @@
|
||||
/+ *test
|
||||
|%
|
||||
++ test-fein-fynd-inverses
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> 0
|
||||
!> (fynd:ob (fein:ob 0))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 15.663.360
|
||||
!> (fynd:ob (fein:ob 15.663.360))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.208.402.137
|
||||
!> (fynd:ob (fein:ob 1.208.402.137))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 123.456.789.012.345
|
||||
!> (fynd:ob (fein:ob 123.456.789.012.345))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 4.267.685.634
|
||||
!> (fynd:ob (fein:ob 4.267.685.634))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.625.882.369
|
||||
!> (fynd:ob (fein:ob 1.625.882.369))
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-fein-fynd-match-reference-vals
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> 1.897.766.331
|
||||
!> (fein:ob 123.456.789)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.208.402.137
|
||||
!> (fein:ob 15.663.360)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 15.663.360
|
||||
!> (fynd:ob 1.208.402.137)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 123.456.789
|
||||
!> (fynd:ob 1.897.766.331)
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-feis-tail-inverses
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> 15.663.360
|
||||
!> (tail:ob (feis:ob 15.663.360))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.208.402.137
|
||||
!> (tail:ob (feis:ob 1.208.402.137))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 4.267.685.634
|
||||
!> (tail:ob (feis:ob 4.267.685.634))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.625.882.369
|
||||
!> (tail:ob (feis:ob 1.625.882.369))
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-feis-tail-match-reference-vals
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> 2.060.458.291
|
||||
!> (feis:ob 123.456.789)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.195.593.620
|
||||
!> (feis:ob 15.663.360)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 1.107.963.580
|
||||
!> (tail:ob 123.456.789)
|
||||
::
|
||||
%+ expect-eq
|
||||
!> 15.663.360
|
||||
!> (tail:ob 1.195.593.620)
|
||||
::
|
||||
==
|
||||
::
|
||||
++ test-exhaustive-small
|
||||
=/ a=(list @) ~[5 9 2 6 4 0 8 7 1 10 3 11]
|
||||
=/ b=(list @) ~[2 1 0 3 10 4 9 5 7 11 6 8]
|
||||
=/ c=(list @) ~[10 6 7 1 0 11 3 9 5 2 8 4]
|
||||
=/ d=(list @) ~[11 0 3 5 9 8 6 10 4 1 2 7]
|
||||
::
|
||||
=/ prf
|
||||
|= [j=@ r=@]
|
||||
^- @
|
||||
?: =(j 0)
|
||||
(snag r a)
|
||||
?: =(j 1)
|
||||
(snag r b)
|
||||
?: =(j 2)
|
||||
(snag r c)
|
||||
(snag r d)
|
||||
::
|
||||
::
|
||||
=/ feis
|
||||
|= arg=@
|
||||
^- @
|
||||
(fee:ob 4 3 4 12 prf arg)
|
||||
::
|
||||
=/ tail
|
||||
|= arg=@
|
||||
^- @
|
||||
(feen:ob 4 3 4 12 prf arg)
|
||||
::
|
||||
=/ emm=(list @) ~[0 1 2 3 4 5 6 7 8 9 10 11]
|
||||
=/ semm=(set @) (sy emm)
|
||||
::
|
||||
=/ perm=(list @) (turn emm feis)
|
||||
=/ inv=(list @) (turn perm tail)
|
||||
=/ distincts=(set @) (sy perm)
|
||||
::
|
||||
;: weld
|
||||
%+ expect-eq
|
||||
!> (lent perm)
|
||||
!> (lent ~(tap in distincts))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> &
|
||||
!> (roll perm |=([x=@ acc=?] &((~(has in semm) x) acc)))
|
||||
::
|
||||
%+ expect-eq
|
||||
!> emm
|
||||
!> inv
|
||||
::
|
||||
==
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user