ilyakooo0/urbit
1
0
Fork 0
mirror of https://github.com/ilyakooo0/urbit.git synced 2024-09-11 10:46:43 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'next/arvo' into jb/next-rc

Browse Source 
* next/arvo: (435 commits)
  vere: backs out overly zealous path canonicalization assertions
  clay: update tests
  vere: bump version to 1.9-rc3
  vere: bump version to 1.9-rc1
  clay: add logging commands
  ames: fix comet communication with breached ship
  pill: multi-brass
  clay: don't add lobe to wire to avoid flow leak
  ames: handle +call moves if re-evolving from larva
  clay: add tomb scry
  clay: make trim clear ford cache
  clay: progress download when receiving tombstone
  clay: fetch entire latest foreign commit
  clay: don't require head of foreign desks
  clay: fixes
  clay: tweaks from walkthrough
  ames: indent
  ames: start drainage timer if regressed from adult
  clay: re-export page to not break apps
  clay: fix stack while building directories
  ...
This commit is contained in:
Joe Bryan 2022-05-26 02:16:20 -04:00
commit 5cb745e31c
272 changed files with 7505 additions and 4720 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CONTRIBUTING.md
View File

@ -216,7 +216,7 @@ Hoon kernel (anything under [`pkg/arvo/sys/`][sys]) is bootstrapped from a
so-called *pill*, and must be recompiled if any changes are made. This should
happen automatically when you make changes, but if it doesn't, the command to
manually recompile and install the new kernel is `|reset` in `dojo`. This
rebuilds from the `sys` directory in the `home` desk in `%clay`.
rebuilds from the `sys` directory in the `base` desk in `%clay`.
Currently, `|reset` does not reload apps like `dojo` itself, which will still
reference the old kernel. To force them to reload, make a trivial edit to their

10
MAINTAINERS.md
View File

@ -326,7 +326,7 @@ separate releases.
(**Note**: the following steps are automated by some other Tlon-internal
tooling. Just ask `~nidsut-tomdun` for details.)
For Urbit OS updates, this means copying the files into ~zod's %home desk. The
For Urbit OS updates, this means copying the files into ~zod's %base desk. The
changes should be merged into /~zod/kids and then propagated through other galaxies
and stars to the rest of the network.
@ -335,10 +335,10 @@ For consistency, I create a release tarball and then rsync the files in.
```
$ wget https://github.com/urbit/urbit/archive/urbit-os-vx.y.tar.gz
$ tar xzf urbit-os-vx.y.tar.gz
$ herb zod -p hood -d "+hood/mount /=home="
$ rsync -zr --delete urbit-urbit-os-vx.y/pkg/arvo/ zod/home
$ herb zod -p hood -d "+hood/commit %home"
$ herb zod -p hood -d "+hood/merge %kids our %home"
$ herb zod -p hood -d "+hood/mount /=base="
$ rsync -zr --delete urbit-urbit-os-vx.y/pkg/arvo/ zod/base
$ herb zod -p hood -d "+hood/commit %base"
$ herb zod -p hood -d "+hood/merge %kids our %base"
```
For Vere updates, this means simply shutting down each desired ship, installing

4
bin/brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:ae4a7a69fe81c5f2114d7b7360c05602f614fe66b96d1db4c3dc0c2a2a5d856e
size 7536000
oid sha256:c4247c64a7d9fc0c0f1d2f017c21dd3464ddfe56529c7d6eef0e64554bd453e8
size 7611162

4
bin/ivory.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:c1203496d2c243329d121f8fd7abebfc5b125f2dc8817d3cf2aecc7f975a320b
size 1827940
oid sha256:5123a1ac30b83ec026587574df1ce13a73e72d06588ff68b5c41c09e1bebb5b7
size 949962

4
bin/multi-brass.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:e660fba934c5b80eeda64037a1f28c71eff4b2ea0bd28809b91432ca3d5ef08a
size 23052691
oid sha256:2f46209c31bc7be965b6ba32db92fb0746be15d9613b1c3c8d09ce7fa0e5e157
size 8280141

4
bin/multi.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:c27cdb47bccda98ba68556181cae6cd845c6daf8d7426d82adf67c1e8f532be9
size 7454265
oid sha256:187ea751a274dba7ed69df3a5b8f6f7ac620e3f9787abd75b18cf494d0c41f05
size 11174099

4
bin/solid.pill
View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1
oid sha256:bcab0698de6efda1bbac54b0833da5e853bca058919110aa5668aa63fb40626e
size 9392699
oid sha256:c45166ff0f8ab8dc1552bcef519c77c0afa6ca52f8ed1ba31ed632012667d619
size 8674763

2
nix/lib/test-fake-ship.nix
View File

@ -163,7 +163,7 @@ stdenvNoCC.mkDerivation {
fail=0
for f in $(find "$out/" -type f); do
if egrep "((FAILED|CRASHED)|(ford|warn):) " $f >/dev/null; then
if egrep "((FAILED|CRASHED)|warn:) " $f >/dev/null; then
if [[ $fail -eq 0 ]]; then
hdr "Test Failures"
fi

BIN
package-lock.json generated
View File

Binary file not shown.

4
pkg/arvo/README.md
View File

@ -23,9 +23,9 @@ To boot a fake ship from your development files, run `urbit` with the following
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=`.
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 /=base=`.
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 create a custom pill (bootstrapping object) from the files loaded into the base 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:

85
pkg/arvo/app/aqua.hoon
View File

@ -12,16 +12,15 @@
:: :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 [%peek ~[~bud] /cx/~bud/base/(scot %da now)/app/curl/hoon]
:: :aqua [%dojo ~[~bud ~dev] '|mount %']
:: :aqua [%file ~[~bud ~dev] %/sys/vane]
:: :aqua [%pause-events ~[~bud ~dev]]
::
::
:: We get ++unix-event and ++pill from /-aquarium
::
/- aquarium
/+ pill, azimuth, default-agent, aqua-azimuth, dbug, verb
/+ pill, azimuth, naive, default-agent, aqua-azimuth, dbug, verb
=, pill-lib=pill
=, aquarium
=> $~ |%
@ -33,6 +32,7 @@
pil=$>(%pill pill)
assembled=*
tym=@da
fresh-piers=(map [=ship fake=?] [=pier boths=(list unix-both)])
fleet-snaps=(map term fleet)
piers=fleet
==
@ -135,6 +135,8 @@
:: Represents a single ship's state.
::
++ pe
::NOTE if we start needing the fake flag outside of +ahoy and +yaho,
:: probably add it as an argument here.
|= who=ship
=+ (~(gut by ships.piers) who *pier)
=* pier-data -
@ -155,6 +157,31 @@
~& pill-size=(met 3 (jam snap))
..abet-pe
::
:: store post-pill ship for later re-use
::
++ ahoy
|= fake=?
=? fresh-piers !(~(has by fresh-piers) [who fake])
%+ ~(put by fresh-piers) [who fake]
[pier-data (~(get ja unix-boths) who)]
..ahoy
::
:: restore post-pill ship for re-use
::
++ yaho
|= fake=?
=/ fresh (~(got by fresh-piers) [who fake])
=. pier-data pier.fresh
=. boths.fresh (flop boths.fresh)
|-
?~ boths.fresh ..yaho
=. ..yaho
?- -.i.boths.fresh
%effect (publish-effect +.i.boths.fresh)
%event (publish-event +.i.boths.fresh)
==
$(boths.fresh t.boths.fresh)
::
:: Enqueue events to child arvo
::
++ push-events
@ -371,6 +398,24 @@
|= p=pill
^- (quip card:agent:gall _state)
?< ?=(%ivory -.p)
=. userspace-ova.p
:: if there is an azimuth-snapshot in the pill, we stub it out,
:: since it would interfere with aqua's azimuth simulation.
::
^+ userspace-ova.p
%+ turn userspace-ova.p
|= e=unix-event:pill-lib
^+ e
?. ?=(%park -.q.e) e
?. ?=(%& -.yok.q.e) e
=- e(q.p.yok.q -)
^- (map path (each page lobe:clay))
%- ~(urn by q.p.yok.q.e)
|= [=path fil=(each page lobe:clay)]
^+ fil
?. =(/app/azimuth/version-0/azimuth-snapshot path) fil
?: ?=(%| -.fil) fil
&+azimuth-snapshot+[%0 [0x0 0] *^state:naive ~ ~]
=. this apex-aqua =< abet-aqua
=. pil p
~& lent=(met 3 (jam boot-ova.pil))
@ -381,6 +426,7 @@
%0
~& %suc
=. assembled +7.p.res
=. fresh-piers ~
this
::
%1
@ -439,7 +485,7 @@
=/ slim-dirs=(list path)
~[/app /ted /gen /lib /mar /sur /hoon/sys /arvo/sys /zuse/sys]
:_ ~
%- unix-event
%- unix-event:pill-lib
%- %*(. file-ovum:pill-lib directories slim-dirs)
/(scot %p our.hid)/work/(scot %da now.hid)
=^ ms state (poke-pill pil)
@ -506,6 +552,18 @@
?- -.ae
::
%init-ship
?: &(fake.ae (~(has by fresh-piers) [who fake]:ae))
~& [%aqua %cached-init +.ae]
=. this abet-pe:(yaho fake):[ae (pe who.ae)]
?: fake.ae (pe who.ae)
:: for real ships, make sure they have their latest keys
::
%. who.ae
=< pe:abet-pe:plow
%- push-events:(pe who.ae)
=/ =life lyfe:(~(got by lives.azi.piers) who.ae)
=/ =ring sec:ex:(get-keys:aqua-azimuth who.ae life)
[/j/aqua/rekey %rekey life ring]~
=. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~])
=/ initted
=< plow
@ -536,14 +594,20 @@
::
userspace-ova.pil :: load os
::
:~ [/b/behn/0v1n.2m9vh %born ~]
:* [/b/behn/0v1n.2m9vh %born ~]
[/i/http-client/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %live 8.080 `8.445]
[/a/newt/0v1n.2m9vh %born ~]
[/d/term/1 %hail ~]
::
?: fake.ae ~
=+ [%raw-poke %noun %refresh-rate ~s30]
[/g/aqua/reduce-refresh-rate %deal [. .]:who.ae %azimuth -]~
==
==
=. this abet-pe:initted
=. this
abet-pe:(ahoy fake):[ae initted]
(pe who.ae)
::
%pause-events
@ -741,7 +805,8 @@
++ dawn
|= who=ship
^- dawn-event:jael
?> ?=(?(%czar %king %duke) (clan:title who))
=/ clan (clan:title who)
?> ?=(?(%czar %king %duke %earl) clan)
=/ spon=(list [ship point:azimuth])
%- flop
|- ^- (list [ship point:azimuth])
@ -764,7 +829,9 @@
[a-point]~
[a-point $(who ship)]
=/ =seed:jael
=/ life-rift (~(got by lives.azi.piers) who)
=/ life-rift=[lyfe=life rut=rift]
?: =(%earl clan) [1 0]
(~(got by lives.azi.piers) who)
=/ =life lyfe.life-rift
[who life sec:ex:(get-keys:aqua-azimuth who life) ~]
:* seed
@ -772,7 +839,7 @@
get-czars
~[~['arvo' 'netw' 'ork']]
0
`(need (de-purl:html 'http://localhost:8545'))
`(need (de-purl:html 'http://fake.aqua.domain/'))
==
::
:: Should only do galaxies

1
pkg/arvo/app/azimuth-tracker.hoon
View File

@ -93,6 +93,7 @@
^- config:eth-watcher
:* url.state =(%czar (clan:title our)) ~m5 ~m30
launch:contracts:azimuth
~
~[azimuth:contracts:azimuth]
~
(topics whos.state)

145
pkg/arvo/app/azimuth.hoon
View File

@ -1,4 +1,4 @@
/- eth-watcher, *dice
/- eth-watcher, *dice, *hood
/+ ethereum,
azimuth,
naive,
@ -21,9 +21,10 @@
=, jael
|%
+$ app-state
$: %5
$: %6
url=@ta
=net
refresh=_~m5
whos=(set ship)
nas=^state:naive
own=owners
@ -38,19 +39,52 @@
:: %watch: configure node url and network
::
[%watch url=@ta =net]
:: %kick: re-start %azimuth subscriptions
::
[%kick ~]
==
::
+$ tagged-diff [=id:block diff:naive]
+$ card card:agent:gall
:: TODO: add to state?
::
++ refresh ~m5
--
::
=| state=app-state
%- agent:dbug
%+ verb |
^- agent:gall
:: Cards
::
=> |%
++ subscribe-to-eth-watcher
|= =bowl:gall
^- card
:* %pass /eth-watcher %agent [our.bowl %eth-watcher]
%watch /logs/[dap.bowl]
==
::
++ listen-to-azimuth
|= [ships=(set ship) =source:jael]
^- card
[%pass /lo %arvo %j %listen ships source]
::
++ nuke-azimuth-tracker
|= =bowl:gall
^- card
:* %pass /old-tracker %agent [our.bowl %hood]
%poke %kiln-nuke !>([%azimuth-tracker %|])
==
::
++ init-timer
|= =bowl:gall
^- card
[%pass /init %arvo %b %wait now.bowl]
::
++ start-log-retrieval
|= [=ship args=vase]
^- card
[%pass /wa %agent [ship %eth-watcher] %poke %eth-watcher-poke args]
--
::
=<
|_ =bowl:gall
+* this .
@ -72,12 +106,7 @@
:_ this
?: .^(? %j /(scot %p our.bowl)/fake/(scot %da now.bowl))
~
:~ :* %pass /old-tracker %agent [our.bowl %hood]
%poke %kiln-nuke !>([%azimuth-tracker %|])
==
::
[%pass /init %arvo %b %wait now.bowl]
==
~[(nuke-azimuth-tracker bowl) (init-timer bowl)]
::
++ on-save !>(state)
++ on-load
@ -93,7 +122,7 @@
`old-state
%- %- slog :_ ~
leaf+"ship: loading snapshot with {<(lent logs.old-state)>} events"
=. +.state +.old-state
=. +.state +:(state-5-to-6 old-state)
=^ cards state
(%*(run-logs do nas.state *^state:naive) logs.state)
[(jael-update:do (to-udiffs:do cards)) state]
@ -101,7 +130,7 @@
?. ?=(%2 -.old-state)
`old-state
~& > '%azimuth: updating to state 3'
=. +.state +.old-state
=. +.state +:(state-5-to-6 old-state)
:: replace naive state and indices with snapshot
::
=: nas.state nas.snap
@ -117,7 +146,7 @@
%- %- slog :_ ~
leaf+"ship: processing azimuth snapshot ({<points>} points)"
=/ snap-cards=udiffs:point (run-state:do id.snap points.nas.state)
:_ [%3 +.state]
:_ [%3 url net whos nas own spo logs]:state
%+ weld
(jael-update:do snap-cards)
:: start getting new logs after the last id:block in the snapshot
@ -131,17 +160,24 @@
=^ cards-4 old-state
?. ?=(%4 -.old-state) [cards-3 old-state]
=^ cards this
%- %*(. on-poke +.state.this +.old-state)
%- %*(. on-poke +.state.this +:(state-5-to-6 old-state))
[%azimuth-poke !>([%watch [url net]:old-state])]
~& > '%azimuth: updating to state 5'
[cards state.this(- %5)]
?> ?=(%5 -.old-state)
[cards [%5 url net whos nas own spo logs]:state.this]
=? old-state ?=(%5 -.old-state)
(state-5-to-6 old-state)
?> ?=(%6 -.old-state)
[cards-4 this(state old-state)]
::
++ app-states $%(state-0 state-1-2-3-4 app-state)
++ app-states $%(state-0 state-1-2-3-4-5 app-state)
::
+$ state-1-2-3-4
$: ?(%1 %2 %3 %4)
++ state-5-to-6
|= state-1-2-3-4-5
^- app-state
[%6 url net ~m5 whos nas own spo logs]
::
+$ state-1-2-3-4-5
$: ?(%1 %2 %3 %4 %5)
url=@ta
=net
whos=(set ship)
@ -167,6 +203,9 @@
^- (quip card _this)
?: =(%noun mark)
?+ q.vase !!
[%refresh-rate @]
=. refresh.state +.q.vase
[start:do this]
::
%rerun
=/ points=@ud ~(wyt by points.nas.state)
@ -176,10 +215,8 @@
[(jael-update:do udiffs) this]
::
%resub
:_ this :_ ~
:* %pass /eth-watcher %agent [our.bowl %eth-watcher]
%watch /logs/[dap.bowl]
==
:_ this
[(subscribe-to-eth-watcher bowl)]~
::
%resnap
=: nas.state nas.snap
@ -194,7 +231,48 @@
=+ !<(poke=poke-data vase)
?- -.poke
%listen
[[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
[[(listen-to-azimuth (silt whos.poke) source.poke)]~ this]
::
%kick
=/ last-block=@
?^ logs.state
number:(last-block-id:dice logs.state)
~& >> %no-logs-in-azimuth-state
last-snap
=+ [our=(scot %p our.bowl) now=(scot %da now.bowl)]
=+ .^(dudes=(set [dude:gall ?]) %ge our %base now /)
=/ running=? (~(has in dudes) [%eth-watcher &])
=/ installed=?
|((~(has in dudes) [%eth-watcher &]) (~(has in dudes) [%eth-watcher |]))
:_ this
=/ cards=(list card)
:- :: %jael will re-subscribe to get all azimuth diffs
::
(listen-to-azimuth ~ [%| dap.bowl])
:: we poke eth-watcher to retrieve logs from the latest we have
::
%*(start do last-snap last-block)
=? cards !running
:: restart %eth-watcher
::
~& >> %starting-eth-watcher
=/ rein=[desk rein] [%base %.y [%eth-watcher ~ ~] ~]
:_ cards
[%pass /rein %agent [our.bowl %hood] %poke kiln-rein+!>(rein)]
=? cards !installed
:: reinstall %base desk
::
=+ spo=(sein:title [our now our]:bowl)
~& >> re-installing-base-from+spo
=/ fresh=[desk ship desk] [%base spo %kids]
:_ cards
[%pass /fresh %agent [our.bowl %hood] %poke kiln-install+!>(fresh)]
:: resubscribe if we somehow get unsubscribed from eth-watcher
::
?: (~(has by wex.bowl) [/eth-watcher our.bowl %eth-watcher])
cards
~& >> %resubscribing-to-eth-watcher
[(subscribe-to-eth-watcher bowl) cards]
::
%watch
=: nas.state ?:(?=(%default net.poke) nas.snap *^state:naive)
@ -245,7 +323,7 @@
[%x %dns ~] ``noun+!>(dns.nas.state)
[%x %own ~] ``noun+!>(own.state)
[%x %spo ~] ``noun+!>(spo.state)
[%x %refresh ~] ``atom+!>(refresh)
[%x %refresh ~] ``atom+!>(refresh.state)
[%x %point @ ~] ``noun+(point i.t.t.path)
==
::
@ -280,7 +358,7 @@
:: doing :azimuth|watch caused a l2-sig-fail when using the eth-log
:: snapshot because we were not updating nas with the saved logs.
::
:: now (L: 189) nas.state is loaded with the contents of the snapshot,
:: now nas.state is loaded with the contents of the snapshot,
:: if we are on the %default network.
::
=^ effects state (run-logs:do loglist.diff)
@ -297,12 +375,7 @@
%- (slog 'azimuth: failed to initialize!' ~)
`this
:_ this
:~ :* %pass /eth-watcher %agent [our.bowl %eth-watcher]
%watch /logs/[dap.bowl]
==
::
[%pass /lo %arvo %j %listen ~ [%| dap.bowl]]
==
~[(subscribe-to-eth-watcher bowl) (listen-to-azimuth ~ [%| dap.bowl])]
::
++ on-fail on-fail:def
--
@ -413,7 +486,6 @@
++ jael-update
|= =udiffs:point
^- (list card)
:: ?: & ~ :: XX
:- [%give %fact ~[/] %azimuth-udiffs !>(udiffs)]
|- ^- (list card)
?~ udiffs
@ -441,11 +513,12 @@
=/ args=vase !>
:+ %watch /[dap.bowl]
^- config:eth-watcher
:* url.state =(%czar (clan:title our.bowl)) refresh ~h30
:* url.state =(%czar (clan:title our.bowl)) refresh.state ~h30
(max launch.net ?:(=(net.state %default) +(last-snap) 0))
~
~[azimuth.net]
~[naive.net]
(topics whos.state)
==
[%pass /wa %agent [our.bowl %eth-watcher] %poke %eth-watcher-poke args]~
[(start-log-retrieval our.bowl args)]~
--

6
pkg/arvo/app/dbug.hoon
View File

@ -530,6 +530,7 @@
:: where an index is specified, the array is generally sorted by those.
::
:: { life: 123,
:: rift: 0,
:: route: { direct: true, lane: 'something' },
:: qos: { kind: 'status', last-contact: 123456 }, // ms timestamp
:: flows: { forward: [snd, rcv, ...], backward: [snd, rcv, ...] }
@ -590,6 +591,9 @@
|= peer-state
%- pairs
:~ 'life'^(numb life)
:: TODO: needs to be updated in /pkg/interface/dbug
::
'rift'^(numb rift)
::
:- 'route'
%+ maybe route
@ -786,7 +790,7 @@
++ v-clay
=, clay
|%
++ start-path /(scot %p our.bowl)/home/(scot %da now.bowl)
++ start-path /(scot %p our.bowl)/base/(scot %da now.bowl)
::
+$ commit
[=tako parents=(list tako) children=(list tako) wen=@da content-hash=@uvI]

4
pkg/arvo/app/dojo.hoon
View File

@ -679,7 +679,9 @@
[%face ^] a(q $(a q.a))
[%cell ^] a(p $(a p.a), q $(a q.a))
[%fork *] a(p (silt (turn ~(tap in p.a) |=(b=type ^$(a b)))))
[%hint *] !!
[%hint *] ?. ?=(%know -.q.p.a) $(a q.a)
?@ p.q.p.a [(cat 3 '#' mark.p.q.p.a)]~
[(rap 3 '#' auth.p.q.p.a (spat type.p.q.p.a) ~)]~
[%core ^] `wain`/core
[%hold *] a(p $(a p.a))
==

75
pkg/arvo/app/eth-watcher.hoon
View File

@ -8,7 +8,7 @@
=> |%
+$ card card:agent:gall
+$ app-state
$: %5
$: %6
dogs=(map path watchdog)
==
::
@ -133,14 +133,16 @@
::
=? old-state ?=(%4 -.old-state)
%- (slog leaf+"upgrading eth-watcher from %4" ~)
^- app-state
^- app-state-5
%= old-state
- %5
dogs
%- ~(run by dogs.old-state)
|= dog=watchdog-4
^- watchdog-5
%= dog
-
^- config-5
=, -.dog
[url eager refresh-rate timeout-time from contracts ~ topics]
::
@ -160,10 +162,55 @@
==
==
::
[cards-1 this(state ?>(?=(%5 -.old-state) old-state))]
=? old-state ?=(%5 -.old-state)
^- app-state
%= old-state
- %6
dogs
%- ~(run by dogs.old-state)
|= dog=watchdog-5
^- watchdog
%= dog
-
^- config
=, -.dog
[url eager refresh-rate timeout-time from ~ contracts batchers topics]
::
running
?~ running.dog ~
`[now.bowl tid.u.running.dog]
==
==
::
[cards-1 this(state ?>(?=(%6 -.old-state) old-state))]
::
+$ app-states
$%(app-state-0 app-state-1 app-state-2 app-state-3 app-state-4 app-state)
$%(app-state-0 app-state-1 app-state-2 app-state-3 app-state-4 app-state-5 app-state)
::
+$ app-state-5
$: %5
dogs=(map path watchdog-5)
==
::
+$ watchdog-5
$: config-5
running=(unit [since=@da =tid:spider])
=number:block
=pending-logs
=history
blocks=(list block)
==
::
+$ config-5
$: url=@ta
eager=?
refresh-rate=@dr
timeout-time=@dr
from=number:block
contracts=(list address:ethereum)
batchers=(list address:ethereum)
=topics
==
::
+$ app-state-4
$: %4
@ -319,6 +366,17 @@
=/ dog=watchdog
?: restart *watchdog
(~(got by dogs.state) path.poke)
=+ pending=(sort ~(tap in ~(key by pending-logs.dog)) lth)
=? pending-logs.dog
?: restart |
?~ pending |
(gte i.pending from.config.poke)
?> ?=(^ pending)
:: if there are pending logs newer than what we poke with,
:: we need to clear those too avoid processing duplicates
::
~& %dropping-unreleased-logs^[from+i.pending n+(lent pending)]
~
%_ dog
- config.poke
number from.config.poke
@ -464,15 +522,12 @@
^- (quip card watchdog)
?: (lth number.dog 30)
`dog
=/ rel-number (sub number.dog 30)
=/ numbers=(list number:block) ~(tap in ~(key by pending-logs.dog))
=. numbers (sort numbers lth)
=^ logs=(list event-log:rpc:ethereum) dog
|- ^- (quip event-log:rpc:ethereum watchdog)
?~ numbers
`dog
?: (gth i.numbers rel-number)
$(numbers t.numbers)
=^ rel-logs-1 dog
=/ =loglist (~(get ja pending-logs.dog) i.numbers)
=. pending-logs.dog (~(del by pending-logs.dog) i.numbers)
@ -530,6 +585,12 @@
::
?^ running.dog
`dog
:: if reached the to-block, don't start a new thread
::
?: ?& ?=(^ to.dog)
(gte number.dog u.to.dog)
==
`dog
::
=/ new-tid=@ta
(cat 3 'eth-watcher--' (scot %uv eny.bowl))

3
pkg/arvo/app/gaze.hoon
View File

@ -210,6 +210,7 @@
refresh-rate
timeout-time
public:mainnet-contracts
~
~[azimuth delegated-sending]:mainnet-contracts
~
~
@ -456,7 +457,7 @@
^- card
=- [%pass /export/[nom] %arvo %c %info -]
%+ foal:space:userlib
/(scot %p our.bowl)/home/(scot %da now.bowl)/gaze-exports/[nom]/txt
/(scot %p our.bowl)/base/(scot %da now.bowl)/gaze-exports/[nom]/txt
[%txt !>(dat)]
::
:: +peek-x: accept gall scry

43
pkg/arvo/app/language-server.hoon
View File

@ -5,7 +5,7 @@
easy-print=language-server-easy-print,
rune-snippet=language-server-rune-snippet,
build=language-server-build,
default-agent, verb
default-agent, verb, dbug
|%
+$ card card:agent:gall
+$ lsp-req
@ -44,6 +44,7 @@
==
--
^- agent:gall
%- agent:dbug
%+ verb |
=| state-zero
=* state -
@ -196,7 +197,7 @@
%+ turn
~(tap in ~(key by builds))
|= uri=@t
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]
[%pass /ford/[uri] %arvo %c %warp our.bow %base ~]
::
++ handle-did-close
|= [uri=@t version=(unit @)]
@ -208,7 +209,7 @@
=. builds
(~(del by builds) uri)
:_ state
[%pass /ford/[uri] %arvo %c %warp our.bow %home ~]~
[%pass /ford/[uri] %arvo %c %warp our.bow %base ~]~
::
++ handle-did-save
|= [uri=@t version=(unit @)]
@ -240,18 +241,29 @@
?> ?=([%writ *] gift)
=/ uri=@t
(snag 1 path)
=; res=(quip card _state)
[(snoc -.res (build-file | uri path)) +.res]
=/ loc=^path (uri-to-path:build uri)
=; [res=(quip card _state) dek=desk]
[(snoc -.res (build-file | uri loc `dek)) +.res]
?~ p.gift
[~ state]
[[~ state] %base]
=. builds
(~(put by builds) uri q.r.u.p.gift)
=. ford-diagnostics
(~(del by ford-diagnostics) uri)
=+ .^(=open:clay %cs /(scot %p our.bow)/home/(scot %da now.bow)/open/foo)
=/ =type -:(open (uri-to-path:build uri))
=/ bek byk.bow(r da+now.bow)
=/ desks=(list desk) ~(tap in .^((set desk) %cd (en-beam bek /)))
=| dek=desk
|-
?~ desks [[~ state] %base]
=. dek ?: =(%kids i.desks) %base i.desks
=/ exists=? .^(? %cu (en-beam bek(q dek) loc))
?. exists $(desks t.desks)
=+ .^(=open:clay %cs /(scot %p our.bow)/[dek]/(scot %da now.bow)/open/foo)
=/ =type -:(open loc)
=. preludes
(~(put by preludes) uri type)
:_ dek
:_ state
(give-rpc-notification (get-diagnostics uri))
::
@ -265,19 +277,28 @@
(get-parser-diagnostics uri)
::
++ build-file
|= [eager=? uri=@t =path]
|= [eager=? uri=@t =path desk=(unit desk)]
^- card
=/ =rave:clay
?: eager
[%sing %a da+now.bow path]
[%next %a da+now.bow path]
[%pass /ford/[uri] %arvo %c %warp our.bow %home `rave]
=/ des=^desk ?^ desk u.desk %base
[%pass /ford/[uri] %arvo %c %warp our.bow des `rave]
::
++ handle-did-open
|= item=text-document-item:lsp-sur
^- (quip card _state)
=/ =path
(uri-to-path:build uri.item)
=/ bek byk.bow
=/ desks=(list desk) ~(tap in .^((set desk) %cd (en-beam bek /)))
=| dek=desk
|-
?~ desks [~ state]
=. dek ?: =(%kids i.desks) %base i.desks
=/ exists=? .^(? %cu (en-beam bek(q dek) path))
?. exists $(desks t.desks)
?: ?=(%sys -.path)
`state
=/ buf=wall
@ -287,7 +308,7 @@
:_ state
%+ weld
(give-rpc-notification (get-diagnostics uri.item))
[(build-file & uri.item path) ~]
[(build-file & uri.item path `dek) ~]
::
++ get-parser-diagnostics
|= uri=@t

