roller: add timestamp to roller-tx

This commit is contained in:
yosoyubik 2021-08-27 16:05:59 +02:00
parent b07774c0d9
commit 2190eea370
4 changed files with 214 additions and 241 deletions

View File

@ -17,34 +17,171 @@
::
=, jael
|%
++ app-state
$: %3
+$ versioned-state
$% app-state
==
::::
+$ app-state
$: %0
url=@ta
net=network
whos=(set ship)
nas=^state:naive
own=owners
logs=(list =event-log:rpc:ethereum)
==
::
+$ poke-data
$% :: %listen
::
[%listen whos=(list ship) =source:jael]
:: %watch: configure node url
:: %watch: configure node url and network
::
[%watch url=@ta]
[%watch url=@ta net=network]
==
+$ tagged-diff [=id:block diff:naive]
::
+$ tagged-diff [=id:block diff:naive]
+$ network ?(%mainnet %ropsten %local)
+$ card card:agent:gall
--
::
|%
++ net
^- network
:: TODO: add poke action to allow switching?
:: eth snapshot could also be considered
=| state=app-state
%- agent:dbug
%+ verb |
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
%local
++ on-init
^- (quip card _this)
=. net.state %local
:_ this
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
`this(state !<(versioned-state old))
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
?: =(%noun mark)
?+ q.vase !!
%rerun
~& [%rerunning (lent logs.state)]
=. points.nas.state ~
=. own.state ~
=^ * state (run-logs:do logs.state)
`this
::
%resub
:_ this :_ ~
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
%resnap
=. logs.state snap
$(mark %noun, vase !>(%rerun))
==
?: =(%eth-logs mark)
=+ !<(logs=(list event-log:rpc:ethereum) vase)
=. logs.state logs
$(mark %noun, vase !>(%rerun))
::
?. ?=(%azimuth-poke mark)
(on-poke:def mark vase)
=+ !<(poke=poke-data vase)
?- -.poke
%listen
[[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
::
%watch
:: TODO: only wipe out state when switching networks?
:: ?: =(net.state net.poke)
:: [~ this]
=: nas.state *^state:naive
net.state net.poke
url.state url.poke
own.state ~
logs.state ~
==
[start:do this]
==
::
++ on-watch
|= =path
^- (quip card _this)
?< =(/sole/drum path)
?: =(/event path)
:_ this
[%give %fact ~ %naive-state !>([nas.state own.state])]~
=/ who=(unit ship)
?~ path ~
?: ?=([@ ~] path) ~
`(slav %p i.path)
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
^- (quip card _this)
[start:do this]
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path (on-peek:def path)
[%x %logs ~] ``noun+!>(logs.state)
[%x %nas ~] ``noun+!>(nas.state)
[%x %dns ~] ``noun+!>(dns.nas.state)
[%x %own ~] ``noun+!>(own.state)
[%x %point @ ~] ``noun+(point i.t.t.path)
==
++ point
|= wat=@t
^- vase
!> ^- (unit point:naive)
?~ ship=(rush wat ;~(pfix sig fed:ag))
~
(get:orm:naive points.nas.state u.ship)
--
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
?. ?=([%eth-watcher ~] wire)
(on-agent:def wire sign)
?. ?=(%fact -.sign)
(on-agent:def wire sign)
?. ?=(%eth-watcher-diff p.cage.sign)
(on-agent:def wire sign)
=+ !<(diff=diff:eth-watcher q.cage.sign)
?: ?=(%disavow -.diff)
[(jael-update:do [*ship id.diff %disavow ~]~) this]
::
=. logs.state
?- -.diff
:: %history loglist.diff
%history (welp logs.state loglist.diff)
%logs (welp logs.state loglist.diff)
==
=? nas.state ?=(%history -.diff) *^state:naive
=^ effects state (run-logs:do loglist.diff)
::
:_ this
%+ weld
(event-update:do effects)
(jael-update:do (to-udiffs:do effects))
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
--
|_ =bowl:gall
:: TODO: maybe flop the endianness here so metamask signs it in normal
:: order?
::
@ -76,16 +213,16 @@
(hex-to-num:ethereum data)
::
++ run-logs
|= [state=app-state logs=(list event-log:rpc:ethereum)]
|= [logs=(list event-log:rpc:ethereum)]
^- (quip tagged-diff _state)
=/ [contract=@ux * chain-id=@ *] (get-network net)
=+ net=(get-network net.state)
?~ logs
`state
?~ mined.i.logs
$(logs t.logs)
=/ [raw-effects=effects:naive new-nas=_nas.state]
=/ =^input:naive
?: =(contract address.i.logs)
?: =(azimuth.net address.i.logs)
=/ data (data-to-hex data.i.logs)
=/ =event-log:naive
[address.i.logs data topics.i.logs]
@ -95,17 +232,26 @@
[%bat u.input.u.mined.i.logs]
=/ res
%- mule
|.((%*(. naive lac |) verifier chain-id nas.state input))
|.((%*(. naive lac |) verifier chain-id.net nas.state input))
?- -.res
%& p.res
%| ((slog 'naive-fail' p.res) `nas.state)
==
=. own.state
=, dice
?. =(contract address.i.logs)
=< own
(apply-effects raw-effects nas.state own.state chain-id)
+:(update-ownership raw-effects nas.state new-nas own.state)
?. =(azimuth.net address.i.logs)
%: apply-effects:dice
raw-effects
nas.state
own.state
chain-id.net
==
%: update-ownership:dice
raw-effects
nas.state
new-nas
own.state
==
=. nas.state new-nas
=/ effects-1
=/ =id:block [block-hash block-number]:u.mined.i.logs
@ -131,10 +277,10 @@
::
++ jael-update
|= =udiffs:point
^- (list card:agent:gall)
^- (list card)
?: & ~ :: XX
:- [%give %fact ~[/] %azimuth-udiffs !>(udiffs)]
|- ^- (list card:agent:gall)
|- ^- (list card)
?~ udiffs
~
=/ =path /(scot %p ship.i.udiffs)
@ -145,18 +291,18 @@
::
++ event-update
|= effects=(list tagged-diff)
^- (list card:agent:gall)
^- (list card)
%+ murn effects
|= tag=tagged-diff
^- (unit card:agent:gall)
^- (unit card)
?. |(?=(%tx +<.tag) ?=(%point +<.tag)) ~
%- some
^- card:agent:gall
^- card
[%give %fact ~[/event] %naive-diffs !>(+.tag)]
::
++ get-network
|= =network
^- [@ux @ux @ @]
^- [azimuth=@ux naive=@ux chain-id=@ launch=@]
=< [azimuth naive chain-id launch]
=, azimuth
?- network
@ -166,199 +312,16 @@
==
::
++ start
|= [state=app-state =network our=ship dap=term]
^- card:agent:gall
=/ [azimuth=@ux naive=@ux * launch=@ud] (get-network network)
^- (list card)
=+ net=(get-network net.state)
=/ args=vase !>
:+ %watch /[dap]
:+ %watch /[dap.bowl]
^- config:eth-watcher
:* url.state =(%czar (clan:title our)) ~m5 ~h30
(max launch last-snap)
~[azimuth]
~[naive]
:* url.state =(%czar (clan:title our.bowl)) ~m5 ~h30
(max launch.net last-snap)
~[azimuth.net]
~[naive.net]
(topics whos.state)
==
[%pass /wa %agent [our %eth-watcher] %poke %eth-watcher-poke args]
--
::
=| state=app-state
%- agent:dbug
%+ verb |
^- agent:gall
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card:agent:gall agent:gall)
:_ this :_ ~
^- card:agent:gall
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
++ on-save !>(state)
++ on-load
|= old=vase
|^
=+ !<(old-state=app-states old)
=? old-state ?=(%0 -.old-state)
%= old-state
- %1
logs
%+ turn logs.old-state
|= =event-log-0
event-log-0(mined ?~(mined.event-log-0 ~ `mined.event-log-0))
==
=? old-state ?=(%1 -.old-state)
%= old-state
- %2
nas *^state:naive
==
=? old-state ?=(%2 -.old-state)
%= old-state
- %3
own *owners
==
`this(state ?>(?=(%3 -.old-state) old-state))
::
++ app-states $%(app-state-0 app-state-1 app-state-2 app-state)
++ app-state-2
$: %2
url=@ta
whos=(set ship)
nas=^state:naive
own=*
logs=(list =event-log:rpc:ethereum)
==
++ app-state-1
$: %1
url=@ta
whos=(set ship)
nas=*
own=*
logs=(list =event-log:rpc:ethereum)
==
++ app-state-0
$: %0
url=@ta
whos=(set ship)
nas=*
own=*
logs=(list =event-log-0)
==
::
+$ event-log-0
$: $= mined %- unit
$: log-index=@ud
transaction-index=@ud
transaction-hash=@ux
block-number=@ud
block-hash=@ux
removed=?
==
::
address=@ux
data=@t
topics=(lest @ux)
==
--
::
++ on-poke
|= [=mark =vase]
?: =(%noun mark)
?+ q.vase !!
%rerun
~& [%rerunning (lent logs.state)]
=^ effects state (run-logs state logs.state)
`this
::
%resub
:_ this :_ ~
[%pass /eth-watcher %agent [our.bowl %eth-watcher] %watch /logs/[dap.bowl]]
::
%resnap
=. logs.state snap
$(mark %noun, vase !>(%rerun))
==
?: =(%eth-logs mark)
=+ !<(logs=(list event-log:rpc:ethereum) vase)
=. logs.state logs
$(mark %noun, vase !>(%rerun))
::
?. ?=(%azimuth-poke mark)
(on-poke:def mark vase)
=+ !<(poke=poke-data vase)
?- -.poke
%listen [[%pass /lo %arvo %j %listen (silt whos.poke) source.poke]~ this]
%watch
=. url.state url.poke
[[(start state net [our dap]:bowl) ~] this]
==
::
++ on-watch
|= =path
^- (quip card:agent:gall _this)
?< =(/sole/drum path)
?: =(/event path)
:_ this
[%give %fact ~ %naive-state !>([nas.state own.state])]~
=/ who=(unit ship)
?~ path ~
?: ?=([@ ~] path) ~
`(slav %p i.path)
=. whos.state
?~ who
~
(~(put in whos.state) u.who)
:_ this :_ ~
(start state net [our dap]:bowl)
::
++ on-leave on-leave:def
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path (on-peek:def path)
[%x %logs ~] ``noun+!>(logs.state)
[%x %nas ~] ``noun+!>(nas.state)
[%x %dns ~] ``noun+!>(dns.nas.state)
[%x %own ~] ``noun+!>(own.state)
[%x %point @ ~] ``noun+(point i.t.t.path)
==
++ point
|= wat=@t
^- vase
!> ^- (unit point:naive)
?~ ship=(rush wat ;~(pfix sig fed:ag))
~
(get:orm:naive points.nas.state u.ship)
--
::
++ on-agent
|= [=wire =sign:agent:gall]
?. ?=([%eth-watcher ~] wire)
(on-agent:def wire sign)
?. ?=(%fact -.sign)
(on-agent:def wire sign)
?. ?=(%eth-watcher-diff p.cage.sign)
(on-agent:def wire sign)
=+ !<(diff=diff:eth-watcher q.cage.sign)
?: ?=(%disavow -.diff)
[(jael-update [*ship id.diff %disavow ~]~) this]
::
=. logs.state
?- -.diff
:: %history loglist.diff
%history (welp logs.state loglist.diff)
%logs (welp logs.state loglist.diff)
==
=? nas.state ?=(%history -.diff) *^state:naive
=^ effects state (run-logs state loglist.diff)
::
:_ this
%+ weld
(event-update effects)
(jael-update (to-udiffs effects))
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
[%pass /wa %agent [our.bowl %eth-watcher] %poke %eth-watcher-poke args]~
--

View File

@ -49,7 +49,7 @@
%+ map l1-tx-pointer
[next-gas-price=@ud txs=(list raw-tx:naive)]
::
finding=(map keccak ?(%confirmed %failed l1-tx-pointer))
finding=(map keccak ?(%confirmed %failed [=time l1-tx-pointer]))
history=(jug address:ethereum roller-tx)
next-nonce=(unit @ud)
next-batch=time
@ -216,7 +216,7 @@
!> ^- tx-status
?^ status=(~(get by finding) u.keccak)
?@ u.status [u.status ~]
[%sending status]
[%sending `+.u.status]
::TODO potentially slow!
=; known=?
[?:(known %pending %unknown) ~]
@ -626,12 +626,13 @@
::
=* key p.i.sending
=* val q.i.sending
=+ txs=(turn txs.val |=(=raw-tx:naive [| 0x0 raw-tx]))
=+ txs=(turn txs.val |=(=raw-tx:naive [| 0x0 *time raw-tx]))
=^ [new-valid=_txs nups=_ups] state
(apply-txs txs %sending)
=. valid
%+ ~(put by valid) key
val(txs (turn new-valid (cork tail tail)))
:: TODO: too much functional hackery?
val(txs (turn new-valid (cork tail (cork tail tail))))
$(sending t.sending, ups (welp ups nups))
::
++ apply-txs
@ -645,6 +646,7 @@
=* tx i.txs
=* raw-tx raw-tx.i.txs
=* ship ship.from.tx.raw-tx.i.txs
=* time time.i.txs
=/ hash=@ux (hash-raw-tx:lib raw-tx)
:: TODO: add tests to validate if this is necessary
::
@ -662,7 +664,7 @@
tx(address u.sign-address)
::
=/ =roller-tx
[ship type hash (l2-tx +<.tx.raw-tx)]
[ship type hash time (l2-tx +<.tx.raw-tx)]
=? nups !gud
%+ snoc nups
[%tx address.tx roller-tx(status %failed)]
@ -701,11 +703,13 @@
::
%submit
%- take-tx
:^ force.action
:* force.action
address.action
now.bowl
sig.action
(part-tx-to-full tx.action)
==
==
::
++ on-config
|= =config
@ -759,15 +763,22 @@
?~ addr=(verify-sig:lib sig message)
~? lverb [dap.bowl %cancel-sig-fail]
[~ state]
=^ time pending
=| nep=(list pend-tx)
=| tx-time=time
|- ^- [time _pending]
?~ pending [tx-time nep]
=+ i.pending
=? tx-time =(keccak (hash-raw-tx:lib raw-tx))
time
=? nep !=(keccak (hash-raw-tx:lib raw-tx))
(snoc nep i.pending)
$(pending t.pending)
:: TODO: mark as failed instead? add a %cancelled to tx-status?
::
=. history
%+ ~(del ju history) u.addr
[ship %pending keccak l2-tx]
=. pending
%+ skip pending
|= pend-tx
=(keccak (hash-raw-tx:lib raw-tx))
[ship %pending keccak time l2-tx]
[~ state]
:: +take-tx: accept submitted l2 tx into the :pending list
::
@ -783,13 +794,14 @@
::
:: =/ not-sent=? !(~(has by finding) hash)
:: =? pending not-sent
=. pending (snoc pending [force address raw-tx])
=. pending (snoc pending [force address time raw-tx])
:: =? history not-sent
=^ update-cards history
=/ =roller-tx
:* ship.from.tx.raw-tx
%pending
hash
time
(l2-tx +<.tx.raw-tx)
==
:- [%tx address roller-tx]~
@ -829,13 +841,13 @@
sending
%+ ~(put by sending)
[get-address nonce]
[0 (turn pending (cork tail tail))]
[0 (turn pending (cork tail (cork tail tail)))]
::
finding
%- ~(gas by finding)
%+ turn pending
|= pend-tx
(hash-raw-tx:lib raw-tx)^[address nonce]
(hash-raw-tx:lib raw-tx)^[time address nonce]
==
:_ state
;: welp
@ -853,6 +865,7 @@
:* ship.from.tx.raw-tx
%pending
(hash-raw-tx:lib raw-tx)
time
(l2-tx +<.tx.raw-tx)
==
=+ tx=[address roller-tx(status %sending)]
@ -938,6 +951,7 @@
=* nonce nonce.u.wer
=* address address.u.wer
=* ship ship.from.tx.raw-tx.diff
=* time time.u.wer
=* tx tx.raw-tx.diff
=/ l2-tx (l2-tx +<.tx)
:: remove the tx from the sending map
@ -965,7 +979,7 @@
%failed
::
=^ updates history
=/ =roller-tx [ship %sending keccak l2-tx]
=/ =roller-tx [ship %sending keccak time l2-tx]
=. history
(~(del ju history) address roller-tx)
=. status.roller-tx

View File

@ -51,17 +51,13 @@
(need (get points.nas ship))
=* event +>.diff
=; [to=(unit owner) from=(unit owner)]
~? =(ship ~marzod)
[-.event to+to from+from]
=? owners &(?=(^ from) !=(address.u.from 0x0))
~? =(ship ~marzod) ['del' u.from ship new old]
(~(del ju owners) u.from ship)
?: ?| =(~ to)
&(?=(^ to) =(address.u.to 0x0))
==
[ups owners]
?~ to [ups owners]
~? =(ship ~marzod) ['add' u.to ship]
:_ (~(put ju owners) u.to ship)
(snoc ups [%point ship new u.to from])
?+ -.event [~ ~]

View File

@ -50,9 +50,9 @@
::
:: TODO: add submission time?
::
+$ roller-tx [=ship =status hash=keccak type=l2-tx]
+$ roller-tx [=ship =status hash=keccak =time type=l2-tx]
::
+$ pend-tx [force=? =address:naive =raw-tx:naive]
+$ pend-tx [force=? =address:naive =time =raw-tx:naive]
::
+$ part-tx
$% [%raw raw=octs]