Merge branch 'next/arvo' into philip/tomb

This commit is contained in:
Philip Monk 2022-05-04 00:45:57 -07:00
commit 591bdf458c
69 changed files with 2316 additions and 648 deletions

View File

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

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:f59ec4eaf907227a1fd64e1d54810b769b5d39f6811c6bb254b2e89de528ca04 oid sha256:dc76fbf64ab20512842c5c87e5302cd8a70141fe4b5a1e4ba086221f36e406a0
size 1209494 size 1894727

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:e660fba934c5b80eeda64037a1f28c71eff4b2ea0bd28809b91432ca3d5ef08a oid sha256:204056f6c140a8d5329f78e149a318bc85190d2aaab73204249d39a12d0353e0
size 23052691 size 9296839

View File

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

View File

@ -1,3 +1,3 @@
version https://git-lfs.github.com/spec/v1 version https://git-lfs.github.com/spec/v1
oid sha256:be477486a9b803d8b8247c0dc321e3e3d2ace78c3a54588a17a0d4832f7f37ca oid sha256:bf44b34c1cb5f70ab86a71b4ff87629282fc5438890e6d087bd05845b086a338
size 9698663 size 25575266

View File

@ -17,11 +17,10 @@
:: :aqua [%file ~[~bud ~dev] %/sys/vane] :: :aqua [%file ~[~bud ~dev] %/sys/vane]
:: :aqua [%pause-events ~[~bud ~dev]] :: :aqua [%pause-events ~[~bud ~dev]]
:: ::
::
:: We get ++unix-event and ++pill from /-aquarium :: We get ++unix-event and ++pill from /-aquarium
:: ::
/- aquarium /- aquarium
/+ pill, azimuth, default-agent, aqua-azimuth, dbug, verb /+ pill, azimuth, naive, default-agent, aqua-azimuth, dbug, verb
=, pill-lib=pill =, pill-lib=pill
=, aquarium =, aquarium
=> $~ |% => $~ |%
@ -33,6 +32,7 @@
pil=$>(%pill pill) pil=$>(%pill pill)
assembled=* assembled=*
tym=@da tym=@da
fresh-piers=(map [=ship fake=?] [=pier boths=(list unix-both)])
fleet-snaps=(map term fleet) fleet-snaps=(map term fleet)
piers=fleet piers=fleet
== ==
@ -135,6 +135,8 @@
:: Represents a single ship's state. :: Represents a single ship's state.
:: ::
++ pe ++ pe
::NOTE if we start needing the fake flag outside of +ahoy and +yaho,
:: probably add it as an argument here.
|= who=ship |= who=ship
=+ (~(gut by ships.piers) who *pier) =+ (~(gut by ships.piers) who *pier)
=* pier-data - =* pier-data -
@ -155,6 +157,31 @@
~& pill-size=(met 3 (jam snap)) ~& pill-size=(met 3 (jam snap))
..abet-pe ..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 :: Enqueue events to child arvo
:: ::
++ push-events ++ push-events
@ -371,6 +398,24 @@
|= p=pill |= p=pill
^- (quip card:agent:gall _state) ^- (quip card:agent:gall _state)
?< ?=(%ivory -.p) ?< ?=(%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 =. this apex-aqua =< abet-aqua
=. pil p =. pil p
~& lent=(met 3 (jam boot-ova.pil)) ~& lent=(met 3 (jam boot-ova.pil))
@ -381,6 +426,7 @@
%0 %0
~& %suc ~& %suc
=. assembled +7.p.res =. assembled +7.p.res
=. fresh-piers ~
this this
:: ::
%1 %1
@ -439,7 +485,7 @@
=/ slim-dirs=(list path) =/ slim-dirs=(list path)
~[/app /ted /gen /lib /mar /sur /hoon/sys /arvo/sys /zuse/sys] ~[/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) %- %*(. file-ovum:pill-lib directories slim-dirs)
/(scot %p our.hid)/work/(scot %da now.hid) /(scot %p our.hid)/work/(scot %da now.hid)
=^ ms state (poke-pill pil) =^ ms state (poke-pill pil)
@ -506,6 +552,18 @@
?- -.ae ?- -.ae
:: ::
%init-ship %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 ~]) =. this abet-pe:(publish-effect:(pe who.ae) [/ %sleep ~])
=/ initted =/ initted
=< plow =< plow
@ -536,14 +594,20 @@
:: ::
userspace-ova.pil :: load os userspace-ova.pil :: load os
:: ::
:~ [/b/behn/0v1n.2m9vh %born ~] :* [/b/behn/0v1n.2m9vh %born ~]
[/i/http-client/0v1n.2m9vh %born ~] [/i/http-client/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %born ~] [/e/http-server/0v1n.2m9vh %born ~]
[/e/http-server/0v1n.2m9vh %live 8.080 `8.445] [/e/http-server/0v1n.2m9vh %live 8.080 `8.445]
[/a/newt/0v1n.2m9vh %born ~] [/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) (pe who.ae)
:: ::
%pause-events %pause-events
@ -741,7 +805,8 @@
++ dawn ++ dawn
|= who=ship |= who=ship
^- dawn-event:jael ^- dawn-event:jael
?> ?=(?(%czar %king %duke) (clan:title who)) =/ clan (clan:title who)
?> ?=(?(%czar %king %duke %earl) clan)
=/ spon=(list [ship point:azimuth]) =/ spon=(list [ship point:azimuth])
%- flop %- flop
|- ^- (list [ship point:azimuth]) |- ^- (list [ship point:azimuth])
@ -764,7 +829,9 @@
[a-point]~ [a-point]~
[a-point $(who ship)] [a-point $(who ship)]
=/ =seed:jael =/ =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 =/ =life lyfe.life-rift
[who life sec:ex:(get-keys:aqua-azimuth who life) ~] [who life sec:ex:(get-keys:aqua-azimuth who life) ~]
:* seed :* seed
@ -772,7 +839,7 @@
get-czars get-czars
~[~['arvo' 'netw' 'ork']] ~[~['arvo' 'netw' 'ork']]
0 0
`(need (de-purl:html 'http://localhost:8545')) `(need (de-purl:html 'http://fake.aqua.domain/'))
== ==
:: ::
:: Should only do galaxies :: Should only do galaxies