283
pkg/arvo/app/roller.hoon
View File

@ -31,7 +31,7 @@
::
|%
+$ app-state
$: %4
$: %6
:: pending: the next l2 txs to be sent
:: sending: l2 txs awaiting l2 confirmation, ordered by nonce
:: finding: sig+raw-tx hash reverse lookup for txs in sending map
@ -263,8 +263,8 @@
[~d7 7 ~m5 ~m1]
=, old-state
:* %1
pending sending finding history
ship-quota next-nonce next-batch
pending ^-((tree [l1-tx-pointer old-send-tx-4]) sending)
finding history ship-quota next-nonce next-batch
pre own pk slice quota derive
frequency endpoint contract chain-id
resend-time update-rate
@ -294,7 +294,7 @@
resend-time update-rate
==
=? old-state ?=(%3 -.old-state)
^- app-state
^- state-4
=, old-state
=/ fallback-gas-price=@ud 10.000.000.000
:* %4
@ -305,10 +305,61 @@
frequency endpoint contract chain-id
resend-time update-rate fallback-gas-price
==
?> ?=(%4 -.old-state)
=? old-state ?=(%4 -.old-state)
^- state-5
=/ new-sending=(tree [l1-tx-pointer old-send-tx-5])
%+ run:ors:dice sending.old-state
|= old=old-send-tx-4
^- old-send-tx-5
old(txs (turn txs.old (lead |)))
=, old-state
:* %5
pending new-sending finding history
ship-quota allowances
next-nonce next-batch next-slice
pre own spo pk slice quota derive
frequency endpoint contract chain-id
resend-time update-rate fallback-gas-price
==
=? old-state ?=(%5 -.old-state)
^- app-state
=/ new-sending=(tree [l1-tx-pointer send-tx])
%+ run:ors:dice sending.old-state
|= old=old-send-tx-5
^- send-tx
%= old
txs
%+ turn txs.old
|= [force=? =raw-tx:naive]
=/ sign-address=(unit @ux)
(extract-address:lib raw-tx pre chain-id)
:_ [force raw-tx]
?. ?=(^ sign-address)
0x0
u.sign-address
==
=, old-state
:* %6
pending new-sending finding history
ship-quota allowances
next-nonce next-batch next-slice
pre own spo pk slice quota derive
frequency endpoint contract chain-id
resend-time update-rate fallback-gas-price
==
?> ?=(%6 -.old-state)
[cards this(state old-state)]
::
++ app-states $%(state-0 state-1 state-2 state-3 app-state)
++ app-states
$% state-0
state-1
state-2
state-3
state-4
state-5
app-state
==
::
++ state-0
$: %0
pending=(list pend-tx)
@ -330,7 +381,7 @@
++ state-1
$: %1
pending=(list pend-tx)
sending=(tree [l1-tx-pointer send-tx])
sending=(tree [l1-tx-pointer old-send-tx-4])
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(map address:ethereum (tree hist-tx))
ship-quota=(map ship @ud)
@ -353,7 +404,7 @@
++ state-2
$: %2
pending=(list pend-tx)
sending=(tree [l1-tx-pointer send-tx])
sending=(tree [l1-tx-pointer old-send-tx-4])
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(map address:ethereum (tree hist-tx))
ship-quota=(map ship @ud)
@ -373,10 +424,11 @@
resend-time=@dr
update-rate=@dr
==
::
++ state-3
$: %3
pending=(list pend-tx)
sending=(tree [l1-tx-pointer send-tx])
sending=(tree [l1-tx-pointer old-send-tx-4])
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(map address:ethereum (tree hist-tx))
ship-quota=(map ship @ud)
@ -398,6 +450,65 @@
resend-time=@dr
update-rate=@dr
==
::
+$ old-send-tx-4 [next-gas-price=@ud sent=? txs=(list =raw-tx:naive)]
::
++ state-4
$: %4
pending=(list pend-tx)
sending=(tree [l1-tx-pointer old-send-tx-4])
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(map address:ethereum (tree hist-tx))
ship-quota=(map ship @ud)
allowances=(map ship (unit @ud))
next-nonce=(unit @ud)
next-batch=time
next-slice=time
pre=^state:naive
own=owners
spo=sponsors
pk=@
slice=@dr
quota=@ud
derive=?
frequency=@dr
endpoint=(unit @t)
contract=@ux
chain-id=@
resend-time=@dr
update-rate=@dr
fallback-gas-price=@ud
==
::
+$ old-send-tx-5
[next-gas-price=@ud sent=? txs=(list [force=? =raw-tx:naive])]
::
++ state-5
$: %5
pending=(list pend-tx)
sending=(tree [l1-tx-pointer old-send-tx-5])
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(map address:ethereum (tree hist-tx))
ship-quota=(map ship @ud)
allowances=(map ship (unit @ud))
next-nonce=(unit @ud)
next-batch=time
next-slice=time
pre=^state:naive
own=owners
spo=sponsors
pk=@
slice=@dr
quota=@ud
derive=?
frequency=@dr
endpoint=(unit @t)
contract=@ux
chain-id=@
resend-time=@dr
update-rate=@dr
fallback-gas-price=@ud
==
--
::
++ on-poke
@ -498,9 +609,20 @@
::
[%resend @ @ ~]
=/ [address=@ux nonce=@ud]
[(slav %ux i.t.wire) (rash i.t.t.wire dem)]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake [(send-roll:do address nonce) this]
[(slav %ux i.t.wire) (slav %ud i.t.t.wire)]
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake
=/ cards=(list card) (send-roll:do address nonce)
=? sending
?& ?=(~ cards)
(has:ors:dice sending [address nonce])
=(0 (lent txs:(got:ors:dice sending [address nonce])))
==
~& > "empty sending, removing {<[nonce address]>}"
=^ * sending
(del:ors:dice sending [address nonce])
sending
[cards this]
==
==
::
@ -572,7 +694,7 @@
|= [address=@t nonce=@t =sign:agent:gall]
^- (quip card _this)
=/ [address=@ux nonce=@ud]
[(slav %ux address) (rash nonce dem)]
[(slav %ux address) (slav %ud nonce)]
?- -.sign
%poke-ack
?~ p.sign
@ -602,7 +724,7 @@
[cards this]
::
%thread-done
=+ !<(result=(each @ud [term @t]) q.cage.sign)
=+ !<(result=(each [@ud @ud] [term @t]) q.cage.sign)
=^ cards state
(on-batch-result:do address nonce result)
[cards this]
@ -674,7 +796,7 @@
++ refresh
|= [nonce=@t =sign:agent:gall]
^- (quip card _this)
=/ failed-nonce=@ud (rash nonce dem)
=/ failed-nonce=@ud (slav %ud nonce)
?- -.sign
%poke-ack
?~ p.sign
@ -776,16 +898,17 @@
::
=* key key.i.sorted
=* val val.i.sorted
=+ txs=(turn txs.val |=(=raw-tx:naive [| 0x0 *time raw-tx]))
=/ txs=(list pend-tx)
%+ turn txs.val
|=([addr=@ux force=? =raw-tx:naive] force^addr^*time^raw-tx)
=^ [new-valid=_txs nups=_ups] state
(apply-txs txs %sending `nonce.key)
=/ new-sending
(turn new-valid |=([force=? addr=@ux * =raw-tx:naive] addr^force^raw-tx))
:: we only hear updates for this nonce if it has been sent
::
=. valid ::=? valid sent.val
%^ put:ors:dice valid
key
:: TODO: too much functional hackery?
val(txs (turn new-valid (cork tail (cork tail tail))))
(put:ors:dice valid key val(txs new-sending))
$(sorted t.sorted, ups (welp ups nups))
::
++ apply-txs
@ -809,8 +932,14 @@
?: gud [~ history]
=. time.tx
?: ?=(%pending type) time.tx
=+ wer=(~(got by finding) keccak)
?>(?=(^ wer) time.wer)
?~ wer=(~(get by finding) keccak)
~& >>> "missing %sending tx in finding"^[ship raw-tx]
now.bowl
?@ u.wer
~& >>> "weird tx in finding gud: {<gud>} {<u.wer>}"^[ship raw-tx]
now.bowl
time.u.wer
~? =(0x0 address.tx) %weird-null-tx-address^'apply-txs'
(update-history:dice history [tx]~ %failed)
=? finding !gud (~(put by finding) keccak %failed)
=. updates :(welp up-2 up-1 updates)
@ -1031,7 +1160,8 @@
sending
%^ put:ors:dice sending
[address nonce]
[0 | (turn pending (cork tail (cork tail tail)))]
:+ 0 |
(turn pending |=([force=? addr=@ux * =raw-tx:naive] addr^force^raw-tx))
::
finding
%- ~(gas by finding)
@ -1084,11 +1214,11 @@
:: If %.y, the roller has been trying to send a batch for a whole frequency.
::
:: The cause of not sending the previous batch can happen because
:: of thread failure (see line 1251) or because the private key loaded onto
:: of thread failure or because the private key loaded onto
:: the roller was used for something other than signing L2 batches right
:: after the send-batch thread started.
::
:: After reaching this state, any subsequents attempts have failed (L: 1251)
:: After reaching this state, any subsequents attempts have failed
:: (prior to updating the sending nonce if we hit the on-out-of-sync case)
:: which would possibly require a manual intervention (e.g. changing the
:: ethereum node URL, adding funds to the roller's address, manually bumping
@ -1139,7 +1269,7 @@
::
++ process-l2-txs
%+ roll txs.q
|= [=raw-tx:naive nif=_finding sih=_history]
|= [[@ @ =raw-tx:naive] nif=_finding sih=_history]
=/ =keccak (hash-raw-tx:lib raw-tx)
|^
?~ val=(~(get by nif) keccak)
@ -1205,17 +1335,18 @@
nonce
fallback-gas-price
::
=< [next-gas-price txs]
(got:ors:dice sending [address nonce])
=< [next-gas-price (turn txs (cork tail tail))]
[. (got:ors:dice sending [address nonce])]
==
:: +on-batch-result: await resend after thread success or failure
::
++ on-batch-result
|= [=address:ethereum nonce=@ud result=(each @ud [term @t])]
|= [=address:ethereum nonce=@ud result=(each [@ud @ud] [term @t])]
^- (quip card _state)
|^
:: print error if there was one
::
~? ?=(%| -.result) [dap.bowl %send-error +.p.result]
~? ?=(%| -.result) [dap.bowl %send-error nonce+nonce +.p.result]
:: if this nonce was removed from the queue by a
:: previous resend-with-higher-gas thread, it's done
::
@ -1230,6 +1361,24 @@
(del:ors:dice sending [address nonce])
`state
=/ =send-tx (got:ors:dice sending [address nonce])
:: if the number of txs sent is less than the ones in sending, we remove
:: them from the latest sending batch and add them on top of the pending list
::
=/ n-txs=@ud ?:(?=(%& -.result) -.p.result (lent txs.send-tx))
=/ not-sent=(list [=address:naive force=? =raw-tx:naive])
(slag n-txs txs.send-tx)
=/ partial-send=? &(?=(%& -.result) (lth n-txs (lent txs.send-tx)))
=? txs.send-tx partial-send
(oust [n-txs (lent txs.send-tx)] txs.send-tx)
=? pending partial-send
(fix-not-sent-pending not-sent)
=/ [nif=_finding sih=_history]
(fix-not-sent-status not-sent)
=: finding nif
history sih
==
~? partial-send [%extracting-txs-from-batch (lent not-sent)]
::
=? sending ?| ?=(%& -.result)
?=([%| %crash *] result)
==
@ -1238,15 +1387,22 @@
:: update gas price for this tx in state
::
?: ?=(%& -.result)
send-tx(next-gas-price p.result, sent &)
:: if the thread crashed, we don't know the gas used,
:: so we udpate it manually, same as the thread would do
send-tx(next-gas-price +.p.result, sent &)
:: if the thread crashed, we don't know the gas used, so we udpate it
:: manually, same as the thread would do. this has the problem of causing
:: the batch to be blocked if the thread keeps crashing, and we don't have
:: enough funds to pay.
::
%_ send-tx
next-gas-price
?: =(0 next-gas-price.send-tx)
fallback-gas-price
(add next-gas-price.send-tx 5.000.000.000)
:: on the other hand if the thread fails because +fetch-gas-price fails
:: (e.g. API change), and our fallback gas price is too low, the batch will
:: also be blocked, if we don't increase the next-gas-price, so either way
:: the batch will be stuck because of another underlying issue.
::
%_ send-tx
next-gas-price
?: =(0 next-gas-price.send-tx)
fallback-gas-price
(add next-gas-price.send-tx 5.000.000.000)
==
:_ state
?: ?& !sent.send-tx
@ -1270,6 +1426,44 @@
%+ wait:b:sys
/resend/(scot %ux address)/(scot %ud nonce)
(add resend-time now.bowl)
::
++ fix-not-sent-pending
|= not-sent=(list [=address:naive force=? =raw-tx:naive])
=; txs=(list pend-tx)
(weld txs pending)
:: TODO: this would not be needed if txs.send-tx was a (list pend-tx)
::
%+ murn not-sent
|= [=address:naive force=? =raw-tx:naive]
=/ =keccak (hash-raw-tx:lib raw-tx)
?~ wer=(~(get by finding) keccak)
~& >>> %missing-tx-in-finding
~
?@ u.wer
~& >>> %missing-tx-in-finding
~
`[force address time.u.wer raw-tx]
::
++ fix-not-sent-status
|= not-sent=(list [=address:naive force=? =raw-tx:naive])
%+ roll not-sent
|= [[@ @ =raw-tx:naive] nif=_finding sih=_history]
=/ =keccak (hash-raw-tx:lib raw-tx)
?~ val=(~(get by nif) keccak)
[nif sih]
?. ?=(^ u.val)
[nif sih]
=* time time.u.val
=* address address.u.val
=* ship ship.from.tx.raw-tx
=/ l2-tx (l2-tx +<.tx.raw-tx)
=/ =roll-tx [ship %pending keccak l2-tx]
=+ txs=(~(got by sih) address)
=. txs +:(del:orh:dice txs time)
:- (~(del by nif) keccak)
%+ ~(put by sih) address
(put:orh:dice txs [time roll-tx])
--
:: +on-naive-diff: process l2 tx confirmations
::
++ on-naive-diff
@ -1309,7 +1503,7 @@
?~ sen=(get:ors:dice sending [address nonce])
~? lverb [dap.bowl %weird-double-remove nonce+nonce]
sending
?~ nin=(find [raw-tx.diff]~ txs.u.sen)
?~ nin=(find [raw-tx.diff]~ (turn txs.u.sen (cork tail tail)))
~? lverb [dap.bowl %weird-unknown nonce+nonce]
sending
=. txs.u.sen (oust [u.nin 1] txs.u.sen)
@ -1331,6 +1525,7 @@
:: ~? !forced [dap.bowl %aggregated-tx-failed-anyway err.diff]
%failed
::
~? =(0x0 tx-address) %weird-null-tx-address^'on-naive-diff'
=^ updates history
%^ update-history:dice
history
@ -1507,11 +1702,17 @@
|= wat=@t
?~ who=(slaw %p wat) [~ ~]
=/ [exceeded=? next-quota=@ud] (quota-exceeded u.who)
=/ allow=(unit (unit @ud)) (~(get by allowances) u.who)
:+ ~ ~
:- %atom
!> ^- @ud
?: exceeded 0
(sub quota.state (dec next-quota))
?: exceeded 0
=/ max-quota=@ quota.state
?: &(?=(^ allow) ?=(~ u.allow))
max-quota
=? max-quota &(?=(^ allow) ?=(^ u.allow))
u.u.allow
(sub max-quota (dec next-quota))
::
++ allowance
|= wat=@t

125
pkg/arvo/app/spider.hoon
View File

@ -9,14 +9,10 @@
+$ input input:spider
+$ yarn (list tid)
+$ thread-form _*eval-form:eval:(strand ,vase)
+$ trie
$~ [*thread-form ~]
[=thread-form kid=(map tid trie)]
::
+$ trying ?(%build %none)
+$ trying ?(%build %none)
+$ state
$: starting=(map yarn [=trying =vase])
running=trie
running=(axal thread-form)
tid=(map tid yarn)
serving=(map tid [(unit @ta) =mark =desk])
==
@ -72,85 +68,6 @@
running=(list yarn)
tid=(map tid yarn)
==
::
+$ start-args
[parent=(unit tid) use=(unit tid) =beak file=term =vase]
--
::
:: Trie operations
::
~% %spider ..card ~
|%
++ get-yarn
|= [=trie =yarn]
^- (unit =thread-form)
?~ yarn
`thread-form.trie
=/ son (~(get by kid.trie) i.yarn)
?~ son
~
$(trie u.son, yarn t.yarn)
::
++ get-yarn-children
|= [=trie =yarn]
^- (list ^yarn)
?~ yarn
(turn (tap-yarn trie) head)
=/ son (~(get by kid.trie) i.yarn)
?~ son
~
$(trie u.son, yarn t.yarn)
::
::
++ has-yarn
|= [=trie =yarn]
!=(~ (get-yarn trie yarn))
::
++ put-yarn
|= [=trie =yarn =thread-form]
^+ trie
?~ yarn
trie(thread-form thread-form)
=/ son (~(gut by kid.trie) i.yarn [*^thread-form ~])
%= trie
kid
%+ ~(put by kid.trie) i.yarn
$(trie son, yarn t.yarn)
==
::
++ del-yarn
|= [=trie =yarn]
^+ trie
?~ yarn
trie
|-
?~ t.yarn
trie(kid (~(del by kid.trie) i.yarn))
=/ son (~(get by kid.trie) i.yarn)
?~ son
trie
%= trie
kid
%+ ~(put by kid.trie) i.yarn
$(trie u.son, yarn t.yarn)
==
::
++ tap-yarn
|= =trie
%- flop :: preorder
=| =yarn
|- ^- (list [=^yarn =thread-form])
%+ welp
?~ yarn
~
[(flop yarn) thread-form.trie]~
=/ kids ~(tap by kid.trie)
|- ^- (list [=^yarn =thread-form])
?~ kids
~
=/ next-1 ^$(yarn [p.i.kids yarn], trie q.i.kids)
=/ next-2 $(kids t.kids)
(welp next-1 next-2)
--
::
%- agent:dbug
@ -250,7 +167,7 @@
=^ cards state
?+ mark (on-poke:def mark vase)
%spider-input (on-poke-input:sc !<(input vase))
%spider-start (handle-start-thread:sc !<(start-args vase))
%spider-start (handle-start-thread:sc !<(start-args:spider vase))
%spider-stop (handle-stop-thread:sc !<([tid ?] vase))
::
%handle-http-request
@ -277,10 +194,10 @@
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %tree ~]
``noun+!>((turn (tap-yarn running.state) head))
``noun+!>((turn ~(tap of running.state) head))
::
[%x %starting @ ~]
``noun+!>((has-yarn running.state (~(got by tid.state) i.t.t.path)))
``noun+!>((~(has of running.state) (~(got by tid.state) i.t.t.path)))
::
[%x %saxo @ ~]
``noun+!>((~(got by tid.state) i.t.t.path))
@ -316,7 +233,7 @@
(on-load on-save)
--
::
~% %spider-helper ..get-yarn ~
~% %spider-helper ..card ~
|_ =bowl:gall
++ bec `beak`byk.bowl(r da+now.bowl)
++ bind-eyre
@ -349,7 +266,7 @@
=/ body=json (need (de-json:html q.u.body.request.inbound-request))
=/ input=vase (slop !>(~) (tube !>(body)))
=/ boc bec
=/ =start-args [~ `tid boc(q desk, r da+now.bowl) thread input]
=/ =start-args:spider [~ `tid boc(q desk, r da+now.bowl) thread input]
(handle-start-thread start-args)
::
++ on-poke-input
@ -394,7 +311,7 @@
=/ new-tid (fall use (new-thread-id file))
=/ =yarn (snoc parent-yarn new-tid)
::
?: (has-yarn running.state yarn)
?: (~(has of running.state) yarn)
~| [%already-started yarn]
!!
?: (~(has by starting.state) yarn)
@ -439,7 +356,7 @@
|= [=yarn =thread]
^- (quip card ^state)
=/ =vase vase:(~(got by starting.state) yarn)
?< (has-yarn running.state yarn)
?< (~(has of running.state) yarn)
=/ m (strand ,^vase)
=/ res (mule |.((thread vase)))
?: ?=(%| -.res)
@ -447,7 +364,7 @@
=/ =eval-form:eval:m
(from-form:eval:m p.res)
=: starting.state (~(del by starting.state) yarn)
running.state (put-yarn running.state yarn eval-form)
running.state (~(put of running.state) yarn eval-form)
==
(take-input yarn ~)
::
@ -458,7 +375,7 @@
?~ yarn
~& %stopping-nonexistent-thread
[~ state]
?: (has-yarn running.state u.yarn)
?: (~(has of running.state) u.yarn)
?: nice
(thread-done u.yarn *vase)
(thread-fail u.yarn %cancelled ~)
@ -474,11 +391,11 @@
|= [=yarn input=(unit input:strand)]
^- (quip card ^state)
=/ m (strand ,vase)
?. (has-yarn running.state yarn)
?. (~(has of running.state) yarn)
%- (slog leaf+"spider got input for non-existent {<yarn>}" ~)
`state
=/ =eval-form:eval:m
thread-form:(need (get-yarn running.state yarn))
(need fil:(~(dip of running.state) yarn))
=| cards=(list card)
|- ^- (quip card ^state)
=^ r=[cards=(list card) =eval-result:eval:m] eval-form
@ -489,7 +406,7 @@
%& p.out
%| [[~ [%fail %crash p.out]] eval-form]
==
=. running.state (put-yarn running.state yarn eval-form)
=. running.state (~(put of running.state) yarn eval-form)
=/ =tid (yarn-to-tid yarn)
=. cards.r
%+ turn cards.r
@ -593,7 +510,10 @@
|= =yarn
^- (quip card ^state)
=/ children=(list ^yarn)
[yarn (get-yarn-children running.state yarn)]
%+ turn
~(tap of (~(dip of running.state) yarn))
|= [child=^yarn *]
(welp yarn child)
|- ^- (quip card ^state)
?~ children
`state
@ -601,9 +521,10 @@
=^ cards-our state
=/ =^yarn i.children
=/ =tid (yarn-to-tid yarn)
=: running.state (del-yarn running.state yarn)
=: running.state (~(lop of running.state) yarn)
tid.state (~(del by tid.state) tid)
serving.state (~(del by serving.state) (yarn-to-tid yarn))
serving.state (~(del by serving.state) (yarn-to-tid yarn))
==
:_ state
%+ murn ~(tap by wex.bowl)
@ -648,7 +569,6 @@
::
++ yarn-to-byk
|= [=yarn =bowl:gall]
=/ [* * =desk]
~| "no desk associated with {<tid>}"
%- ~(got by serving.state) (yarn-to-tid yarn)
@ -657,7 +577,7 @@
::
++ clean-state
!> ^- clean-slate
4+state(running (turn (tap-yarn running.state) head))
4+state(running (turn ~(tap of running.state) head))
::
++ convert-tube
|= [from=mark to=mark =desk =bowl:gall]
@ -666,5 +586,4 @@
%cc
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
==
--

3
pkg/arvo/gen/azimuth/kick.hoon
View File

@ -1,4 +1,5 @@
:: Kick azimuth
::
:- %say
|= *
[%azimuth-poke %listen ~ %| %azimuth]
[%azimuth-poke %kick ~]

1
pkg/arvo/gen/azimuth/watch.hoon
View File

@ -1,4 +1,5 @@
:: Change node url and network for azimuth
::
:- %say
|= [* [url=@ta net=?(%mainnet %ropsten %local %default) ~] ~]
[%azimuth-poke %watch url net]

2
pkg/arvo/gen/brass.hoon
View File

@ -26,7 +26,7 @@
::
~
==
:- %boot-pill
:- %pill
^- pill:pill
:: sys: root path to boot system, `/~me/[desk]/now/sys`
:: bas: root path to boot system' desk

2
pkg/arvo/gen/dns-bind/authority.hoon
View File

@ -20,7 +20,7 @@
%- crip
+:(scow %p .^(@p %j /(scot %p our)/code/(scot %da now)/(scot %p our)))
=/ secrets
.^(@t %cx :(weld /(scot %p our)/home/(scot %da now)/sec domain /atom))
.^(@t %cx :(weld /(scot %p our)/base/(scot %da now)/sec domain /atom))
::
=- ?~ arg -
(fun.q.q [%& dom.arg])

2
pkg/arvo/gen/help.hoon
View File

@ -42,7 +42,7 @@
::
:- %say
|= [[now=time @ our=ship ^] typ=$@(~ [p=term ~]) ~]
=/ pax=path /(scot %p our)/home/(scot %da now)/gen :: XX hardcoded
=/ pax=path /(scot %p our)/base/(scot %da now)/gen :: XX hardcoded
=+ len=(lent pax)
=. pax ?~(typ pax (welp pax /[p.typ]))
:- %tang %- flop ^- tang

4
pkg/arvo/gen/hood/ames-prod.hoon Normal file
View File

@ -0,0 +1,4 @@
:- %say
|= [^ ships=(list ship) ~]
:- %helm-ames-prod
ships

2
pkg/arvo/gen/hood/fuse.hoon
View File

@ -13,7 +13,7 @@
+$ fuse-arg
$: des=desk
:: specified as [germ path] instead of [path germ] so
:: users can write mate//=home= instead of [/=home= %mate]
:: users can write mate//=base= instead of [/=base= %mate]
::
res=[?([%cancel ~] [bas=path con=(list [germ path])])]
==

2
pkg/arvo/gen/hood/fuse/help.txt
View File

@ -1,6 +1,6 @@
Usage:
|fuse %dest /=kids= mate//~nel/home= meet//~zod/kids/track
|fuse %dest /=kids= mate//~nel/base= meet//~zod/kids/track
|fuse %old-desk /=kids= only-that//~nus/test=, =overwrite &
|fuse %desk-to-cancel-fuse-into %cancel

8
pkg/arvo/gen/hood/merge/help.txt
View File

@ -7,7 +7,7 @@ Usage:
We support various merge strategies. A "commit" is a snapshot of
the files with a list of parents plus a date. Most commits have
one parent; a "merge" commit is a commit with two parents. The
%home desk starts with an initial commit with no parents; commits
%base desk starts with an initial commit with no parents; commits
with several parents ("octopus merges") are possible but we don't
generate them right now.
@ -72,13 +72,13 @@ We speak of merging into a destination *desk* from a source *commit*
because while you can only merge on top of a desk, you can merge from
historical commits. For example,
|merge %old our %home, =cas ud+5, =gem %init
|merge %old our %base, =cas ud+5, =gem %init
will create a new desk called %old with the 5th commit in %home.
will create a new desk called %old with the 5th commit in %base.
You can revert the contents of a desk to what they were yesterday
with
|merge %home our %home, =cas da+(sub now ~d1), =gem %only-that
|merge %base our %base, =cas da+(sub now ~d1), =gem %only-that
Note this is a normal %only-that merge, which means you're creating a
*new* commit with the old *contents*.

