mirror of
https://github.com/urbit/shrub.git
synced 2024-12-28 06:32:51 +03:00
Merge branch 'next/arvo' into philip/tomb
This commit is contained in:
Philip Monk
commit
591bdf458c
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:ae4a7a69fe81c5f2114d7b7360c05602f614fe66b96d1db4c3dc0c2a2a5d856e
|
||||
size 7536000
|
||||
oid sha256:c4247c64a7d9fc0c0f1d2f017c21dd3464ddfe56529c7d6eef0e64554bd453e8
|
||||
size 7611162
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:f59ec4eaf907227a1fd64e1d54810b769b5d39f6811c6bb254b2e89de528ca04
|
||||
size 1209494
|
||||
oid sha256:dc76fbf64ab20512842c5c87e5302cd8a70141fe4b5a1e4ba086221f36e406a0
|
||||
size 1894727
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:e660fba934c5b80eeda64037a1f28c71eff4b2ea0bd28809b91432ca3d5ef08a
|
||||
size 23052691
|
||||
oid sha256:204056f6c140a8d5329f78e149a318bc85190d2aaab73204249d39a12d0353e0
|
||||
size 9296839
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:c27cdb47bccda98ba68556181cae6cd845c6daf8d7426d82adf67c1e8f532be9
|
||||
size 7454265
|
||||
oid sha256:187ea751a274dba7ed69df3a5b8f6f7ac620e3f9787abd75b18cf494d0c41f05
|
||||
size 11174099
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
version https://git-lfs.github.com/spec/v1
|
||||
oid sha256:be477486a9b803d8b8247c0dc321e3e3d2ace78c3a54588a17a0d4832f7f37ca
|
||||
size 9698663
|
||||
oid sha256:bf44b34c1cb5f70ab86a71b4ff87629282fc5438890e6d087bd05845b086a338
|
||||
size 25575266
|
||||
|
||||
@ -17,11 +17,10 @@
|
||||
:: :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
|
||||
|
||||
@ -93,6 +93,7 @@
|
||||
^- config:eth-watcher
|
||||
:* url.state =(%czar (clan:title our)) ~m5 ~m30
|
||||
launch:contracts:azimuth
|
||||
~
|
||||
~[azimuth:contracts:azimuth]
|
||||
~
|
||||
(topics whos.state)
|
||||
|
||||
@ -21,9 +21,10 @@
|
||||
=, jael
|
||||
|%
|
||||
+$ app-state
|
||||
$: %5
|
||||
$: %6
|
||||
url=@ta
|
||||
=net
|
||||
refresh=_~m5
|
||||
whos=(set ship)
|
||||
nas=^state:naive
|
||||
own=owners
|
||||
@ -42,9 +43,6 @@
|
||||
::
|
||||
+$ tagged-diff [=id:block diff:naive]
|
||||
+$ card card:agent:gall
|
||||
:: TODO: add to state?
|
||||
::
|
||||
++ refresh ~m5
|
||||
--
|
||||
::
|
||||
=| state=app-state
|
||||
@ -93,7 +91,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 +99,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 +115,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 +129,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 +172,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)
|
||||
@ -245,7 +253,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)
|
||||
==
|
||||
::
|
||||
@ -441,8 +449,9 @@
|
||||
=/ 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)
|
||||
|
||||
@ -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,56 @@
|
||||
==
|
||||
==
|
||||
::
|
||||
[cards-1 this(state ?>(?=(%5 -.old-state) old-state))]
|
||||
=? old-state ?=(%5 -.old-state)
|
||||
%- (slog leaf+"upgrading eth-watcher from %5" ~)
|
||||
^- app-state
|
||||
%= old-state
|
||||
- %6
|
||||
dogs
|
||||
%- ~(run by dogs.old-state)
|
||||
|= dog=watchdog-5
|
||||
^- watchdog
|
||||
%= dog
|
||||
-
|
||||
^- config
|
||||
=, -.dog
|
||||
[url eager refresh-rate refresh-rate 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
|
||||
@ -464,15 +512,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 +575,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))
|
||||
|
||||
@ -210,6 +210,7 @@
|
||||
refresh-rate
|
||||
timeout-time
|
||||
public:mainnet-contracts
|
||||
~
|
||||
~[azimuth delegated-sending]:mainnet-contracts
|
||||
~
|
||||
~
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -68,9 +68,6 @@
|
||||
running=(list yarn)
|
||||
tid=(map tid yarn)
|
||||
==
|
||||
::
|
||||
+$ start-args
|
||||
[parent=(unit tid) use=(unit tid) =beak file=term =vase]
|
||||
--
|
||||
::
|
||||
%- agent:dbug
|
||||
@ -170,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
|
||||
@ -269,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
|
||||
@ -572,7 +569,6 @@
|
||||
::
|
||||
++ yarn-to-byk
|
||||
|= [=yarn =bowl:gall]
|
||||
|
||||
=/ [* * =desk]
|
||||
~| "no desk associated with {<tid>}"
|
||||
%- ~(got by serving.state) (yarn-to-tid yarn)
|
||||
@ -590,5 +586,4 @@
|
||||
%cc
|
||||
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
|
||||
==
|
||||
|
||||
--
|
||||
|
||||
@ -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
|
||||
|
||||
23
pkg/arvo/gen/hood/story-init.hoon
Normal file
23
pkg/arvo/gen/hood/story-init.hoon
Normal 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
36
pkg/arvo/gen/hood/story-remove.hoon
Normal 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
34
pkg/arvo/gen/hood/story-write.hoon
Normal 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)]~]]
|
||||
@ -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
23
pkg/arvo/gen/story-list.hoon
Normal 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
154
pkg/arvo/gen/story-read.hoon
Normal 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)
|
||||
==
|
||||
--
|
||||
@ -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
|
||||
|
||||
@ -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 @))]
|
||||
|
||||
@ -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
|
||||
|
||||
1
pkg/arvo/lib/story.hoon
Symbolic link
1
pkg/arvo/lib/story.hoon
Symbolic link
@ -0,0 +1 @@
|
||||
../../base-dev/lib/story.hoon
|
||||
@ -1,8 +1,7 @@
|
||||
::
|
||||
:::: /hoon/pill/mar
|
||||
::
|
||||
/- aquarium
|
||||
=, aquarium
|
||||
/+ *pill
|
||||
=, mimes:html
|
||||
|_ pil=pill
|
||||
++ grow
|
||||
|
||||
1
pkg/arvo/mar/story.hoon
Symbolic link
1
pkg/arvo/mar/story.hoon
Symbolic link
@ -0,0 +1 @@
|
||||
../../base-dev/mar/story.hoon
|
||||
1
pkg/arvo/mar/thread-done.hoon
Symbolic link
1
pkg/arvo/mar/thread-done.hoon
Symbolic link
@ -0,0 +1 @@
|
||||
../../base-dev/mar/thread-done.hoon
|
||||
1
pkg/arvo/mar/thread-fail.hoon
Symbolic link
1
pkg/arvo/mar/thread-fail.hoon
Symbolic link
@ -0,0 +1 @@
|
||||
../../base-dev/mar/thread-fail.hoon
|
||||
@ -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]
|
||||
|
||||
@ -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
1
pkg/arvo/sur/story.hoon
Symbolic link
@ -0,0 +1 @@
|
||||
../../base-dev/sur/story.hoon
|
||||
@ -19,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
|
||||
@ -50,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)
|
||||
@ -87,7 +89,7 @@
|
||||
:: +wite: kernel action/error builder
|
||||
::
|
||||
+$ ball (wite [vane=term task=maze] maze)
|
||||
+$ card (cask)
|
||||
+$ card (pair @tas *)
|
||||
+$ duct (list wire)
|
||||
++ hobo
|
||||
|$ [a]
|
||||
@ -1721,6 +1723,7 @@
|
||||
%g %gall
|
||||
%i %iris
|
||||
%j %jael
|
||||
%k %khan
|
||||
==
|
||||
-- =>
|
||||
::
|
||||
|
||||
@ -264,8 +264,8 @@
|
||||
++ tail |*(^ ,:+<+) :: get tail
|
||||
++ test |=(^ =(+<- +<+)) :: equality
|
||||
::
|
||||
++ lead |*(* |*(* [+>+< +<])) :: put head
|
||||
++ late |*(* |*(* [+< +>+<])) :: put tail
|
||||
++ lead |*(* |*(* [+>+< +<])) :: put head
|
||||
++ late |*(* |*(* [+< +>+<])) :: put tail
|
||||
::
|
||||
:: # %containers
|
||||
::
|
||||
@ -8579,15 +8579,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
|
||||
@ -9059,7 +9051,7 @@
|
||||
::
|
||||
^- type
|
||||
~+
|
||||
~= sut
|
||||
=- ?.(=(sut -) - sut)
|
||||
?+ sut sut
|
||||
[%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
|
||||
[%core *] :+ %core
|
||||
@ -9073,7 +9065,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]
|
||||
==
|
||||
::
|
||||
|
||||
@ -859,7 +859,6 @@
|
||||
== ::
|
||||
+$ norm (axal ?) :: tombstone policy
|
||||
+$ open $-(path vase) :: get prelude
|
||||
+$ page (cask *) :: untyped cage
|
||||
+$ rang :: repository
|
||||
$: hut=(map tako yaki) :: changes
|
||||
lat=(map lobe page) :: data
|
||||
@ -2093,6 +2092,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 ~]
|
||||
@ -2104,6 +2129,7 @@
|
||||
gift:gall
|
||||
gift:iris
|
||||
gift:jael
|
||||
gift:khan
|
||||
==
|
||||
+$ task-arvo :: in request ->$
|
||||
$% task:ames
|
||||
@ -2114,6 +2140,7 @@
|
||||
task:gall
|
||||
task:iris
|
||||
task:jael
|
||||
task:khan
|
||||
==
|
||||
+$ note-arvo :: out request $->
|
||||
$~ [%b %wake ~]
|
||||
@ -2125,6 +2152,7 @@
|
||||
[%g task:gall]
|
||||
[%i task:iris]
|
||||
[%j task:jael]
|
||||
[%k task:khan]
|
||||
[%$ %whiz ~]
|
||||
[@tas %meta vase]
|
||||
==
|
||||
@ -2146,6 +2174,7 @@
|
||||
[%gall gift:gall]
|
||||
[%iris gift:iris]
|
||||
[%jael gift:jael]
|
||||
[%khan gift:khan]
|
||||
==
|
||||
:: $unix-task: input from unix
|
||||
::
|
||||
|
||||
@ -1369,6 +1369,9 @@
|
||||
!>([0 *@da])
|
||||
!>([let.dom t:(~(got by hut.ran) (~(got by hit.dom) let.dom))])
|
||||
=+ nao=(case-to-aeon case.mun)
|
||||
?: ?=([%s case %case ~] mun)
|
||||
:: case existence check
|
||||
[``[%flag !>(!=(~ nao))] ..park]
|
||||
?~(nao [~ ..park] (read-at-aeon:ze for u.nao mun))
|
||||
::
|
||||
:: Queue a move.
|
||||
@ -2232,6 +2235,7 @@
|
||||
merges t.merges
|
||||
hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki)
|
||||
lat.rag (~(uni by lat.u.merge-result) lat.rag)
|
||||
lat.ran (~(uni by lat.u.merge-result) lat.ran)
|
||||
parents [(~(got by hit.ali-dom) let.ali-dom) parents]
|
||||
==
|
||||
==
|
||||
@ -3882,10 +3886,15 @@
|
||||
++ read-s
|
||||
|= [yon=aeon pax=path]
|
||||
^- (unit (unit cage))
|
||||
?. ?=([?(%tako %yaki %blob %hash %cage %open %late %base) * *] pax)
|
||||
?. ?=([@ * *] pax)
|
||||
`~
|
||||
?- i.pax
|
||||
%tako ``tako+[-:!>(*tako) (aeon-to-tako:ze yon)]
|
||||
?+ i.pax `~
|
||||
%tako
|
||||
=/ tak=(unit tako) (~(get by hit.dom) yon)
|
||||
?~ tak
|
||||
~
|
||||
``tako+[-:!>(*tako) u.tak]
|
||||
::
|
||||
%yaki
|
||||
=/ yak=(unit yaki) (~(get by hut.ran) (slav %uv i.t.pax))
|
||||
?~ yak
|
||||
@ -3918,6 +3927,21 @@
|
||||
::
|
||||
%open ``open+!>(prelude:(aeon-ford yon))
|
||||
%late !! :: handled in +aver
|
||||
%case !! :: handled in +aver
|
||||
%base-tako
|
||||
:: XX this ignores the given beak
|
||||
:: maybe move to +aver?
|
||||
?> ?=(^ t.t.pax)
|
||||
:^ ~ ~ %uvs !>
|
||||
^- (list @uv)
|
||||
=/ tako-a (slav %uv i.t.pax)
|
||||
=/ tako-b (slav %uv i.t.t.pax)
|
||||
=/ yaki-a (~(got by hut.ran) tako-a)
|
||||
=/ yaki-b (~(got by hut.ran) tako-b)
|
||||
%+ turn ~(tap in (find-merge-points yaki-a yaki-b))
|
||||
|= =yaki
|
||||
r.yaki
|
||||
::
|
||||
%base
|
||||
?> ?=(^ t.t.pax)
|
||||
:^ ~ ~ %uvs !>
|
||||
|
||||
222
pkg/arvo/sys/vane/khan.hoon
Normal file
222
pkg/arvo/sys/vane/khan.hoon
Normal file
@ -0,0 +1,222 @@
|
||||
:: %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) ~
|
||||
?~ tea ~
|
||||
?. ?=(%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]~
|
||||
==
|
||||
--
|
||||
@ -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)
|
||||
@ -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
33
pkg/arvo/ted/eth/get-tx-receipts.hoon
Normal 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
390
pkg/arvo/ted/naive-csv.hoon
Normal 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)
|
||||
==
|
||||
--
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
::
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
@ -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,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)
|
||||
|
||||
@ -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?
|
||||
|
||||
476
pkg/arvo/tests/sys/vane/khan.hoon
Normal file
476
pkg/arvo/tests/sys/vane/khan.hoon
Normal 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
|
||||
~
|
||||
--
|
||||
@ -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 ,~)
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -61,10 +61,10 @@
|
||||
=; hav ~& user-files+(lent hav)
|
||||
=/ =yuki:clay
|
||||
:- *(list tako:clay)
|
||||
%- ~(gas by *(map path (each page:clay lobe:clay)))
|
||||
(turn hav |=([=path =page:clay] [path &+page]))
|
||||
%- ~(gas by *(map path (each page lobe:clay)))
|
||||
(turn hav |=([=path =page] [path &+page]))
|
||||
[/c/sync [%park des &+yuki *rang:clay]]
|
||||
=| hav=(list [path page:clay])
|
||||
=| hav=(list [path page])
|
||||
|- ^+ hav
|
||||
?~ sal ~
|
||||
=. hav $(sal t.sal)
|
||||
|
||||
@ -349,15 +349,16 @@
|
||||
|= [our=@p now=@da ship=@p =life]
|
||||
^- @udpoint
|
||||
::
|
||||
=/ d=[=^life =pass]
|
||||
=/ d=[=^life =pass *]
|
||||
=/ scry-path=path
|
||||
:~ %k
|
||||
:~ %j
|
||||
(scot %p our)
|
||||
%deed
|
||||
(scot %da now)
|
||||
(scot %p ship)
|
||||
(scot %ud life)
|
||||
==
|
||||
.^([^life pass] scry-path)
|
||||
.^([^life pass *] scry-path)
|
||||
:: we have the deed which has pass, which is several numbers +cat-ed
|
||||
:: together; pull out the keys
|
||||
::
|
||||
@ -376,15 +377,15 @@
|
||||
?~ invited
|
||||
[participants keys]
|
||||
::
|
||||
=/ =life
|
||||
.^(life k+/(scot %p our)/life/(scot %da now)/(scot %p i.invited))
|
||||
=/ lyfe=(unit @ud)
|
||||
.^((unit @ud) j+/(scot %p our)/lyfe/(scot %da now)/(scot %p i.invited))
|
||||
::
|
||||
?: =(life 0)
|
||||
?~ lyfe
|
||||
$(invited t.invited)
|
||||
::
|
||||
=/ pubkey=@udpoint (ship-life-to-pubid our now i.invited life)
|
||||
=/ pubkey=@udpoint (ship-life-to-pubid our now i.invited u.lyfe)
|
||||
::
|
||||
=. participants (~(put in participants) [i.invited life])
|
||||
=. participants (~(put in participants) [i.invited u.lyfe])
|
||||
=. keys (~(put in keys) pubkey)
|
||||
::
|
||||
$(invited t.invited)
|
||||
@ -436,11 +437,11 @@
|
||||
:: get our ships' current life
|
||||
::
|
||||
=/ our-life=life
|
||||
.^(life %k /(scot %p our)/life/(scot %da now)/(scot %p our))
|
||||
.^(life %j /(scot %p our)/life/(scot %da now)/(scot %p our))
|
||||
:: get our ships' secret keyfile ring
|
||||
::
|
||||
=/ secret-ring=ring
|
||||
.^(ring %k /(scot %p our)/vein/(scot %da now)/(scot %ud our-life))
|
||||
.^(ring %j /(scot %p our)/vein/(scot %da now)/(scot %ud our-life))
|
||||
:: fetch the encoded auth seed from the ring
|
||||
::
|
||||
=/ secret-auth-seed=@
|
||||
|
||||
112
pkg/base-dev/lib/story.hoon
Normal file
112
pkg/base-dev/lib/story.hoon
Normal file
@ -0,0 +1,112 @@
|
||||
/- *story
|
||||
!:
|
||||
^?
|
||||
|%
|
||||
:: XX generalize move to hoon.hoon
|
||||
++ dif-ju
|
||||
|= [a=story b=story]
|
||||
^- story
|
||||
:: if 0 is the empty set,
|
||||
:: a \ 0 = a
|
||||
:: 0 \ b = 0 :: anything in 0 but not in b is by definition 0
|
||||
::
|
||||
?: =(~ a) ~
|
||||
:: uno := (a-b) + (merged items in both a and b) + (b-a)
|
||||
:: ret := (a-b) + (merged items in both a and b)
|
||||
:: ret = (~(int by a) uno) :: preserve only the entries whose keys are in a
|
||||
=/ uno=story
|
||||
%- (~(uno by a) b)
|
||||
|= [k=tako:clay proses-a=proses proses-b=proses]
|
||||
^- proses
|
||||
(~(dif in proses-a) proses-b)
|
||||
::
|
||||
=/ ret=story (~(int by a) uno)
|
||||
:: normalizing step, remove any keys with null sets,
|
||||
:: which can occur if proses-a == proses-b above
|
||||
%- ~(gas by *story)
|
||||
(skip ~(tap by ret) |=([k=* v=proses] ?=(~ v)))
|
||||
::
|
||||
++ uni-ju
|
||||
|= [a=story b=story]
|
||||
^- story
|
||||
:: 0 + b = b
|
||||
?: =(~ a) b
|
||||
%- (~(uno by a) b)
|
||||
|= [k=tako:clay proses-a=proses proses-b=proses]
|
||||
^- proses
|
||||
(~(uni in proses-a) proses-b)
|
||||
::
|
||||
:: Canonical textual representation
|
||||
::
|
||||
++ tako-to-text
|
||||
|= [=tako:clay]
|
||||
^- tape
|
||||
"commit: {<`@uv`tako>}\0a"
|
||||
::
|
||||
++ proses-to-text
|
||||
|= [=proses]
|
||||
^- tape
|
||||
=/ proses-list=(list prose) ~(tap in proses)
|
||||
?: ?=(~ proses-list) ""
|
||||
?: ?=([prose ~] proses-list)
|
||||
(prose-to-text i.proses-list)
|
||||
%- tail
|
||||
%^ spin `(list prose)`t.proses-list
|
||||
(prose-to-text i.proses-list)
|
||||
|= [prz=prose state=tape]
|
||||
^- [prose tape]
|
||||
:- prz
|
||||
;: welp
|
||||
state
|
||||
"|||"
|
||||
"\0a"
|
||||
(prose-to-text prz)
|
||||
==
|
||||
::
|
||||
++ prose-to-text
|
||||
|= prz=prose
|
||||
=/ [title=@t body=@t] prz
|
||||
^- tape
|
||||
;: welp
|
||||
"{(trip title)}"
|
||||
"\0a\0a"
|
||||
"{(trip body)}"
|
||||
"\0a"
|
||||
==
|
||||
::
|
||||
:: Parsers
|
||||
::
|
||||
++ parse-commit-hash
|
||||
;~ sfix
|
||||
;~ pfix (jest 'commit: ')
|
||||
(cook @uv ;~(pfix (jest '0v') viz:ag))
|
||||
==
|
||||
::
|
||||
(just '\0a')
|
||||
==
|
||||
::
|
||||
++ parse-title
|
||||
;~ sfix
|
||||
(cook crip (star prn))
|
||||
(jest '\0a\0a')
|
||||
==
|
||||
::
|
||||
++ parse-body
|
||||
%+ cook of-wain:format
|
||||
%- star
|
||||
;~ less
|
||||
;~(pose (jest '|||\0a') (jest '---\0a'))
|
||||
(cook crip ;~(sfix (star prn) (just '\0a')))
|
||||
==
|
||||
::
|
||||
++ parse-prose ;~(plug parse-title parse-body)
|
||||
++ parse-rest-proses (star ;~(pfix (jest '|||\0a') parse-prose))
|
||||
++ parse-proses (cook silt ;~(plug parse-prose parse-rest-proses))
|
||||
++ parse-chapter ;~(plug parse-commit-hash parse-proses)
|
||||
++ parse-story
|
||||
(cook ~(gas by *story) (star ;~(sfix parse-chapter (jest '---\0a'))))
|
||||
::
|
||||
:: N.B: If conflicting messages are written individually,
|
||||
:: instead of under the same commit, we will overwrite previous entries
|
||||
:: with later ones due to the nature of gas:by.
|
||||
--
|
||||
@ -734,7 +734,7 @@
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
=/ tid
|
||||
(scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl))))
|
||||
=/ poke-vase !>([`tid.bowl `tid beak file args])
|
||||
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid beak file args])
|
||||
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
|
||||
;< ~ bind:m (sleep ~s0) :: wait for thread to start
|
||||
(pure:m tid)
|
||||
@ -748,7 +748,7 @@
|
||||
^- form:m
|
||||
;< =bowl:spider bind:m get-bowl
|
||||
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.bowl))))
|
||||
=/ poke-vase !>([`tid.bowl `tid file args])
|
||||
=/ poke-vase !>(`start-args:spider`[`tid.bowl `tid byk.bowl file args])
|
||||
;< ~ bind:m (watch-our /awaiting/[tid] %spider /thread-result/[tid])
|
||||
;< ~ bind:m (poke-our %spider %spider-start poke-vase)
|
||||
;< ~ bind:m (sleep ~s0) :: wait for thread to start
|
||||
@ -756,6 +756,6 @@
|
||||
;< ~ bind:m (take-kick /awaiting/[tid])
|
||||
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
|
||||
%thread-done (pure:m %& q.cage)
|
||||
%thread-fail (pure:m %| !<([term tang] q.cage))
|
||||
%thread-fail (pure:m %| ;;([term tang] q.q.cage))
|
||||
==
|
||||
--
|
||||
|
||||
16
pkg/base-dev/mar/story-diff.hoon
Normal file
16
pkg/base-dev/mar/story-diff.hoon
Normal file
@ -0,0 +1,16 @@
|
||||
::
|
||||
::::
|
||||
::
|
||||
/- *story
|
||||
|_ =story-diff
|
||||
::
|
||||
++ grad %noun
|
||||
++ grow
|
||||
|%
|
||||
++ noun story-diff
|
||||
--
|
||||
++ grab :: convert from
|
||||
|%
|
||||
++ noun ^story-diff :: make from %noun
|
||||
--
|
||||
--
|
||||
70
pkg/base-dev/mar/story.hoon
Normal file
70
pkg/base-dev/mar/story.hoon
Normal file
@ -0,0 +1,70 @@
|
||||
/- *story
|
||||
/+ *story
|
||||
|_ tale=story
|
||||
++ grad
|
||||
|%
|
||||
++ form %story-diff
|
||||
++ diff
|
||||
|= tory=story
|
||||
^- story-diff
|
||||
:: Given new story (tory), old story (tale), compute the diff
|
||||
:: additions = new - old
|
||||
:: deletions = old - new
|
||||
[(dif-ju tory tale) (dif-ju tale tory)]
|
||||
++ pact
|
||||
|= dif=story-diff
|
||||
:: Compute the new story after applying dif to tale.
|
||||
::
|
||||
^- story
|
||||
=. tale (uni-ju tale additions.dif)
|
||||
=. tale (dif-ju tale deletions.dif)
|
||||
tale
|
||||
++ join
|
||||
|= [ali=story-diff bob=story-diff]
|
||||
^- (unit story-diff)
|
||||
=/ joined-additions (uni-ju additions.ali additions.bob)
|
||||
=/ joined-deletions (uni-ju deletions.ali deletions.bob)
|
||||
::
|
||||
:: In a true join, we'd do a set intersection on the keys.
|
||||
:: If they're not equal, we have a conflict.
|
||||
:: In this case, we'd produce null and kick the flow to +mash
|
||||
::
|
||||
%- some
|
||||
[joined-additions joined-deletions]
|
||||
++ mash
|
||||
:: called by meld, force merge, annotating conflicts
|
||||
|= $: [als=ship ald=desk ali=story-diff]
|
||||
[bos=ship bod=desk bob=story-diff]
|
||||
==
|
||||
^- story-diff
|
||||
(need (join ali bob)) :: XX temporary, only because join doesn't fail
|
||||
--
|
||||
::
|
||||
++ grow :: convert to
|
||||
|% ::
|
||||
++ mime :: to %mime
|
||||
[/text/x-urb-story (as-octs:mimes:html (of-wain:format txt))]
|
||||
++ txt
|
||||
^- wain
|
||||
%- snoc :_ '' :: ensures terminating newline is present
|
||||
%+ murn ~(tap by tale)
|
||||
|= [[=tako:clay =proses]]
|
||||
^- (unit cord)
|
||||
?~ proses ~
|
||||
%- some
|
||||
%- crip
|
||||
;: welp
|
||||
(tako-to-text tako)
|
||||
(proses-to-text proses)
|
||||
"---"
|
||||
==
|
||||
--
|
||||
++ grab
|
||||
|% :: convert from
|
||||
++ noun story :: clam from %noun
|
||||
++ mime :: retrieve from %mime
|
||||
|= [p=mite q=octs]
|
||||
=/ story-text `@t`q.q
|
||||
`story`(rash story-text parse-story)
|
||||
--
|
||||
--
|
||||
11
pkg/base-dev/mar/thread-done.hoon
Normal file
11
pkg/base-dev/mar/thread-done.hoon
Normal file
@ -0,0 +1,11 @@
|
||||
|_ res=*
|
||||
++ grab
|
||||
|%
|
||||
++ noun *
|
||||
--
|
||||
++ grow
|
||||
|%
|
||||
++ noun res
|
||||
--
|
||||
++ grad %noun
|
||||
--
|
||||
11
pkg/base-dev/mar/thread-fail.hoon
Normal file
11
pkg/base-dev/mar/thread-fail.hoon
Normal file
@ -0,0 +1,11 @@
|
||||
|_ err=*
|
||||
++ grab
|
||||
|%
|
||||
++ noun (pair term tang)
|
||||
--
|
||||
++ grow
|
||||
|%
|
||||
++ noun err
|
||||
--
|
||||
++ grad %noun
|
||||
--
|
||||
@ -24,7 +24,16 @@
|
||||
aqua-event
|
||||
==
|
||||
::
|
||||
+$ unix-event unix-event:pill-lib
|
||||
+$ unix-event ::NOTE like unix-event:pill-lib but for all tasks
|
||||
%+ pair wire
|
||||
$% [%wack p=@]
|
||||
[%what p=(list (pair path (cask)))]
|
||||
[%whom p=ship]
|
||||
[%boot ? $%($>(%fake task:jael) $>(%dawn task:jael))]
|
||||
[%wyrd p=vere]
|
||||
[%verb p=(unit ?)]
|
||||
task-arvo
|
||||
==
|
||||
+$ pill pill:pill-lib
|
||||
::
|
||||
+$ aqua-event
|
||||
|
||||
@ -11,4 +11,11 @@
|
||||
%nonexistent :: 404
|
||||
%offline :: 504
|
||||
==
|
||||
+$ start-args
|
||||
$: parent=(unit tid)
|
||||
use=(unit tid)
|
||||
=beak
|
||||
file=term
|
||||
=vase
|
||||
==
|
||||
--
|
||||
|
||||
9
pkg/base-dev/sur/story.hoon
Normal file
9
pkg/base-dev/sur/story.hoon
Normal file
@ -0,0 +1,9 @@
|
||||
^?
|
||||
|%
|
||||
+$ prose [title=@t body=@t]
|
||||
+$ proses (set prose)
|
||||
+$ story (jug tako:clay prose) :: set len > 1 means conflicting messages have been assigned
|
||||
+$ chapter [tako:clay proses] :: prose entry type
|
||||
+$ cash $%([%tako p=tako:clay] case) :: used in generators to accept a tako directly as well
|
||||
+$ story-diff [additions=story deletions=story]
|
||||
--
|
||||
Loading…
Reference in New Issue
Block a user