View File

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

View File

@ -21,9 +21,10 @@
=, jael =, jael
|% |%
+$ app-state +$ app-state
$: %5 $: %6
url=@ta url=@ta
=net =net
refresh=_~m5
whos=(set ship) whos=(set ship)
nas=^state:naive nas=^state:naive
own=owners own=owners
@ -42,9 +43,6 @@
:: ::
+$ tagged-diff [=id:block diff:naive] +$ tagged-diff [=id:block diff:naive]
+$ card card:agent:gall +$ card card:agent:gall
:: TODO: add to state?
::
++ refresh ~m5
-- --
:: ::
=| state=app-state =| state=app-state
@ -93,7 +91,7 @@
`old-state `old-state
%- %- slog :_ ~ %- %- slog :_ ~
leaf+"ship: loading snapshot with {<(lent logs.old-state)>} events" leaf+"ship: loading snapshot with {<(lent logs.old-state)>} events"
=. +.state +.old-state =. +.state +:(state-5-to-6 old-state)
=^ cards state =^ cards state
(%*(run-logs do nas.state *^state:naive) logs.state) (%*(run-logs do nas.state *^state:naive) logs.state)
[(jael-update:do (to-udiffs:do cards)) state] [(jael-update:do (to-udiffs:do cards)) state]
@ -101,7 +99,7 @@
?. ?=(%2 -.old-state) ?. ?=(%2 -.old-state)
`old-state `old-state
~& > '%azimuth: updating to state 3' ~& > '%azimuth: updating to state 3'
=. +.state +.old-state =. +.state +:(state-5-to-6 old-state)
:: replace naive state and indices with snapshot :: replace naive state and indices with snapshot
:: ::
=: nas.state nas.snap =: nas.state nas.snap
@ -117,7 +115,7 @@
%- %- slog :_ ~ %- %- slog :_ ~
leaf+"ship: processing azimuth snapshot ({<points>} points)" leaf+"ship: processing azimuth snapshot ({<points>} points)"
=/ snap-cards=udiffs:point (run-state:do id.snap points.nas.state) =/ snap-cards=udiffs:point (run-state:do id.snap points.nas.state)
:_ [%3 +.state] :_ [%3 url net whos nas own spo logs]:state
%+ weld %+ weld
(jael-update:do snap-cards) (jael-update:do snap-cards)
:: start getting new logs after the last id:block in the snapshot :: start getting new logs after the last id:block in the snapshot
@ -131,17 +129,24 @@
=^ cards-4 old-state =^ cards-4 old-state
?. ?=(%4 -.old-state) [cards-3 old-state] ?. ?=(%4 -.old-state) [cards-3 old-state]
=^ cards this =^ 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-poke !>([%watch [url net]:old-state])]
~& > '%azimuth: updating to state 5' ~& > '%azimuth: updating to state 5'
[cards state.this(- %5)] [cards [%5 url net whos nas own spo logs]:state.this]
?> ?=(%5 -.old-state) =? old-state ?=(%5 -.old-state)
(state-5-to-6 old-state)
?> ?=(%6 -.old-state)
[cards-4 this(state 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 ++ state-5-to-6
$: ?(%1 %2 %3 %4) |= 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 url=@ta
=net =net
whos=(set ship) whos=(set ship)
@ -167,6 +172,9 @@
^- (quip card _this) ^- (quip card _this)
?: =(%noun mark) ?: =(%noun mark)
?+ q.vase !! ?+ q.vase !!
[%refresh-rate @]
=. refresh.state +.q.vase
[start:do this]
:: ::
%rerun %rerun
=/ points=@ud ~(wyt by points.nas.state) =/ points=@ud ~(wyt by points.nas.state)
@ -245,7 +253,7 @@
[%x %dns ~] ``noun+!>(dns.nas.state) [%x %dns ~] ``noun+!>(dns.nas.state)
[%x %own ~] ``noun+!>(own.state) [%x %own ~] ``noun+!>(own.state)
[%x %spo ~] ``noun+!>(spo.state) [%x %spo ~] ``noun+!>(spo.state)
[%x %refresh ~] ``atom+!>(refresh) [%x %refresh ~] ``atom+!>(refresh.state)
[%x %point @ ~] ``noun+(point i.t.t.path) [%x %point @ ~] ``noun+(point i.t.t.path)
== ==
:: ::
@ -441,8 +449,9 @@
=/ args=vase !> =/ args=vase !>
:+ %watch /[dap.bowl] :+ %watch /[dap.bowl]
^- config:eth-watcher ^- 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)) (max launch.net ?:(=(net.state %default) +(last-snap) 0))
~
~[azimuth.net] ~[azimuth.net]
~[naive.net] ~[naive.net]
(topics whos.state) (topics whos.state)