11
pkg/arvo/gen/hood/norm.hoon Normal file
View File

@ -0,0 +1,11 @@
:: Add rule to tombstone policy
::
:- %say
|= [[now=@da eny=@uvJ bec=beak] [=ship =desk =path keep=? ~] ~]
:- %helm-pass
=+ .^(=cone:clay %cx /(scot %p p.bec)//(scot %da now)/domes)
=/ =norm:clay
?~ got=(~(get by cone) ship desk)
*norm:clay
nor.u.got
[%c %tomb %norm ship desk (~(put of norm) path keep)]

6
pkg/arvo/gen/hood/pick.hoon Normal file
View File

@ -0,0 +1,6 @@
:: Execute tombstone policy
::
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %helm-pass
[%c %tomb %pick ~]

23
pkg/arvo/gen/hood/story-init.hoon Normal file
View File

@ -0,0 +1,23 @@
:: story: Create a story file for a given desk, optionally overwriting
::
::::
::
/- *story
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[~] =desk overwrite=_| ~]
==
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
=/ existing-story .^(? %cu /(scot %p our)/[desk]/(scot %da now)/story)
?: ?&(existing-story !overwrite)
~& >> "Error: /{(trip (slav %tas desk))}/story already exists."
~& >> "To forcibly overwrite, use `=overwrite %.y`"
:: XX could use a better way to noop
helm-pass+[%d %noop ~]
=| tale=story
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

36
pkg/arvo/gen/hood/story-remove.hoon Normal file
View File

@ -0,0 +1,36 @@
:: story: Remove any commit message(s) for a given commit
::
:: Optionally targeting a specific desk or prose
::
::::
::
/- *story
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[cas=cash ~] =desk prz=prose ~]
==
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
=/ tak=tako:clay
?: ?=([%tako tako:clay] cas)
p.cas
?: !.^(? %cs /(scot %p our)/[desk]/(scot cas)/case)
~& >> "Error: invalid case {<cas>} provided"
!!
.^(tako:clay %cs /(scot %p our)/[desk]/(scot cas)/tako/~)
::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one."
helm-pass+[%d %noop ~]
=/ tale=story .^(story %cx pax)
=. tale
?: =(*prose prz)
(~(del by tale) tak)
(~(del ju tale) tak prz)
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

34
pkg/arvo/gen/hood/story-write.hoon Normal file
View File

@ -0,0 +1,34 @@
:: story: Attach a commit message (to the last commit by default)
::
:: Optionally takes a case and desk
::
::::
::
/- *story
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[title=@t body=$@(~ [p=@t ~])] =desk cas=cash ~]
==
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=? cas =(*case cas) r.bec :: use case from beak if cas not provided
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
~& >> "Error: desk {<desk>} does not exist."
helm-pass+[%d %noop ~]
=/ tak=tako:clay
?: ?=([%tako tako:clay] cas)
p.cas
?: !.^(? %cs /(scot %p our)/[desk]/(scot cas)/case)
~& >> "Error: invalid case {<cas>} provided"
!!
.^(tako:clay %cs /(scot %p our)/[desk]/(scot cas)/tako/~)
::
=/ pax /(scot %p our)/[desk]/(scot %da now)/story
?: !.^(? %cu pax)
~& >> "Error: No story file found. Please use |story-init to create one."
helm-pass+[%d %noop ~]
=/ tale=story .^(story %cx /(scot %p our)/[desk]/(scot %da now)/story)
=/ =prose [title ?~(body '' p.body)]
=. tale (~(put ju tale) tak prose)
:- %helm-pass
[%c [%info desk %& [/story %ins story+!>(tale)]~]]

65
pkg/arvo/gen/hood/tomb.hoon Normal file
View File

