urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-15 04:22:48 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #1169 from urbit/philip/individual-breaches

Browse Source 
Individual breaches, Clay edition
This commit is contained in:
Jared Tobin 2019-05-18 05:31:24 +08:00 committed by GitHub
commit ec1b5a2e21
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
32 changed files with 3618 additions and 3019 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.travis/test.js
View File

@ -85,7 +85,7 @@ function barMass(urb) {
function aqua(urb) {
return urb.line("|start %ph")
.then(function(){
return urb.line(":ph %init");
return urb.line(":ph|init");
})
.then(function(){
return urb.line(":aqua &pill +solid");
@ -94,7 +94,7 @@ function aqua(urb) {
urb.every(/TEST [^ ]* FAILED/, function(arg){
throw Error(arg);
});
return urb.line(":ph [%run-test %hi]");
return urb.line(":ph|run %hi");
})
.then(function(){
return urb.expectEcho("ALL TESTS SUCCEEDED")

3
README.md
View File

@ -57,8 +57,9 @@ Most parts of Arvo have dedicated maintainers.
* `/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.
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.

9
app/acme.hoon
View File

@ -1265,6 +1265,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

2
app/aqua-dill.hoon
View File

@ -73,6 +73,6 @@
%sav ~& [%save-file-to p.b] line
%url ~& [%activate-url p.b] line
==
~& last-line
~? !=(~ last-line) last-line
this
--

26
app/aqua.hoon
View File

@ -21,6 +21,8 @@
:: We get ++unix-event and ++pill from /-aquarium
::
/- aquarium
/+ pill
=, pill-lib=pill
=, aquarium
=> $~ |%
+$ move (pair bone card)
@ -117,10 +119,13 @@
?> ?=(%0 -.poke-arm)
=/ poke p.poke-arm
=. tym (max +(tym) now.hid)
=/ poke-result (slum poke tym ue)
=. snap +.poke-result
=/ poke-result (mule |.((slum poke tym ue)))
?: ?=(%| -.poke-result)
%- (slog >%aqua-crash< >guest=who< p.poke-result)
$
=. snap +.p.poke-result
=. ..abet-pe (publish-event tym ue)
=. ..abet-pe (handle-effects ((list ovum) -.poke-result))
=. ..abet-pe (handle-effects ((list ovum) -.p.poke-result))
$
::
:: Peek
@ -370,6 +375,14 @@
=> .(this ^+(this this))
=^ ms this (poke-pill pil)
(emit-moves ms)
::
[%swap-files ~]
=. userspace-ova.pil
:_ ~
%- unix-event
(file-ovum:pill-lib /(scot %p our.hid)/home/(scot %da now.hid))
=^ ms this (poke-pill pil)
(emit-moves ms)
::
[%wish hers=* p=@t]
%+ turn-ships ((list ship) hers.val)
@ -458,6 +471,8 @@
%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]~)
==
::
@ -508,14 +523,15 @@
++ peek-x-i
|= pax=path
^- (unit (unit [%noun noun]))
?. ?=([@ @ @ *] pax)
?. ?=([@ @ @ @ @ *] pax)
~
=/ who (slav %p i.pax)
=/ pier (~(get by piers) who)
=/ ren i.t.t.t.t.pax
?~ pier
~
:^ ~ ~ %noun
(peek:(pe who) [%cx pax])
(peek:(pe who) t.pax)
::
:: Get all created ships
::

1
app/hood.hoon
View File

@ -202,5 +202,6 @@
++ reap-drum-phat (wrap reap-phat):from-drum
++ woot-helm (wrap take-woot):from-helm
++ writ-kiln-autoload (wrap take-writ-autoload):from-kiln
++ writ-kiln-find-ship (wrap take-writ-find-ship):from-kiln
++ writ-kiln-sync (wrap take-writ-sync):from-kiln
--

432
app/ph.hoon
View File

@ -7,10 +7,12 @@
:: - Restore a fleet
:: - Compose tests
::
/- aquarium
/+ ph
/- aquarium, ph
/+ ph, ph-tests, ph-azimuth, ph-philter
=, ph-sur=^ph
=, aquarium
=, ph
=, ph-philter
=> $~ |%
+$ move (pair bone card)
+$ card
@ -32,20 +34,21 @@
::
+$ state
$: %0
raw-test-cores=(map term raw-test-core)
test-core=(unit test-core-state)
tests=(map term [(list ship) _*form:(ph ,~)])
other-state
==
::
+$ test-core-state
$: hers=(list ship)
cor=raw-test-core
effect-log=(list [who=ship uf=unix-effect])
$: 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
@ -55,176 +58,156 @@
state
==
++ this .
++ test-lib ~(. ^test-lib our.hid)
::
:: Tests that will be run automatically with :ph %run-all-tests
::
++ auto-tests
=, test-lib
^- (list (pair term raw-test-core))
:~
:- %boot-bud
(galaxy ~bud)
::
:- %add
^- raw-test-core
%+ compose-tests (galaxy ~bud)
%+ stateless-test
%add
|_ now=@da
++ start
(dojo ~bud "[%test-result (add 2 3)]")
::
++ route
|= [who=ship uf=unix-effect]
(expect-dojo-output ~bud who uf "[%test-result 5]")
--
::
:- %hi
%+ compose-tests
%+ compose-tests
(galaxy ~bud)
(galaxy ~dev)
%+ stateless-test
%hi
|_ now=@da
++ start
(dojo ~bud "|hi ~dev")
::
++ route
|= [who=ship uf=unix-effect]
(expect-dojo-output ~bud who uf "hi ~dev successful")
--
::
:- %boot-planet
(planet ~linnup-torsyx)
::
:- %hi-grandparent
%+ compose-tests (planet ~linnup-torsyx)
%+ stateless-test
%hi-grandparent
|_ now=@da
++ start
(dojo ~linnup-torsyx "|hi ~bud")
::
++ route
|= [who=ship uf=unix-effect]
(expect-dojo-output ~linnup-torsyx who uf "hi ~bud successful")
--
::
:- %second-cousin-hi
%+ compose-tests
%+ compose-tests (planet ~mitnep-todsut)
(planet ~haplun-todtus)
%+ stateless-test
%second-cousin-hi
|_ now=@da
++ start
(dojo ~haplun-todtus "|hi ~mitnep-todsut")
::
++ route
|= [who=ship uf=unix-effect]
(expect-dojo-output ~haplun-todtus who uf "hi ~mitnep-todsut successful")
--
::
:- %change-file
%+ compose-tests (galaxy ~bud)
(touch-file ~bud %home)
::
:- %child-sync
%+ compose-tests
%+ compose-tests
(star ~marbud)
(touch-file ~bud %base)
(check-file-touched ~marbud %home)
==
::
:: Tests that will not be run automatically.
::
:: Some valid reasons for not running a test automatically:
:: - Nondeterministic
:: - Depends on external services
:: - Is very slow
::
++ manual-tests
=, test-lib
^- (list (pair term raw-test-core))
:~ :- %boot-from-azimuth
%+ compose-tests
%+ compose-tests
(raw-ship ~bud `(dawn:azimuth ~bud))
(touch-file ~bud %home)
:: %- assert-happens
:: :~
:: ==
*raw-test-core
^- (list (pair term [(list ship) _*form:(ph ,~)]))
=+ (ph-tests our.hid)
=/ eth-node (spawn:ph-azimuth ~bud)
=/ m (ph ,~)
:~ :+ %boot-bud
~[~bud]
(raw-ship ~bud ~)
::
:- %simple-add
%+ compose-tests (galaxy ~bud)
%+ stateless-test
%add
^- stateless-test-core
|_ now=@da
++ start
=/ command "[%test-result (add 2 3)]"
:~ [%event ~bud //term/1 %belt %txt ((list @c) command)]
[%event ~bud //term/1 %belt %ret ~]
==
::
++ route
|= [who=ship uf=unix-effect]
?. (is-dojo-output ~bud who uf "[%test-result 5]")
~
[%test-done &]~
--
:+ %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 ~]
::
:- %count
%+ compose-tests (galaxy ~bud)
%+ porcelain-test
%state
=| count=@
|_ now=@da
++ start
^- (quip ph-event _..start)
[(dojo ~bud "\"count: {<count>}\"") ..start]
::
++ route
|= [who=ship uf=unix-effect]
^- (quip ph-event _..start)
?. (is-dojo-output ~bud who uf "\"count: {<count>}\"")
[~ ..start]
?: (gte count 10)
[[%test-done &]~ ..start]
=. count +(count)
start
--
:+ %hi
~[~bud ~dev]
;< ~ bind:m (raw-ship ~bud ~)
;< ~ bind:m (raw-ship ~dev ~)
(send-hi ~bud ~dev)
::
:- %break-behn
%+ compose-tests
%+ compose-tests
(galaxy ~bud)
(galaxy ~dev)
^- raw-test-core
|_ now=@da
++ label %break-behn
++ ships ~
++ start
[(dojo ~bud "|hi ~dev") ..start]
::
++ route
|= [who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
?: ?=(%doze -.q.uf)
[| ~ ..start]
:- & :_ ..start
(expect-dojo-output ~bud who uf "hi ~dev successful")
--
:+ %boot-planet
~[~bud ~marbud ~linnup-torsyx]
(planet ~linnup-torsyx)
::
:+ %second-cousin-hi
~[~bud ~marbud ~linnup-torsyx ~dev ~mardev ~mitnep-todsut]
;< ~ bind:m (planet ~linnup-torsyx)
;< ~ bind:m (planet ~mitnep-todsut)
(send-hi ~linnup-torsyx ~mitnep-todsut)
::
:+ %change-file
~[~bud]
;< ~ bind:m (raw-ship ~bud ~)
;< file=@t bind:m (touch-file ~bud %home)
(check-file-touched ~bud %home file)
::
:+ %child-sync
~[~bud ~marbud]
;< ~ bind:m (star ~marbud)
;< file=@t bind:m (touch-file ~bud %base)
(check-file-touched ~marbud %home file)
::
:+ %boot-az
~[~bud]
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
(raw-ship ~bud `(dawn:eth-node ~bud))
(pure:m ~)
::
:+ %breach-hi
~[~bud ~dev]
=. eth-node (spawn:eth-node ~dev)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~bud `(dawn:eth-node ~bud))
;< ~ bind:m (raw-ship ~dev `(dawn:eth-node ~dev))
(send-hi ~bud ~dev)
;< eth-node=_eth-node bind:m
(breach-and-hear:eth-node our.hid ~dev ~bud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (send-hi-not-responding ~bud ~dev)
;< ~ bind:m (raw-ship ~dev `(dawn:eth-node ~dev))
(wait-for-dojo ~bud "hi ~dev successful")
(pure:m ~)
::
:+ %breach-hi-cousin
~[~bud ~dev ~marbud ~mardev]
=. eth-node (spawn:eth-node ~dev)
=. eth-node (spawn:eth-node ~marbud)
=. eth-node (spawn:eth-node ~mardev)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~bud `(dawn:eth-node ~bud))
;< ~ bind:m (raw-ship ~dev `(dawn:eth-node ~dev))
;< ~ bind:m (raw-ship ~marbud `(dawn:eth-node ~marbud))
;< ~ bind:m (raw-ship ~mardev `(dawn:eth-node ~mardev))
(send-hi ~marbud ~mardev)
;< eth-node=_eth-node bind:m
(breach-and-hear:eth-node our.hid ~mardev ~marbud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (send-hi-not-responding ~marbud ~mardev)
;< ~ bind:m (raw-ship ~mardev `(dawn:eth-node ~mardev))
(wait-for-dojo ~marbud "hi ~mardev successful")
(pure:m ~)
::
:+ %breach-sync
~[~bud ~marbud]
=. eth-node (spawn:eth-node ~marbud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~bud `(dawn:eth-node ~bud))
;< ~ bind:m (raw-ship ~marbud `(dawn:eth-node ~marbud))
;< file=@t bind:m (touch-file ~bud %base)
(check-file-touched ~marbud %home file)
;< eth-node=_eth-node bind:m
(breach-and-hear:eth-node our.hid ~bud ~marbud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~bud `(dawn:eth-node ~bud))
;< ~ bind:m (just-events (dojo ~bud "|merge %base ~marbud %kids, =gem %this"))
;< file=@t bind:m (touch-file ~bud %base)
;< file=@t bind:m (touch-file ~bud %base)
(check-file-touched ~marbud %home file)
(pure:m ~)
::
:+ %breach-multiple
~[~bud ~marbud]
=. eth-node (spawn:eth-node ~marbud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~bud `(dawn:eth-node ~bud))
;< ~ bind:m (raw-ship ~marbud `(dawn:eth-node ~marbud))
;< file=@t bind:m (touch-file ~bud %base)
(check-file-touched ~marbud %home file)
;< eth-node=_eth-node bind:m
(breach-and-hear:eth-node our.hid ~bud ~marbud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
(raw-ship ~bud `(dawn:eth-node ~bud))
;< eth-node=_eth-node bind:m
(breach-and-hear:eth-node our.hid ~marbud ~bud)
;< [eth-node=_eth-node ~] bind:m
%+ (wrap-philter ,_eth-node ,~)
router:eth-node
;< ~ bind:m (raw-ship ~marbud `(dawn:eth-node ~marbud))
;< file=@t bind:m (touch-file ~bud %base)
;< file=@t bind:m (touch-file ~bud %base)
(check-file-touched ~marbud %home file)
(pure:m ~)
==
::
++ install-tests
^+ this
=. raw-test-cores
(~(uni by (malt auto-tests)) (malt manual-tests))
=. tests (malt manual-tests)
this
::
++ prep
@ -260,9 +243,6 @@
?~ what
[%& ~]
?: ?=(%test-done -.i.what)
~& ?~ p.i.what
"TEST {(trip lab)} SUCCESSFUL"
"TEST {(trip lab)} FAILED"
[%| p.i.what]
=/ nex $(what t.what)
?: ?=(%| -.nex)
@ -281,6 +261,9 @@
^- (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
@ -309,12 +292,14 @@
`this(results ~)
=^ lab test-qeu ~(get to test-qeu)
~& [running-test=lab test-qeu]
=/ res=[events=(list ph-event) new-state=raw-test-core]
~(start (~(got by raw-test-cores) lab) now.hid)
=. effect-log ~
=+ ^- [ships=(list ship) test=_*form:(ph ,~)]
(~(got by tests) lab)
=> .(test-core `(unit test-core-state)`test-core)
=. test-core `[ships . ~]:new-state.res
=^ moves-1 this (subscribe-to-effects lab ships.new-state.res)
=^ moves-2 this (run-events lab events.res)
=. 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 ~&
@ -384,24 +369,16 @@
::
:: User interface
::
++ poke-noun
|= arg=*
++ poke-ph-command
|= com=cli:ph-sur
^- (quip move _this)
?+ arg ~|(%bad-noun-arg !!)
%init
[init-vanes this]
::
%run-all-tests
=. test-qeu
%- ~(gas to test-qeu)
(turn auto-tests head)
run-test
::
[%run-test lab=@tas]
?. (~(has by raw-test-cores) lab.arg)
~& [%no-test lab.arg]
?- -.com
%init [init-vanes this]
%run
?. (~(has by tests) lab.com)
~& [%no-test lab.com]
`this
=. test-qeu (~(put to test-qeu) lab.arg)
=. test-qeu (~(put to test-qeu) lab.com)
run-test
::
%cancel
@ -409,11 +386,16 @@
=. 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
=/ log effect-log:(need test-core)
~& lent=(lent log)
~& %+ roll log
~& lent=(lent effect-log)
~& %+ roll effect-log
|= [[who=ship uf=unix-effect] ~]
?: ?=(?(%blit %doze) -.q.uf)
~
@ -434,30 +416,50 @@
?> ?=([@tas @ ~] way)
=/ lab i.way
?~ test-core
~& [%ph-dropping lab]
`this
~& [%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)
cor=_u.test-core
log=_effect-log
done=(unit ?)
test=_test.u.test-core
==
?~ ufs.afs
[~ ~ u.test-core]
=. effect-log.u.test-core
[[who i.ufs]:afs effect-log.u.test-core]
=+ ^- [thru=? events-1=(list ph-event) cor=_cor.u.test-core]
(~(route cor.u.test-core now.hid) who.afs i.ufs.afs)
=. cor.u.test-core cor
=+ $(ufs.afs t.ufs.afs)
:+ ?: thru
[i.ufs.afs thru-effects]
thru-effects
(weld events-1 events)
cor
=. test-core `cor
=> .(test-core `(unit test-core-state)`test-core)
=/ moves-1 (publish-aqua-effects who.afs thru-effects)
=^ moves-2 this (run-events lab events)
[(weld moves-1 moves-2) this]
[~ ~ ~ ~ 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
::

2
gen/aqua/dojo.hoon
View File

@ -1,7 +1,7 @@
/- aquarium
=, aquarium
:- %say
|= [* [her=ship command=tape] ~]
|= [* [her=ship command=tape ~] ~]
:- %aqua-events
%+ turn
^- (list unix-event)

2
gen/aqua/init.hoon
View File

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

10
gen/aqua/scry.hoon Normal file
View File

@ -0,0 +1,10 @@
/- aquarium
/+ ph-util
=, aquarium
:- %say
|* $: [now=@da eny=@uvJ bec=beak]
[a=mold pax=path ~]
~
==
:- %noun
(scry-aqua:ph-util a p.bec now pax)

6
gen/ph/cancel.hoon Normal file
View File

@ -0,0 +1,6 @@
/- ph
:- %say
|= [* ~ ~]
:- %ph-command
^- cli:ph
[%cancel ~]

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

@ -0,0 +1,6 @@
/- ph
:- %say
|= [* ~ ~]
:- %ph-command
^- cli:ph
[%init ~]

6
gen/ph/print.hoon Normal file
View File

@ -0,0 +1,6 @@
/- ph
:- %say
|= [* ~ ~]
:- %ph-command
^- cli:ph
[%print ~]

6
gen/ph/run-all.hoon Normal file
View File

@ -0,0 +1,6 @@
/- ph
:- %say
|= [* ~ ~]
:- %ph-command
^- cli:ph
[%run-all ~]

6
gen/ph/run.hoon Normal file
View File

@ -0,0 +1,6 @@
/- ph
:- %say
|= [* [lab=term ~] ~]
:- %ph-command
^- cli:ph
[%run lab]

22
lib/hood/kiln.hoon
View File

@ -320,6 +320,16 @@
==
abet:abet:(mere:(auto hos) mes)
::
++ take-writ-find-ship ::
|= {way/wire rot/riot}
?> ?=({@ @ @ *} way)
=+ ^- hos/kiln-sync
:* syd=(slav %tas i.way)
her=(slav %p i.t.way)
sud=(slav %tas i.t.t.way)
==
abet:abet:(take-find-ship:(auto hos) rot)
::
++ take-writ-sync ::
|= {way/wire rot/riot}
?> ?=({@ @ @ *} way)
@ -379,7 +389,13 @@
(blab [ost %warp wire her sud `[%sing %y ud+let /]] ~)
::
++ start-sync
=< (spam (render "activated sync" sud her syd) ~)
=> (spam (render "finding ship and desk" sud her syd) ~)
=/ =wire /kiln/find-ship/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %y ud+1 /]] ~)
::
++ take-find-ship
|= rot=riot
=> (spam (render "activated sync" sud her syd) ~)
=/ =wire /kiln/sync/[syd]/(scot %p her)/[sud]
(blab [ost %warp wire her sud `[%sing %w [%da now] /]] ~)
::
@ -420,10 +436,10 @@
::
++ mere
|= mes=(each (set path) (pair term tang))
?: ?=([%| %ali-sunk *] mes)
?: ?=([%| %bad-fetch-ali *] mes)
=. +>.$
%^ spam
leaf+"merge cancelled because sunk, restarting"
leaf+"merge cancelled, maybe because sunk; restarting"
(render "on sync" sud her syd)
~
start-sync:stop

533
lib/ph.hoon
View File

@ -1,473 +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.
::
:::: /hoon/ph/lib
::
/- aquarium
=, aquarium
|%
:: Defines a complete integration test.
+$ ph-input
[now=@da who=ship uf=unix-effect]
::
++ raw-test-core
$_ ^|
|_ now=@da
::
:: Unique name, used as a cache label.
::
++ label *@ta
::
:: List of ships that are part of the test.
::
:: We'll only hear effects from these ships, and only these will
:: be in the cache points.
::
++ ships *(list ship)
::
:: Called first to kick off the test.
::
++ start *(quip ph-event _^|(..start))
::
:: Called on every effect from a ship.
::
:: The loobean in the return value says whether we should pass on
:: the effect to vane drivers. Usually this should be yes.
::
++ route |~([ship unix-effect] *[? (quip ph-event _^|(..start))])
--
::
:: A simpler interface for when you don't need all the power.
::
:: Doesn't allwow you to explicitly subscribe to certain ships or
:: blocking certain effects from going to their usual vane drivers.
::
:: Use with +porcelain-test
::
++ porcelain-test-core
$_ ^|
|_ now=@da
:: Called first to kick off the test.
::
++ start *(quip ph-event _^|(..start))
::
:: Called on every effect from a ship.
::
++ route |~([ship unix-effect] *(quip ph-event _^|(..start)))
--
::
:: A simpler interface for when you don't need test state.
::
:: Use with +stateless-test
::
++ stateless-test-core
$_ ^|
|_ now=@da
:: Called first to kick off the test.
::
++ start *(list ph-event)
::
:: Called on every effect from a ship.
::
++ route |~([ship unix-effect] *(list ph-event))
--
::
++ ph-event
$% [%test-done p=?]
aqua-event
++ ph-output-raw
|* a=mold
$~ [& ~ %done *a]
$: thru=?
events=(list ph-event)
$= next
$% [%wait ~]
[%cont self=(ph-form-raw a)]
[%fail ~]
[%done value=a]
==
==
::
:: Call with a +porecelain-test-core create a stateless test.
++ ph-form-raw
|* a=mold
$-(ph-input (ph-output-raw a))
::
++ porcelain-test
|= [label=@ta porcelain=porcelain-test-core]
^- raw-test-core
|_ now=@da
++ label ^label
++ ships ~
++ start
=^ events porcelain ~(start porcelain now)
[events ..start]
::
++ route
|= args=[ship unix-effect]
=^ events porcelain (~(route porcelain now) args)
[& events ..start]
--
::
:: Call with a +stateless-test-core create a stateless test.
::
++ stateless-test
|= [label=@tas stateless=stateless-test-core]
%+ porcelain-test
label
^- porcelain-test-core
|_ now=@da
++ start
[~(start stateless now) ..start]
::
++ route
|= args=[ship unix-effect]
[(~(route stateless now) args) ..start]
--
::
:: Turn [ship (list unix-event)] into (list ph-event)
::
++ send-events-to
|= [who=ship what=(list unix-event)]
^- (list ph-event)
%+ turn what
|= ue=unix-event
[%event who ue]
::
:: Start a ship (low-level; prefer +raw-ship)
::
++ init
|= [who=ship keys=(unit dawn-event)]
^- (list ph-event)
[%init-ship who keys]~
::
:: factor out send-events-to
::
++ dojo
|= [who=ship what=tape]
^- (list ph-event)
%+ send-events-to who
^- (list unix-event)
:~
[//term/1 %belt %ctl `@c`%e]
[//term/1 %belt %ctl `@c`%u]
[//term/1 %belt %txt ((list @c) what)]
[//term/1 %belt %ret ~]
==
::
:: Inject a file into a ship
::
++ insert-file
|= [who=ship des=desk pax=path txt=@t]
^- (list ph-event)
?> ?=([@ @ @ *] pax)
=/ file [/text/plain (as-octs:mimes:html txt)]
%+ send-events-to who
:~
[//sync/0v1n.2m9vh %into des | [t.t.t.pax `file]~]
==
::
:: Checks whether the given event is a dojo output blit containing the
:: given tape
::
++ is-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
?& =(who her)
?=(%blit -.q.uf)
::
%+ lien p.q.uf
|= =blit:dill
?. ?=(%lin -.blit)
|
!=(~ (find what p.blit))
==
::
:: Test is successful if +is-dojo-output
::
++ expect-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
^- (list ph-event)
?. (is-dojo-output who her uf what)
~
[%test-done &]~
::
:: Check whether the given event is an ergo
::
++ is-ergo
|= [who=ship her=ship uf=unix-effect]
?& =(who her)
?=(%ergo -.q.uf)
==
::
++ azimuth
++ ph
|* a=mold
|%
++ dawn
|= who=ship
^- dawn-event
:* (need (private-key who))
(^sein:title who)
czar
~[~['arvo' 'netw' 'ork']]
0
`(need (de-purl:html 'http://localhost:8545'))
~
==
++ output (ph-output-raw a)
++ form (ph-form-raw a)
++ pure
|= arg=a
^- form
|= ph-input
[& ~ %done arg]
::
++ czar
^- (map ship [life pass])
%- my
^- (list (pair ship [life pass]))
%+ murn (gulf 0x0 0xff)
|= her=ship
^- (unit [ship life pass])
=/ pub (public-key her)
?~ pub
~
`[her u.pub]
::
++ private-key
|= who=ship
=- (~(get by -) who)
^- (map ship seed:able:jael)
%- my
:~ [~bud ~bud 1 'BbudB' ~]
[~dev ~dev 1 'Bdev' ~]
==
::
++ public-key
|= who=ship
^- (unit [life pass])
=/ priv (private-key who)
?~ priv
~
=/ cub (nol:nu:crub:crypto key.u.priv)
`[lyf.u.priv pub:ex:cub]
--
::
++ test-lib
|_ our=ship
::
:: Run one test, then the next.
::
:: Caches the result of the first test.
::
++ compose-tests
|= [a=raw-test-core b=raw-test-core]
^- raw-test-core
=/ done-with-a |
=>
|%
++ filter-a
|= [now=@da events=(list ph-event)]
^- (quip ph-event _..filter-a)
=+ ^- [done=(list ph-event) other-events=(list ph-event)]
%+ skid events
|= e=ph-event
=(%test-done -.e)
?~ done
[other-events ..filter-a]
?> ?=(%test-done -.i.done)
?. p.i.done
[[%test-done |]~ ..filter-a]
=. done-with-a &
=/ snap-event [%snap-ships label:a ships:a]
=^ events-start b ~(start b now)
[(welp other-events [snap-event events-start]) ..filter-a]
--
|_ now=@da
::
:: Cache lookup label
::
++ label `@tas`:((cury cat 3) label:a '--' label:b)
::
:: Union of ships in a and b
::
++ ships ~(tap in (~(uni in (silt ships.a)) (silt ships.b)))
::
:: Start with start of a
::
++ start
^- (quip ph-event _..start)
=/ have-cache
(scry-aqua ? now /fleet-snap/[label:a]/noun)
?: have-cache
~& [%caching-in label:a label]
=. done-with-a &
=/ restore-event [%restore-snap label:a]
=^ events-start b ~(start b now)
=^ events ..filter-a (filter-a now restore-event events-start)
[events ..start]
=^ events a ~(start a now)
[events ..start]
::
:: Keep going on a until it's done. If success, go to b.
::
:: In theory, we should be able to just swap out the whole core
:: for b, but in practice the types are hard, and we generally
:: try to avoid changing the structure of a core in the middle
:: like that.
::
++ route
|= [who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
?: done-with-a
=+ ^- [thru=? events=(list ph-event) cor=raw-test-core]
(~(route b now) who uf)
=. b cor
[thru events ..start]
=+ ^- [thru=? events=(list ph-event) cor=raw-test-core]
(~(route a now) who uf)
=. a cor
=^ events ..filter-a (filter-a now events)
[thru events ..start]
--
::
:: Don't use directly unless you've already started any parent.
::
:: Consider ++galaxy, ++star, ++planet, and ++ship-with-ancestors.
::
++ raw-ship
|= [her=ship keys=(unit dawn-event)]
^- raw-test-core
|_ now=@da
++ label :((cury cat 3) 'init-' (scot %p her) '-' (scot %uw (mug (fall keys *dawn-event))))
++ ships ~[her]
++ start
^- (quip ph-event _..start)
[(init her keys) ..start]
::
++ route
|= [who=ship uf=unix-effect]
^- [? (quip ph-event _..start)]
:- &
:_ ..start
%- zing
:: This is a pretty bad heuristic, but in general galaxies will
:: hit the first of these cases, and other ships will hit the
:: second.
::
:~
?. %^ is-dojo-output her who :- uf
"clay: committed initial filesystem (all)"
~
[%test-done &]~
::
?. %^ is-dojo-output her who :- uf
"is your neighbor"
~
[%test-done &]~
==
--
::
++ galaxy
|= her=ship
?> =(%czar (clan:title her))
(raw-ship her ~)
::
++ star
|= her=ship
?> =(%king (clan:title her))
%+ compose-tests (galaxy (^sein:title her))
(raw-ship her ~)
::
++ planet
|= her=ship
?> =(%duke (clan:title her))
%+ compose-tests (star (^sein:title her))
(raw-ship her ~)
::
++ ship-with-ancestors
|= her=ship
%. her
?- (clan:title her)
%czar galaxy
%king star
%duke planet
%earl ~|(%moon-not-implemented !!)
%pawn ~|(%comet-not-implemented !!)
==
::
:: Touches /sur/aquarium/hoon on the given ship.
::
++ touch-file
|= [her=ship des=desk]
%+ porcelain-test
(cat 3 'touch-file-' (scot %p her))
=| [warped=@t change-sent=_|]
^- porcelain-test-core
|_ now=@da
++ start
^- (pair (list ph-event) _..start)
:_ ..start
(dojo her "|mount /={(trip des)}=")
::
++ route
|= [who=ship uf=unix-effect]
^- (quip ph-event _..start)
?. (is-ergo her who uf)
`..start
?. change-sent
=/ host-pax
/(scot %p our)/home/(scot %da now)/sur/aquarium/hoon
=. warped (cat 3 '=> . ' .^(@t %cx host-pax))
=. change-sent &
[(insert-file her des host-pax warped) ..start]
:_ ..start
=/ pax /i/(scot %p her)/[des]/(scot %da now)/sur/aquarium/hoon/noun
?: =(warped (need (scry-aqua (unit @) now pax)))
[%test-done &]~
~
--
::
:: Check that /sur/aquarium/hoon has been touched, as by ++touch-file
::
++ check-file-touched
|= [her=ship des=desk]
%+ stateless-test
(cat 3 'check-file-touched-' (scot %p her))
|_ now=@da
++ start
:: mounting is not strictly necessary since we check via scry,
:: but this way we don't have to check on every event, just
:: ergos (and dojo because we can't guarantee an ergo if the desk
:: is already mounted)
::
(dojo her "|mount /={(trip des)}=")
::
++ route
|= [who=ship uf=unix-effect]
^- (list ph-event)
?. ?| (is-ergo her who uf)
(is-dojo-output her who uf ">=")
==
~
=/ pax /home/(scot %da now)/sur/aquarium/hoon
=/ warped (cat 3 '=> . ' .^(@t %cx (weld /(scot %p our) pax)))
=/ aqua-pax
;: weld
/i/(scot %p her)
pax(- des)
/noun
==
?: =(warped (need (scry-aqua (unit @) now aqua-pax)))
[%test-done &]~
~
--
::
:: Reload vane from filesystem
::
++ reload-vane
|= [her=ship vane=term]
%+ stateless-test
:((cury cat 3) 'reload-vane-' (scot %p her) '-' vane)
|_ now=@da
++ start
^- (list ph-event)
=/ pax
/(scot %p our)/home/(scot %da now)/sys/vane/[vane]/hoon
%- zing
:~ (dojo her "|mount /=home=")
(insert-file her %home pax .^(@t %cx pax))
[%test-done &]~
==
::
++ route
|= [who=ship uf=unix-effect]
~
--
::
:: Scry into a running aqua ship
::
++ scry-aqua
|* [a=mold now=@da pax=path]
.^ a
%gx
(scot %p our)
%aqua
(scot %da now)
pax
++ 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)]
==
--
--

365
lib/ph/azimuth.hoon Normal file
View File

@ -0,0 +1,365 @@
:: 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
=| lives=(map ship [lyfe=life rut=rift])
=| $= eth-filters
$: next=_1 :: jael assumes != 0
all=(map @ud [from-block=@ud last-block=@ud address=@ux])
==
|%
++ 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+(scot %ux next.eth-filters))
=. all.eth-filters
%+ ~(put by all.eth-filters)
next.eth-filters
:+
(get-param-obj req 'fromBlock')
(get-param-obj req 'fromBlock')
(get-param-obj req 'address')
=. next.eth-filters +(next.eth-filters)
[%cont ..stay]
?: =(method 'eth_getFilterLogs')
=/ fil (~(get by all.eth-filters) (get-filter-id req))
?~ fil
~|(%no-filter-not-implemented !!)
:+ |
%+ answer-request req
~| [eth-filters latest-block]
(logs-to-json from-block.u.fil latest-block)
=. last-block.u.fil latest-block
[%cont ..stay]
?: =(method 'eth_getFilterChanges')
=/ fil-id (get-filter-id req)
=/ fil (~(get by all.eth-filters) fil-id)
?~ fil
~|(%no-filter-not-implemented !!)
:+ |
%+ answer-request req
(logs-to-json last-block.u.fil latest-block)
=. all.eth-filters
%+ ~(put by all.eth-filters)
fil-id
u.fil(last-block 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
::
++ get-filter-id
|= req=@t
=, dejs:format
%- hex-to-num:ethereum
=/ id
%. (need (de-json:html req))
(ot params+(ar so) ~)
?> ?=([* ~] id)
i.id
::
++ 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)
==
--
--
::
++ dawn
|= who=ship
^- dawn-event
=/ lyfe lyfe:(~(got by lives) who)
:* [who lyfe sec:ex:(get-keys who lyfe) ~]
(^sein:title who)
get-czars
~[~['arvo' 'netw' 'ork']]
0
`(need (de-purl:html 'http://localhost:8545'))
~
==
::
:: Should only do galaxies
::
++ get-czars
^- (map ship [life pass])
%- malt
%+ murn
~(tap by lives)
|= [who=ship lyfe=life rut=rift]
?. =(%czar (clan:title who))
~
%- some
:+ who lyfe
%^ pass-from-eth:azimuth
(as-octs:mimes:html (get-public who lyfe %crypt))
(as-octs:mimes:html (get-public who lyfe %auth))
1
::
++ spawn
|= who=@p
?< (~(has by lives) who)
=. lives (~(put by lives) who [1 0])
%- add-logs
%+ welp
?: =(%czar (clan:title who))
~
~[(spawned:lo (^sein:title who) who)]
:~ (activated:lo who)
(owner-changed:lo who 0xdead.beef)
%- changed-keys:lo
:* who
(get-public who 1 %crypt)
(get-public who 1 %auth)
1
1
==
==
::
:: our: host ship
:: who: cycle keys
:: her: wait until hears about cycle
::
++ cycle-keys-and-hear
|= [our=@p who=@p her=@p]
=. this-az (cycle-keys who)
=/ new-lyfe lyfe:(~(got by lives) who)
=/ m (ph ,_this-az)
;< [this-az=_this-az ~] bind:m
%+ (wrap-philter ,_this-az ,~)
router:this-az
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/life/(scot %da now.pin)/(scot %p who)/noun
=/ lyfe (scry-aqua noun our now.pin aqua-pax)
~& [new-lyfe=[0 new-lyfe] lyfe=lyfe]
?: =([~ new-lyfe] lyfe)
[%done ~]
[%wait ~]
(pure:m this-az)
::
++ cycle-keys
|= who=@p
=/ prev (~(got by lives) who)
=/ lyfe +(lyfe.prev)
=. lives (~(put by lives) who [lyfe rut.prev])
%- add-logs
:_ ~
%- changed-keys:lo
:* who
(get-public who lyfe %crypt)
(get-public who lyfe %auth)
1
lyfe
==
::
:: our: host ship
:: who: breachee
:: her: wait until hears about breach
::
++ breach-and-hear
|= [our=@p who=@p her=@p]
=. this-az (breach who)
=/ new-rut rut:(~(got by lives) who)
=/ m (ph ,_this-az)
;< [this-az=_this-az ~] bind:m
%+ (wrap-philter ,_this-az ,~)
router:this-az
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
=/ aqua-pax
:- %i
/(scot %p her)/j/(scot %p her)/rift/(scot %da now.pin)/(scot %p who)/noun
=/ rut (scry-aqua noun our now.pin aqua-pax)
?: =([~ new-rut] rut)
[%done ~]
[%wait ~]
(pure:m this-az)
::
++ breach
|= who=@p
=. this-az (cycle-keys who)
=/ prev (~(got by lives) who)
=/ rut +(rut.prev)
=. lives (~(put by lives) who [lyfe.prev rut])
%- add-logs
:_ ~
(broke-continuity:lo who rut)
::
++ get-keys
|= [who=@p lyfe=life]
^- acru:ames
%+ pit:nu:crub:crypto 32
(can 5 [1 (scot %p who)] [1 (scot %ud lyfe)] ~)
::
++ get-public
|= [who=@p lyfe=life typ=?(%auth %crypt)]
=/ bod (rsh 3 1 pub:ex:(get-keys who lyfe))
=+ [enc=(rsh 8 1 bod) aut=(end 8 1 bod)]
?: =(%auth typ)
aut
enc
::
:: Generate logs
::
++ lo
=, azimuth-events:azimuth
|%
++ activated
|= who=ship
^- az-log
[~[^activated who] '']
::
++ broke-continuity
|= [who=ship rut=rift]
^- az-log
:- ~[^broke-continuity who]
%- crip
%- prefix-hex:ethereum
(render-hex-bytes:ethereum 32 `@`rut)
::
++ changed-keys
|= [who=ship enc=@ux aut=@ux crypto=@ud lyfe=life]
^- az-log
:- ~[^changed-keys who]
%- crip
%- prefix-hex:ethereum
;: welp
(render-hex-bytes:ethereum 32 `@`enc)
(render-hex-bytes:ethereum 32 `@`aut)
(render-hex-bytes:ethereum 32 `@`crypto)
(render-hex-bytes:ethereum 32 `@`lyfe)
==
::
++ owner-changed
|= [who=ship owner=@ux]
^- az-log
[~[^owner-changed who owner] '']
::
++ spawned
|= [par=ship who=ship]
^- az-log
[~[^spawned par who] '']
--
--

76
lib/ph/philter.hoon Normal file
View 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]
==
==
--

177
lib/ph/tests.hoon Normal file
View File

@ -0,0 +1,177 @@
:: Useful tests for testing things
::
/+ ph, ph-util
=, ph
=, ph-util
|= our=ship
::
:: Useful tests
::
|%
::
:: Never-ending test, for development.
::
++ stall
|= ph-input
[& ~ %wait ~]
::
:: Stall until you run :aqua|dojo ~ship "%go" on any ship.
::
++ please-press-enter
^+ *form:(ph ,~)
|= pin=ph-input
:+ & ~
?: (is-dojo-output who.pin who.pin uf.pin "%go")
[%done ~]
[%wait ~]
::
:: Test to produce events unconditionally.
::
++ just-events
|= events=(list ph-event)
=/ m (ph ,~)
^- form:m
|= ph-input
[& events %done ~]
::
::
::
++ wait-for-dojo
|= [her=@p what=tape]
=/ m (ph ,~)
^- form:m
|= pin=ph-input
:+ & ~
?. (is-dojo-output her who.pin uf.pin what)
[%wait ~]
[%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 ,~)
;< ~ bind:m (just-events (dojo from "|hi {(scow %p to)}"))
(wait-for-dojo from "hi {(scow %p to)} successful")
::
:: Send "|hi" and wait for "not responding" message
::
++ send-hi-not-responding
|= [from=@p to=@p]
=/ m (ph ,~)
;< ~ bind:m (just-events (dojo from "|hi {(scow %p to)}"))
(wait-for-dojo from "{(scow %p to)} not responding still trying")
::
:: 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
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
pax
/noun
==
=/ warped
%^ cat 3 '=> . '
(need (scry-aqua (unit @) our now.pin aqua-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 ,~)
;< ~ bind:m (mount her des)
^- form:m
|= pin=ph-input
?. &(=(her who.pin) ?=(?(%init %ergo) -.q.uf.pin))
[& ~ %wait ~]
=/ pax /sur/aquarium/hoon
=/ aqua-pax
;: weld
/i/(scot %p her)/cx/(scot %p her)/[des]/(scot %da now.pin)
pax
/noun
==
?: =(warped (need (scry-aqua (unit @) our now.pin aqua-pax)))
[& ~ %done ~]
[& ~ %wait ~]
--

102
lib/ph/util.hoon Normal file
View File

@ -0,0 +1,102 @@
:: 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]
::
:: Scry into a running aqua ship
::
++ scry-aqua
|* [a=mold our=@p now=@da pax=path]
.^ a
%gx
(scot %p our)
%aqua
(scot %da now)
pax
==
--

19
mar/pem.hoon Normal file
View 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
--

7
sur/aquarium.hoon
View File

@ -1,4 +1,3 @@
::
:: 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
@ -12,6 +11,11 @@
:: 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]
@ -55,6 +59,7 @@
[%ergo p=@tas q=mode:clay]
[%sleep ~]
[%restore ~]
[%init ~]
==
+$ pill
[boot-ova=* kernel-ova=(list unix-event) userspace-ova=(list unix-event)]

9
sur/ph.hoon Normal file
View File

@ -0,0 +1,9 @@
|%
++ cli
$% [%init ~]
[%cancel ~]
[%run lab=term]
[%run-all ~]
[%print ~]
==
--

23
sys/hoon.hoon
View File

@ -608,7 +608,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/*]
@ -667,6 +667,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)
@ -6680,6 +6687,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/spec q/hoon} :: ;; normalize
:: :::::: compositions
@ -8757,6 +8765,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
@ -14013,6 +14031,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 ';;' ~ ~ ~[(spec p.x) (hn q.x)])
[%tsbr *] (rune '=|' ~ ~ ~[(spec p.x) (hn q.x)])
@ -16625,6 +16644,7 @@
^. stet ^. limo
:~ [':' (rune col %mccl expi)]
['/' (rune net %mcnt expa)]
['<' (rune gal %mcgl exp1)]
['~' (rune sig %mcsg expi)]
[';' (rune mic %mcmc exqc)]
==
@ -16895,6 +16915,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

40
sys/vane/behn.hoon
View File

@ -6,12 +6,18 @@
|= pit=vase
=> |%
+$ move [p=duct q=(wind note:able gift:able)]
+$ sign ~
+$ sign [%b %wake error=(unit tang)]
::
+$ behn-state
$: timers=(list timer)
unix-duct=duct
next-wake=(unit @da)
drips=drip-manager
==
::
+$ drip-manager
$: count=@ud
movs=(map @ud vase)
==
::
+$ timer [date=@da =duct]
@ -52,6 +58,30 @@
::
++ rest |=(date=@da set-unix-wake(timers.state (unset-timer [date duct])))
++ wait |=(date=@da set-unix-wake(timers.state (set-timer [date duct])))
:: +drip: XX
::
++ drip
|= mov=vase
=< [moves state]
^+ event-core
=. moves
[duct %pass /drip/(scot %ud count.drips.state) %b %wait +(now)]~
=. movs.drips.state
(~(put by movs.drips.state) count.drips.state mov)
=. count.drips.state +(count.drips.state)
event-core
:: +take-drip: XX
::
++ take-drip
|= [num=@ud error=(unit tang)]
=< [moves state]
^+ event-core
=/ drip (~(got by movs.drips.state) num)
=. movs.drips.state (~(del by movs.drips.state) num)
?^ error
:: if we errored, drop it
event-core
event-core(moves [duct %give %meta drip]~)
:: +vega: learn of a kernel upgrade
::
++ vega [moves state]
@ -209,6 +239,7 @@
%born born:event-core
%crud (crud:event-core [tag tang]:task)
%rest (rest:event-core date=p.task)
%drip (drip:event-core move=p.task)
%vega vega:event-core
%wait (wait:event-core date=p.task)
%wake (wake:event-core error=~)
@ -240,7 +271,10 @@
++ take
|= [tea=wire hen=duct hin=(hypo sign)]
^- [(list move) _behn-gate]
~| %behn-take-not-implemented
!!
?> ?=([%drip @ ~] tea)
=/ event-core (per-event [our now hen] state)
=^ moves state
(take-drip:event-core (slav %ud i.t.tea) error.q.hin)
[moves behn-gate]
--

4486
sys/vane/clay.hoon
View File

File diff suppressed because it is too large Load Diff

3
sys/vane/dill.hoon
View File

@ -97,6 +97,7 @@
== ::
++ sign-behn ::
$% {$mass p/mass} ::
{$writ p/riot:clay} ::
== ::
++ sign-clay ::
$% {$mere p/(each (set path) (pair term tang))} ::
@ -420,7 +421,7 @@
{$c $note *}
(from %out (tuba p.sih ' ' ~(ram re q.sih)))
::
{$c $writ *}
{?($b $c) $writ *}
init
::
{$c $mere *}

8
sys/vane/ford.hoon
View File

@ -161,9 +161,9 @@
:: +sign: private response from another vane to ford
::
+= sign
$% :: %c: from clay
$? :: %c: from clay
::
$: %c
$: ?(%b %c)
:: %writ: internal (intra-ship) file response
::
$% $: %writ
@ -6258,7 +6258,7 @@
++ take-rebuilds
^- [(list move) ford-state]
::
?> ?=([%c %wris *] sign)
?> ?=([@tas %wris *] sign)
=+ [ship desk date]=(raid:wired t.wire ~[%p %tas %da])
=/ disc [ship desk]
::
@ -6289,7 +6289,7 @@
++ take-unblocks
^- [(list move) ford-state]
::
?> ?=([%c %writ *] sign)
?> ?=([@tas %writ *] sign)
:: scry-request: the +scry-request we had previously blocked on
::
=/ =scry-request

2
sys/vane/jael.hoon
View File

@ -1445,6 +1445,7 @@
net:(fall (~(get by pos.eth) who) *point)
*[life pass continuity-number=@ud [? @p] (unit @p)]
%+ weld
:: %- flop
^- (list move)
:~ [hen %slip %a %sunk who rit]
[hen %slip %c %sunk who rit]
@ -2240,6 +2241,7 @@
eny=@uvJ
ski=sley
==
^?
|%
:: :: ++call
++ call :: request

17
sys/zuse.hoon
View File

@ -424,18 +424,23 @@
++ able ^?
|%
++ note :: out request $->
$% $: %d :: to %dill
$% [$flog =flog:dill]
$% $: %b :: to %behn
$% [%wait p=@da]
== ==
$: %d :: to %dill
$% [%flog =flog:dill]
== == ==
++ gift :: out result <-$
$% [%doze p=(unit @da)] :: next alarm
[%mass p=mass] :: memory usage
[%wake error=(unit tang)] :: wakeup or failed
[%meta p=vase]
==
++ task :: in request ->$
$% [%born ~] :: new unix process
[%crud tag=@tas =tang] :: error with trace
[%rest p=@da] :: cancel alarm
[%drip p=vase] :: give in next event
[%vega ~] :: report upgrade
[%wait p=@da] :: set alarm
[%wake ~] :: timer activate
@ -7087,7 +7092,11 @@
==
++ sign-arvo :: in result $<-
$% {$a gift:able:ames}
{$b gift:able:behn}
$: $b
$% gift:able:behn
[%writ riot:clay]
==
==
{$c gift:able:clay}
{$d gift:able:dill}
{$e gift:able:eyre}
@ -8198,6 +8207,8 @@
|= n=@
^- tape
%- prefix-hex
?: =(0 n)
"0"
%- render-hex-bytes
(as-octs:mimes:html n)
::

227
tests/sys/vane/clay.hoon
View File

@ -38,34 +38,15 @@
|= moves=(list move:clay-gate)
^- tang
::
?. ?=([* * * ~] moves)
?. ?=([* ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
^- tang
;: weld
%+ expect-eq
!> ^- move:clay-gate
:- duct=~[/info]
^- (wind note:clay-gate gift:able:clay)
:+ %pass /castifying/~nul/home/~1111.1.1
^- note:clay-gate
:- %f
[%build live=%.n [%pin ~1111.1.1 [%list ~]]]
!> i.moves
::
%+ expect-eq
!> ^- move:clay-gate
:- duct=~[/info]
^- (wind note:clay-gate gift:able:clay)
:+ %pass /diffing/~nul/home/~1111.1.1
^- note:clay-gate
:- %f
[%build live=%.n [%pin ~1111.1.1 [%list ~]]]
!> i.t.moves
::
^- tang
::
=/ move=move:clay-gate i.t.t.moves
=/ move=move:clay-gate i.moves
=/ =duct p.move
=/ card=(wind note:clay-gate gift:able:clay) q.move
::
@ -78,7 +59,7 @@
=/ =wire p.card
::
%+ weld
(expect-eq !>(/inserting/~nul/home/~1111.1.1) !>(wire))
(expect-eq !>(/commit/home/inserts) !>(wire))
::
=/ note=note:clay-gate q.card
::
@ -103,91 +84,15 @@
==
== ==
::
:: inserting
::
=^ results2 clay-gate
%- clay-take-with-comparator :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/castifying/~nul/home/~1111.1.1
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
^= comparator
|= moves=(list move:clay-gate)
^- tang
::
?. ?=([* ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
=/ move=move:clay-gate i.moves
=/ =duct p.move
=/ card=(wind note:clay-gate gift:able:clay) q.move
::
%+ weld
(expect-eq !>(~[/info]) !>(duct))
::
?. ?=(%pass -.card)
[%leaf "bad move, not a %pass: {<move>}"]~
::
=/ =wire p.card
::
%+ weld
(expect-eq !>(/mutating/~nul/home/~1111.1.1) !>(wire))
::
=/ note=note:clay-gate q.card
::
?. ?=([%f %build *] note)
[%leaf "bad move, not a %build: {<move>}"]~
::
%+ weld
(expect-eq !>(%.n) !>(live.note))
::
%- expect-schematic:test-ford
:_ schematic.note
^- schematic:ford
[%pin ~1111.1.1 %list ~]
==
::
=^ results3 clay-gate
%- clay-take :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/mutating/~nul/home/~1111.1.1
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
expected-moves=~
==
::
=^ results4 clay-gate
%- clay-take :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/diffing/~nul/home/~1111.1.1
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
expected-moves=~
==
::
=^ results5 clay-gate
%- clay-take-with-comparator :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/inserting/~nul/home/~1111.1.1
:* wire=/commit/home/inserts
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
@ -201,6 +106,70 @@
[%success %$ %path -:!>(*path) /file2/noun]
[%success %cast %noun %noun 'file2']
== == ==
^= comparator
|= moves=(list move:clay-gate)
^- tang
::
?. ?=([* ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
%+ expect-eq
!> ^- move:clay-gate
:- duct=~[/info]
^- (wind note:clay-gate gift:able:clay)
:+ %pass /commit/home/diffs
^- note:clay-gate
:- %f
[%build live=%.n [%pin ~1111.1.1 [%list ~]]]
!> i.moves
== :: ==
::
:: diffing
::
=^ results3 clay-gate
%- clay-take-with-comparator :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/commit/home/diffs
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
^= move-comparator
|= moves=(list move:clay-gate)
^- tang
::
?. ?=([* ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
%+ expect-eq
!> ^- move:clay-gate
:- duct=~[/info]
^- (wind note:clay-gate gift:able:clay)
:+ %pass /commit/home/casts
^- note:clay-gate
:- %f
[%build live=%.n [%pin ~1111.1.1 [%list ~]]]
!> i.moves
==
::
:: castifying
::
=^ results4 clay-gate
%- clay-take-with-comparator :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/commit/home/casts
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
^= comparator
|= moves=(list move:clay-gate)
^- tang
@ -221,7 +190,57 @@
=/ =wire p.card
::
%+ weld
(expect-eq !>(/patching/~nul/home) !>(wire))
(expect-eq !>(/commit/home/mutates) !>(wire))
::
=/ note=note:clay-gate q.card
::
?. ?=([%f %build *] note)
[%leaf "bad move, not a %build: {<move>}"]~
::
%+ weld
(expect-eq !>(%.n) !>(live.note))
::
%- expect-schematic:test-ford
:_ schematic.note
^- schematic:ford
[%pin ~1111.1.1 %list ~]
==
::
:: mutating
::
=^ results5 clay-gate
%- clay-take-with-comparator :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/commit/home/mutates
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate
[%f %made ~1111.1.1 %complete %success %list ~]
==
^= comparator
|= moves=(list move:clay-gate)
^- tang
::
?. ?=([* ~] moves)
[%leaf "wrong number of moves: {<(lent moves)>}"]~
::
=/ move=move:clay-gate i.moves
=/ =duct p.move
=/ card=(wind note:clay-gate gift:able:clay) q.move
::
%+ weld
(expect-eq !>(~[/info]) !>(duct))
::
?. ?=(%pass -.card)
[%leaf "bad move, not a %pass: {<move>}"]~
::
=/ =wire p.card
::
%+ weld
(expect-eq !>(/commit/home/checkout) !>(wire))
::
=/ note=note:clay-gate q.card
::
@ -249,13 +268,15 @@
[%volt [~nul %home] %noun 'file2']
== ==
::
:: patching
::
=^ results6 clay-gate
%- clay-take :*
clay-gate
now=~1111.1.1
scry=*sley
^= take-args
:* wire=/patching/~nul/home
:* wire=/commit/home/checkout
duct=~[/info]
-:!>(*sign:clay-gate)
^- sign:clay-gate