View File

@ -8,7 +8,7 @@
=> |% => |%
+$ card card:agent:gall +$ card card:agent:gall
+$ app-state +$ app-state
$: %5 $: %6
dogs=(map path watchdog) dogs=(map path watchdog)
== ==
:: ::
@ -133,14 +133,16 @@
:: ::
=? old-state ?=(%4 -.old-state) =? old-state ?=(%4 -.old-state)
%- (slog leaf+"upgrading eth-watcher from %4" ~) %- (slog leaf+"upgrading eth-watcher from %4" ~)
^- app-state ^- app-state-5
%= old-state %= old-state
- %5 - %5
dogs dogs
%- ~(run by dogs.old-state) %- ~(run by dogs.old-state)
|= dog=watchdog-4 |= dog=watchdog-4
^- watchdog-5
%= dog %= dog
- -
^- config-5
=, -.dog =, -.dog
[url eager refresh-rate timeout-time from contracts ~ topics] [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-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 +$ app-state-4
$: %4 $: %4
@ -464,15 +512,12 @@
^- (quip card watchdog) ^- (quip card watchdog)
?: (lth number.dog 30) ?: (lth number.dog 30)
`dog `dog
=/ rel-number (sub number.dog 30)
=/ numbers=(list number:block) ~(tap in ~(key by pending-logs.dog)) =/ numbers=(list number:block) ~(tap in ~(key by pending-logs.dog))
=. numbers (sort numbers lth) =. numbers (sort numbers lth)
=^ logs=(list event-log:rpc:ethereum) dog =^ logs=(list event-log:rpc:ethereum) dog
|- ^- (quip event-log:rpc:ethereum watchdog) |- ^- (quip event-log:rpc:ethereum watchdog)
?~ numbers ?~ numbers
`dog `dog
?: (gth i.numbers rel-number)
$(numbers t.numbers)
=^ rel-logs-1 dog =^ rel-logs-1 dog
=/ =loglist (~(get ja pending-logs.dog) i.numbers) =/ =loglist (~(get ja pending-logs.dog) i.numbers)
=. pending-logs.dog (~(del by pending-logs.dog) i.numbers) =. pending-logs.dog (~(del by pending-logs.dog) i.numbers)
@ -530,6 +575,12 @@
:: ::
?^ running.dog ?^ running.dog
`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 =/ new-tid=@ta
(cat 3 'eth-watcher--' (scot %uv eny.bowl)) (cat 3 'eth-watcher--' (scot %uv eny.bowl))

View File

@ -210,6 +210,7 @@
refresh-rate refresh-rate
timeout-time timeout-time
public:mainnet-contracts public:mainnet-contracts
~
~[azimuth delegated-sending]:mainnet-contracts ~[azimuth delegated-sending]:mainnet-contracts
~ ~
~ ~

View File

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

View File

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

View File

@ -68,9 +68,6 @@
running=(list yarn) running=(list yarn)
tid=(map tid yarn) tid=(map tid yarn)
== ==
::
+$ start-args
[parent=(unit tid) use=(unit tid) =beak file=term =vase]
-- --
:: ::
%- agent:dbug %- agent:dbug
@ -170,7 +167,7 @@
=^ cards state =^ cards state
?+ mark (on-poke:def mark vase) ?+ mark (on-poke:def mark vase)
%spider-input (on-poke-input:sc !<(input 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)) %spider-stop (handle-stop-thread:sc !<([tid ?] vase))
:: ::
%handle-http-request %handle-http-request
@ -269,7 +266,7 @@
=/ body=json (need (de-json:html q.u.body.request.inbound-request)) =/ body=json (need (de-json:html q.u.body.request.inbound-request))
=/ input=vase (slop !>(~) (tube !>(body))) =/ input=vase (slop !>(~) (tube !>(body)))
=/ boc bec =/ 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) (handle-start-thread start-args)
:: ::
++ on-poke-input ++ on-poke-input
@ -572,7 +569,6 @@
:: ::
++ yarn-to-byk ++ yarn-to-byk
|= [=yarn =bowl:gall] |= [=yarn =bowl:gall]
=/ [* * =desk] =/ [* * =desk]
~| "no desk associated with {<tid>}" ~| "no desk associated with {<tid>}"
%- ~(got by serving.state) (yarn-to-tid yarn) %- ~(got by serving.state) (yarn-to-tid yarn)
@ -590,5 +586,4 @@
%cc %cc
/(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to] /(scot %p our.bowl)/[desk]/(scot %da now.bowl)/[from]/[to]
== ==
-- --

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

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

View File

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

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

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

View File

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

View File

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

View File

@ -85,7 +85,13 @@
+$ hist-tx [p=time q=roll-tx] +$ hist-tx [p=time q=roll-tx]
+$ roll-tx [=ship =status hash=keccak type=l2-tx] +$ roll-tx [=ship =status hash=keccak type=l2-tx]
+$ pend-tx [force=? =address:naive =time =raw-tx:naive] +$ 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 +$ part-tx
$% [%raw raw=octs] $% [%raw raw=octs]
[%don =tx:naive] [%don =tx:naive]

View File

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

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

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

View File

@ -19,6 +19,7 @@
:: $gang: infinite set of peers :: $gang: infinite set of peers
:: $mark: symbolic content type :: $mark: symbolic content type
:: $mien: orientation :: $mien: orientation
:: $page: untyped cage
:: +omen: namespace path and data :: +omen: namespace path and data
:: $ship: network identity :: $ship: network identity
:: $sink: subscription :: $sink: subscription
@ -50,6 +51,7 @@
+$ gang (unit (set ship)) +$ gang (unit (set ship))
+$ mark @tas +$ mark @tas
+$ mien [our=ship now=@da eny=@uvJ] +$ mien [our=ship now=@da eny=@uvJ]
+$ page (cask)
++ omen |$ [a] (pair path (cask a)) ++ omen |$ [a] (pair path (cask a))
+$ ship @p +$ ship @p
+$ sink (trel bone ship path) +$ sink (trel bone ship path)
@ -87,7 +89,7 @@
:: +wite: kernel action/error builder :: +wite: kernel action/error builder
:: ::
+$ ball (wite [vane=term task=maze] maze) +$ ball (wite [vane=term task=maze] maze)
+$ card (cask) +$ card (pair @tas *)
+$ duct (list wire) +$ duct (list wire)
++ hobo ++ hobo
|$ [a] |$ [a]
@ -1721,6 +1723,7 @@
%g %gall %g %gall
%i %iris %i %iris
%j %jael %j %jael
%k %khan
== ==
-- => -- =>
:: ::

View File

@ -264,8 +264,8 @@
++ tail |*(^ ,:+<+) :: get tail ++ tail |*(^ ,:+<+) :: get tail
++ test |=(^ =(+<- +<+)) :: equality ++ test |=(^ =(+<- +<+)) :: equality
:: ::
++ lead |*(* |*(* [+>+< +<])) :: put head ++ lead |*(* |*(* [+>+< +<])) :: put head
++ late |*(* |*(* [+< +>+<])) :: put tail ++ late |*(* |*(* [+< +>+<])) :: put tail
:: ::
:: # %containers :: # %containers
:: ::
@ -8579,15 +8579,7 @@
== ==
:: ::
[%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~]) [%mcfs *] =+(zoy=[%rock %ta %$] [%clsg [zoy [%clsg [zoy p.gen] ~]] ~])
[%mcgl *] [%mcgl *] [%cnls [%cnhp q ktcl+p] r [%brts p [%tsgr $+3 s]]]:gen
:^ %cnls
:+ %cnhp
q.gen
[%ktcl p.gen]
r.gen
:+ %brts
p.gen
s.gen
:: ::
[%mcsg *] :: ;~ [%mcsg *] :: ;~
|- ^- hoon |- ^- hoon
@ -9059,7 +9051,7 @@
:: ::
^- type ^- type
~+ ~+
~= sut =- ?.(=(sut -) - sut)
?+ sut sut ?+ sut sut
[%cell *] [%cell burp(sut p.sut) burp(sut q.sut)] [%cell *] [%cell burp(sut p.sut) burp(sut q.sut)]
[%core *] :+ %core [%core *] :+ %core
@ -9073,7 +9065,7 @@
== ==
[%face *] [%face p.sut burp(sut q.sut)] [%face *] [%face p.sut burp(sut q.sut)]
[%fork *] [%fork (~(run in p.sut) |=(type burp(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] [%hold *] [%hold burp(sut p.sut) q.sut]
== ==
:: ::

View File

@ -859,7 +859,6 @@
== :: == ::
+$ norm (axal ?) :: tombstone policy +$ norm (axal ?) :: tombstone policy
+$ open $-(path vase) :: get prelude +$ open $-(path vase) :: get prelude
+$ page (cask *) :: untyped cage
+$ rang :: repository +$ rang :: repository
$: hut=(map tako yaki) :: changes $: hut=(map tako yaki) :: changes
lat=(map lobe page) :: data lat=(map lobe page) :: data
@ -2093,6 +2092,32 @@
+$ oath @ :: signature +$ oath @ :: signature
-- :: pki -- :: pki
-- :: jael -- :: 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 <-$ +$ gift-arvo :: out result <-$
$~ [%doze ~] $~ [%doze ~]
@ -2104,6 +2129,7 @@
gift:gall gift:gall
gift:iris gift:iris
gift:jael gift:jael
gift:khan
== ==
+$ task-arvo :: in request ->$ +$ task-arvo :: in request ->$
$% task:ames $% task:ames
@ -2114,6 +2140,7 @@
task:gall task:gall
task:iris task:iris
task:jael task:jael
task:khan
== ==
+$ note-arvo :: out request $-> +$ note-arvo :: out request $->
$~ [%b %wake ~] $~ [%b %wake ~]
@ -2125,6 +2152,7 @@
[%g task:gall] [%g task:gall]
[%i task:iris] [%i task:iris]
[%j task:jael] [%j task:jael]
[%k task:khan]
[%$ %whiz ~] [%$ %whiz ~]
[@tas %meta vase] [@tas %meta vase]
== ==
@ -2146,6 +2174,7 @@
[%gall gift:gall] [%gall gift:gall]
[%iris gift:iris] [%iris gift:iris]
[%jael gift:jael] [%jael gift:jael]
[%khan gift:khan]
== ==
:: $unix-task: input from unix :: $unix-task: input from unix
:: ::

View File

@ -1369,6 +1369,9 @@
!>([0 *@da]) !>([0 *@da])
!>([let.dom t:(~(got by hut.ran) (~(got by hit.dom) let.dom))]) !>([let.dom t:(~(got by hut.ran) (~(got by hit.dom) let.dom))])
=+ nao=(case-to-aeon case.mun) =+ 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)) ?~(nao [~ ..park] (read-at-aeon:ze for u.nao mun))
:: ::
:: Queue a move. :: Queue a move.
@ -2232,6 +2235,7 @@
merges t.merges merges t.merges
hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki) hut.ran (~(put by hut.ran) r.merged-yaki merged-yaki)
lat.rag (~(uni by lat.u.merge-result) lat.rag) 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] parents [(~(got by hit.ali-dom) let.ali-dom) parents]
== ==
== ==
@ -3882,10 +3886,15 @@
++ read-s ++ read-s
|= [yon=aeon pax=path] |= [yon=aeon pax=path]
^- (unit (unit cage)) ^- (unit (unit cage))
?. ?=([?(%tako %yaki %blob %hash %cage %open %late %base) * *] pax) ?. ?=([@ * *] pax)
`~ `~
?- i.pax ?+ i.pax `~
%tako ``tako+[-:!>(*tako) (aeon-to-tako:ze yon)] %tako
=/ tak=(unit tako) (~(get by hit.dom) yon)
?~ tak
~
``tako+[-:!>(*tako) u.tak]
::
%yaki %yaki
=/ yak=(unit yaki) (~(get by hut.ran) (slav %uv i.t.pax)) =/ yak=(unit yaki) (~(get by hut.ran) (slav %uv i.t.pax))
?~ yak ?~ yak
@ -3918,6 +3927,21 @@
:: ::
%open ``open+!>(prelude:(aeon-ford yon)) %open ``open+!>(prelude:(aeon-ford yon))
%late !! :: handled in +aver %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 %base
?> ?=(^ t.t.pax) ?> ?=(^ t.t.pax)
:^ ~ ~ %uvs !> :^ ~ ~ %uvs !>

222
pkg/arvo/sys/vane/khan.hoon Normal file
View 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]~
==
--