@ -0,0 +1,65 @@
:: Perform minimal norm change to delete a file, use =dry & for dry run
::
:: TODO: recognize when it's going to fail because it's in the head of
:: a desk, and maybe offer to |rm
::
=, clay
:- %say
|= [[now=@da eny=@uvJ bec=beak] [target=path ~] dry=_|]
:- %helm-pans
=+ .^(=arch %cy target)
?~ fil.arch
[%d %flog %text "tomb: not a file"]~ :: should recurse
=/ =lobe u.fil.arch
=+ .^(=rang %cx /(scot %p p.bec)//(scot %da now)/rang)
=+ .^(=cone %cx /(scot %p p.bec)//(scot %da now)/domes)
=/ domes=(list [[=ship =desk] =dome tom=(map tako norm) nor=norm])
~(tap by cone)
=/ norms
|^
|- ^- (set [ship desk tako norm path])
?~ domes
~
=/ n 1
=/ =aeon 1
%- ~(uni in $(domes t.domes))
|- ^- (set [ship desk tako norm path])
?: (lth let.dome.i.domes aeon)
~
=/ =tako (~(got by hit.dome.i.domes) aeon)
=/ paths (draw-tako ship.i.domes desk.i.domes +.i.domes tako)
(~(uni in paths) $(aeon +(aeon)))
::
++ draw-tako
|= [=ship =desk [dome tom=(map tako norm) nor=norm] =tako]
^- (set [^ship ^desk ^tako norm path])
~+
=/ =yaki (~(got by hut.rang) tako)
=/ takos
|- ^- (set [^ship ^desk ^tako norm path])
?~ p.yaki
~
(~(uni in $(p.yaki t.p.yaki)) ^$(tako i.p.yaki))
|- ^- (set [^ship ^desk ^tako norm path])
?~ q.yaki
takos
%- ~(uni in $(q.yaki l.q.yaki))
%- ~(uni in $(q.yaki r.q.yaki))
^- (set [^ship ^desk ^tako norm path])
?. =(lobe q.n.q.yaki)
~
[[ship desk tako (~(gut by tom) tako nor) p.n.q.yaki] ~ ~]
--
^- (list note-arvo)
%+ welp
%+ murn ~(tap in norms)
|= [=ship =desk =tako =norm =path]
?: ?=([~ %|] (~(fit of norm) path))
~
%- (slog leaf+"tomb: {<ship desk path `@uv`tako norm path>}" ~)
?: dry
~
`[%c %tomb %worn ship desk tako (~(put of norm) path %|)]
?: dry
~
[%c %tomb %pick ~]~

15
pkg/arvo/gen/norms.hoon Normal file
View File

@ -0,0 +1,15 @@
:: Display tombstone policies
::
=, clay
:- %say
|= [[now=@da eny=@uvJ bec=beak] ~ ~]
:- %tang
=+ .^(=cone %cx /(scot %p p.bec)//(scot %da now)/domes)
%- flop ^- tang
%- zing
%+ turn ~(tap by cone)
|= [[=ship =desk] dome tom=(map tako norm) nor=norm]
:- leaf+"{<ship>}/{<desk>}:"
%+ turn ~(tap of nor)
|= [=path keep=?]
leaf+" {<path>}: {<keep>}"

6
pkg/arvo/gen/show-vat.hoon
View File

@ -7,8 +7,8 @@
%- flop ^- tang
=/ pax=path /(scot %p p.bec)/[desk]/(scot %da now)
=+ .^([lal=@tas num=@ud] cx+(weld pax /sys/kelvin))
:~ 'sys.kelvin:'
leaf/"[%{<lal>} %{<num>}]"
'desk.bill:'
:~ '/sys/kelvin:'
leaf/"[{<lal>} {<num>}]"
'/desk/bill:'
(sell !>(.^((list dude:gall) cx+(weld pax /desk/bill))))
==

2
pkg/arvo/gen/solid.hoon
View File

@ -29,7 +29,7 @@
::
dub=_|
==
:- %boot-pill
:- %pill
^- pill:pill
:: sys: root path to boot system, `/~me/[desk]/now/sys`
:: bas: root path to boot system' desk

23
pkg/arvo/gen/story-list.hoon Normal file
View File

@ -0,0 +1,23 @@
:: story: List unordered commit messages for the given desk, including orphans
::
::::
::
/- *story
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[~] =desk ~]
==
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=/ cas r.bec :: use case from beak
=/ pax /(scot %p our)/[desk]/(scot cas)/story
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
tang+[leaf+"Error: desk {<desk>} does not exist." ~]
?: !.^(? %cu pax)
tang+['Error: No story file found. Please use |story-init to create one.' ~]
=/ story-to-txt
.^($-(story wain) %cf /(scot %p our)/[desk]/(scot cas)/story/txt)
::
=/ tale .^(story %cx pax)
=/ tale-text (story-to-txt tale)
tang+tale-text

154
pkg/arvo/gen/story-read.hoon Normal file
View File

@ -0,0 +1,154 @@
:: story: log commits in order
::
::::
::
/- *story
/+ lib=story
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[~] =desk ~]
==
|^
=/ our p.bec
=? desk =(*^desk desk) q.bec :: use current desk if user didn't provide
=/ cas r.bec :: use case from beak
=/ pax /(scot %p our)/[desk]/(scot cas)/story
?: !(~(has in .^((set ^desk) %cd /(scot %p our)/$/(scot %da now))) desk)
tang+[leaf+"Error: desk {<desk>} does not exist." ~]
?: !.^(? %cu pax)
tang+['Error: No story file found. Please use |story-init to create one.' ~]
=/ tak .^(tako:clay %cs /(scot %p our)/[desk]/(scot cas)/tako/~)
=/ yak .^(yaki:clay %cs /(scot %p our)/[desk]/(scot cas)/yaki/(scot %uv tak))
=/ tale .^(story %cx pax)
:- %tang
(story-read [our desk cas] yak tale)
::::
:: Remarks:
::
:: There are two recursions in the logging process:
:: 1. the outer loop `commit-loop` threads down into each commit by ancestor
:: 2. the inner loop `ancestor-loop` threads left-to-right on reverse-ancestors
::
:: +story-read outputs a tang with the least-recent commits at the head
:: of the list, even though we want most-recent commits to print first.
:: But because dojo prints tangs in reverse, we don't flop the results.
::::
++ story-read
|= [[our=ship syd=^desk cas=case] this-commit=yaki:clay tale=story]
^- tang
:: TODO factor out /(scot %p our)/[syd]/(scot cas)
%- head :: result from state
=| state=[result=tang mergebase=(unit tako:clay)]
|-
^- _state
=* commit-loop $
=/ reverse-ancestors (flop p.this-commit)
|-
=* ancestor-loop $
?- reverse-ancestors
~
:: stop here and return the current message
=/ msg=(list cord) (msg-from-commit this-commit tale)
[(weld msg result.state) mergebase=~]
::
[tako:clay ~]
=/ parent i.reverse-ancestors
=/ parent-commit
.^(yaki:clay %cs /(scot %p our)/[syd]/(scot cas)/yaki/(scot %uv parent))
::
=/ msg
(msg-from-commit this-commit tale)
::
:: If there is a mergebase and we are visting it right now:
:: stop here and clear the mergebase.
:: skip adding the mergebase's msg itself,
:: because it will be added through the other branch.
:: Otherwise, record the current message if exists and recur.
?: ?&(?=(^ mergebase.state) =(u.mergebase.state r.this-commit))
[result=result.state mergebase=~]
commit-loop(this-commit parent-commit, result.state (weld msg result.state))
::
[tako:clay tako:clay ~]
::
:: mainline: ultimate base chain
:: nowline: relative mainline
:: sideline: side-chain, featurebranch
::
:: From the context of e, commit c is on its relative mainline, or nowline,
:: while commit d is on its sideline.
::
:: %base a--b-------------X :: mainline
:: %new \--c------e--/ :: nowline
:: %new2 \--d--/ :: sideline
::
::
=/ sideline i.reverse-ancestors
=/ mainline i.t.reverse-ancestors
:: XX base-tako ignores beak
::
=/ mergebases
.^ (list tako:clay) %cs
(scot %p our) syd (scot cas)
/base-tako/(scot %uv mainline)/(scot %uv sideline)
==
::
:: Take the first valid mergebase (by convention) if exists, else none
::
=/ next-mergebase
?~(mergebases ~ (some i.mergebases))
::
=/ sideline-commit
.^(yaki:clay %cs /(scot %p our)/[syd]/(scot cas)/yaki/(scot %uv sideline))
::
=/ mainline-commit
.^(yaki:clay %cs /(scot %p our)/[syd]/(scot cas)/yaki/(scot %uv mainline))
::
=/ msg=(list cord)
(msg-from-commit this-commit tale)
::
:: 1 - process current commit
:: 2 - recur and queue processing on all commits on the sideline
:: 3 - recur and queue processing on all commits on the mainline
::
:: Because mainline messages are cons'd to result last, they are
:: (by definition) towards the less recent side of the flopped list
::
=. state [result=(weld msg result.state) mergebase=next-mergebase] :: 1
=. state commit-loop(this-commit sideline-commit) :: 2
=. state commit-loop(this-commit mainline-commit) :: 3
state
::
[tako:clay tako:clay tako:clay *]
:: ~& "in 3+ ancestor commit"
=/ sideline i.reverse-ancestors
=/ nowline i.t.reverse-ancestors
=/ mergebases
.^ (list tako:clay) %cs
(scot %p our) syd (scot cas)
/base-tako/(scot %uv nowline)/(scot %uv sideline)
==
::
:: Take the first valid mergebase (by convention) if exists, else none
::
=/ next-mergebase ?~(mergebases ~ (some i.mergebases))
=/ sideline-commit
.^(yaki:clay %cs /(scot %p our)/[syd]/(scot cas)/yaki/(scot %uv sideline))
=. mergebase.state next-mergebase
=. state commit-loop(this-commit sideline-commit) :: downward
=. state ancestor-loop(reverse-ancestors t.reverse-ancestors) :: rightward
state
==
::
++ msg-from-commit
|= [commit=yaki:clay tale=story]
^- (list cord)
=/ proses (~(get by tale) r.commit)
?~ proses ~
%- flop :: fixes formatting reversal in dojo
%- to-wain:format
%- crip
;: welp
(tako-to-text:lib r.commit)
(proses-to-text:lib u.proses)
==
--

10
pkg/arvo/gen/vat.hoon Normal file
View File

@ -0,0 +1,10 @@
/- *hood
:- %say
|= $: [now=@da eny=@uvJ bec=beak]
[[=desk ~] ~]
==
?: =(desk %kids) [%tang ~[(report-kids p.bec now)]]
=+ .^ =vat %gx
/(scot %p p.bec)/hood/(scot %da now)/kiln/vat/[desk]/noun
==
[%tang ~[(report-vat p.bec now vat)]]

2
pkg/arvo/lib/aqua-azimuth.hoon
View File

@ -14,7 +14,7 @@
|= [our=ship her=ship uf=unix-effect azi=az-state]
^- (unit card:agent:gall)
=, enjs:format
=/ ask (extract-request uf 'http://localhost:8545/')
=/ ask (extract-request uf 'http://fake.aqua.domain/')
?~ ask
~
?~ body.request.u.ask

19
pkg/arvo/lib/azimuth-roll-rpc.hoon
View File

@ -179,6 +179,12 @@
^- (unit @ud)
?~ nonce=(~(get by params) 'nonce') ~
(ni u.nonce)
::
++ force
|= params=(map @t json)
^- (unit ?)
?~ force=(~(get by params) 'force') ~
(bo u.force)
--
::
++ to-json
@ -520,15 +526,20 @@
++ process-rpc
|= [id=@t params=(map @t json) action=l2-tx over-quota=$-(@p ?)]
^- [(unit cage) response:rpc]
?. =((lent ~(tap by params)) 4)
?. ?| =((lent ~(tap by params)) 4)
=((lent ~(tap by params)) 5)
==
[~ ~(params error:json-rpc id)]
=? params =((lent ~(tap by params)) 4)
(~(put by params) 'force' b+|)
=+ ^- $: sig=(unit @)
from=(unit [=ship proxy:naive])
addr=(unit @ux)
force=(unit ?)
==
=, from-json
[(sig params) (from params) (address params)]
?: |(?=(~ sig) ?=(~ from) ?=(~ addr))
[(sig params) (from params) (address params) (force params)]
?: |(?=(~ sig) ?=(~ from) ?=(~ addr) ?=(~ force))
[~ ~(parse error:json-rpc id)]
?: (over-quota ship.u.from)
`[%error id '-32002' 'Max tx quota exceeded']
@ -537,7 +548,7 @@
=+ (gen-tx-octs:lib u.tx)
:_ [%result id (hex:to-json 32 (hash-tx:lib p q))]
%- some
roller-action+!>([%submit | u.addr u.sig %don u.tx])
roller-action+!>([%submit u.force u.addr u.sig %don u.tx])
::
++ nonce
|= [id=@t params=(map @t json) scry=$-([ship proxy:naive] (unit @))]

18
pkg/arvo/lib/desk-jam.hoon
View File

@ -3,11 +3,12 @@
++ jam-desk
|= [our=ship =desk now=@da]
~> %slog.0^leaf/"jamming desk {<desk>}"
=+ .^(=rang:clay %cx /(scot %p our)//(scot %da now))
=+ .^(=tako:clay %cs /(scot %p our)/[desk]/(scot %da now))
%- jam
%- ?:(=(%base desk) remove-misc-dirs same)
%- ankh-to-map
=< ank
.^(dome:clay %cv /(scot %p our)/[desk]/(scot %da now))
%- ~(run by q:(~(got by hut.rang) tako))
~(got by lat.rang)
::
++ remove-misc-dirs
|= fiz=(map path page)
@ -18,15 +19,4 @@
?| ?=([%tmp *] p)
?=([%tests *] p)
==
::
++ ankh-to-map
=| res=(map path page)
=| pax=path
|= a=ankh
^- (map path page)
=? res ?=(^ fil.a) (~(put by res) pax [p q.q]:q.u.fil.a)
=/ dir=(list [seg=@ta =ankh]) ~(tap by dir.a)
|- ^+ res
?~ dir res
$(dir t.dir, res ^$(pax (snoc pax seg.i.dir), a ankh.i.dir))
--

4
pkg/arvo/lib/dice.hoon
View File

@ -68,13 +68,13 @@
?. (verify-sig-and-nonce:naive verifier chain-t nas raw-tx)
=+ [force ~ nas indices]
?. verb -
~& >>> [verb+verb %verify-sig-and-nonce %failed tx.raw-tx] -
~& >>> [force+force %verify-sig-and-nonce %failed tx.raw-tx] -
=^ effects-1 points.nas
(increment-nonce:naive nas from.tx.raw-tx)
?~ nex=(receive-tx:naive nas tx.raw-tx)
=+ [force ~ ?:(force nas cache) indices]
?. verb -
~& >>> [verb+verb %receive-tx %failed] -
~& >>> [force+force %receive-tx %failed] -
=* new-nas +.u.nex
=/ effects (welp effects-1 -.u.nex)
=^ updates indices

46
pkg/arvo/lib/hood/helm.hoon
View File

@ -109,6 +109,26 @@
this
(emit %pass / %arvo %j %moon u.sed)
::
++ poke-moon-breach
|= =ship
?> ?| =(our src):bowl
=(src.bowl ship)
==
abet:(emit %pass /helm/moon-breach/(scot %p ship) %arvo %b %wait now.bowl)
::
++ take-wake-moon-breach
|= [way=wire error=(unit tang)]
?^ error
%- (slog %take-wake-moon-breach-fail u.error)
abet
?> ?=([@ ~] way)
=/ =ship (slav %p i.way)
?> =(%earl (clan:title ship))
?> =(our.bowl (sein:title our.bowl now.bowl ship))
=/ =rift
+(.^(rift j+/(scot %p our.bowl)/rift/(scot %da now.bowl)/(scot %p ship)))
abet:(emit %pass / %arvo %j %moon ship *id:block:jael %rift rift %.n)
::
++ poke-code
|= act=?(~ %reset)
=< abet
@ -138,6 +158,12 @@
|= ~ =< abet
(emit %pass /pack %arvo %d %flog %pack ~)
::
++ poke-pans
|= pans=(list note-arvo)
?~ pans abet
=. this (emit %pass /helm/pans %arvo i.pans)
$(pans t.pans)
::
++ poke-pass
|= =note-arvo =< abet
(emit %pass /helm/pass %arvo note-arvo)
@ -172,6 +198,10 @@
!!
abet:(flog %text "< {<src.bowl>}: {(trip mes)}")
::
++ poke-ames-prod
|= ships=(list ship)
abet:(emit %pass /helm/prod %arvo %a %prod ships)
::
++ poke-atom
|= ato=@
=+ len=(scow %ud (met 3 ato))
@ -225,9 +255,11 @@
++ poke
|= [=mark =vase]
?> ?| ?=(%helm-hi mark)
?=(%helm-moon-breach mark)
=(our src):bowl
==
?+ mark ~|([%poke-helm-bad-mark mark] !!)
%helm-ames-prod =;(f (f !<(_+<.f vase)) poke-ames-prod)
%helm-ames-sift =;(f (f !<(_+<.f vase)) poke-ames-sift)
%helm-ames-verb =;(f (f !<(_+<.f vase)) poke-ames-verb)
%helm-ames-wake =;(f (f !<(_+<.f vase)) poke-ames-wake)
@ -239,9 +271,11 @@
%helm-cors-reject =;(f (f !<(_+<.f vase)) poke-cors-reject)
%helm-hi =;(f (f !<(_+<.f vase)) poke-hi)
%helm-knob =;(f (f !<(_+<.f vase)) poke-knob)
%helm-pans =;(f (f !<(_+<.f vase)) poke-pans)
%helm-mass =;(f (f !<(_+<.f vase)) poke-mass)
%helm-meld =;(f (f !<(_+<.f vase)) poke-meld)
%helm-moon =;(f (f !<(_+<.f vase)) poke-moon)
%helm-moon-breach =;(f (f !<(_+<.f vase)) poke-moon-breach)
%helm-pack =;(f (f !<(_+<.f vase)) poke-pack)
%helm-pass =;(f (f !<(_+<.f vase)) poke-pass)
%helm-rekey =;(f (f !<(_+<.f vase)) poke-rekey)
@ -266,10 +300,12 @@
++ take-arvo
|= [=wire =sign-arvo]
?+ wire ~|([%helm-bad-take-wire wire +<.sign-arvo] !!)
[%automass *] %+ take-wake-automass t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%serv *] %+ take-bound t.wire
?>(?=(%bound +<.sign-arvo) +>.sign-arvo)
[%pass *] abet
[%automass *] %+ take-wake-automass t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%serv *] %+ take-bound t.wire
?>(?=(%bound +<.sign-arvo) +>.sign-arvo)
[%moon-breach *] %+ take-wake-moon-breach t.wire
?>(?=(%wake +<.sign-arvo) +>.sign-arvo)
[%pass *] abet
==
--

6
pkg/arvo/lib/hood/kiln.hoon
View File

@ -1050,9 +1050,7 @@
=+ .^(=cass:clay %cw /(scot %p our)/[desk]/(scot %da now))
?- ud.cass
%0 %init
* %take-that
::%1 %take-that
::* %mate
* %only-that
==
::
++ poke
@ -1630,7 +1628,7 @@
:: fail.
::
:: We want to always use %only-that for the first remote merge.
:: But we also want local syncs (%base to %home or %kids) to
:: But we also want local syncs (%base to %base or %kids) to
:: succeed after that first remote sync. To accomplish both we
:: simply use %only-that for the first three sync merges. (The
:: first two are from the pill.)

1
pkg/arvo/lib/story.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/lib/story.hoon

29
pkg/arvo/lib/trie.hoon
View File

@ -1,29 +0,0 @@
|%
++ trie
|$ [key-t val-t]
[val=(unit val-t) kid=(map key-t (trie key-t val-t))]
--
::
=| a=(trie * *)
=* val-t ?>(?=(^ val.a) val.a)
|@
++ put
|* [b=(list *) c=*]
=> .(b (homo b))
|- ^+ a
?~ b
a(val `c)
=/ son (~(gut by kid.a) i.b [~ ~])
a(kid (~(put by kid.a) i.b $(a son, b t.b)))
::
++ get
|* b=(list *)
=> .(b (homo b))
|-
?~ b
[~ val.a]
=/ son (~(get by kid.a) i.b)
?~ son
[b val.a]
$(a u.son, b t.b)
--

12
pkg/arvo/mar/helm-moon-breach.hoon Normal file
View File

@ -0,0 +1,12 @@
|_ mun=ship
::
++ grad %noun
++ grab
|%
++ noun ship
--
++ grow
|%
++ noun mun
--
--

3
pkg/arvo/mar/pill.hoon
View File

@ -1,8 +1,7 @@
::
:::: /hoon/pill/mar
::
/- aquarium
=, aquarium
/+ *pill
=, mimes:html
|_ pil=pill
++ grow

1
pkg/arvo/mar/story.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/mar/story.hoon

1
pkg/arvo/mar/thread-done.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/mar/thread-done.hoon

1
pkg/arvo/mar/thread-fail.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/mar/thread-fail.hoon

8
pkg/arvo/sur/dice.hoon
View File

@ -85,7 +85,13 @@
+$ hist-tx [p=time q=roll-tx]
+$ roll-tx [=ship =status hash=keccak type=l2-tx]
+$ pend-tx [force=? =address:naive =time =raw-tx:naive]
+$ send-tx [next-gas-price=@ud sent=? txs=(list raw-tx:naive)]
+$ send-tx
$: next-gas-price=@ud
sent=?
:: TODO: make txs as (list pend-tx)?
::
txs=(list [=address:naive force=? =raw-tx:naive])
==
+$ part-tx
$% [%raw raw=octs]
[%don =tx:naive]

2
pkg/arvo/sur/eth-watcher.hoon
View File

@ -9,6 +9,7 @@
:: refresh-rate: rate at which to check for updates
:: timeout-time: time an update check is allowed to take
:: from: oldest block number to look at
:: to: optional newest block number to look at
:: contracts: contract addresses to look at
:: topics: event descriptions to look for
::
@ -17,6 +18,7 @@
refresh-rate=@dr
timeout-time=@dr
from=number:block
to=(unit number:block)
contracts=(list address:ethereum)
batchers=(list address:ethereum)
=topics

1
pkg/arvo/sur/story.hoon Symbolic link
View File

@ -0,0 +1 @@
../../base-dev/sur/story.hoon

2
pkg/arvo/sys.kelvin
View File

@ -1 +1 @@
[%zuse 419]
[%zuse 418]

106
pkg/arvo/sys/arvo.hoon
View File

@ -1,11 +1,12 @@
=> ..ride =>
!:
|%
+| %global
::
++ arvo %240
::
:: $arch: node identity
:: $axal: fundamental node, recursive
:: $axal: fundamental node, recursive (trie)
:: $axil: fundamental node
:: $beak: global context
:: $beam: global name
@ -18,6 +19,7 @@
:: $gang: infinite set of peers
:: $mark: symbolic content type
:: $mien: orientation
:: $page: untyped cage
:: +omen: namespace path and data
:: $ship: network identity
:: $sink: subscription
@ -25,7 +27,7 @@
+$ arch (axil @uvI)
++ axal
|$ [item]
[fil=(unit item) dir=(map @ta $)] ::
[fil=(unit item) dir=(map @ta $)]
++ axil
|$ [item]
[fil=(unit item) dir=(map @ta ~)]
@ -49,6 +51,7 @@
+$ gang (unit (set ship))
+$ mark @tas
+$ mien [our=ship now=@da eny=@uvJ]
+$ page (cask)
++ omen |$ [a] (pair path (cask a))
+$ ship @p
+$ sink (trel bone ship path)
@ -414,11 +417,19 @@
::
:: |de: axal engine
::
++ de
++ of
=| fat=(axal)
|@
++ del
|= pax=path
^+ fat
?~ pax [~ dir.fat]
=/ kid (~(get by dir.fat) i.pax)
?~ kid fat
fat(dir (~(put by dir.fat) i.pax $(fat u.kid, pax t.pax)))
:: Descend to the axal at this path
::
++ get
++ dip
|= pax=path
^+ fat
?~ pax fat
@ -426,21 +437,51 @@
?~ kid [~ ~]
$(fat u.kid, pax t.pax)
::
++ put
|* [pax=path dat=*]
=> .(dat `_?>(?=(^ fil.fat) u.fil.fat)`dat)
^+ fat
?~ pax fat(fil `dat)
=/ kid (~(get by dir.fat) i.pax)
=/ new (fall kid fat(fil ~, dir ~))
fat(dir (~(put by dir.fat) i.pax $(fat new, pax t.pax)))
::
++ gas
|= lit=(list (pair path _?>(?=(^ fil.fat) u.fil.fat)))
^+ fat
?~ lit fat
$(fat (put p.i.lit q.i.lit), lit t.lit)
::
++ get
|= pax=path
fil:(dip pax)
:: Fetch file at longest existing prefix of the path
::
++ fit
|= pax=path
^+ [pax fil.fat]
?~ pax [~ fil.fat]
=/ kid (~(get by dir.fat) i.pax)
?~ kid [pax fil.fat]
=/ low $(fat u.kid, pax t.pax)
?~ +.low
[pax fil.fat]
low
::
++ has
|= pax=path
!=(~ (get pax))
:: Delete subtree
::
++ lop
|= pax=path
^+ fat
?~ pax fat
|-
?~ t.pax fat(dir (~(del by dir.fat) i.pax))
=/ kid (~(get by dir.fat) i.pax)
?~ kid fat
fat(dir (~(put by dir.fat) i.pax $(fat u.kid, pax t.pax)))
::
++ put
|* [pax=path dat=*]
=> .(dat `_?>(?=(^ fil.fat) u.fil.fat)`dat, pax `path`pax)
|- ^+ fat
?~ pax fat(fil `dat)
=/ kid (~(gut by dir.fat) i.pax ^+(fat [~ ~]))
fat(dir (~(put by dir.fat) i.pax $(fat kid, pax t.pax)))
::
++ tap
=| pax=path
=| out=(list (pair path _?>(?=(^ fil.fat) u.fil.fat)))
@ -453,6 +494,10 @@
dir t.dir
out ^$(pax (weld pax /[p.i.dir]), fat q.i.dir)
==
:: Serialize to map
::
++ tar
(~(gas by *(map path _?>(?=(^ fil.fat) u.fil.fat))) tap)
--
::
++ wa :: cached compile
@ -781,8 +826,8 @@
::
=* pax p.i.fal
=* dat q.i.fal
=/ hav (~(get de fat) pax)
=? del |(?=(~ fil.hav) !=(u.fil.hav dat))
=/ hav (~(get of fat) pax)
=? del |(?=(~ hav) !=(u.hav dat))
?: ?=([%sys *] pax)
del(sys (~(put by sys.del) pax dat))
del(use (~(put by use.del) pax dat))
@ -799,7 +844,7 @@
`[`(sole u.arv) [/sys/arvo u.arv] ~]
=/ rav
~| %usurp-hoon-no-arvo
((bond |.((need fil:(~(get de fat) /sys/arvo)))) arv)
((bond |.((need (~(get of fat) /sys/arvo)))) arv)
~! rav
:+ ~
[`(sole u.hun) (sole rav)]
@ -814,10 +859,10 @@
=^ lul fat
?^ hav=(~(get by sys.del) /sys/lull)
:- `(sole u.hav)
(~(put de fat) /sys/lull u.hav)
(~(put of fat) /sys/lull u.hav)
:_ fat
~| %adorn-no-lull
?.(all ~ `(sole (need fil:(~(get de fat) /sys/lull))))
?.(all ~ `(sole (need (~(get of fat) /sys/lull))))
:: zuse: shared library
::
:: %lull is the subject of %zuse; force all if we have a new %lull
@ -826,10 +871,10 @@
=^ zus fat
?^ hav=(~(get by sys.del) /sys/zuse)
:- `(sole u.hav)
(~(put de fat) /sys/zuse u.hav)
(~(put of fat) /sys/zuse u.hav)
:_ fat
~| %adorn-no-zuse
?.(all ~ `(sole (need fil:(~(get de fat) /sys/zuse))))
?.(all ~ `(sole (need (~(get of fat) /sys/zuse))))
:: kernel modules
::
:: %zuse is the subject of the vanes; force all if we have a new %zuse
@ -839,7 +884,7 @@
=? nav all
%- ~(gas by nav)
%+ turn
~(tap by dir:(~(get de fat) /sys/vane))
~(tap by dir:(~(dip of fat) /sys/vane))
|=([name=@ta _fat] [`@tas`name (sole (need fil))])
::
=^ new fat
@ -852,7 +897,7 @@
?> ?=([%sys %vane @tas ~] p)
=* nam i.t.t.p
?> ((sane %tas) nam)
[[`@tas`nam (sole q)] (~(put de taf) p q)]
[[`@tas`nam (sole q)] (~(put of taf) p q)]
::
=; van
[[lul zus van] fat]
@ -1008,7 +1053,7 @@
++ create
|= [our=ship zus=vase lal=term pax=path txt=@t]
^- vase
=/ cap "vane %{(trip lal)}"
=/ cap "vane: %{(trip lal)}"
(slym (smit cap zus pax txt) our)
::
++ settle
@ -1310,7 +1355,7 @@
::
%+ turn
(sort ~(tap by van.mod) |=([[a=@tas *] [b=@tas *]] (aor a b)))
=/ bem=beam [[our %home da+now] /whey] ::TODO %base?
=/ bem=beam [[our %base da+now] /whey] ::TODO %base?
|= [nam=term =vane]
=; mas=(list mass)
nam^|+(welp mas [dot+&+q.vase typ+&+p.vase sac+&+worm ~]:vane)
@ -1437,7 +1482,7 @@
++ lod
|= kel=(list (pair path (cask)))
^+ ..pith
=. fat.mod.sol (~(gas de fat.mod.sol) kel)
=. fat.mod.sol (~(gas of fat.mod.sol) kel)
%+ mod
(~(group adapt fat.mod.sol) fil)
%+ lien kel
@ -1505,7 +1550,7 @@
[%fad %lac ~] ``noun/!>(lac.fad)
[%zen %lag ~] ``noun/!>(lag.zen)
[%zen %ver ~] ``noun/!>(ver.zen)
[%mod %fat *] ``noun/!>((~(get de fat.mod) t.t.s.bem))
[%mod %fat *] ``noun/!>((~(dip of fat.mod) t.t.s.bem))
==
::
++ poke
@ -1574,7 +1619,7 @@
|= [kel=wynn hun=(unit @t) van=@t]
^- $-(heir (trap ^))
~> %mean.'arvo: upgrade failed'
~> %slog.[1 'arvo: beginning upgrade']
~> %slog.[0 'arvo: beginning upgrade']
?~ hun
=/ gat
~> %slog.[0 'arvo: compiling next arvo']
@ -1583,7 +1628,7 @@
=/ lod
(slap (slot 7 gat) [%limb %load])
|= =heir
|. ~> %slog.[1 'arvo: +load next']
|. ~> %slog.[0 'arvo: +load next']
;;(^ q:(slam lod !>(heir)))
::
:: hyp: hoon core type
@ -1678,6 +1723,7 @@
%g %gall
%i %iris
%j %jael
%k %khan
==
-- =>
::
@ -1836,7 +1882,7 @@
=? taf =(~ dir.taf) :: XX TMI
~| %larval-need-kernel
?> &(?=(^ tub) ?=(^ hun.p.u.tub))
(~(gas de taf) q.u.tub)
(~(gas of taf) q.u.tub)
::
=^ job=oped:part taf (~(adorn adapt:part taf) del |)
=? lul ?=(^ lul.job)
@ -1852,7 +1898,7 @@
|= [[nam=term txt=cord] =_van]
^+ van
%+ ~(put by van) nam
(smit "vane %{(trip nam)}" u.zus /sys/vane/[nam]/hoon txt)
(smit "vane: %{(trip nam)}" u.zus /sys/vane/[nam]/hoon txt)
gub(fat `taf)
--
::

53
pkg/arvo/sys/hoon.hoon
View File

@ -264,8 +264,8 @@
++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality
::
++ lead |*(* |*(* [+>+< +<])) :: put head
++ late |*(* |*(* [+< +>+<])) :: put tail
++ lead |*(* |*(* [+>+< +<])) :: put head
++ late |*(* |*(* [+< +>+<])) :: put tail
::
:: # %containers
::
@ -1453,7 +1453,6 @@
++ by :: map engine
~/ %by
=| a=(tree (pair)) :: (map)
=* node ?>(?=(^ a) n.a)
|@
++ all :: logical AND
~/ %all
@ -1717,14 +1716,14 @@
=+ b=a
|@
++ $
|= meg=$-([_p:node _q:node _q:node] _q:node)
|* meg=$-([* * *] *)
|- ^+ a
?~ b
a
?~ a
b
?: =(p.n.b p.n.a)
:+ [p.n.a (meg p.n.a q.n.a q.n.b)]
:+ [p.n.a `_?>(?=(^ a) q.n.a)`(meg p.n.a q.n.a q.n.b)]
$(b l.b, a l.a)
$(b r.b, a r.a)
?: (mor p.n.a p.n.b)
@ -2205,7 +2204,7 @@
++ si :: signed integer
^?
|%
++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
++ abs |=(a=@s (add (end 0 a) (rsh 0 a))) :: absolute value
++ dif |= [a=@s b=@s] :: subtraction
(sum a (new !(syn b) (abs b)))
++ dul |= [a=@s b=@] :: modulus
@ -7781,7 +7780,7 @@
[%bcgl *] $(mod q.mod)
[%bcgr *] $(mod q.mod)
[%bckt *] $(mod q.mod)
[%bcls *] $(mod q.mod)
[%bcls *] [%note [%know p.mod] $(mod q.mod)]
[%bcmc *] :: borrow sample
::
[%tsgl [%$ 6] p.mod]
@ -7832,7 +7831,7 @@
[%bchp *] (decorate (function:clear p.mod q.mod))
[%bcmc *] (decorate (home [%tsgl [%limb %$] p.mod]))
[%bcsg *] [%ktls example(mod q.mod) (home p.mod)]
[%bcls *] (decorate example(mod q.mod))
[%bcls *] (decorate [%note [%know p.mod] example(mod q.mod)])
[%bcts *] (decorate [%ktts p.mod example:clear(mod q.mod)])
[%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
[%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
@ -7866,7 +7865,12 @@
::
:+ %brcl
[%ktsg spore]
~(relative analyze:(descend 7) 6)
:+ %tsls
~(relative analyze:(descend 7) 6)
:: trigger unifying equality
::
:+ %tsls [%dtts $/14 $/2]
$/6
::
++ analyze
:: normalize a fragment of the subject
@ -8189,7 +8193,7 @@
relative:clear(mod q.mod)
relative:clear(mod p.mod)
::
[%bcls *] relative(mod q.mod)
[%bcls *] [%note [%know p.mod] relative(mod q.mod)]
[%bcdt *] (decorate (home (interface %gold p.mod q.mod)))
[%bcfs *] (decorate (home (interface %iron p.mod q.mod)))
[%bczp *] (decorate (home (interface %lead p.mod q.mod)))
@ -8580,15 +8584,7 @@
==
::
[%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
[%mcgl *]
:^ %cnls
:+ %cnhp
q.gen
[%ktcl p.gen]
r.gen
:+ %brts
p.gen
s.gen
[%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen
::
[%mcsg *] :: ;~
|- ^- hoon
@ -9060,7 +9056,7 @@
::
^- type
~+
~= sut
=- ?.(=(sut -) - sut)
?+ sut sut
[%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
[%core *] :+ %core
@ -9074,7 +9070,7 @@
==
[%face *] [%face p.sut burp(sut q.sut)]
[%fork *] [%fork (~(run in p.sut) |=(type burp(sut +<)))]
[%hint *] (hint p.sut burp(sut q.sut))
[%hint *] (hint [burp(sut p.p.sut) q.p.sut] burp(sut q.sut))
[%hold *] [%hold burp(sut p.sut) q.sut]
==
::
@ -10914,6 +10910,7 @@
[%stop p=@ud] ::
[%tree p=term q=wine] ::
[%unit p=term q=wine] ::
[%name p=stud q=wine] ::
== ::
--
|_ sut=type
@ -11004,6 +11001,11 @@
[%unit *]
=^ cox gid $(q.ham q.q.ham)
:_(gid [%rose [" " (weld (trip p.q.ham) "(") ")"] cox ~])
::
[%name *]
:_ gid
?@ p.q.ham (cat 3 '#' mark.p.q.ham)
(rap 3 '#' auth.p.q.ham '+' (spat type.p.q.ham) ~)
==
--
::
@ -11191,6 +11193,9 @@
?~ wal
~
[~ %rose [[' ' ~] ['[' ~] [']' ~]] [%leaf '~' ~] u.wal ~]
::
[%name *]
$(q.ham q.q.ham)
==
::
++ doge
@ -11295,7 +11300,9 @@
==
::
[%hint *]
$(sut q.sut)
=+ yad=$(sut q.sut)
?. ?=(%know -.q.p.sut) yad
[p.yad [%name p.q.p.sut q.yad]]
::
[%face *]
=+ yad=$(sut q.sut)
@ -13010,6 +13017,7 @@
['=' (rune tis %bcts exqg)]
['?' (rune wut %bcwt exqs)]
[';' (rune mic %bcmc expa)]
['+' (rune lus %bcls exqg)]
==
==
:- '%'
@ -13080,6 +13088,7 @@
['-' (stag %ktcl (rune hep %bchp exqb))]
['=' (stag %ktcl (rune tis %bcts exqg))]
['?' (stag %ktcl (rune wut %bcwt exqs))]
['+' (stag %ktcl (rune lus %bcls exqg))]
['.' (rune dot %kttr exqa)]
[',' (rune com %ktcl exqa)]
==

111
pkg/arvo/sys/lull.hoon
View File

@ -3,7 +3,7 @@
::
=> ..part
|%
++ lull %330
++ lull %329
:: :: ::
:::: :: :: (1) models
:: :: ::
@ -59,7 +59,7 @@
[r=@uxD g=@uxD b=@uxD] :: 24bit true color
+$ turf (list @t) :: domain, tld first
:: ::::
:::: ++ethereum-types :: eth surs for jael
:::: ++ethereum-types :: eth surs for jael
:: ::::
++ ethereum-types
|%
@ -73,7 +73,7 @@
++ events (set event-id)
--
:: ::::
:::: ++azimuth-types :: az surs for jael
:::: ++azimuth-types :: az surs for jael
:: ::::
++ azimuth-types
=, ethereum-types
@ -153,7 +153,7 @@
[%plea =ship =plea:ames]
==
:: ::::
:::: ++http ::
:::: ++http ::
:: ::::
:: http: shared representations of http concepts
::
@ -340,7 +340,7 @@
==
--
:: ::::
:::: ++ames :: (1a) network
:::: ++ames :: (1a) network
:: ::::
++ ames ^?
|%
@ -357,6 +357,7 @@
::
:: %born: process restart notification
:: %init: vane boot
:: %prod: re-send a packet per flow, to all peers if .ships is ~
:: %sift: limit verbosity to .ships
:: %spew: set verbosity toggles
:: %trim: release memory
@ -370,6 +371,7 @@
::
$>(%born vane-task)
$>(%init vane-task)
[%prod ships=(list ship)]
[%sift ships=(list ship)]
[%spew veb=(list verb)]
[%stir arg=@t]
@ -513,6 +515,7 @@
+$ peer-state
$: $: =symmetric-key
=life
=rift
=public-key
sponsor=ship
==
@ -766,53 +769,58 @@
des=desk :: target desk
bas=beak :: base desk
con=(list [beak germ]) :: merges
==
== ::
[%mont pot=term bem=beam] :: mount to unix
[%dirk des=desk] :: mark mount dirty
[%ogre pot=$@(desk beam)] :: delete mount point
[%dirk pot=term] :: mark mount dirty
[%ogre pot=$@(term beam)] :: delete mount point
[%park des=desk yok=yoki ran=rang] :: synchronous commit
[%perm des=desk pax=path rit=rite] :: change permissions
[%pork ~] :: resume commit
[%stir arg=*] :: debug
[%tomb =clue] :: tombstone specific
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
[%warp wer=ship rif=riff] :: internal file req
[%werp who=ship wer=ship rif=riff-any] :: external file req
$>(%plea vane-task) :: ames request
== ::
::
:: ::
:::: :: (1c2)
::
:: ::
+$ aeon @ud :: version number
+$ ankh :: fs node (new)
$~ [~ ~]
$: fil=(unit [p=lobe q=cage]) :: file
dir=(map @ta ankh) :: folders
== ::
+$ beam [[p=ship q=desk r=case] s=path] :: global name
+$ beak [p=ship q=desk r=case] :: path prefix
+$ blob :: fs blob
$% [%delta p=lobe q=[p=mark q=lobe] r=page] :: delta on q
[%direct p=lobe q=page] :: immediate
+$ cable :: lib/sur/mark ref
$: face=(unit term) ::
file-path=term ::
== ::
:: +cable: a reference to something on the filesystem
:: face: the face to wrap around the imported file
:: file-path: location in clay
+$ cable
$: face=(unit term)
file-path=term
==
+$ care ?(%a %b %c %d %e %f %p %r %s %t %u %v %w %x %y %z) :: clay submode
+$ care :: clay submode
?(%a %b %c %d %e %f %p %r %s %t %u %v %w %x %y %z) ::
+$ case :: ship desk case spur
$% [%da p=@da] :: date
[%tas p=@tas] :: label
[%ud p=@ud] :: number
== ::
+$ cash :: case or tako
$% [%tako p=tako] ::
case ::
== ::
+$ cass [ud=@ud da=@da] :: cases for revision
+$ clue :: murder weapon
$% [%lobe =lobe] :: specific lobe
[%all ~] :: all safe targets
[%pick ~] :: collect garbage
[%norm =ship =desk =norm] :: set default norm
[%worn =ship =desk =tako =norm] :: set commit norm
[%seek =ship =desk =cash] :: fetch source blobs
== ::
+$ cone :: domes
%+ map [ship desk] ::
[dome tom=(map tako norm) nor=norm] ::
+$ crew (set ship) :: permissions group
+$ dict [src=path rul=real] :: effective permission
+$ dome :: project state
$: ank=ankh :: state
let=@ud :: top id
$: let=@ud :: top id
hit=(map @ud tako) :: changes by id
lab=(map @tas @ud) :: labels
== ::
@ -830,8 +838,7 @@
%meet-that :: hers if conflict
== ::
+$ lobe @uvI :: blob ref
+$ maki [p=@ta q=@ta r=@ta s=path] ::
+$ miso :: ankh delta
+$ miso :: file delta
$% [%del ~] :: delete
[%ins p=cage] :: insert
[%dif p=cage] :: mutate from diff
@ -856,12 +863,12 @@
$% [%& p=suba] :: delta
[%| p=@tas] :: label
== ::
+$ norm (axal ?) :: tombstone policy
+$ open $-(path vase) :: get prelude
+$ page (cask *) :: untyped cage
+$ plop blob :: unvalidated blob
+$ page ^page :: export for compat
+$ rang :: repository
$: hut=(map tako yaki) :: changes
lat=(map lobe blob) :: data
lat=(map lobe page) :: data
== ::
+$ rant :: response to request
$: p=[p=care q=case r=desk] :: clade release book
@ -880,9 +887,9 @@
== ::
+$ regs (map path rule) :: rules for paths
+$ riff [p=desk q=(unit rave)] :: request+desist
+$ riff-any
$% [%1 =riff]
==
+$ riff-any ::
$% [%1 =riff] ::
== ::
+$ rite :: new permissions
$% [%r red=(unit rule)] :: for read
[%w wit=(unit rule)] :: for write
@ -894,7 +901,7 @@
+$ saba [p=ship q=@tas r=moar s=dome] :: patch+merge
+$ soba (list [p=path q=miso]) :: delta
+$ suba (list [p=path q=misu]) :: delta
+$ tako @ :: yaki ref
+$ tako @uvI :: yaki ref
+$ toro [p=@ta q=nori] :: general change
++ unce :: change part
|* a=mold ::
@ -2092,6 +2099,32 @@
+$ oath @ :: signature
-- :: pki
-- :: jael
:: ::::
:::: ++khan :: (1i) threads
:: ::::
++ khan ^?
|%
+$ gift :: out result <-$
$% [%arow p=(avow cage)] :: in-arvo result
[%avow p=(avow page)] :: external result
== ::
+$ task :: in request ->$
$~ [%vega ~] ::
$% $>(%born vane-task) :: new unix process
[%done ~] :: socket closed
:: XX mark ignored
::
[%fard p=(fyrd cage)] :: in-arvo thread
[%fyrd p=(fyrd cast)] :: external thread
$>(%trim vane-task) :: trim state
$>(%vega vane-task) :: report upgrade
== ::
:: ::
++ avow |$ [a] (each a goof) :: $fyrd result
+$ bear $@(desk beak) :: partial $beak
+$ cast (pair mark page) :: output mark + input
++ fyrd |$ [a] [=bear name=term args=a] :: thread run request
-- ::khan
::
+$ gift-arvo :: out result <-$
$~ [%doze ~]
@ -2103,6 +2136,7 @@
gift:gall
gift:iris
gift:jael
gift:khan
==
+$ task-arvo :: in request ->$
$% task:ames
@ -2113,6 +2147,7 @@
task:gall
task:iris
task:jael
task:khan
==
+$ note-arvo :: out request $->
$~ [%b %wake ~]
@ -2124,6 +2159,7 @@
[%g task:gall]
[%i task:iris]
[%j task:jael]
[%k task:khan]
[%$ %whiz ~]
[@tas %meta vase]
==
@ -2145,6 +2181,7 @@
[%gall gift:gall]
[%iris gift:iris]
[%jael gift:jael]
[%khan gift:khan]
==
:: $unix-task: input from unix
::

472
pkg/arvo/sys/vane/ames.hoon
View File

@ -196,22 +196,38 @@
:+ (add 4 next-bone.ossuary)
(~(put by by-duct.ossuary) duct next-bone.ossuary)
(~(put by by-bone.ossuary) next-bone.ossuary duct)
:: +make-bone-wire: encode ship and bone in wire for sending to vane
:: +make-bone-wire: encode ship, rift and bone in wire for sending to vane
::
++ make-bone-wire
|= [her=ship =bone]
|= [her=ship =rift =bone]
^- wire
::
/bone/(scot %p her)/(scot %ud bone)
:: +parse-bone-wire: decode ship and bone from wire from local vane
/bone/(scot %p her)/(scot %ud rift)/(scot %ud bone)
:: +parse-bone-wire: decode ship, bone and rift from wire from local vane
::
++ parse-bone-wire
|= =wire
^- [her=ship =bone]
^- %- unit
$% [%old her=ship =bone]
[%new her=ship =rift =bone]
==
?. ?| ?=([%bone @ @ @ ~] wire)
?=([%bone @ @ ~] wire)
==
:: ignore malformed wires
::
~
?+ wire ~
[%bone @ @ ~]
`[%old `@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
::
~| %ames-wire-bone^wire
?> ?=([%bone @ @ ~] wire)
[`@p`(slav %p i.t.wire) `@ud`(slav %ud i.t.t.wire)]
[%bone @ @ @ ~]
%- some
:^ %new
`@p`(slav %p i.t.wire)
`@ud`(slav %ud i.t.t.wire)
`@ud`(slav %ud i.t.t.t.wire)
==
:: +make-pump-timer-wire: construct wire for |packet-pump timer
::
++ make-pump-timer-wire
@ -352,6 +368,18 @@
%earl 8
%pawn 16
==
:: +encode-keys-packet: create key request $packet
::
++ encode-keys-packet
~/ %encode-keys-packet
|= [sndr=ship rcvr=ship sndr-life=life]
^- packet
:* [sndr rcvr]
(mod sndr-life 16)
`@`1
origin=~
content=`@`%keys
==
:: +encode-open-packet: convert $open-packet attestation to $packet
::
++ encode-open-packet
@ -397,6 +425,8 @@
::
++ encode-shut-packet
~/ %encode-shut-packet
:: TODO add rift to signed messages to prevent replay attacks?
::
|= $: =shut-packet
=symmetric-key
sndr=ship
@ -502,6 +532,7 @@
::
$: =symmetric-key
=her=life
=her=rift
=her=public-key
her-sponsor=ship
== ==
@ -529,6 +560,8 @@
:: This data structure gets signed and jammed to form the .contents
:: field of a $packet.
::
:: TODO add rift to prevent replay attacks
::
+$ open-packet
$: =public-key
sndr=ship
@ -565,6 +598,36 @@
::
+$ naxplanation [=message-num =error]
::
+$ ames-state-4 ames-state-5
+$ ames-state-5
$: peers=(map ship ship-state-5)
=unix=duct
=life
crypto-core=acru:ames
=bug
==
::
+$ ship-state-4 ship-state-5
+$ ship-state-5
$% [%alien alien-agenda]
[%known peer-state-5]
==
::
+$ peer-state-5
$: $: =symmetric-key
=life
=public-key
sponsor=ship
==
route=(unit [direct=? =lane])
=qos
=ossuary
snd=(map bone message-pump-state)
rcv=(map bone message-sink-state)
nax=(set [=bone =message-num])
heeds=(set duct)
==
::
+| %statics
::
:: $ames-state: state for entire vane
@ -654,12 +717,14 @@
:: %memo: packetize and send application-level message
:: %hear: handle receipt of ack on fragment or message
:: %near: handle receipt of naxplanation
:: $prod: reset congestion control
:: %wake: handle timer firing
::
+$ message-pump-task
$% [%memo =message-blob]
[%hear =message-num =ack-meat]
[%near =naxplanation]
[%prod ~]
[%wake ~]
==
:: $message-pump-gift: effect from |message-pump
@ -681,12 +746,14 @@
:: %done: deal with message acknowledgment
:: %halt: finish event, possibly updating timer
:: %wake: handle timer firing
:: %prod: reset congestion control
::
+$ packet-pump-task
$% [%hear =message-num =fragment-num]
[%done =message-num lag=@dr]
[%halt ~]
[%wake current=message-num]
[%prod ~]
==
:: $packet-pump-gift: effect from |packet-pump
::
@ -728,10 +795,18 @@
::
=< =* adult-gate .
=| queued-events=(qeu queued-event)
=| cached-state=(unit [%5 ames-state-5])
::
|= [now=@da eny=@ rof=roof]
=* larval-gate .
=* adult-core (adult-gate +<)
=< |%
++ call ^call
++ load ^load
++ scry ^scry
++ stay ^stay
++ take ^take
--
|%
:: +call: handle request $task
::
@ -739,12 +814,14 @@
|= [=duct dud=(unit goof) wrapped-task=(hobo task)]
::
=/ =task ((harden task) wrapped-task)
::
:: reject larval error notifications
::
?^ dud
~|(%ames-larval-call-dud (mean tang.u.dud))
::
?: &(?=(^ cached-state) ?=(~ queued-events))
=^ moves adult-gate (call:adult-core duct dud task)
(molt moves)
:: %born: set .unix-duct and start draining .queued-events
::
?: ?=(%born -.task)
@ -774,11 +851,17 @@
~|(%ames-larval-take-dud (mean tang.u.dud))
:: enqueue event if not a larval drainage timer
::
=? queued-events !=(/larva wire)
(~(put to queued-events) %take wire duct sign)
:: start drainage timer if have regressed from adult ames
::
?: ?& !=(/larva wire)
?=(^ cached-state)
==
[[duct %pass /larva %b %wait now]~ larval-gate]
:: XX what to do with errors?
::
?. =(/larva wire)
=. queued-events (~(put to queued-events) %take wire duct sign)
[~ larval-gate]
?. =(/larva wire) [~ larval-gate]
:: larval event drainage timer; pop and process a queued event
::
?. ?=([%behn %wake *] sign)
@ -820,6 +903,7 @@
:: .queued-events has been cleared; metamorphose
::
?~ queued-events
?: ?=(^ cached-state) (molt moves)
~> %slog.0^leaf/"ames: metamorphosis"
[moves adult-gate]
:: set timer to drain next event
@ -829,41 +913,67 @@
:: lifecycle arms; mostly pass-throughs to the contained adult ames
::
++ scry scry:adult-core
++ stay [%5 %larva queued-events ames-state.adult-gate]
++ stay [%6 %larva queued-events ames-state.adult-gate]
++ load
|= $= old
$% $: %4
$% $: %larva
events=(qeu queued-event)
state=_ames-state.adult-gate
state=ames-state-4
==
[%adult state=_ames-state.adult-gate]
[%adult state=ames-state-4]
== ==
$: %5
$% $: %larva
events=(qeu queued-event)
state=ames-state-5
==
[%adult state=ames-state-5]
== ==
$: %6
$% $: %larva
events=(qeu queued-event)
state=_ames-state.adult-gate
==
[%adult state=_ames-state.adult-gate]
== ==
==
== == ==
?- old
[%4 %adult *] (load:adult-core %4 state.old)
[%4 %adult *]
$(old [%5 %adult (state-4-to-5:load:adult-core state.old)])
::
[%4 %larva *]
~> %slog.1^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %4 state.old)
larval-gate
=. state.old (state-4-to-5:load:adult-core state.old)
$(-.old %5)
::
[%5 %adult *] (load:adult-core %5 state.old)
[%5 %adult *]
=. cached-state `[%5 state.old]
~> %slog.0^leaf/"ames: larva reload"
larval-gate
::
[%5 %larva *]
~> %slog.1^leaf/"ames: larva: load"
~> %slog.0^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %5 state.old)
larval-gate
::
[%6 %adult *] (load:adult-core %6 state.old)
::
[%6 %larva *]
~> %slog.0^leaf/"ames: larva: load"
=. queued-events events.old
=. adult-gate (load:adult-core %6 state.old)
larval-gate
==
:: +molt: re-evolve to adult-ames
::
++ molt
|= moves=(list move)
^- (quip move _adult-gate)
=. ames-state.adult-gate
?> ?=(^ cached-state)
(state-5-to-6:load:adult-core +.u.cached-state)
=. cached-state ~
~> %slog.0^leaf/"ames: metamorphosis reload"
[moves adult-gate]
--
:: adult ames, after metamorphosis from larva
::
@ -898,6 +1008,7 @@
%heed (on-heed:event-core ship.task)
%init on-init:event-core
%jilt (on-jilt:event-core ship.task)
%prod (on-prod:event-core ships.task)
%sift (on-sift:event-core ships.task)
%spew (on-spew:event-core veb.task)
%stir (on-stir:event-core arg.task)
@ -934,27 +1045,23 @@
[moves ames-gate]
:: +stay: extract state before reload
::
++ stay [%5 %adult ames-state]
++ stay [%6 %adult ames-state]
:: +load: load in old state after reload
::
++ load
|= $= old-state
$% [%4 ^ames-state]
[%5 ^ames-state]
==
|^
^+ ames-gate
=? old-state ?=(%4 -.old-state) %5^(state-4-to-5 +.old-state)
::
?> ?=(%5 -.old-state)
ames-gate(ames-state +.old-state)
=< |= old-state=[%6 ^ames-state]
^+ ames-gate
?> ?=(%6 -.old-state)
ames-gate(ames-state +.old-state)
|%
:: +state-4-to-5 called from larval-ames
::
++ state-4-to-5
|= =^ames-state
^- ^^ames-state
|= ames-state=ames-state-4
^- ames-state-4
=. peers.ames-state
%- ~(run by peers.ames-state)
|= =ship-state
|= ship-state=ship-state-4
?. ?=(%known -.ship-state)
ship-state
=. snd.ship-state
@ -965,6 +1072,31 @@
message-pump-state
ship-state
ames-state
:: +state-5-to-6 called from larval-ames
::
++ state-5-to-6
|= ames-state=ames-state-5
^- ^^ames-state
:_ +.ames-state
%- ~(rut by peers.ames-state)
|= [=ship ship-state=ship-state-5]
^- ^ship-state
?. ?=(%known -.ship-state)
ship-state
=/ peer-state=peer-state-5 +.ship-state
=/ =rift
:: harcoded because %jael doesn't have data about comets
::
?: ?=(%pawn (clan:title ship)) 0
;; @ud
=< q.q %- need %- need
(rof ~ %j `beam`[[our %rift %da now] /(scot %p ship)])
=/ =^peer-state
:_ +.peer-state
=, -.peer-state
[symmetric-key life rift public-key sponsor]
^- ^ship-state
[-.ship-state peer-state]
--
:: +scry: dereference namespace
::
@ -1105,31 +1237,61 @@
^+ event-core
:: relay the vane ack to the foreign peer
::
=+ ^- [her=ship =bone] (parse-bone-wire wire)
::
?~ parsed=(parse-bone-wire wire)
:: no-op
::
~> %slog.0^leaf/"ames: dropping malformed wire: {(spud wire)}"
event-core
?> ?=([@ her=ship *] u.parsed)
=* her her.u.parsed
=/ =peer-state (got-peer-state her)
=/ =channel [[our her] now channel-state -.peer-state]
=/ peer-core (make-peer-core peer-state channel)
|^
?: ?& ?=([%new *] u.parsed)
(lth rift.u.parsed rift.peer-state)
==
:: ignore events from an old rift
::
%- %^ trace odd.veb her
|.("dropping old rift wire: {(spud wire)}")
event-core
=/ =bone
?-(u.parsed [%new *] bone.u.parsed, [%old *] bone.u.parsed)
=? peer-core ?=([%old *] u.parsed)
%- %^ trace odd.veb her
|.("parsing old wire: {(spud wire)}")
peer-core
?~ error
(send-ack bone)
(send-nack bone u.error)
::
:: if processing succeded, send positive ack packet and exit
::
?~ error
++ send-ack
|= =bone
^+ event-core
abet:(run-message-sink:peer-core bone %done ok=%.y)
:: failed; send message nack packet
::
=. event-core abet:(run-message-sink:peer-core bone %done ok=%.n)
=/ =^peer-state (got-peer-state her)
=/ =^channel [[our her] now channel-state -.peer-state]
:: construct nack-trace message, referencing .failed $message-num
::
=/ failed=message-num last-acked:(~(got by rcv.peer-state) bone)
=/ =naxplanation [failed u.error]
=/ =message-blob (jam naxplanation)
:: send nack-trace message on associated .nack-trace-bone
::
=. peer-core (make-peer-core peer-state channel)
=/ nack-trace-bone=^bone (mix 0b10 bone)
::
abet:(run-message-pump:peer-core nack-trace-bone %memo message-blob)
++ send-nack
|= [=bone =^error]
^+ event-core
=. event-core abet:(run-message-sink:peer-core bone %done ok=%.n)
=/ =^peer-state (got-peer-state her)
=/ =^channel [[our her] now channel-state -.peer-state]
:: construct nack-trace message, referencing .failed $message-num
::
=/ failed=message-num last-acked:(~(got by rcv.peer-state) bone)
=/ =naxplanation [failed error]
=/ =message-blob (jam naxplanation)
:: send nack-trace message on associated .nack-trace-bone
::
=. peer-core (make-peer-core peer-state channel)
=/ nack-trace-bone=^bone (mix 0b10 bone)
::
abet:(run-message-pump:peer-core nack-trace-bone %memo message-blob)
--
:: +on-sift: handle request to filter debug output by ship
::
++ on-sift
@ -1158,6 +1320,29 @@
%rot acc(rot %.y)
==
event-core
:: +on-prod: re-send a packet per flow to each of .ships
::
++ on-prod
|= ships=(list ship)
^+ event-core
=? ships =(~ ships) ~(tap in ~(key by peers.ames-state))
|^ ^+ event-core
?~ ships event-core
$(ships t.ships, event-core (prod-peer i.ships))
::
++ prod-peer
|= her=ship
^+ event-core
=/ par (get-peer-state her)
?~ par event-core
=/ =channel [[our her] now channel-state -.u.par]
=/ peer-core (make-peer-core u.par channel)
=/ bones ~(tap in ~(key by snd.u.par))
|- ^+ event-core
?~ bones abet:peer-core
=. peer-core (run-message-pump:peer-core i.bones %prod ~)
$(bones t.bones)
--
:: +on-stir: start timers for any flow that lack them
::
:: .arg is unused, meant to ease future debug commands
@ -1247,6 +1432,8 @@
~/ %on-hear-packet
|= [=lane =packet dud=(unit goof)]
^+ event-core
%- %^ trace odd.veb sndr.packet
|.("received packet")
::
?: =(our sndr.packet)
event-core
@ -1256,6 +1443,8 @@
?. =(our rcvr.packet)
on-hear-forward
::
?: =(%keys content.packet)
on-hear-keys
?: ?& ?=(%pawn (clan:title sndr.packet))
!?=([~ %known *] (~(get by peers.ames-state) sndr.packet))
==
@ -1285,12 +1474,24 @@
::
=/ =blob (encode-packet packet)
(send-blob & rcvr.packet blob)
:: +on-hear-keys: handle receipt of attestion request
::
++ on-hear-keys
~/ %on-hear-keys
|= [=lane =packet dud=(unit goof)]
=+ %^ trace msg.veb sndr.packet
|.("requested attestation")
?. =(%pawn (clan:title our))
event-core
(send-blob | sndr.packet (attestation-packet sndr.packet 1))
:: +on-hear-open: handle receipt of plaintext comet self-attestation
::
++ on-hear-open
~/ %on-hear-open
|= [=lane =packet dud=(unit goof)]
^+ event-core
=+ %^ trace msg.veb sndr.packet
|.("got attestation")
:: assert the comet can't pretend to be a moon or other address
::
?> ?=(%pawn (clan:title sndr.packet))
@ -1301,25 +1502,29 @@
event-core
::
=/ =open-packet (decode-open-packet packet our life.ames-state)
:: store comet as peer in our state
:: add comet as an %alien if we haven't already
::
=? peers.ames-state ?=(~ ship-state)
(~(put by peers.ames-state) sndr.packet %alien *alien-agenda)
:: upgrade comet to %known via on-publ-full
::
=. event-core
=/ crypto-suite=@ud 1
=/ keys
(my [sndr-life.open-packet crypto-suite public-key.open-packet]~)
=/ =point
:* ^= rift 0
^= life sndr-life.open-packet
^= keys keys
^= sponsor `(^sein:title sndr.packet)
==
(on-publ / [%full (my [sndr.packet point]~)])
:: manually add the lane to the peer state
::
=. peers.ames-state
%+ ~(put by peers.ames-state) sndr.packet
^- ^ship-state
:- %known
=| =peer-state
=/ our-private-key sec:ex:crypto-core.ames-state
=/ =symmetric-key
(derive-symmetric-key public-key.open-packet our-private-key)
::
%_ peer-state
qos [%unborn now]
symmetric-key symmetric-key
life sndr-life.open-packet
public-key public-key.open-packet
sponsor (^sein:title sndr.packet)
route `[direct=%.n lane]
==
=/ =peer-state (gut-peer-state sndr.packet)
=. route.peer-state `[direct=%.n lane]
(~(put by peers.ames-state) sndr.packet %known peer-state)
::
event-core
:: +on-hear-shut: handle receipt of encrypted packet
@ -1329,7 +1534,10 @@
|= [=lane =packet dud=(unit goof)]
^+ event-core
=/ sndr-state (~(get by peers.ames-state) sndr.packet)
:: if we don't know them, ask jael for their keys and enqueue
:: If we don't know them, ask Jael for their keys. If they're a
:: comet, this will also cause us to request a self-attestation
:: from the sender. The packet itself is dropped; we can assume it
:: will be resent.
::
?. ?=([~ %known *] sndr-state)
(enqueue-alien-todo sndr.packet |=(alien-agenda +<))
@ -1382,13 +1590,31 @@
++ on-take-boon
|= [=wire payload=*]
^+ event-core
?~ parsed=(parse-bone-wire wire)
~> %slog.0^leaf/"ames: dropping malformed wire: {(spud wire)}"
event-core
::
=+ ^- [her=ship =bone] (parse-bone-wire wire)
::
?> ?=([@ her=ship *] u.parsed)
=* her her.u.parsed
=/ =peer-state (got-peer-state her)
=/ =channel [[our her] now channel-state -.peer-state]
=/ peer-core (make-peer-core peer-state channel)
::
abet:(on-memo:(make-peer-core peer-state channel) bone payload %boon)
?: ?& ?=([%new *] u.parsed)
(lth rift.u.parsed rift.peer-state)
==
:: ignore events from an old rift
::
%- %^ trace odd.veb her
|.("dropping old rift wire: {(spud wire)}")
event-core
=/ =bone
?-(u.parsed [%new *] bone.u.parsed, [%old *] bone.u.parsed)
=? peer-core ?=([%old *] u.parsed)
%- %^ trace odd.veb her
|.("parsing old wire: {(spud wire)}")
peer-core
abet:(on-memo:peer-core bone payload %boon)
:: +on-plea: handle request to send message
::
++ on-plea
@ -1420,6 +1646,20 @@
|= [=wire error=(unit tang)]
^+ event-core
::
?: ?=([%alien @ ~] wire)
:: if we haven't received an attestation, ask again
::
?^ error
%- (slog leaf+"ames: attestation timer failed: {<u.error>}" ~)
event-core
?~ ship=`(unit @p)`(slaw %p i.t.wire)
%- (slog leaf+"ames: got timer for strange wire: {<wire>}" ~)
event-core
=/ ship-state (~(get by peers.ames-state) u.ship)
?: ?=([~ %known *] ship-state)
event-core
(request-attestation u.ship)
::
=/ res=(unit [her=ship =bone]) (parse-pump-timer-wire wire)
?~ res
%- (slog leaf+"ames: got timer for strange wire: {<wire>}" ~)
@ -1478,7 +1718,8 @@
::
?- public-keys-result
[%diff @ %rift *]
event-core
:: event-core
(on-publ-rift [who to.diff]:public-keys-result)
::
[%diff @ %keys *]
(on-publ-rekey [who to.diff]:public-keys-result)
@ -1655,6 +1896,24 @@
::
event-core(duct original-duct)
--
:: on-publ-rift: XX
::
++ on-publ-rift
|= [=ship =rift]
^+ event-core
?~ ship-state=(~(get by peers.ames-state) ship)
:: print error here? %rift was probably called before %keys
::
~> %slog.1^leaf/"ames: missing peer-state on-publ-rift"
event-core
?: ?=([%alien *] u.ship-state)
:: ignore aliens
::
event-core
=/ =peer-state +.u.ship-state
=. rift.peer-state rift
=. peers.ames-state (~(put by peers.ames-state) ship %known peer-state)
event-core
::
++ insert-peer-state
|= [=ship =point]
@ -1703,7 +1962,6 @@
(rof ~ %j `beam`[[our %turf %da now] /])
::
(emit unix-duct.ames-state %give %turf turfs)
:: +on-trim: handle request to free memory
:: +on-vega: handle kernel reload
:: +on-trim: handle request to free memory
::
@ -1712,7 +1970,7 @@
:: +enqueue-alien-todo: helper to enqueue a pending request
::
:: Also requests key and life from Jael on first request.
:: On a comet, enqueues self-attestation packet on first request.
:: If talking to a comet, requests attestation packet.
::
++ enqueue-alien-todo
|= [=ship mutate=$-(alien-agenda alien-agenda)]
@ -1729,14 +1987,26 @@
::
=. todos (mutate todos)
=. peers.ames-state (~(put by peers.ames-state) ship %alien todos)
:: ask jael for .sndr life and keys on first contact
::
?: already-pending
event-core
::
?: =(%pawn (clan:title ship))
(request-attestation ship)
:: NB: we specifically look for this wire in +public-keys-give in
:: Jael. if you change it here, you must change it there.
::
(emit duct %pass /public-keys %j %public-keys [n=ship ~ ~])
:: +request-attestation: helper to request attestation from comet
::
:: Also sets a timer to resend the request every 30s.
::
++ request-attestation
|= =ship
^+ event-core
=+ (trace msg.veb ship |.("requesting attestion"))
=. event-core (send-blob | ship (sendkeys-packet ship))
=/ =wire /alien/(scot %p ship)
(emit duct %pass wire %b %wait (add now ~s30))
:: +send-blob: fire packet at .ship and maybe sponsors
::
:: Send to .ship and sponsors until we find a direct lane,
@ -1757,6 +2027,8 @@
=/ ship-state (~(get by peers.ames-state) ship)
::
?. ?=([~ %known *] ship-state)
?: ?=(%pawn (clan:title ship))
(try-next-sponsor (^sein:title ship))
%+ enqueue-alien-todo ship
|= todos=alien-agenda
todos(packets (~(put in packets.todos) blob))
@ -1820,6 +2092,16 @@
^= rcvr her
^= rcvr-life her-life
==
:: +sendkeys-packet: generate a request for a self-attestation.
::
:: Sent by non-comets to comets. Not acked.
::
++ sendkeys-packet
|= her=ship
^- blob
?> ?=(%pawn (clan:title her))
%- encode-packet
(encode-keys-packet our her life.ames-state)
:: +get-peer-state: lookup .her state or ~
::
++ get-peer-state
@ -2287,10 +2569,9 @@
::
=+ ;; =plea message
::
=/ =wire (make-bone-wire her.channel bone)
=/ =wire (make-bone-wire her.channel her-rift.channel bone)
::
?+ vane.plea ~| %ames-evil-vane^our^her.channel^vane.plea !!
%a (emit duct %pass wire %a %plea her.channel plea)
%c (emit duct %pass wire %c %plea her.channel plea)
%g (emit duct %pass wire %g %plea her.channel plea)
%j (emit duct %pass wire %j %plea her.channel plea)
@ -2342,6 +2623,7 @@
^+ message-pump
::
?- -.task
%prod (run-packet-pump %prod ~)
%memo (on-memo message-blob.task)
%wake (run-packet-pump %wake current.state)
%hear
@ -2560,8 +2842,29 @@
%hear (on-hear [message-num fragment-num]:task)
%done (on-done message-num.task)
%wake (on-wake current.task)
%prod on-prod
%halt set-wake
==
:: +on-prod: reset congestion control, re-send packets
::
++ on-prod
^+ packet-pump
?: =(~ next-wake.state)
packet-pump
::
=. metrics.state %*(. *pump-metrics counter counter.metrics.state)
=. live.state
%+ run:packet-queue live.state
|=(p=live-packet-val p(- *packet-state))
::
=/ sot (max 1 num-slots:gauge)
=/ liv live.state
|- ^+ packet-pump
?: =(0 sot) packet-pump
?: =(~ liv) packet-pump
=^ hed liv (pop:packet-queue liv)
=. packet-pump (give %send (to-static-fragment hed))
$(sot (dec sot))
:: +on-wake: handle packet timeout
::
++ on-wake
@ -2570,7 +2873,6 @@
:: assert temporal coherence
::
?< =(~ next-wake.state)
?> (gte now.channel (need next-wake.state))
=. next-wake.state ~
:: tell congestion control a packet timed out
::

3166
pkg/arvo/sys/vane/clay.hoon
View File

File diff suppressed because it is too large Load Diff

26
pkg/arvo/sys/vane/dill.hoon
View File

@ -102,19 +102,19 @@
|= kyz=task
^+ +>
?+ -.kyz ~& [%strange-kiss -.kyz] +>
%flow +>
%harm +>
%hail (send %hey ~)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%heft (pass /whey %$ whey/~)
%meld (dump kyz)
%pack (dump kyz)
%crop (dump trim+p.kyz)
%verb (pass /verb %$ kyz)
::
%flow +>
%harm +>
%hail (send %hey ~)
%text (from %out (tuba p.kyz))
%crud :: (send `dill-belt`[%cru p.kyz q.kyz])
(crud p.kyz q.kyz)
%blew (send %rez p.p.kyz q.p.kyz)
%heft (pass /whey %$ whey/~)
%meld (dump kyz)
%pack (dump kyz)
%crop (dump trim+p.kyz)
%verb (pass /verb %$ kyz)
%noop +>
%belt
%- send
::TMP forwards compatibility with next-dill

15
pkg/arvo/sys/vane/eyre.hoon
View File

@ -1705,13 +1705,14 @@
==
::
%fact
:~ ['response' [%s 'diff']]
::
:- 'json'
~| [%unexpected-fact-mark p.cage.sign]
?> =(%json p.cage.sign)
!<(json q.cage.sign)
==
:+ ['response' [%s 'diff']]
:- 'json'
~| [%unexpected-fact-mark p.cage.sign]
?> =(%json p.cage.sign)
!<(json q.cage.sign)
::
?~ from ~
['mark' [%s mark.u.from]]~
::
%kick
['response' [%s 'quit']]~

2
pkg/arvo/sys/vane/gall.hoon
View File

@ -1007,7 +1007,7 @@
^+ ap-core
=. stats.yak
:+ +(change.stats.yak)
(shaz (mix (add dap change.stats.yak) eny))
(shaz (mix (add dap change.stats.yak) eny)) :: TODO: so bad, use +og
now
=. agent-name dap
=. agent-routes routes

217
pkg/arvo/sys/vane/khan.hoon Normal file
View File

@ -0,0 +1,217 @@
:: %khan, thread runner
::
:: this vane presents a command/response interface for running
:: threads. two modes are supported: %fard for intra-arvo
:: requests (i.e. within the same kernel space) and %fyrd for
:: external requests (e.g. from the unix control plane.)
::
:: both modes take a thread start request consisting of a
:: namespace, thread name, and input data; they respond over the
:: same duct with either success or failure. %fard takes its
:: input arguments as a cage and produces %arow, which contains
:: a cage on success (or tang on failure). %fyrd takes an output
:: mark and input page; it produces %avow, which contains a page
:: on success.
::
:: threads currently expect input and produce output as vase,
:: not cage. %fard/%arow use cage instead since this is the
:: eventual desired thread API; however, the input mark is
:: currently ignored, and the output mark is always %noun. (for
:: forward compatibility, it is safe to specify %noun as the
:: input mark.)
::
:: %fyrd does mark conversion on both ends, and additionally
:: lifts its input into a $unit. this second step is done
:: because threads conventionally take their input as a unit,
:: with ~ for the case of "no arguments".
::
:: n.b. the current convention for threads is to use !< to
:: unpack their input vase. !< imposes the requirement that the
:: input type nests within the specified type. this limits %fyrd
:: to threads with inputs for which a named mark exists; it is
:: impossible to use %noun in general since it does not nest.
:: threads written against the current vase-based API could use
:: ;; instead of !< to unpack their input, thus allowing the
:: use of %fyrd with %noun. however the eventual solution is
:: probably to make threads consume and produce cages, and do
:: mark conversion where appropriate.
!:
!? 164
::
=, khan
|= our=ship
=> |% :: %khan types
+$ move [p=duct q=(wite note gift)] ::
+$ note :: out request $->
$~ [%g %deal *sock *term *deal:gall] ::
$% $: %g :: to %gall
$>(%deal task:gall) :: full transmission
== ::
$: %k :: to self
$>(%fard task) :: internal thread
== == ::
+$ sign :: in response $<-
$% $: %gall :: from %gall
$>(%unto gift:gall) :: update
== ::
$: %khan :: from self
$>(?(%arow %avow) gift) :: thread result
== == ::
+$ khan-state ::
$: %0 :: state v0
hey=duct :: unix duct
tic=@ud :: tid counter
== ::
-- ::
=>
|%
++ get-beak
|= [=bear now=@da]
?@(bear [our bear %da now] bear)
::
++ get-dais
|= [=beak =mark rof=roof]
^- dais:clay
?~ ret=(rof ~ %cb beak /[mark])
~|(mark-unknown+mark !!)
?~ u.ret
~|(mark-invalid+mark !!)
?> =(%dais p.u.u.ret)
!<(dais:clay q.u.u.ret)
::
++ get-tube
|= [=beak =mark =out=mark rof=roof]
^- tube:clay
?~ ret=(rof ~ %cc beak /[mark]/[out-mark])
~|(tube-unknown+[mark out-mark] !!)
?~ u.ret
~|(tube-invalid+[mark out-mark] !!)
?> =(%tube p.u.u.ret)
!<(tube:clay q.u.u.ret)
::
++ make-wire
|= [=beak =mark]
^- wire
[%fyrd (en-beam beak mark ~)]
::
++ read-wire
|= =wire
^- (pair beak mark)
~| khan-read-wire+wire
?> ?=([%fyrd ^] wire)
=/ =beam (need (de-beam t.wire))
?>(?=([@ ~] s.beam) beam(s i.s.beam))
::
++ start-spider
|= =vase
^- note
[%g %deal [our our] %spider %poke %spider-start vase]
::
++ watch-spider
|= =path
^- note
[%g %deal [our our] %spider %watch path]
--
=| khan-state
=* state -
|= [now=@da eny=@uvJ rof=roof]
=* khan-gate .
^?
|%
:: +call: handle a +task request
::
++ call
|= $: hen=duct
dud=(unit goof)
wrapped-task=(hobo task)
==
^- [(list move) _khan-gate]
::
=/ =task ((harden task) wrapped-task)
?^ dud
~|(%khan-call-dud (mean tang.u.dud))
?+ -.task [~ khan-gate]
%born
[~ khan-gate(hey hen, tic 0)]
::
%fard
=/ tid=@ta
%^ cat 3
'khan-fyrd--'
(scot %uv (sham (mix tic eny)))
=. tic +(tic)
=* fyd p.task
=/ =beak (get-beak bear.fyd now)
=/ args [~ `tid beak name.fyd q.args.fyd]
:_ khan-gate
%+ turn
:~ (watch-spider /thread-result/[tid])
(start-spider !>(args))
==
|=(=note ^-(move [hen %pass //g note]))
::
%fyrd
=* fyd p.task
=/ =beak (get-beak bear.fyd now)
=/ =wire (make-wire beak p.args.fyd)
=/ =dais:clay (get-dais beak p.q.args.fyd rof)
=/ =vase
(slap (vale.dais q.q.args.fyd) !,(*hoon [~ u=.]))
=- [[hen %pass wire -]~ khan-gate]
[%k %fard bear.fyd name.fyd p.q.args.fyd vase]
==
:: +load: migrate an old state to a new khan version
::
++ load
|= old=khan-state
^+ khan-gate
khan-gate(state old)
:: +scry: nothing to see as yet
::
++ scry
^- roon
|= [lyc=gang car=term bem=beam]
^- (unit (unit cage))
~
++ stay state
:: +take: handle responses.
::
++ take
|= [tea=wire hen=duct dud=(unit goof) hin=sign]
^- [(list move) _khan-gate]
?^ dud
~|(%khan-take-dud (mean tang.u.dud))
:_ khan-gate
?- -.hin
%gall
?+ -.p.hin ~
?(%poke-ack %watch-ack)
?~ p.p.hin ~
%- (slog 'khan-ack' u.p.p.hin)
[hen %give %arow %| -.p.hin u.p.p.hin]~
::
%fact
=* cag cage.p.hin
?+ p.cag ~&(bad-fact+p.cag !!)
%thread-fail
=/ =tang !<(tang q.cag)
%- (slog 'khan-fact' tang)
[hen %give %arow %| p.cag tang]~
::
%thread-done
[hen %give %arow %& %noun q.cag]~
==
==
::
%khan
?. ?=(%arow +<.hin) ~
?. ?=([%fyrd *] tea) ~
=* row p.hin
?. ?=(%& -.row)
[hen %give %avow row]~
=/ [=beak =mark] (read-wire tea)
=/ =tube:clay (get-tube beak p.p.row mark rof)
=/ =vase (tube q.p.row)
[hen %give %avow %& mark q.vase]~
==
--

59
pkg/arvo/sys/zuse.hoon
View File

@ -4,7 +4,7 @@
=> ..lull
~% %zuse ..part ~
|%
++ zuse %419
++ zuse %418
:: :: ::
:::: :: :: (2) engines
:: :: ::
@ -3495,6 +3495,14 @@
|= jon=json
?> ?=([%n *] jon)
(rash p.jon dem)
:: :: ++ns:dejs:format
++ ns :: number as signed
|= jon=json
^- @s
?> ?=([%n *] jon)
%+ rash p.jon
%+ cook new:si
;~(plug ;~(pose (cold %| (jest '-')) (easy %&)) dem)
:: :: ++no:dejs:format
++ no :: number as cord
|=(jon=json ?>(?=([%n *] jon) p.jon))
@ -3844,55 +3852,6 @@
++ new-desk
|= [=desk tako=(unit tako) files=(map path page)]
[%c %park desk &/[(drop tako) (~(run by files) (lead %&))] *rang]
:: +an: $ankh interface door
::
++ an
|_ nak=ankh
:: +dug: produce ankh at path
::
++ dug
|= =path
^- (unit ankh)
?~ path `nak
?~ kid=(~(get by dir.nak) i.path)
~
$(nak u.kid, path t.path)
:: +get: produce file at path
::
++ get
|= =path
^- (unit cage)
?~ nik=(dug path) ~
?~ fil.u.nik ~
`q.u.fil.u.nik
:: +mup: convert sub-tree at .pre to (map path [lobe cage])
::
++ mup
|= pre=path
=- ~? =(~ -) [%oh-no-empty pre]
-
^- (map path [lobe cage])
=/ nek=(unit ankh) (dug pre)
?~ nek
~& [%oh-no-empty-pre pre ~(key by dir.nak)]
~
=. nak u.nek
~? =(~ nak) [%oh-no-empty-nak pre]
=| pax=path
=| res=(map path [=lobe =cage])
|- ^+ res
=? res ?=(^ fil.nak) (~(put by res) pax u.fil.nak)
:: =/ anz=(list [seg=@ta =ankh]) ~(tap by dir.nak)
:: |- ^+ res
:: ?~ anz res
:: %_ $
:: anz t.anz
:: res ^$(pax (snoc pax seg.i.anz), nak ankh.i.anz)
:: ==
%+ roll ~(tap by dir.nak)
|= [[seg=@ta =ankh] res=_res]
^$(pax (snoc pax seg), nak ankh, res res)
--
--
:: ::
:::: ++differ :: (2d) hunt-mcilroy

2
pkg/arvo/ted/aqua/ames.hoon
View File

@ -70,5 +70,5 @@
==
[cards this]
::
++ handle-arvo-response _!!
++ handle-arvo-response |=(* !!)
--

2
pkg/arvo/ted/aqua/dill.hoon
View File

@ -43,5 +43,5 @@
==
[cards this]
::
++ handle-arvo-response _!!
++ handle-arvo-response |=(* !!)
--

305
pkg/arvo/ted/azimuth-tracker.hoon
View File

@ -1,305 +0,0 @@
/- spider
/+ strandio, *azimuthio
=, strand=strand:spider
=, jael
|%
+$ pending-udiffs (map number:block udiffs:point)
+$ app-state
$: %2
url=@ta
=number:block
=pending-udiffs
blocks=(list block)
whos=(set ship)
==
+$ in-poke-data
$% [%listen whos=(list ship) =source:jael]
[%watch url=@ta]
==
+$ in-peer-data ~
--
::
:: Async helpers
::
|%
++ topics
|= ships=(set ship)
^- (list ?(@ux (list @ux)))
:: The first topic should be one of these event types
::
:- => azimuth-events:azimuth
:~ broke-continuity
changed-keys
lost-sponsor
escape-accepted
==
:: If we're looking for a specific set of ships, specify them as
:: the second topic. Otherwise don't specify the second topic so
:: we will match all ships.
::
?: =(~ ships)
~
[(turn ~(tap in ships) ,@) ~]
::
++ get-logs-by-hash
|= [url=@ta whos=(set ship) =hash:block]
=/ m (strand udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by hash'
%eth-get-logs-by-hash
hash
~[azimuth:contracts:azimuth]
(topics whos)
==
=/ event-logs=(list event-log:rpc:ethereum)
(parse-event-logs:rpc:ethereum json)
=/ =udiffs:point (event-logs-to-udiffs event-logs)
(pure:m udiffs)
::
++ get-logs-by-range
|= [url=@ta whos=(set ship) =from=number:block =to=number:block]
=/ m (strand udiffs:point)
^- form:m
;< =json bind:m
%+ request-rpc url
:* `'logs by range'
%eth-get-logs
`number+from-number
`number+to-number
~[azimuth:contracts:azimuth]
(topics whos)
==
=/ event-logs=(list event-log:rpc:ethereum)
(parse-event-logs:rpc:ethereum json)
=/ =udiffs:point (event-logs-to-udiffs event-logs)
(pure:m udiffs)
::
++ event-logs-to-udiffs
|= event-logs=(list =event-log:rpc:ethereum)
^- =udiffs:point
%+ murn event-logs
|= =event-log:rpc:ethereum
^- (unit [=ship =udiff:point])
?~ mined.event-log
~
?: removed.u.mined.event-log
~& [%removed-log event-log]
~
=/ =id:block [block-hash block-number]:u.mined.event-log
=, azimuth-events:azimuth
=, abi:ethereum
?: =(broke-continuity i.topics.event-log)
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
=/ num=@ (decode-results data.event-log ~[%uint])
`[who id %rift num]
?: =(changed-keys i.topics.event-log)
=/ who=@ (decode-topics t.topics.event-log ~[%uint])
=/ [enc=octs aut=octs sut=@ud rev=@ud]
%+ decode-results data.event-log
~[[%bytes-n 32] [%bytes-n 32] %uint %uint]
`[who id %keys rev sut (pass-from-eth:azimuth enc aut sut)]
?: =(lost-sponsor i.topics.event-log)
=/ [who=@ pos=@]
(decode-topics t.topics.event-log ~[%uint %uint])
`[who id %spon ~]
?: =(escape-accepted i.topics.event-log)
=/ [who=@ wer=@]
(decode-topics t.topics.event-log ~[%uint %uint])
`[who id %spon `wer]
~& [%bad-topic event-log]
~
::
++ jael-update
|= =udiffs:point
=/ m (strand ,~)
|- ^- form:m
=* loop $
?~ udiffs
(pure:m ~)
=/ =path /(scot %p ship.i.udiffs)
=/ cards
:~ [%give %fact ~[/] %azimuth-udiff !>(i.udiffs)]
[%give %fact ~[path] %azimuth-udiff !>(i.udiffs)]
==
;< ~ bind:m (send-raw-cards:strandio cards)
loop(udiffs t.udiffs)
::
++ handle-azimuth-tracker-poke
=/ m (strand ,in-poke-data)
^- form:m
;< =vase bind:m
((handle:strandio ,vase) (take-poke:strandio %azimuth-tracker-poke))
=/ =in-poke-data !<(in-poke-data vase)
(pure:m in-poke-data)
--
::
:: Main loop
::
|%
::
:: Switch eth node
::
++ handle-watch
|= state=app-state
=/ m (strand ,app-state)
^- form:m
;< =in-poke-data bind:m handle-azimuth-tracker-poke
?. ?=(%watch -.in-poke-data)
ignore:strandio
(pure:m state(url url.in-poke-data))
::
:: Send %listen to jael
::
++ handle-listen
|= state=app-state
=/ m (strand ,app-state)
^- form:m
;< =in-poke-data bind:m handle-azimuth-tracker-poke
?. ?=(%listen -.in-poke-data)
ignore:strandio
=/ card
[%pass /lo %arvo %j %listen (silt whos.in-poke-data) source.in-poke-data]
;< ~ bind:m (send-raw-card:strandio card)
(pure:m state)
::
:: Start watching a node
::
++ handle-peer
|= state=app-state
=/ m (strand ,app-state)
;< =path bind:m ((handle:strandio ,path) take-watch:strandio)
=: number.state 0
pending-udiffs.state *pending-udiffs
blocks.state *(list block)
whos.state
=/ who=(unit ship) ?~(path ~ `(slav %p i.path))
?~ who
~
(~(put in whos.state) u.who)
==
::
;< ~ bind:m send-cancel-request:strandio
(get-updates state)
::
:: Get more blocks
::
++ handle-wake
|= state=app-state
=/ m (strand ,app-state)
^- form:m
;< ~ bind:m ((handle:strandio ,~) (take-wake:strandio ~))
(get-updates state)
::
:: Get updates since last checked
::
++ get-updates
|= state=app-state
=/ m (strand ,app-state)
^- form:m
;< =latest=block bind:m (get-latest-block url.state)
;< state=app-state bind:m (zoom state number.id.latest-block)
|- ^- form:m
=* walk-loop $
?: (gth number.state number.id.latest-block)
;< now=@da bind:m get-time:strandio
;< ~ bind:m (send-wait:strandio (add now ~m5))
(pure:m state)
;< =block bind:m (get-block-by-number url.state number.state)
;< [=new=pending-udiffs new-blocks=(lest ^block)] bind:m
%- take-block
[url.state whos.state pending-udiffs.state block blocks.state]
=: pending-udiffs.state new-pending-udiffs
blocks.state new-blocks
number.state +(number.id.i.new-blocks)
==
walk-loop
::
:: Process a block, detecting and handling reorgs
::
++ take-block
|= [url=@ta whos=(set ship) =a=pending-udiffs =block blocks=(list block)]
=/ m (strand ,[pending-udiffs (lest ^block)])
^- form:m
?: &(?=(^ blocks) !=(parent-hash.block hash.id.i.blocks))
(rewind url a-pending-udiffs block blocks)
;< =b=pending-udiffs bind:m
(release-old-events a-pending-udiffs number.id.block)
;< =new=udiffs:point bind:m (get-logs-by-hash url whos hash.id.block)
=. b-pending-udiffs (~(put by b-pending-udiffs) number.id.block new-udiffs)
(pure:m b-pending-udiffs block blocks)
::
:: Release events if they're more than 30 blocks ago
::
++ release-old-events
|= [=pending-udiffs =number:block]
=/ m (strand ,^pending-udiffs)
^- form:m
=/ rel-number (sub number 30)
=/ =udiffs:point (~(get ja pending-udiffs) rel-number)
;< ~ bind:m (jael-update udiffs)
(pure:m (~(del by pending-udiffs) rel-number))
::
:: Reorg detected, so rewind until we're back in sync
::
++ rewind
|= [url=@ta =pending-udiffs =block blocks=(list block)]
=/ m (strand ,[^pending-udiffs (lest ^block)])
|- ^- form:m
=* loop $
?~ blocks
(pure:m pending-udiffs block blocks)
?: =(parent-hash.block hash.id.i.blocks)
(pure:m pending-udiffs block blocks)
;< =next=^block bind:m (get-block-by-number url number.id.i.blocks)
?: =(~ pending-udiffs)
;< ~ bind:m (disavow block)
loop(block next-block, blocks t.blocks)
=. pending-udiffs (~(del by pending-udiffs) number.id.block)
loop(block next-block, blocks t.blocks)
::
:: Tell subscribers there was a deep reorg
::
++ disavow
|= =block
=/ m (strand ,~)
^- form:m
(jael-update [*ship id.block %disavow ~]~)
::
:: Zoom forward to near a given block number.
::
:: Zooming doesn't go forward one block at a time. As a
:: consequence, it cannot detect and handle reorgs. Only use it
:: at a safe distance -- 500 blocks ago is probably sufficient.
::
++ zoom
|= [state=app-state =latest=number:block]
=/ m (strand ,app-state)
^- form:m
=/ zoom-margin=number:block 100
?: (lth latest-number (add number.state zoom-margin))
(pure:m state)
=/ to-number=number:block (sub latest-number zoom-margin)
;< =udiffs:point bind:m
(get-logs-by-range url.state whos.state number.state to-number)
;< ~ bind:m (jael-update udiffs)
=. number.state +(to-number)
=. blocks.state ~
(pure:m state)
--
::
:: Main
::
^- thread:spider
|= args=vase
=/ m (strand ,vase)
^- form:m
;< ~ bind:m
%- (main-loop:strandio ,app-state)
:~ handle-listen
handle-watch
handle-wake
handle-peer
==
(pure:m *vase)

3
pkg/arvo/ted/azimuth/snap-logs.hoon
View File

@ -9,7 +9,8 @@
lib=naive-transactions,
ethereum,
dice
/* logs %eth-logs /app/azimuth/logs/eth-logs
:: /* logs %eth-logs /app/azimuth/logs/eth-logs
=/ logs ~
=, strand=strand:spider
::
=> |% +$ card card:agent:gall

11
pkg/arvo/ted/eth-watcher.hoon
View File

@ -13,7 +13,8 @@
=/ m (strand:strandio ,vase)
^- form:m
;< =latest=block bind:m (get-latest-block:ethio url.pup)
;< pup=watchpup bind:m (zoom pup number.id.latest-block)
=+ last=number.id.latest-block
;< pup=watchpup bind:m (zoom pup last (min last (fall to.pup last)))
=| vows=disavows
;< pup=watchpup bind:m (fetch-batches pup)
::?. eager.pup
@ -79,7 +80,7 @@
:: at a safe distance -- 100 blocks ago is probably sufficient.
::
++ zoom
|= [pup=watchpup =latest=number:block]
|= [pup=watchpup =latest=number:block up-to=number:block]
=/ m (strand:strandio ,watchpup)
^- form:m
=/ zoom-margin=number:block 30
@ -87,7 +88,11 @@
?: (lth latest-number (add number.pup zoom-margin))
(pure:m pup)
=/ up-to-number=number:block
(min (add 10.000.000 number.pup) (sub latest-number zoom-margin))
;: min
(add 10.000.000 number.pup)
(sub latest-number zoom-margin)
up-to
==
|-
=* loop $
?: (gth number.pup up-to-number)

33
pkg/arvo/ted/eth/get-tx-receipts.hoon Normal file
View File

@ -0,0 +1,33 @@
:: eth/get-tx-receipts
::
:: asks an ethereum node for transaction receipts from a list of transaction
:: hashes. returns a (list [@t json]), where @t is the transaction hash in
:: hex written as a cord, and json is the receipt
::
/+ ethereum, ethio, *strandio
=, jael
::
|= args=vase
=+ !<([url=@t tx-hashes=(list @ux)] args)
=/ m (strand ,vase)
=| out=(list [@t json])
|^
^- form:m
=* loop $
?: =(~ tx-hashes) (pure:m !>(out))
;< res=(list [@t json]) bind:m
(request-receipts url (scag 100 tx-hashes))
%_ loop
out (welp out res)
tx-hashes (slag 100 tx-hashes)
==
::
++ request-receipts
|= [url=@t tx-hashes=(list @ux)]
%+ request-batch-rpc-strict:ethio url
%+ turn tx-hashes
|= txh=@ux
^- [(unit @t) request:rpc:ethereum]
:- `(crip '0' 'x' ((x-co:co 64) txh))
[%eth-get-transaction-receipt txh]
--

390
pkg/arvo/ted/naive-csv.hoon Normal file
View File

@ -0,0 +1,390 @@
:: naive-csv: produces csv file containing L2 transaction data
::
:: takes in the network to use and the ethereum node url to grab data from.
:: it starts with the azimuth snapshot and scries the logs from %azimuth.
:: it then produces a csv file containing the following data on L2
:: transactions:
::
:: - block number
:: - timestamp
:: - roller address
:: - roll hash
:: - tx hash
:: - sending ship
:: - sending proxy
:: - nonce
:: - gas price
:: - length of input data
:: - success or failure
:: - function name
:: - spawning ship (^sein:title)
::
:: A lot of the data-scrounging here is stuff that %roller already keeps track
:: of. We could just scry it from there, but then this thread needs to be run
:: on the roller ship. So we rebuild the list of historical transactions
:: ourselves so that this can run from any ship.
::
/- dice,
spider
::
/+ dice,
ethereum,
ethio,
naive,
naive-tx=naive-transactions,
*strandio
:: starting snapshot. this may not be the right starting point once we have
:: clay tombstoning and the snapshot may be updated
::
/* snap %azimuth-snapshot /app/azimuth/version-0/azimuth-snapshot
::
=, strand=strand:spider
=, jael
::
^- thread:spider
=< process-logs
=>
|%
:: imported logs is cast as $events
+$ events (list event-log:rpc:ethereum)
+$ address address:naive :: @ux
+$ keccak @ux :: used for transaction and roll hashes
+$ blocknum number:block :: @udblocknumber
+$ net net:dice :: ?(%mainnet %ropsten %local %default)
+$ roll-dat :: all data required for each roll
[[gas=@ud sender=address] =effects:naive]
+$ block-dat :: all data required for each block
[timestamp=@da rolls=(map keccak roll-dat)]
+$ block-map (map blocknum block-dat)
+$ rolls-map (map blocknum (map keccak effects:naive))
::
+$ action
$? %transfer-point
%spawn
%configure-keys
%escape
%cancel-escape
%adopt
%reject
%detach
%set-management-proxy
%set-spawn-proxy
%set-transfer-proxy
==
::
+$ tx-data
$: =blocknum
timestamp=@da
roller=address
roll-hash=keccak
tx-hash=keccak
sender=ship
proxy=proxy:naive
nonce=nonce:naive
gas=@ud
length=@ux
suc=?
=action
parent=ship
==
--
::
|%
:: +process-logs is the main process. it grabs the azimuth snapshop, runs
:: +naive on the logs, grabs the timestamps and gas costs for each roll,
:: then flattens them into a list of $tx-data and saves them to disk.
::
++ process-logs
|= arg=vase
=+ !<([~ =net node-url=@t] arg)
=/ pax=path /naive-exports/csv :: data will be saved here
=/ m (strand ,vase)
^- form:m
;< =events bind:m (scry events /gx/azimuth/logs/noun)
=/ [naive-contract=address chain-id=@]
[naive chain-id]:(get-network:dice net)
=/ snap=snap-state:dice snap
::
;< ~ bind:m
%- flog-text %+ weld "naive-csv: processing {<net>} ethereum logs "
"with {<(lent events)>} events"
=/ =rolls-map
(compute-effects nas.snap events net naive-contract chain-id)
;< ~ bind:m (flog-text "naive-csv: getting timestamps")
;< tim=thread-result bind:m
%+ await-thread %eth-get-timestamps
!>([node-url ~(tap in ~(key by rolls-map))])
=/ timestamps %- ~(gas by *(map blocknum @da))
?- tim
[%.y *] ;;((list [@ud @da]) q.p.tim)
[%.n *]
=> (mean 'naive-csv: %eth-get-timestamps failed' p.tim)
!!
==
;< ~ bind:m (flog-text "naive-csv: got timestamps")
;< ~ bind:m (flog-text "naive-csv: getting tx receipts")
;< gaz=thread-result bind:m
%+ await-thread %eth-get-tx-receipts
!>([node-url (get-roll-hashes rolls-map)])
=/ gas-sender %- ~(gas by *(map keccak [gas=@ud sender=address]))
?- gaz
[%.y *] (parse-gas-sender ;;((list [@t json]) q.p.gaz))
[%.n *]
=> (mean 'naive-csv: %eth-tx-receipts failed' p.gaz)
!!
==
;< ~ bind:m (flog-text "naive-csv: got tx receipts")
=/ csv=(list cord)
(make-csv (flatten (collate-roll-data rolls-map timestamps gas-sender)))
;< ~ bind:m (export-csv csv pax)
;< ~ bind:m (flog-text :(weld "naive-csv: csv saved to %" (spud pax) "/"))
::
(pure:m !>(~))
:: +collate-roll-data throws naive:effects, timestamps, and gas costs into
:: one $block-map
::
++ collate-roll-data
|= $: =rolls-map
timestamps=(map blocknum @da)
roll-receipts=(map keccak [gas=@ud sender=address])
==
=/ blocknums=(list blocknum) ~(tap in ~(key by rolls-map))
=| =block-map
^+ block-map
|-
?~ blocknums block-map
=/ =blocknum i.blocknums
=/ rolls=(map keccak [[gas=@ud sender=address] =effects:naive])
%- ~(gas by *(map keccak [[gas=@ud sender=address] =effects:naive]))
%+ turn ~(tap in ~(key by (~(got by rolls-map) blocknum)))
|= txh=keccak
:+ txh
(~(got by roll-receipts) txh)
(~(got by (~(got by rolls-map) blocknum)) txh)
%= $
blocknums t.blocknums
block-map %+ ~(put by block-map)
blocknum
[(~(got by timestamps) blocknum) rolls]
==
:: +flatten takes a $block-map and creates a $tx-data for every transaction
:: in every roll, returned as a (list tx-data)
::
++ flatten
|= =block-map
=/ blocks=(list [blocknum block-dat]) ~(tap by block-map)
=| tx-list=(list tx-data)
^+ tx-list
:: recurse through the list of blocks, getting the rolls submitted in that
:: block, their timestamp, and the gas price of that roll
::
|-
=* block-loop $
?~ blocks tx-list
=/ block=[=blocknum =block-dat] i.blocks
=/ roll-list=(list [=keccak =roll-dat]) ~(tap by rolls.block-dat.block)
=| block-tx-list=(list tx-data)
:: recurse through each roll, getting the transaction data from the effects
::
|-
=* roll-loop $
?~ roll-list
%= block-loop
blocks t.blocks
tx-list (welp tx-list block-tx-list)
==
=/ roll=[=keccak =roll-dat] i.roll-list
:: recurse through the list of effects, building up transaction data as we
:: go. there's a choice here to use the effects, or the submitted
:: raw-tx. the effects include whether or not a transaction failed,
:: which is important data not a part of the submitted raw-tx. we
:: could determine this ourselves, but we build the effects anyways when
:: computing the state transitions, so we may as well use them.
::
:: an individual transaction results in up to 3 diffs: a %nonce, a %tx, and
:: a %point. they always appear in this order. successful transactions
:: always have all 3, while failed transactions only have %nonce and %tx.
:: note that the nonce listed is always the expected nonce - we can't know
:: what nonce was actually submitted without the private key of the signer.
::
=| roll-tx-list=(list tx-data)
=| =tx-data
=| nonce-and-tx=[_| _|]
|-
=* effect-loop $
:: if we are processing a new transaction, initialize the parts of tx-data
:: that are identical for every transaction in the roll
=? tx-data =([| |] nonce-and-tx)
:* blocknum.block timestamp.block-dat.block sender.roll-dat.roll
keccak.roll *keccak *ship *proxy:naive *nonce:naive
gas.roll-dat.roll *@ | *action *ship
==
:: if we've gotten both the %nonce and %tx diff from a transaction, add the
:: tx-data to the list of tx for the roll
::
?: =([& &] nonce-and-tx)
%= effect-loop
nonce-and-tx [| |]
roll-tx-list (snoc roll-tx-list tx-data)
==
:: if we've finished looping through the effects, add the tx list from the
:: roll to the list of tx for the block
::
?~ effects.roll-dat.roll
%= roll-loop
roll-list t.roll-list
block-tx-list (welp block-tx-list roll-tx-list)
==
::
=/ =diff:naive i.effects.roll-dat.roll
:: we ignore %operator, %dns, %point diffs
::
?+ diff
$(effects.roll-dat.roll t.effects.roll-dat.roll)
:: %nonce is always the first diff from a given transaction.
::
[%nonce *]
%= effect-loop
-.nonce-and-tx &
sender.tx-data ship.diff
nonce.tx-data nonce.diff
proxy.tx-data proxy.diff
parent.tx-data (^sein:title ship.diff)
effects.roll-dat.roll t.effects.roll-dat.roll
==
:: %tx is always the second diff from a given transaction.
::
[%tx *]
%= effect-loop
+.nonce-and-tx &
effects.roll-dat.roll t.effects.roll-dat.roll
action.tx-data +<.tx.raw-tx.diff
suc.tx-data ?~ err.diff & |
length.tx-data `@`-.raw.raw-tx.diff
tx-hash.tx-data (hash-raw-tx:naive-tx raw-tx.diff)
==
==
::
++ parse-gas-sender
|= res=(list [@t json])
^- (list [=keccak [gas=@ud sender=address]])
%+ turn res
|= [id=@t =json]
^- [=keccak [gas=@ud sender=address]]
:- (hex-to-num:ethereum id)
:- %- parse-hex-result:rpc:ethereum
~| json
?> ?=(%o -.json)
(~(got by p.json) 'effectiveGasPrice') :: gas used in wei
%- parse-hex-result:rpc:ethereum
~| json
?> ?=(%o -.json)
(~(got by p.json) 'from')
:: +get-roll-hashes makes a list of hashes of all transactions from $rolls-map
::
++ get-roll-hashes
|= =rolls-map ^- (list keccak)
%- zing
%+ turn ~(val by rolls-map)
|= a=(map keccak effects:naive)
~(tap in ~(key by a))
:: +compute-effects calls +naive to compute the state transitions for all
:: logs, but it returns a map that only has the effects for L2 transactions,
:: leaving out L1 transactions. we need to compute all of them in order to
:: determine whether the transactions were valid.
::
++ compute-effects
|= $: nas=^state:naive
=events
=net
naive-contract=address
chain-id=@ud
==
=| out=rolls-map
^+ out
::
|-
?~ events out
=/ log=event-log:rpc:ethereum i.events
?~ mined.log
~& >> 'naive-csv: empty log'
$(events t.events)
=/ =blocknum block-number.u.mined.log
=/ =^input:naive
:- blocknum
?. =(naive-contract address.log)
:- %log
[address.log (data-to-hex:dice data.log) topics.log]
?~ input.u.mined.log
~& >> 'naive-csv: empty L2 transaction'
[%bat *@]
[%bat u.input.u.mined.log]
=^ =effects:naive nas
(%*(. naive lac |) verifier:naive-tx chain-id nas input)
%= $
events t.events
out ?. =(%bat +<.input)
out :: skip L1 logs
=/ cur (~(get by out) blocknum)
?~ cur
%+ ~(put by out) blocknum
(my [[transaction-hash.u.mined.log effects]~])
%+ ~(put by out) blocknum
(~(put by u.cur) transaction-hash.u.mined.log effects)
==
:: +export-csv writes a (list cord) as csv to disk at .pax
::
++ export-csv
|= [in=(list cord) pax=path]
=/ m (strand ,~)
^- form:m
;< =bowl:spider bind:m get-bowl
=- (send-raw-card %pass / %arvo %c %info -)
%+ foal:space:userlib
;: weld
/(scot %p our.bowl)/base/(scot %da now.bowl)
pax
/(scot %da now.bowl)/txt
==
[%txt !>(in)]
:: +make-csv takes in a (list tx-data) and makes it into a (list cord) to be
:: saved as a csv file
::
++ make-csv
|= in=(list tx-data)
^- (list cord)
:- %- crip
;: weld
"block number,"
"timestamp,"
"roller address,"
"roll hash,"
"tx hash,"
"sending ship,"
"sending proxy,"
"nonce,"
"gas price,"
"length of input data,"
"success or failure,"
"function name,"
"parent"
==
%+ turn in
|= =tx-data
%- crip
;: weld
(scow %ud blocknum.tx-data) ","
(scow %da timestamp.tx-data) ","
(scow %ux roller.tx-data) ","
(scow %ux roll-hash.tx-data) ","
(scow %ux tx-hash.tx-data) ","
(scow %p sender.tx-data) ","
(scow %tas proxy.tx-data) ","
(scow %ud nonce.tx-data) ","
(scow %ud gas.tx-data) ","
(scow %ux length.tx-data) ","
(scow %f suc.tx-data) ","
(scow %tas action.tx-data) ","
(scow %p parent.tx-data)
==
--

31
pkg/arvo/ted/ph/all.hoon
View File

@ -4,7 +4,7 @@
^- thread:spider
|= args=vase
=/ m (strand ,vase)
=+ !<(group=(list @tas) args)
=+ !<([~ group=(list @tas)] args)
;< =bowl:spider bind:m get-bowl
=/ threads=(list @tas)
?- group
@ -20,8 +20,8 @@
==
::
[%all ~]
=+ .^(=arch %cy /(scot %p our.bowl)/home/(scot %da now.bowl)/ted/ph)
%+ turn (turn ~(tap by dir.arch) head)
=+ .^(=arch %cy /(scot %p our.bowl)/base/(scot %da now.bowl)/ted/ph)
%+ turn (sort (turn ~(tap by dir.arch) head) aor)
|= =term
(cat 3 'ph-' term)
::
@ -29,11 +29,24 @@
(turn group |=(=term (cat 3 'ph-' term)))
==
::
=| results=(list [@tas thread-result])
=| results=(list [n=@tas r=thread-result])
|- ^- form:m
=* loop $
?~ threads
(pure:m !>(results))
;< =thread-result bind:m (await-thread i.threads *vase)
;< ~ bind:m (flog-text "ph-all: {<i.threads>} complete")
loop(threads t.threads, results [[i.threads thread-result] results])
?^ threads
?: =(%ph-all i.threads)
loop(threads t.threads)
;< ~ bind:m (flog-text "ph-all: {<i.threads>} started")
;< =thread-result bind:m (await-thread i.threads *vase)
;< ~ bind:m (flog-text "ph-all: {<i.threads>} complete")
loop(threads t.threads, results [[i.threads thread-result] results])
::
|-
=* loop $
?~ results (pure:m !>(~)) ::TODO maybe collate vases
?: ?=(%& -.r.i.results) loop(results t.results)
=* name n.i.results
=* mess p.r.i.results
;< ~ bind:m (flog-text "ph-all: {(trip name)} failed: {(trip -.mess)}")
;< ~ bind:m (flog-tang +.mess)
;< ~ bind:m (flog-text "")
loop(results t.results)

4
pkg/arvo/ted/ph/breach-multiple.hoon
View File

@ -12,13 +12,13 @@
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m (breach-and-hear ~bud ~marbud)
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (breach-and-hear ~marbud ~bud)
;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m end
(pure:m *vase)

6
pkg/arvo/ted/ph/breach-sudden.hoon
View File

@ -14,13 +14,13 @@
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m (breach ~bud)
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m
(dojo ~bud "|merge %home ~marbud %kids, =gem %only-this")
(dojo ~bud "|merge %base ~marbud %kids, =gem %only-this")
;< file=@t bind:m (touch-file ~bud %kids %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m end
(pure:m *vase)

9
pkg/arvo/ted/ph/breach-sync.hoon
View File

@ -1,5 +1,6 @@
:: This tests that syncs are correctly restarted after a breach
::
::TODO breach tests broken by dangling bone?
/- spider
/+ *ph-io
=, strand=strand:spider
@ -12,17 +13,17 @@
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
:: Merge so that when we unify history with the %only-this merge later, we
:: don't get a spurious conflict in %home
:: don't get a spurious conflict in %base
::
;< ~ bind:m (dojo ~marbud "|merge %kids our %home")
;< ~ bind:m (dojo ~marbud "|merge %kids our %base")
;< ~ bind:m (breach-and-hear ~bud ~marbud)
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m
(dojo ~bud "|merge %kids ~marbud %kids, =gem %only-this")
;< file=@t bind:m (touch-file ~bud %kids %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz)
;< ~ bind:m (check-file-touched ~marbud %home file)
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m end
(pure:m *vase)

4
pkg/arvo/ted/ph/change-file.hoon
View File

@ -6,7 +6,7 @@
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (init-ship ~bud &)
;< file=@t bind:m (touch-file ~bud %home %foo)
;< ~ bind:m (check-file-touched ~bud %home file)
;< file=@t bind:m (touch-file ~bud %base %foo)
;< ~ bind:m (check-file-touched ~bud %base file)
;< ~ bind:m end
(pure:m *vase)

6
pkg/arvo/ted/ph/child-sync.hoon
View File

@ -7,8 +7,8 @@
;< ~ bind:m start-simple
;< ~ bind:m (init-ship ~bud &)
;< ~ bind:m (init-ship ~marbud &)
;< file=@t bind:m (touch-file ~bud %home %foo)
;< ~ bind:m (dojo ~bud "|merge %kids our %home")
;< ~ bind:m (check-file-touched ~marbud %home file)
;< file=@t bind:m (touch-file ~bud %base %foo)
;< ~ bind:m (dojo ~bud "|merge %kids our %base")
;< ~ bind:m (check-file-touched ~marbud %base file)
;< ~ bind:m end
(pure:m *vase)

22
pkg/arvo/ted/ph/child-update.hoon
View File

@ -6,9 +6,9 @@
|^
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< [path @t] bind:m (modify ~bud %home)
;< ~ bind:m (init-ship ~bud &)
;< ~ bind:m (init-ship ~marbud &)
;< * bind:m (modify ~bud %base)
;< [=path file=@t] bind:m (modify ~bud %kids)
;< ~ bind:m (check-touched ~marbud %kids path file)
;< ~ bind:m end
@ -26,18 +26,16 @@
%^ cat 3 '=/ new-val 57 '
(get-val /sys/zuse/hoon)
=/ mar-contents
%^ cat 3 (get-val /mar/js/hoon)
' ~& > new-val=new-val .'
=/ js-contents
%^ cat 3 (get-val /app/landscape/js/channel/js)
'extra'
%^ cat 3 (get-val /mar/hoon/hoon)
::TODO doesn't get picked up somehow
:: ' ~& > new-val=new-val .'
' ~& > %testing .'
=/ files
:~ [/sys/zuse/hoon zuse-contents]
[/mar/js/hoon mar-contents]
[/app/landscape/js/channel/js js-contents]
:~ ::[/sys/zuse/hoon zuse-contents]
[/mar/hoon/hoon mar-contents]
==
;< ~ bind:m (send-events (insert-files:util her desk files))
(pure:m /app/landscape/js/channel/js js-contents)
(pure:m /mar/hoon/hoon mar-contents)
::
++ aqua-path
|= =path

2
pkg/arvo/ted/ph/group-rejoin.hoon
View File

@ -8,7 +8,7 @@
^- form:m
=* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect
?: (is-dojo-output:util ship her unix-effect "activated app home/{(trip agent)}")
?: (is-dojo-output:util ship her unix-effect "activated app base/{(trip agent)}")
(pure:m ~)
loop
::

1
pkg/arvo/ted/ph/hi.hoon
View File

@ -7,7 +7,6 @@
;< ~ bind:m start-simple
;< ~ bind:m (init-ship ~bud &)
;< ~ bind:m (init-ship ~dev &)
;< ~ bind:m (init-ship ~dev &)
;< ~ bind:m (send-hi ~bud ~dev)
;< ~ bind:m end
(pure:m *vase)

0
pkg/arvo/ted/ph/migrate/end.hoon
View File

49
pkg/arvo/ted/ph/migrate/make-groups.hoon
View File

@ -1,49 +0,0 @@
/- spider,
graph-store,
graph-view,
post,
*resource,
*group
/+ *ph-io, strandio
=, strand=strand:spider
=>
|%
::
++ create-group
|= our=@p
%^ dojo-thread our %group-create
:- %group-view-action
:* %create
%group-1
[%open ~ ~]
'Test Group'
'A description'
==
::
++ join-group
|= our=@p
%^ poke-app our %group-view
:- %group-view-action
:* %join
[~zod %group-1]
~zod
==
--
::
^- thread:spider
|= vase
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (create-group ~zod)
;< ~ bind:m (join-group ~bus)
;< ~ bind:m (join-group ~web)
;< ~ bind:m (send-hi ~zod ~bus)
;< ~ bind:m (send-hi ~zod ~web)
;< ~ bind:m (send-hi ~bus ~zod)
;< ~ bind:m (send-hi ~bus ~web)
;< ~ bind:m (send-hi ~web ~zod)
;< ~ bind:m (send-hi ~web ~bus)
(pure:m *vase)

38
pkg/arvo/ted/ph/migrate/setup.hoon
View File

@ -1,38 +0,0 @@
/- spider,
graph-store,
graph-view,
post,
*resource,
*group
/+ *ph-io, strandio
=, strand=strand:spider
=>
|%
::
++ create-group
|= our=@p
%^ dojo-thread our %group-create
:- %group-view-action
:* %create
%group-1
[%open ~ ~]
'Test Group'
'A description'
==
::
++ hang
=/ m (strand ,~)
^- form:m
|= tin=strand-input:strand
`[%wait ~]
--
::
^- thread:spider
|= vase
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m hang
(pure:m *vase)

42
pkg/arvo/ted/ph/migrate/wait.hoon
View File

@ -1,42 +0,0 @@
/- spider,
graph-store,
graph-view,
post,
*resource,
*group
/+ *ph-io, strandio
=, strand=strand:spider
=>
|%
::
++ create-group
|= our=@p
%^ dojo-thread our %group-create
:- %group-view-action
:* %create
%group-1
[%open ~ ~]
'Test Group'
'A description'
==
::
++ join-group
|= our=@p
%^ poke-app our %group-view
:- %group-view-action
:* %join
[~zod %group-1]
~zod
==
--
::
^- thread:spider
|= vase
=/ m (strand ,vase)
;< ~ bind:m start-simple
;< ~ bind:m (sleep ~s10)
;< ~ bind:m end
(pure:m *vase)

12
pkg/arvo/ted/ph/moon-az.hoon
View File

@ -12,11 +12,13 @@
;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |)
;< ~ bind:m (init-ship ~linnup-torsyx |)
;< ~ bind:m (init-ship ~linnup-torsyx-linnup-torsyx |)
;< ~ bind:m (send-hi ~bud ~linnup-torsyx-linnup-torsyx)
;< ~ bind:m (send-hi ~linnup-torsyx-linnup-torsyx ~marbud)
::NOTE only shortmoons supported, see also /ted/aqua/ames +lane-to-ship
;< ~ bind:m (init-moon ~torsyx-linnup-torsyx |)
;< ~ bind:m (send-hi ~bud ~torsyx-linnup-torsyx)
;< ~ bind:m (send-hi ~torsyx-linnup-torsyx ~marbud)
;< ~ bind:m (init-ship ~dev |)
;< ~ bind:m (send-hi ~linnup-torsyx-linnup-torsyx ~dev)
;< ~ bind:m (send-hi ~dev ~linnup-torsyx-linnup-torsyx)
::TODO these hi's never come through!
;< ~ bind:m (send-hi ~torsyx-linnup-torsyx ~dev)
;< ~ bind:m (send-hi ~dev ~torsyx-linnup-torsyx)
;< ~ bind:m end
(pure:m *vase)

58
pkg/arvo/ted/roller/send.hoon
View File

@ -13,12 +13,26 @@
=/ =address:ethereum (address-from-prv:key:ethereum pk)
;< expected-nonce=@ud bind:m
(get-next-nonce:ethio endpoint address)
=/ batch-data=octs
%+ cad:naive 3
%- flop
%+ roll txs
|= [=raw-tx:naive out=(list octs)]
[raw.raw-tx 65^sig.raw-tx out]
:: Infura enforces a max calldata size (32, 64, 128 Kb?) so we calculate how
:: many txs are included in a batch of that size, and only send those
::
=/ max-calldata=@ud 128.000
=/ [n-txs=@ud batch-data=octs]
=| n-txs=@ud
=| size=@ud
=| out=(list octs)
|- ^- [@ud octs]
?~ txs
[n-txs (cad:naive 3 (flop out))]
=* raw-tx i.txs
=. size :(add 65 p.raw.raw-tx size)
?: (gth size max-calldata)
[n-txs (cad:naive 3 (flop out))]
%_ $
n-txs +(n-txs)
txs t.txs
out [raw.raw-tx 65^sig.raw-tx out]
==
:: if the batch is malformed, emit error to kick it out of sending
::
?~ (parse-roll:naive q.batch-data)
@ -26,16 +40,15 @@
:: if chain expects a different nonce, don't send this transaction
::
?. =(nonce expected-nonce)
~& >>> [%unexpected-nonce nonce expected+expected-nonce]
%- pure:m
!> ^- [%.n @tas @t]
:+ %.n
%not-sent
?: (lth expected-nonce nonce)
:: if ahead, it will use the same next-gas-price when resending
:: if ahead, use the same next-gas-price when resending
::
%ahead-nonce
:: if behind, start out-of-sync flow
:: if behind, start out-of-sync flow if batch was not sent before
::
%behind-nonce
:: if a gas-price of 0 was specified, fetch the recommended one
@ -49,22 +62,23 @@
:: gasLimit = G_transaction + G_txdatanonzero × dataByteLength
:: where
:: G_transaction = 21000 gas (base fee)
:: + G_txdatanonzero = 68 gas
:: + G_txdatanonzero = 16 gas (previously 68; see EIP-2028)
:: * dataByteLength = (65 + raw) * (lent txs) bytes
::
:: TODO: enforce max number of tx in batch?
:: 1.000 gas are added to the base fee as extra, for emitting the log
::
=/ gas-limit=@ud (add 21.000 (mul 68 p.batch-data))
:: if we cannot pay for the transaction, don't bother sending it out
::
=/ max-cost=@ud (mul gas-limit use-gas-price)
=/ gas-limit=@ud (add 22.000 (mul 16 p.batch-data))
=/ max-cost=@ud (mul gas-limit use-gas-price)
;< balance=@ud bind:m
(get-balance:ethio endpoint address)
?: (gth max-cost balance)
:: if we cannot pay for the transaction, don't bother sending it out
::
(pure:m !>(%.n^[%not-sent %insufficient-roller-balance]))
::
::NOTE this fails the thread if sending fails, which in the app gives us
:: the "retry with same gas price" behavior we want
::
;< =response:rpc bind:m
%+ send-batch endpoint
=; tx=transaction:rpc:ethereum
@ -80,19 +94,23 @@
:: log batch tx-hash to getTransactionReceipt(tx-hash)
::
~? &(?=(%result -.response) ?=(%s -.res.response))
^- [nonce=@ud batch-hash=@t gas=@ud]
nonce^(so:dejs:format res.response)^use-gas-price
^- [nonce=@ud batch-hash=@t gas=@ud sent-txs=@ud bytes=@ud]
:* nonce
(so:dejs:format res.response)
use-gas-price
n-txs
p.batch-data
==
%- pure:m
!> ^- (each @ud [term @t])
!> ^- (each [@ud @ud] [term @t])
:: TODO: capture if the tx fails (e.g. Runtime Error: revert)
:: check that tx-hash in +.response is non-zero?
:: enforce max here, or in app?
::
?+ -.response %.n^[%error 'unexpected rpc response']
%error %.n^[%error message.response]
:: add five gwei to gas price of next attempt
::
%result %.y^(add use-gas-price 5.000.000.000)
%result %.y^[n-txs (add use-gas-price 5.000.000.000)]
==
::
::TODO should be distilled further, partially added to strandio?

6
pkg/arvo/ted/work.hoon
View File

@ -2,7 +2,7 @@
::
:: With no arguments, creates and mounts a %work desk.
:: If there are arguments, each one is created and mounted.
:: All desks are begun by merging from our %home desk.
:: All desks are begun by merging from our %base desk.
::
/- spider
/+ strandio
@ -16,10 +16,10 @@
|- ^- form:m
=* loop $
?~ desks (pure:m !>(ok=&))
:: |merge %work our %home
:: |merge %work our %base
::
;< [=ship =desk =case:clay] bind:m get-beak:strandio
=/ kiln-merge [i.desks ship %home case %auto]
=/ kiln-merge [i.desks ship %base case %auto]
;< ~ bind:m (poke-our:strandio %hood %kiln-merge !>(kiln-merge))
;< ~ bind:m (trace:strandio leaf+"work: merged {<i.desks>}" ~)
:: sleep 10ms to defer to new event

4
pkg/arvo/tests/sys/hoon/map.hoon
View File

@ -670,10 +670,6 @@
;: weld
:: +uno:by arm test
::
:: Checks with empty map (a or b)
::
%- expect-fail
|. ((~(uno by m-nul) m-des) union-gate)
%+ expect-eq
!> m-des
!> ((~(uno by m-des) m-nul) union-gate)

321
pkg/arvo/tests/sys/vane/ames.hoon
View File

@ -1,10 +1,16 @@
/+ *test
/= ames /sys/vane/ames
/= jael /sys/vane/jael
:: construct some test fixtures
::
=/ nec (ames ~nec)
=/ bud (ames ~bud)
=/ comet (ames ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud)
=/ nec (ames ~nec)
=/ bud (ames ~bud)
=/ marbud (ames ~marbud)
::
=/ our-comet ~bosrym-podwyl-magnes-dacrys--pander-hablep-masrym-marbud
=/ our-comet2 ~togdut-rosled-fadlev-siddys--botmun-wictev-sapfus-marbud
=/ comet (ames our-comet)
=/ comet2 (ames our-comet2)
::
=. now.nec ~1111.1.1
=. eny.nec 0xdead.beef
@ -22,8 +28,17 @@
=/ bud-pub pub:ex:crypto-core.ames-state.bud
=/ bud-sec sec:ex:crypto-core.ames-state.bud
::
=. now.marbud ~1111.1.1
=. eny.marbud 0xbeef.beef
=. life.ames-state.marbud 4
=. rof.marbud |=(* ``[%noun !>(*(list turf))])
=. crypto-core.ames-state.marbud (pit:nu:crub:crypto 512 (shaz 'marbud'))
=/ marbud-pub pub:ex:crypto-core.ames-state.marbud
=/ marbud-sec sec:ex:crypto-core.ames-state.marbud
::
=. now.comet ~1111.1.1
=. eny.comet 0xbeef.cafe
=. life.ames-state.comet 1
=. rof.comet |=(* ``[%noun !>(*(list turf))])
=. crypto-core.ames-state.comet
%- nol:nu:crub:crypto
@ -31,12 +46,25 @@
3q3td.T4UF0.d5sDL.JGpZq.S3A92.QUuWg.IHdw7.izyny.j9W92
=/ comet-pub pub:ex:crypto-core.ames-state.comet
=/ comet-sec sec:ex:crypto-core.ames-state.comet
::
=. now.comet2 ~1111.1.1
=. eny.comet2 0xcafe.cafe
=. life.ames-state.comet2 1
=. rof.comet2 |=(* ``[%noun !>(*(list turf))])
=. crypto-core.ames-state.comet2 (pit:nu:crub:crypto 512 0v1eb4)
=/ comet2-pub pub:ex:crypto-core.ames-state.comet2
=/ comet2-sec sec:ex:crypto-core.ames-state.comet2
::
=/ nec-sym (derive-symmetric-key:ames bud-pub nec-sec)
=/ bud-sym (derive-symmetric-key:ames nec-pub bud-sec)
?> =(nec-sym bud-sym)
=/ nec-marbud-sym (derive-symmetric-key:ames marbud-pub nec-sec)
::
=/ comet-sym (derive-symmetric-key:ames bud-pub comet-sec)
=/ marbud-sym (derive-symmetric-key:ames marbud-pub comet-sec)
=/ marbud2-sym (derive-symmetric-key:ames marbud-pub comet2-sec)
=/ bud-marbud-sym (derive-symmetric-key:ames bud-pub marbud-sec)
::
=/ comet-sym (derive-symmetric-key:ames bud-pub comet-sec)
::
=. peers.ames-state.nec
%+ ~(put by peers.ames-state.nec) ~bud
@ -44,29 +72,95 @@
=. -.peer-state
:* symmetric-key=bud-sym
life=3
rift=0
public-key=bud-pub
sponsor=~nec
==
=. route.peer-state `[direct=%.y `lane:ames`[%& ~nec]]
[%known peer-state]
::
=. peers.ames-state.nec
%+ ~(put by peers.ames-state.nec) ~marbud
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=nec-marbud-sym
life=5
rift=0
public-key=marbud-pub
sponsor=~bud
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
::
=. peers.ames-state.bud
%+ ~(put by peers.ames-state.bud) ~nec
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=nec-sym
life=2
rift=0
public-key=nec-pub
sponsor=~nec
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
::
=. peers.ames-state.comet
%+ ~(put by peers.ames-state.comet) ~marbud
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=marbud-sym
life=5
rift=0
public-key=marbud-pub
sponsor=~bud
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
=. peers.ames-state.comet
%+ ~(put by peers.ames-state.comet) ~bud
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=bud-marbud-sym
life=3
rift=0
public-key=bud-pub
sponsor=~bud
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
=. peers.ames-state.comet2
%+ ~(put by peers.ames-state.comet2) ~marbud
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=marbud2-sym
life=5
rift=0
public-key=marbud-pub
sponsor=~bud
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
=. peers.ames-state.comet2
%+ ~(put by peers.ames-state.comet2) ~bud
=| =peer-state:ames
=. -.peer-state
:* symmetric-key=bud-marbud-sym
life=3
rift=0
public-key=bud-pub
sponsor=~bud
==
=. route.peer-state `[direct=%.y `lane:ames`[%| `@`%lane-bar]]
[%known peer-state]
:: metamorphose
::
=> .(nec +:(call:(nec) ~[//unix] ~ %born ~))
=> .(bud +:(call:(bud) ~[//unix] ~ %born ~))
=> .(comet +:(call:(comet) ~[//unix] ~ %born ~))
=> .(comet2 +:(call:(comet2) ~[//unix] ~ %born ~))
:: helper core
::
::
=>
|%
++ move-to-packet
@ -195,7 +289,7 @@
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
=^ moves2 bud
=/ =point:ames
:* rift=1
:* rift=0
life=4
keys=[[life=4 [crypto-suite=1 `@`nec-pub]] ~ ~]
sponsor=`~bus
@ -213,7 +307,7 @@
::
%+ expect-eq
!> %- sy
:~ :^ ~[//unix] %pass /bone/~bus/1
:~ :^ ~[//unix] %pass /bone/~bus/0/1
[%g %plea ~bus %g /talk [%first %post]]
::
:^ ~[//unix] %pass /qos
@ -222,57 +316,6 @@
!> (sy ,.moves3)
==
::
++ test-comet-encounter ^- tang
::
=/ lane-foo=lane:ames [%| `@ux``@`%lane-foo]
::
=/ =open-packet:ames
:* public-key=`@`comet-pub
sndr=our.comet
sndr-life=1
rcvr=~bud
rcvr-life=3
==
=/ packet
~! ames
(encode-open-packet:ames open-packet crypto-core.ames-state.comet)
=/ blob (encode-packet:ames packet)
::
=^ moves0 bud (call bud ~[//unix] %hear lane-foo blob)
::
=/ =plea:ames [%g /talk [%first %post]]
=/ =shut-packet:ames
:* bone=1
message-num=1
[%& num-fragments=1 fragment-num=0 (jam plea)]
==
=/ =packet:ames
%: encode-shut-packet:ames
shut-packet
comet-sym
our.comet
~bud
sndr-life=1
rcvr-life=3
==
=/ blob (encode-packet:ames packet)
=^ moves1 bud (call bud ~[//unix] %hear lane-foo blob)
::
;: weld
%+ expect-eq
!> ~
!> moves0
::
%+ expect-eq
!> :~ :* ~[//unix] %pass /qos %d %flog %text
"; {<our.comet>} is your neighbor"
==
:* ~[//unix] %pass /bone/(scot %p our.comet)/1
%g %plea our.comet plea
== ==
!> moves1
==
::
++ test-message-flow ^- tang
:: ~nec -> %plea -> ~bud
::
@ -280,11 +323,11 @@
=^ moves2 bud (call bud ~[//unix] %hear (snag-packet 0 moves1))
:: ~bud -> %done -> ~nec
::
=^ moves3 bud (take bud /bone/~nec/1 ~[//unix] %g %done ~)
=^ moves3 bud (take bud /bone/~nec/0/1 ~[//unix] %g %done ~)
=^ moves4 nec (call nec ~[//unix] %hear (snag-packet 0 moves3))
:: ~bud -> %boon -> ~nec
::
=^ moves5 bud (take bud /bone/~nec/1 ~[//unix] %g %boon [%post 'first1!!'])
=^ moves5 bud (take bud /bone/~nec/0/1 ~[//unix] %g %boon [%post 'first1'])
=^ moves6 nec (call nec ~[//unix] %hear (snag-packet 0 moves5))
:: ~nec -> %done -> ~bud (just make sure ~bud doesn't crash on ack)
::
@ -293,7 +336,8 @@
;: weld
%+ expect-eq
!> :~ [~[//unix] %pass /qos %d %flog %text "; ~nec is your neighbor"]
[~[//unix] %pass /bone/~nec/1 %g %plea ~nec %g /talk [%get %post]]
:^ ~[//unix] %pass /bone/~nec/0/1
[%g %plea ~nec %g /talk [%get %post]]
==
!> moves2
::
@ -306,10 +350,82 @@
!> (sy ,.moves4)
::
%+ expect-eq
!> [~[/g/talk] %give %boon [%post 'first1!!']]
!> [~[/g/talk] %give %boon [%post 'first1']]
!> (snag 0 `(list move:ames)`moves6)
==
::
++ test-comet-message-flow ^- tang
:: same as test-message-flow, but ~nec will send a sendkeys packet to request
:: comet's self-attestation directly
::
=^ moves0 nec (call nec ~[/g/talk] %plea our-comet %g /talk [%get %post])
=^ moves1 comet (call comet ~[//unix] %hear (snag-packet 0 moves0))
=^ moves2 comet
=/ =point:ames
:* rift=1
life=2
keys=[[life=2 [crypto-suite=1 `@`nec-pub]] ~ ~]
sponsor=`~nec
==
%- take
:^ comet /public-keys ~[//unix]
^- sign:ames
[%jael %public-keys %full [n=[~nec point] ~ ~]]
:: give comet's self-attestation to ~nec; at this point, we have established
:: a channel, and can proceed as usual
::
=^ moves3 nec (call nec ~[//unix] %hear (snag-packet 0 moves2))
=^ moves4 comet (call comet ~[//unix] %hear (snag-packet 0 moves3))
=^ moves5 comet (take comet /bone/~nec/0/1 ~[//unix] %g %done ~)
=^ moves6 nec (call nec ~[//unix] %hear (snag-packet 0 moves5))
=^ moves7 comet (take comet /bone/~nec/0/1 ~[//unix] %g %boon [%post 'first1!!'])
=^ moves8 nec (call nec ~[//unix] %hear (snag-packet 0 moves7))
::
;: weld
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; ~nec is your neighbor"]
!> (snag 0 `(list move:ames)`moves4)
::
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; {<our-comet>} is your neighbor"]
!> (snag 0 `(list move:ames)`moves6)
::
%+ expect-eq
!> [~[/g/talk] %give %boon [%post 'first1!!']]
!> (snag 0 `(list move:ames)`moves8)
==
::
++ test-comet-comet-message-flow ^- tang
:: same as test-message-flow, but the comets need to exchange
:: self-attestations to establish a channel
::
=^ moves0 comet (call comet ~[/g/talk] %plea our-comet2 %g /talk [%get %post])
=^ moves1 comet2 (call comet2 ~[//unix] %hear (snag-packet 0 moves0))
=^ moves2 comet (call comet ~[//unix] %hear (snag-packet 0 moves1))
:: channel is now established; comet also emitted a duplicate
:: self-attestation, which we ignore
::
=^ moves3 comet2 (call comet2 ~[//unix] %hear (snag-packet 0 moves2))
=^ moves4 comet2 (call comet2 ~[//unix] %hear (snag-packet 1 moves2))
=^ moves5 comet2 (take comet2 /bone/(scot %p our-comet)/0/1 ~[//unix] %g %done ~)
=^ moves6 comet2 (take comet2 /bone/(scot %p our-comet)/0/1 ~[//unix] %g %boon [%post 'first1!!'])
=^ moves7 comet (call comet ~[//unix] %hear (snag-packet 0 moves5))
=^ moves8 comet (call comet ~[//unix] %hear (snag-packet 0 moves6))
::
;: weld
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; {<our-comet>} is your neighbor"]
!> (snag 0 `(list move:ames)`moves4)
::
%+ expect-eq
!> [~[//unix] %pass /qos %d %flog %text "; {<our-comet2>} is your neighbor"]
!> (snag 0 `(list move:ames)`moves7)
::
%+ expect-eq
!> [~[/g/talk] %give %boon [%post 'first1!!']]
!> (snag 0 `(list move:ames)`moves8)
==
::
++ test-nack ^- tang
:: ~nec -> %plea -> ~bud
::
@ -318,7 +434,7 @@
:: ~bud -> nack -> ~nec
::
=/ =error:ames [%flub [%leaf "sinusoidal repleneration"]~]
=^ moves3 bud (take bud /bone/~nec/1 ~[/bud] %g %done `error)
=^ moves3 bud (take bud /bone/~nec/0/1 ~[/bud] %g %done `error)
=^ moves4 nec (call nec ~[//unix] %hear (snag-packet 0 moves3))
:: ~bud -> nack-trace -> ~nec
::
@ -330,4 +446,81 @@
%+ expect-eq
!> [~[/g/talk] %give %done `error]
!> (snag 1 `(list move:ames)`moves5)
::
++ test-old-ames-wire ^- tang
=^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~)
=^ moves1 nec (call nec ~[/g/talk] %plea ~bud %g /talk [%get %post])
=^ moves2 bud (call bud ~[//unix] %hear (snag-packet 0 moves1))
=^ moves3 bud (take bud /bone/~nec/1 ~[//unix] %g %done ~)
%+ expect-eq
!> 1
!> (lent `(list move:ames)`moves3)
::
++ test-dangling-bone ^- tang
=^ moves0 bud (call bud ~[/g/hood] %spew [%odd]~)
:: ~nec -> %plea -> ~bud
::
=^ moves1 nec (call nec ~[/g/talk] %plea ~bud %g /talk [%get %post])
=^ moves2 bud (call bud ~[//unix] %hear (snag-packet 0 moves1))
:: ~bud receives a gift from %jael with ~nec's new rift
::
=^ moves3 bud
%- take
:^ bud /public-keys ~[//unix]
^- sign:ames
[%jael %public-keys %diff who=~nec %rift from=0 to=1]
:: %gall has a pending wire with the old rift, so sending a gift to
:: %ames on it will drop that request, not producing any moves
::
=^ moves3 bud (take bud /bone/~nec/0/1 ~[//unix] %g %done ~)
::
%+ expect-eq
!> ~
!> (sy ,.moves3)
::
++ test-ames-flow-with-new-rift ^- tang
:: ~nec receives a gift from %jael with ~bud's new rift
::
=^ moves1 nec
%- take
:^ nec /public-keys ~[//unix]
^- sign:ames
[%jael %public-keys %diff who=~bud %rift from=0 to=1]
:: now we try a normal message flow using the new rift in the wire
:: ~nec -> %plea -> ~bud
::
=^ moves2 nec (call nec ~[/g/talk] %plea ~bud %g /talk [%get %post])
=^ moves3 bud (call bud ~[//unix] %hear (snag-packet 0 moves2))
:: ~bud -> %done -> ~nec
::
=^ moves4 bud (take bud /bone/~nec/1/1 ~[//unix] %g %done ~)
=^ moves5 nec (call nec ~[//unix] %hear (snag-packet 0 moves4))
:: ~bud -> %boon -> ~nec
::
=^ moves6 bud (take bud /bone/~nec/1/1 ~[//unix] %g %boon [%post '¡hola!'])
=^ moves7 nec (call nec ~[//unix] %hear (snag-packet 0 moves6))
:: ~nec -> %done -> ~bud (just make sure ~bud doesn't crash on ack)
::
=^ moves8 bud (call bud ~[//unix] %hear (snag-packet 0 moves7))
::
;: weld
%+ expect-eq
!> :~ [~[//unix] %pass /qos %d %flog %text "; ~nec is your neighbor"]
:^ ~[//unix] %pass /bone/~nec/0/1
[%g %plea ~nec %g /talk [%get %post]]
==
!> moves3
::
%+ expect-eq
!> %- sy
:~ [~[/ames] %pass /pump/~bud/0 %b %rest ~1111.1.1..00.00.03]
[~[//unix] %pass /qos %d %flog %text "; ~bud is your neighbor"]
[~[/g/talk] %give %done error=~]
==
!> (sy ,.moves5)
::
%+ expect-eq
!> [~[/g/talk] %give %boon [%post '¡hola!']]
!> (snag 0 `(list move:ames)`moves7)
==
--

114
pkg/arvo/tests/sys/vane/clay.hoon
View File

@ -18,6 +18,18 @@
=/ clay-gate (clay-raw ~nul)
=/ fusion fusion:clay-gate
::
=> |%
++ leak-to-deps
|= =leak:fusion
^- (set mist:fusion)
%- sy
|- ^- (list mist:fusion)
%- zing
%+ turn ~(tap in deps.leak)
|= l=leak:fusion
:- (pour-to-mist:fusion pour.l)
^$(leak l)
--
|%
++ test-parse-pile ^- tang
=/ src "."
@ -85,11 +97,11 @@
|.
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes=(my [/lib/self/hoon &+hoon+source]~)
files=(my [/lib/self/hoon &+hoon+source]~)
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
(build-file:ford /lib/self/hoon)
::
@ -100,29 +112,28 @@
++ test-mar-mime ^- tang
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes=(my [/mar/mime/hoon &+hoon+mar-mime]~)
files=(my [/mar/mime/hoon &+hoon+mar-mime]~)
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-nave:ford %mime)
=/ =leak:fusion leak:(~(got by sprig.nub) file+/mar/mime/hoon)
;: weld
%+ expect-eq
!>(*mime)
(slap res !,(*hoon *vale))
::
%+ expect-eq
!> (~(gas in *(set [? path])) |^/mar/mime/hoon ~)
!> dez:(~(got by files.cache.nub) /mar/mime/hoon)
!> (~(gas in *(set mist:fusion)) vale+/mar/mime/hoon ~)
!> (leak-to-deps leak)
==
::
++ test-mar-udon ^- tang
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
^= changes
^= files
%- my
:~ [/mar/udon/hoon &+hoon+mar-udon]
[/lib/cram/hoon &+hoon+lib-cram]
@ -130,32 +141,39 @@
[/mar/txt-diff/hoon &+hoon+mar-txt-diff]
==
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-nave:ford %udon)
=/ =leak:fusion leak:(~(got by sprig.nub) file+/mar/udon/hoon)
;: weld
%+ expect-eq
!>(*@t)
(slap res !,(*hoon *vale))
::
%+ expect-eq
!> (~(gas in *(set [? path])) |^/mar/udon/hoon |^/lib/cram/hoon ~)
!> dez:(~(got by files.cache.nub) /mar/udon/hoon)
!> %- ~(gas in *(set mist:fusion))
:~ vale+/mar/udon/hoon
vale+/lib/cram/hoon
file+/lib/cram/hoon
==
!> (leak-to-deps leak)
==
::
++ test-cast-html-mime ^- tang
=/ changes
=/ files
%- my
:~ [/mar/mime/hoon &+hoon+mar-mime]
[/mar/html/hoon &+hoon+mar-html]
==
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes
files
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-cast:ford %html %mime)
%+ expect-eq
@ -163,18 +181,18 @@
!> `mime`[/text/html 13 '<html></html>']
::
++ test-fascen ^- tang
=/ changes
=/ files
%- my
:~ [/mar/mime/hoon &+hoon+mar-mime]
[/lib/foo/hoon &+hoon+'/% moo %mime\0a*vale:moo']
==
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes
files
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/foo/hoon)
%+ expect-eq
@ -182,7 +200,7 @@
!> *mime
::
++ test-fasbuc ^- tang
=/ changes
=/ files
%- my
:~ [/mar/mime/hoon &+hoon+mar-mime]
[/mar/html/hoon &+hoon+mar-html]
@ -190,11 +208,11 @@
==
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes
files
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/foo/hoon)
%+ expect-eq
@ -204,49 +222,53 @@
++ test-gen-hello ^- tang
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
changes=(my [/gen/hello/hoon &+hoon+gen-hello]~)
files=(my [/gen/hello/hoon &+hoon+gen-hello]~)
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-file:ford /gen/hello/hoon)
=/ =leak:fusion leak:(~(got by sprig.nub) file+/gen/hello/hoon)
;: weld
%+ expect-eq
!> noun+'hello, bob'
(slap res (ream '(+ [*^ [%bob ~] ~])'))
::
%+ expect-eq
!> (~(gas in *(set [? path])) |^/gen/hello/hoon ~)
!> dez:(~(got by files.cache.nub) /gen/hello/hoon)
!> (~(gas in *(set mist:fusion)) vale+/gen/hello/hoon ~)
!> (leak-to-deps leak)
==
::
++ test-lib-strandio ^- tang
=/ ford
%: ford:fusion
*ankh:clay
deletes=~
^= changes
^= files
%- my
:~ [/lib/strand/hoon &+hoon+lib-strand]
[/lib/strandio/hoon &+hoon+lib-strandio]
[/sur/spider/hoon &+hoon+sur-spider]
==
file-store=~
*ford-cache:fusion
0
*flow:fusion
*flue:fusion
==
=/ [res=vase nub=state:ford:fusion] (build-file:ford /lib/strandio/hoon)
=/ =leak:fusion leak:(~(got by sprig.nub) file+/lib/strandio/hoon)
;: weld
%- expect
!>((slab %read %get-our -.res))
::
%+ expect-eq
!> %- ~(gas in *(set [? path]))
:~ [| /lib/strandio/hoon]
[| /lib/strand/hoon]
[| /sur/spider/hoon]
!> %- ~(gas in *(set mist:fusion))
:~ vale+/lib/strandio/hoon
file+/lib/strand/hoon
vale+/lib/strand/hoon
file+/sur/spider/hoon
vale+/sur/spider/hoon
==
!> dez:(~(got by files.cache.nub) /lib/strandio/hoon)
!> (leak-to-deps leak)
==
::
:: |utilities: helper functions for testing

2
pkg/arvo/tests/sys/vane/eyre.hoon
View File

@ -663,7 +663,7 @@
eyre-gate
now=~1111.1.2
scry=scry-provides-code
call-args=[duct=~[/gen1] ~ [%serve [~ /] [%home /gen/handler/hoon ~]]]
call-args=[duct=~[/gen1] ~ [%serve [~ /] [%base /gen/handler/hoon ~]]]
expected-moves=[duct=~[/gen1] %give %bound %.y [~ /]]~
==
:: outside requests a path that app1 has bound to

476
pkg/arvo/tests/sys/vane/khan.hoon Normal file
View File

@ -0,0 +1,476 @@
:: remaining cases to test:
:: call dud
:: take dud
:: TODO when can dud happen?
::
/+ *test
/= khan-raw /sys/vane/khan
=/ khan-gate (khan-raw ~nul)
|%
++ test-khan-fyrd-start-args
=^ born-moves khan-gate
%- khan-call :*
khan-gate
now=~1162.1.1
scry=scry-provides-mark
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
==
=/ results-0 (expect-eq !>(~) !>(born-moves))
=/ fyrd=(fyrd:khan cast:khan) [%base %nonexistent %noun %noun ~]
=/ now=@da (add ~1162.1.1 ~s1)
=^ start-moves khan-gate
%- khan-call :*
khan-gate
now
scry=scry-provides-mark
^= call-args
:* duct=~[//khan/1/0vsome.ductt] ~
%fyrd fyrd
== ==
=/ results-1 (expect !>(=(1 (lent start-moves))))
=/ mev (head start-moves)
=/ results-2
%+ expect-eq
!> ~[//khan/1/0vsome.ductt]
!> p.mev
?> ?=(%pass -.q.mev)
=/ results-3
%+ expect-eq
!> /fyrd/~nul/base/~1162.1.1..00.00.01/noun
!> wire.q.mev
=/ results-4 (expect-eq !>(%k) !>(-.note.q.mev))
?> ?=(%fard +<.note.q.mev)
=/ fad p.note.q.mev
;: weld
results-0 results-1 results-2
results-3 results-4
(expect-eq !>(%base) !>(bear.fad))
(expect-eq !>(%nonexistent) !>(name.fad))
(expect-eq !>(%noun) !>(p.args.fad))
(expect-eq !>(`~) q.args.fad)
==
++ test-khan-fard-start-args
=^ born-moves khan-gate
%- khan-call :*
khan-gate
now=~1162.1.1
scry=scry-provides-mark
call-args=[duct=~[/initial-born-duct] ~ [%born ~]]
==
=/ fard=(fyrd:khan cage) [%base %nonexistent %noun !>(~)]
=/ now=@da (add ~1162.1.1 ~s1)
=^ start-moves khan-gate
%- khan-call :*
khan-gate
now
scry=scry-provides-mark
^= call-args
:* duct=~[//khan/1/0vthat.ductt] ~
%fard fard
== ==
=/ results-0 (expect !>(=(2 (lent start-moves))))
:: XX overspecified
::
=/ expected-tid (cat 3 'khan-fyrd--' (scot %uv (sham 0xdead.beef)))
=/ results-1
%+ expect-eq
!> :* ~[//khan/1/0vthat.ductt]
%pass //g %g %deal
[~nul ~nul] %spider %watch
/thread-result/[expected-tid]
==
!> (head start-moves)
=/ mev (rear start-moves)
=/ results-2 (expect-eq !>(~[//khan/1/0vthat.ductt]) !>(p.mev))
?> ?=(%pass -.q.mev)
=/ results-3 (expect-eq !>(//g) !>(wire.q.mev))
=* not note.q.mev
=/ results-4 (expect-eq !>(%g) !>(-.not))
?> ?=(%deal +<.not)
=/ results-5 (expect-eq !>([~nul ~nul]) !>(p.not))
=/ results-6 (expect-eq !>(%spider) !>(q.not))
?> ?=(%poke -.r.not)
=* cag cage.r.not
?> ?=(%spider-start p.cag)
=/ rag
:: XX $start-args in %/app/spider/hoon
::
!< [p=(unit @ta) q=(unit @ta) r=beak s=term t=vase]
q.cag
=/ results-7
%+ expect-eq
!> :* ~ `expected-tid
[~nul %base %da now] %nonexistent ~
==
!>(rag(t ~))
=/ results-8 (expect-eq !>(~) t.rag)
;: weld
results-0 results-1 results-2
results-3 results-4 results-5
results-6 results-7 results-8
==
++ test-khan-take-full-run-fard
=^ born-moves khan-gate
%- khan-call :*
khan-gate
now=~1162.1.1
scry=scry-provides-mark
call-args=[duct=~[/a] ~ [%born ~]]
==
=/ results-0 (expect-eq !>(~) !>(born-moves))
=/ fard=(fyrd:khan cage) [%base %fake %noun !>(~)]
=^ start-moves khan-gate
%- khan-call :*
khan-gate
now=(add ~1162.1.1 ~s1)
scry=scry-provides-mark
^= call-args
:* duct=~[//khan/2/0v0] ~
%fard fard
== ==
=^ take-moves khan-gate
%- khan-take-all :*
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
:~ [//g ~[//khan/2/0v0] ~ %gall %unto %watch-ack ~]
[//g ~[//khan/2/0v0] ~ %gall %unto %poke-ack ~]
[//g ~[//khan/2/0v0] ~ %gall %unto %fact %thread-done !>(%res)]
[//g ~[//khan/2/0v0] ~ %gall %unto %kick ~]
==
==
=/ results-1
%- expect !>(=(1 (lent take-moves)))
=/ results-2
%+ expect-eq
!>([~[//khan/2/0v0] %give %arow %& %noun !>(%res)])
!>((head take-moves))
:(weld results-0 results-1 results-2)
++ test-khan-multi-fard
=^ born-moves khan-gate
%- khan-call :*
khan-gate
now=~1162.1.1
scry=scry-provides-mark
call-args=[duct=~[/a] ~ [%born ~]]
==
=/ fard=(fyrd:khan cage) [%base %fake %noun !>(~)]
=/ khan-call-args :*
now=(add ~1162.1.1 ~s1)
scry=scry-provides-mark
^= call-args :*
duct=~[//khan/2/0va] ~ %fard fard
==
==
=^ start-1-moves khan-gate
%- khan-call :*
khan-gate
khan-call-args
==
=^ start-2-moves khan-gate
%- khan-call :*
khan-gate
khan-call-args
==
=/ results-1
%+ expect-spider-start-tid
'khan-fyrd--0vir6kv.ci3nm.a8rcs.kua3e.9sp7o'
start-1-moves
=/ results-2
%+ expect-spider-start-tid
'khan-fyrd--0v4.la9d1.uc5cu.ngv3f.pbo8a.mlc5f'
start-2-moves
(weld results-1 results-2)
++ test-khan-take-full-run-fyrd
=^ born-moves khan-gate
%- khan-call :*
khan-gate
now=~1162.1.1
scry=scry-provides-mark
call-args=[duct=~[/a] ~ [%born ~]]
==
=^ fyrd-moves khan-gate
%- khan-call :*
khan-gate
now=(add ~1162.1.1 ~s1)
scry=scry-provides-mark
^= call-args
duct=~[//khan/0v0/1/0v2] ~
%fyrd [%base %fake %noun %noun ~]
==
=/ results-0 (expect !>(=(1 (lent fyrd-moves))))
=/ fard-move (head fyrd-moves)
?> ?=(%pass -.q.fard-move)
?> ?=(%k -.note.q.fard-move)
=* wir wire.q.fard-move
:: XX may erroneously break if %khan keeps state dependent on
:: its inner %fard.
::
=^ arow-moves khan-gate
%- khan-take :*
khan-gate
now=(add ~1162.1.1 ~s3)
scry=scry-provides-mark
^= take-args
wire=wir
duct=~[//khan/0v0/1/0v2]
dud=~
[%khan %arow %& %noun !>(%res)]
==
=/ results-1 (expect !>(=(1 (lent arow-moves))))
=/ row (head arow-moves)
=/ results-2
%+ expect-eq
!>(~[//khan/0v0/1/0v2])
!>(p.row)
=/ results-3
%+ expect-eq
!>([%give %avow %& %noun %res])
!>(q.row)
:(weld results-0 results-1 results-2 results-3)
++ test-khan-fard-watch-ack-fail
=^ born-moves khan-gate
%- khan-call-all :*
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
:~ [~[/a] ~ %born ~]
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
==
==
=^ watch-ack-moves khan-gate
%- khan-take :*
khan-gate now=~1162.1.2 scry=scry-provides-mark
^= take-args
//g ~[//khan/0v0/1/0v0] ~
%gall %unto %watch-ack `~['fail']
==
=/ results-0 (expect !>(=(1 (lent watch-ack-moves))))
=/ mev (head watch-ack-moves)
=/ results-1
%+ expect-eq
!>([~[//khan/0v0/1/0v0] %give %arow %| %watch-ack ~['fail']])
!>(mev)
(weld results-0 results-1)
++ test-khan-fard-poke-ack-fail
=^ call-moves khan-gate
%- khan-call-all :*
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
:~ [~[/a] ~ %born ~]
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
==
==
=^ take-moves khan-gate
%- khan-take-all :*
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
:~ [//g ~[//khan/0v0/1/0v0] ~ %gall %unto %watch-ack ~]
:* //g ~[//khan/0v0/1/0v0] ~
%gall %unto %poke-ack `~['fail']
==
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %kick ~]
==
==
=/ results-0 (expect !>(=(1 (lent take-moves))))
=/ mev (head take-moves)
=/ results-1
%+ expect-eq
!>([~[//khan/0v0/1/0v0] %give %arow %| %poke-ack ~['fail']])
!>(mev)
(weld results-0 results-1)
++ test-khan-fard-thread-fail
=^ call-moves khan-gate
%- khan-call-all :*
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
:~ [~[/a] ~ %born ~]
[~[//khan/0v0/1/0v0] ~ %fard %base %hi %noun %noun ~]
==
==
=^ take-moves khan-gate
%- khan-take-all :*
khan-gate now=~1162.1.2 sep=~s1 scry=scry-provides-mark
:~ [//g ~[//khan/0v0/1/0v0] ~ %gall %unto %watch-ack ~]
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %poke-ack ~]
:* //g ~[//khan/0v0/1/0v0] ~
%gall %unto %fact %thread-fail
!>([%woops ~['fail']])
==
[//g ~[//khan/0v0/1/0v0] ~ %gall %unto %kick ~]
==
==
=/ results-0 (expect !>(=(1 (lent take-moves))))
=/ mev (head take-moves)
=/ results-1
%+ expect-eq
!> :* ~[//khan/0v0/1/0v0] %give
%arow %| %thread-fail ~['woops' 'fail']
==
!>(mev)
(weld results-0 results-1)
++ test-khan-fyrd-arow-fail
=^ call-moves khan-gate
%- khan-call-all :*
khan-gate now=~1162.1.1 sep=~s1 scry=scry-provides-mark
:~ [~[/a] ~ %born ~]
[~[//khan/0v0/1/0v0] ~ %fyrd %base %a %noun %noun ~]
==
==
=/ results-0 (expect !>(=(1 (lent call-moves))))
=/ fard-move (head call-moves)
?> ?=(%pass -.q.fard-move)
=* wir wire.q.fard-move
=^ arow-moves khan-gate
%- khan-take :*
khan-gate now=~1162.1.2 scry=scry-provides-mark
^= take-args
wir ~[//khan/0v0/1/0v0] ~
%khan %arow %| %watch-ack ~['fail']
==
=/ results-1 (expect !>(=(1 (lent arow-moves))))
=/ mev (head arow-moves)
=/ results-2
%+ expect-eq
!>([~[//khan/0v0/1/0v0] %give %avow %| %watch-ack ~['fail']])
!>(mev)
:(weld results-0 results-1 results-2)
++ test-khan-fyrd-no-input-mark
=^ born-moves khan-gate
%- khan-call :*
khan-gate
~1162.1.1
scry-provides-mark
~[/a] ~ %born ~
==
%- expect-fail
|.
%- khan-call :*
khan-gate
(add ~1162.1.1 ~s1)
scry-provides-mark
~[//khan/0v0/1/0v0] ~
%fyrd %base %a %noun %bad-mark ~
==
++ test-khan-fyrd-no-output-mark
=^ call-moves khan-gate
%- khan-call-all :*
khan-gate ~1162.1.1 ~s1 scry-provides-mark
:~ [~[/a] ~ %born ~]
[~[//khan/0v0/1/0v0] ~ %fyrd %base %a %bad-mark %noun ~]
==
==
%- expect-fail
|.
%- khan-take :*
khan-gate
~1162.1.2
scry-provides-mark
/fyrd/~nul/base/da/~1162.1.1..00.00.01/bad-mark
~[//khan/0v0/1/0v0] ~
[%khan %arow %& %noun !>(~)]
==
++ expect-spider-start-tid
|= [tid=@ta mev=(list move:khan-gate)]
?> ?=([^ ^ ~] mev)
=* watch-move i.mev
=* start-move i.t.mev
?> ?=([* %pass * %g %deal * %spider %watch *] watch-move)
=/ results-1
%+ expect-eq
!>(/thread-result/[tid])
!>(path.r.note.q.watch-move)
?> ?=([* %pass * %g %deal * %spider %poke %spider-start *] start-move)
=/ start-args
!< [p=(unit @ta) q=(unit @ta) r=beak s=term t=vase]
q.cage.r.note.q.start-move
=/ results-2
%+ expect-eq
!> `tid
!> q.start-args
(weld results-1 results-2)
++ khan-call
|= $: khan-gate=_khan-gate
now=@da
scry=roof
$= call-args
$: =duct
dud=(unit goof)
wrapped-task=(hobo task:khan)
== ==
^- [(list move:khan-gate) _khan-gate]
=/ khan-core
(khan-gate now eny=`@uvJ`0xdead.beef scry=scry)
(call:khan-core [duct dud wrapped-task]:call-args)
++ khan-call-all
|= $: khan-gate=_khan-gate
now=@da
sep=@dr
scry=roof
call-list=(list [p=duct q=(unit goof) r=(hobo task:khan)])
==
^- [(list move:khan-gate) _khan-gate]
=+ i=0
=/ mev=(list move:khan-gate) ~
|-
?~ call-list [mev khan-gate]
=^ mov khan-gate
%- khan-call :*
khan-gate
now=(add now (mul sep i))
scry=scry
call-args=i.call-list
==
$(i +(i), call-list t.call-list, mev (weld mev mov))
++ khan-take
|= $: khan-gate=_khan-gate
now=@da
scry=roof
$= take-args
$: =wire
=duct
dud=(unit goof)
=sign:khan-gate
== ==
^- [(list move:khan-gate) _khan-gate]
=/ khan-core
(khan-gate now eny=`@uvJ`0xdead.beef scry=scry)
(take:khan-core [wire duct dud sign]:take-args)
++ khan-take-all
|= $: khan-gate=_khan-gate
now=@da
sep=@dr
scry=roof
take-list=(list [p=wire q=duct r=(unit goof) s=sign:khan-gate])
==
^- [(list move:khan-gate) _khan-gate]
=+ i=0
=/ mev=(list move:khan-gate) ~
|-
?~ take-list [mev khan-gate]
=^ mov khan-gate
%- khan-take :*
khan-gate
now=(add now (mul sep i))
scry=scry
take-args=i.take-list
==
$(i +(i), take-list t.take-list, mev (weld mev mov))
++ dais-noun ^- dais:clay
|_ sam=vase
++ diff !!
++ form !!
++ join !!
++ mash !!
++ pact !!
++ vale |=(=noun !>(;;(^noun noun)))
--
++ tube-noun-noun ^- tube:clay
|= =vase
!>(!<(noun vase))
++ scry-provides-mark ^- roof
|= [gang =view =beam]
^- (unit (unit cage))
?: &(=(%cb view) =(/noun s.beam))
:^ ~ ~ %dais
!> ^- dais:clay
dais-noun
?: &(=(%cc view) =(/noun/noun s.beam))
:^ ~ ~ %tube
!> ^- tube:clay
tube-noun-noun
~
--

21
pkg/arvo/tests/sys/zuse/format.hoon
View File

@ -85,8 +85,8 @@
:: path)
::
++ test-beam
=/ b=beam [[p=~zod q=%home r=[%ud p=12]] s=/sys/zuse/hoon]
=/ p=path /~zod/home/12/sys/zuse/hoon
=/ b=beam [[p=~zod q=%base r=[%ud p=12]] s=/sys/zuse/hoon]
=/ p=path /~zod/base/12/sys/zuse/hoon
;: weld
:: proper encode
::
@ -107,12 +107,12 @@
::
%+ expect-eq
!> ~
!> (de-beam /~zod/home)
!> (de-beam /~zod/base)
:: invalid ship
::
%+ expect-eq
!> ~
!> (de-beam /'~zodisok'/home/12/sys/zuse/hoon)
!> (de-beam /'~zodisok'/base/12/sys/zuse/hoon)
:: invalid desk
::
%+ expect-eq
@ -122,7 +122,7 @@
::
%+ expect-eq
!> ~
!> (de-beam /~zod/home/~zod/sys/zuse/hoon)
!> (de-beam /~zod/base/~zod/sys/zuse/hoon)
==
:: example values used in test
::
@ -131,6 +131,7 @@
++ nul `json`~
++ tru `json`[%b &]
++ num `json`[%n ~.12]
++ neg `json`[%n '-3']
++ str `json`[%s 'hey']
++ frond `json`(frond:enjs 'foo' num)
++ obj `json`(pairs:enjs ~[['foo' num] ['bar' str]])
@ -228,6 +229,16 @@
!> (ni num:ex)
%- expect-fail
|. (ni tru:ex)
:: as @s
::
%+ expect-eq
!> -3
!> (ns neg:ex)
%+ expect-eq
!> --12
!> (ns num:ex)
%- expect-fail
|. (ns tru:ex)
:: as cord
::
%+ expect-eq

20
pkg/base-dev/lib/ethereum.hoon
View File

@ -948,6 +948,21 @@
%- prefix-hex
(render-hex-bytes 20 `@`a)
::
++ address-to-checksum
|= a=address
^- tape
=/ hexed (render-hex-bytes 20 `@`a)
=/ hash (keccak-256:keccak:crypto (as-octs:mimes:html (crip hexed)))
=| ret=tape
=/ pos 63
|-
?~ hexed (prefix-hex (flop ret))
=/ char i.hexed
?: (lth char 58) $(pos (dec pos), ret [char ret], hexed t.hexed)
=/ nib (cut 2 [pos 1] hash)
?: (lth 7 nib) $(pos (dec pos), ret [(sub char 32) ret], hexed t.hexed)
$(pos (dec pos), ret [char ret], hexed t.hexed)
::
++ transaction-to-hex
|= h=@
^- tape
@ -978,5 +993,8 @@
::
++ hex-to-num
|= a=@t
(rash (rsh [3 2] a) hex)
~| %non-hex-cord
?> =((end [3 2] a) '0x')
=< ?<(=(0 p) q) %- need
(de:base16:mimes:html (rsh [3 2] a))
--

16
pkg/base-dev/lib/ph/io.hoon
View File

@ -1,5 +1,5 @@
/- *aquarium, spider
/+ libstrand=strand, *strandio, util=ph-util
/+ libstrand=strand, *strandio, util=ph-util, aqua-azimuth
=, strand=strand:libstrand
|%
++ send-events
@ -127,7 +127,7 @@
;< ~ bind:m (send-azimuth-action %breach who)
|- ^- form:m
=* loop $
;< ~ bind:m (sleep ~s1)
;< ~ bind:m (sleep ~s10)
;< =bowl:spider bind:m get-bowl
=/ aqua-pax
:- %i
@ -137,6 +137,18 @@
(pure:m ~)
loop
::
++ init-moon ::NOTE real moon always have the same keys
|= [moon=ship fake=?]
?> ?=(%earl (clan:title moon))
?: fake (init-ship moon &)
=/ m (strand ,~)
^- form:m
;< ~ bind:m
%+ dojo (^sein:title moon)
=/ =pass pub:ex:(get-keys:aqua-azimuth moon 1)
"|moon {(scow %p moon)}, =public-key {(scow %uw pass)}"
(init-ship moon |)
::
++ init-ship
|= [=ship fake=?]
=/ m (strand ,~)

2
pkg/base-dev/lib/ph/util.hoon
View File

@ -59,7 +59,7 @@
::
:: Checks whether the given event is a dojo output blit containing the
:: given tape
::
::TODO should be rename -dill-output
++ is-dojo-output
|= [who=ship her=ship uf=unix-effect what=tape]
?& =(who her)

Some files were not shown because too many files have changed in this diff Show More