View File

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

View File

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

View File

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

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

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

View File

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

View File

@ -12,13 +12,13 @@
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |) ;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo) ;< 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 (breach-and-hear ~bud ~marbud)
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (breach-and-hear ~marbud ~bud) ;< ~ bind:m (breach-and-hear ~marbud ~bud)
;< ~ bind:m (init-ship ~marbud |) ;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %bar) ;< file=@t bind:m (touch-file ~bud %kids %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz) ;< 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 ;< ~ bind:m end
(pure:m *vase) (pure:m *vase)

View File

@ -14,13 +14,13 @@
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |) ;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo) ;< 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 (breach ~bud)
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m ;< ~ 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 %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz) ;< 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 ;< ~ bind:m end
(pure:m *vase) (pure:m *vase)

View File

@ -1,5 +1,6 @@
:: This tests that syncs are correctly restarted after a breach :: This tests that syncs are correctly restarted after a breach
:: ::
::TODO breach tests broken by dangling bone?
/- spider /- spider
/+ *ph-io /+ *ph-io
=, strand=strand:spider =, strand=strand:spider
@ -12,17 +13,17 @@
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m (init-ship ~marbud |) ;< ~ bind:m (init-ship ~marbud |)
;< file=@t bind:m (touch-file ~bud %kids %foo) ;< 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 :: 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 (breach-and-hear ~bud ~marbud)
;< ~ bind:m (init-ship ~bud |) ;< ~ bind:m (init-ship ~bud |)
;< ~ bind:m ;< ~ bind:m
(dojo ~bud "|merge %kids ~marbud %kids, =gem %only-this") (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 %bar)
;< file=@t bind:m (touch-file ~bud %kids %baz) ;< 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 ;< ~ bind:m end
(pure:m *vase) (pure:m *vase)

View File

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

View File

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

View File

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

View File

@ -8,7 +8,7 @@
^- form:m ^- form:m
=* loop $ =* loop $
;< [her=^ship =unix-effect] bind:m take-unix-effect ;< [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 ~) (pure:m ~)
loop loop
:: ::

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,5 +1,5 @@
/- *aquarium, spider /- *aquarium, spider
/+ libstrand=strand, *strandio, util=ph-util /+ libstrand=strand, *strandio, util=ph-util, aqua-azimuth
=, strand=strand:libstrand =, strand=strand:libstrand
|% |%
++ send-events ++ send-events
@ -127,7 +127,7 @@
;< ~ bind:m (send-azimuth-action %breach who) ;< ~ bind:m (send-azimuth-action %breach who)
|- ^- form:m |- ^- form:m
=* loop $ =* loop $
;< ~ bind:m (sleep ~s1) ;< ~ bind:m (sleep ~s10)
;< =bowl:spider bind:m get-bowl ;< =bowl:spider bind:m get-bowl
=/ aqua-pax =/ aqua-pax
:- %i :- %i
@ -137,6 +137,18 @@
(pure:m ~) (pure:m ~)
loop 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 ++ init-ship
|= [=ship fake=?] |= [=ship fake=?]
=/ m (strand ,~) =/ m (strand ,~)

View File

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

View File

@ -61,10 +61,10 @@
=; hav ~& user-files+(lent hav) =; hav ~& user-files+(lent hav)
=/ =yuki:clay =/ =yuki:clay
:- *(list tako:clay) :- *(list tako:clay)
%- ~(gas by *(map path (each page:clay lobe:clay))) %- ~(gas by *(map path (each page lobe:clay)))
(turn hav |=([=path =page:clay] [path &+page])) (turn hav |=([=path =page] [path &+page]))
[/c/sync [%park des &+yuki *rang:clay]] [/c/sync [%park des &+yuki *rang:clay]]
=| hav=(list [path page:clay]) =| hav=(list [path page])
|- ^+ hav |- ^+ hav
?~ sal ~ ?~ sal ~
=. hav $(sal t.sal) =. hav $(sal t.sal)

View File

@ -349,15 +349,16 @@
|= [our=@p now=@da ship=@p =life] |= [our=@p now=@da ship=@p =life]
^- @udpoint ^- @udpoint
:: ::
=/ d=[=^life =pass] =/ d=[=^life =pass *]
=/ scry-path=path =/ scry-path=path
:~ %k :~ %j
(scot %p our) (scot %p our)
%deed
(scot %da now) (scot %da now)
(scot %p ship) (scot %p ship)
(scot %ud life) (scot %ud life)
== ==
.^([^life pass] scry-path) .^([^life pass *] scry-path)
:: we have the deed which has pass, which is several numbers +cat-ed :: we have the deed which has pass, which is several numbers +cat-ed
:: together; pull out the keys :: together; pull out the keys
:: ::
@ -376,15 +377,15 @@
?~ invited ?~ invited
[participants keys] [participants keys]
:: ::
=/ =life =/ lyfe=(unit @ud)
.^(life k+/(scot %p our)/life/(scot %da now)/(scot %p i.invited)) .^((unit @ud) j+/(scot %p our)/lyfe/(scot %da now)/(scot %p i.invited))
:: ::
?: =(life 0) ?~ lyfe
$(invited t.invited) $(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) =. keys (~(put in keys) pubkey)
:: ::
$(invited t.invited) $(invited t.invited)
@ -436,11 +437,11 @@
:: get our ships' current life :: get our ships' current life
:: ::
=/ our-life=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 :: get our ships' secret keyfile ring
:: ::
=/ secret-ring=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 :: fetch the encoded auth seed from the ring
:: ::
=/ secret-auth-seed=@ =/ secret-auth-seed=@

112
pkg/base-dev/lib/story.hoon Normal file
View 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.
--

View File

@ -734,7 +734,7 @@
;< =bowl:spider bind:m get-bowl ;< =bowl:spider bind:m get-bowl
=/ tid =/ tid
(scot %ta (cat 3 (cat 3 'strand_' file) (scot %uv (sham file eny.bowl)))) (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 (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start ;< ~ bind:m (sleep ~s0) :: wait for thread to start
(pure:m tid) (pure:m tid)
@ -748,7 +748,7 @@
^- form:m ^- form:m
;< =bowl:spider bind:m get-bowl ;< =bowl:spider bind:m get-bowl
=/ tid (scot %ta (cat 3 'strand_' (scot %uv (sham file eny.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 (watch-our /awaiting/[tid] %spider /thread-result/[tid])
;< ~ bind:m (poke-our %spider %spider-start poke-vase) ;< ~ bind:m (poke-our %spider %spider-start poke-vase)
;< ~ bind:m (sleep ~s0) :: wait for thread to start ;< ~ bind:m (sleep ~s0) :: wait for thread to start
@ -756,6 +756,6 @@
;< ~ bind:m (take-kick /awaiting/[tid]) ;< ~ bind:m (take-kick /awaiting/[tid])
?+ p.cage ~|([%strange-thread-result p.cage file tid] !!) ?+ p.cage ~|([%strange-thread-result p.cage file tid] !!)
%thread-done (pure:m %& q.cage) %thread-done (pure:m %& q.cage)
%thread-fail (pure:m %| !<([term tang] q.cage)) %thread-fail (pure:m %| ;;([term tang] q.q.cage))
== ==
-- --

View File

@ -0,0 +1,16 @@
::
::::
::
/- *story
|_ =story-diff
::
++ grad %noun
++ grow
|%
++ noun story-diff
--
++ grab :: convert from
|%
++ noun ^story-diff :: make from %noun
--
--

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

View File

@ -0,0 +1,11 @@
|_ res=*
++ grab
|%
++ noun *
--
++ grow
|%
++ noun res
--
++ grad %noun
--

View File

@ -0,0 +1,11 @@
|_ err=*
++ grab
|%
++ noun (pair term tang)
--
++ grow
|%
++ noun err
--
++ grad %noun
--

View File

@ -24,7 +24,16 @@
aqua-event 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 +$ pill pill:pill-lib
:: ::
+$ aqua-event +$ aqua-event

View File

@ -11,4 +11,11 @@
%nonexistent :: 404 %nonexistent :: 404
%offline :: 504 %offline :: 504
== ==
+$ start-args
$: parent=(unit tid)
use=(unit tid)
=beak
file=term
=vase
==
-- --

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