shrub/pkg/arvo/app/roller-cli.hoon
2021-08-22 18:23:30 +02:00

536 lines
14 KiB
Plaintext

:: roller-cli: CLI for L2 Azimuth Rollers
::
:: TODO: commands
::
:: client | roller
:: _________|___________
:: - CLI command
:: [%track 0x1234.abcd]
:: - init subscriptions to the roller
:: watch --> /point/[0x1234.abcd] - point updates
:: watch --> /tx/[0x1234.abcd] - tx status updates
::
:: ----------------------
:: Submit Txs
:: poke --tx--> +take-tx
::
:: ---------------------
:: Receive Tx status updates
:: watch /tx/[0x1234.abcd]
::
:: <--(list roller-tx:dice)-- - init
:: <--[address roller-tx:dice]-- - update
:: <--%kick-sub-- ?: ?=(?(%confirmed %failed) tx-status)
:: ---------------------
:: Receive Point updates (i.e. nonces)
:: watch /point/[0x1234.abcd]
::
:: <-(list point:naive)- - init
:: <-[address point:naive]- - update
::
/- *dice
/+ *dice,
naive,
lib=naive-transactions,
*fake-roller,
shoe,
verb,
dbug,
default-agent,
ethereum
|%
+$ app-state
$: %0
:: TODO: keep track of sessions
::
:: sessions=(map sole-id session)
points=(jug address:ethereum [ship point:naive])
history=(jug address:ethereum roller-tx)
unsigned-txs=(jug address:ethereum [keccak tx:naive])
:: TODO: track pub/prv keys
::
:: keys=(list (pair address:ethereum address:ethereum)
==
::
+$ card card:shoe
::
+$ command
$% :: List all possible L2 tx types
::
[%l2-tx ~] :: ?
:: Loads a new address (login?)
:: — should require signing?
:: - it subscribes to the Roller, for updates to it
:: - innitially receives a list of points (if any) it controls
::
:: [%track pubkey=address:ethereum prvkey=address:ethereum]
[%track address:ethereum]
:: Table of all submitted txs, by address
::
[%history address:ethereum]
:: Table of all unsigned txs, by address
::
[%show-unsigned ~]
:: Signs and Submit an unsigned txs (signed)
::
[%submit address:ethereum tx:naive]
:: Cancels a submitted (but pending) txs
::
[%cancel ~]
:: Ships owned by an address
::
[%ships address:ethereum]
:: Example flow
::
[%example-flow ~]
==
--
=| app-state
=* state -
::
%+ verb |
%- agent:dbug
^- agent:gall
%- (agent:shoe command)
^- (shoe:shoe command)
:: => |%
:: ++ get-address-points
:: |= [roller=@p =address:ethereum]
:: :* %pass
:: /roller-points
:: %agent
:: [roller %azimuth]
:: %watch
:: /address/[address]
:: ==
:: --
|_ =bowl:gall
+* this .
def ~(. (default-agent this %|) bowl)
des ~(. (default:shoe this command) bowl)
::
++ on-init on-init:def
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(app-state old))]
:: |^
:: =+ !<(old-state=app-states old)
:: |-
:: ?- -.old-state
:: %0 $(old-state [%1 ~ ~ ~])
:: %1 $(old-state [%2 ~ ~ ~])
:: %2 [~ this(state old-state)]
:: ==
:: ++ app-states $%([%0 ~] [%1 *] app-state)
:: --
::
++ on-poke on-poke:def
++ on-watch on-watch:def
++ on-leave on-leave:def
:: +on-peek: scry paths
::
:: /x/ships/[0x1234.abcd] -> %noun (list ship)
::
++ on-peek
|= =path
^- (unit (unit cage))
|^
?+ path ~
[%x %ships @ ~] (ships i.t.t.path)
==
::
++ ships
|= wat=@t
:+ ~ ~
:- %noun
!> ^- (list ship)
?~ addr=(slaw %ux wat) ~
%+ turn
~(tap in (~(get ju points) u.addr))
head
--
::
++ on-agent
|= [=wire =sign:agent:gall]
^- (quip card _this)
|^
?+ wire (on-agent:def wire sign)
[%points @ ~] (get-points i.t.wire sign)
[%txs @ ~] (get-txs i.t.wire sign)
==
::
++ get-points
|= [wat=@t =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%fact
?+ p.cage.sign (on-agent:def wire sign)
%points
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(points=(list [ship point:naive]) q.cage.sign)
=. points.state
(~(gas ju points.state) (turn points (cork same (lead u.addr))))
[~ this]
::
%point
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(point=[ship point:naive] q.cage.sign)
:: TODO: handle multiple sole sessions?
::
:: =/ sez=(list [=sole-id =session])
:: ~(tap by sessions)
=/ console=tape
"Point update ({(scow %p -.point)})"
=. points.state
:: FIXME: doesn't properly update point
:: handle proper insert/deletion of points
:: to account for ownership changes/nonce updates
::
(~(put ju points.state) [u.addr point])
:_ this
:_ ~
:- %shoe
:- ~
:- %sole
?. =(src our):bowl
[%txt console]
[%klr [[`%br ~ `%g] [(crip console)]~]~]
==
==
::
++ get-txs
|= [wat=@t =sign:agent:gall]
^- (quip card _this)
?+ -.sign (on-agent:def wire sign)
%fact
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
?+ p.cage.sign (on-agent:def wire sign)
%txs
=+ !<(txs=(list roller-tx) q.cage.sign)
=. history.state
(~(gas ju history.state) (turn txs (cork same (lead u.addr))))
[~ this]
::
%tx
?~ addr=(slaw %ux wat) (on-agent:def wire sign)
=+ !<(=roller-tx q.cage.sign)
=/ hash=tape
=+ hash=(scow %ux hash.roller-tx)
=+ len=(lent hash)
;: weld
(swag [0 6] hash)
"..."
(swag [(sub len 4) len] hash)
==
=/ console=tape
"Tx hash: {hash} -> {(trip status.roller-tx)}"
=. history.state (update-tx u.addr roller-tx)
:: ~& console
:_ this
:_ ~
:- %shoe
:- ~
:- %sole
?. =(src our):bowl
[%txt console]
[%klr [[`%br ~ `%g] [(crip console)]~]~]
==
==
::
++ update-tx
|= [=address:ethereum =roller-tx]
%. [address roller-tx]
?+ status.roller-tx ~(put ju history.state)
%pending
~(put ju history.state)
::
%sending
%~ put ju
%- ~(del ju history.state)
[address roller-tx(status %pending)]
::
%confirmed
%~ put ju
%- ~(del ju history.state)
[address roller-tx(status %sending)]
::
%failed
:: TODO: make it not ugly
::
%~ put ju
%- %~ del ju
%- ~(del ju history.state)
[address roller-tx(status %sending)]
[address roller-tx(status %pending)]
==
--
::
++ on-arvo on-arvo:def
++ on-fail on-fail:def
::
++ command-parser
|= sole-id=@ta
^+ |~(nail *(like [? command]))
:: wait for 'enter' to run the command
::
|^
%+ stag |
:: (perk %demo %row %table %track %submit %history ~)
;~ pose
;~(plug (tag %track) ;~(pfix (jest ' 0x') hex))
;~(plug (tag %example-flow) (easy ~))
;~(plug (tag %history) ;~(pfix (jest ' 0x') hex))
;~((glue ace) (tag %submit) submit)
;~((glue ace) (tag %ships) address)
==
::
++ tag |*(a=@tas (cold a (jest a))) :: TODO (from /app/chat-cli) into stdlib
++ address ;~(pfix (jest '0x') hex)
++ sponsorship
%- perk
:~ %escape
%cancel-escape
%adopt
%reject
%detach
==
::
++ ownership
%- perk
:~ %set-management-proxy
%set-spawn-proxy
%set-transfer-proxy
==
::
++ proxies
(perk %own %spawn %manage %vote %transfer ~)
++ submit
%+ cook ,[address:naive tx:naive]
;~ (glue ace)
address
:: from=[ship proxy:naive]
::
%+ cook ,[ship proxy:naive]
%+ ifix [sel ser]
;~((glue ace) ;~(pfix sig fed:ag) proxies)
:: skim-tx:naive
::
%+ cook ,skim-tx:naive
;~ pose
:: [%transfer-point =address reset=?]
::
;~ (glue ace)
(perk %transfer-point ~)
address
;~(pose (cold & (just 'y')) (cold | (just 'n')))
==
:: [%spawn ship address:naive]
::
;~ (glue ace)
(perk %spawn ~)
;~(pfix sig fed:ag)
address
==
:: [%configure-keys encrypt=@ auth=@ crypto-suite=@ breach=?]
::
;~ (glue ace)
(perk %configure-keys ~)
address
address
dem
;~(pose (cold & (just 'y')) (cold | (just 'n')))
==
:: [?([%escape %cancel-escape %adopt %reject %detach]) ship]
::
;~((glue ace) sponsorship ;~(pfix sig fed:ag))
:: $: ?([%set-management-proxy %set-spawn-proxy %set-transfer-proxy])
:: address
:: ==
::
;~((glue ace) ownership address)
==
==
--
::
++ tab-list
|= sole-id=@ta
^- (list [@t tank])
:~ ['txs' leaf+"list available L2 transaction"]
['submit' leaf+"sends| a L2 transaction to the Roller"]
['cancel' leaf+"cancels a (pending) L2 transaction"]
['history' leaf+"shows all current submitted transactions"]
['track' leaf+"loads an ethereum address and tracks points and L2 txs"]
==
::
++ on-command
|= [sole-id=@ta =command]
^- (quip card _this)
|^
?+ -.command !!
%track (track +.command)
%submit (submit +.command)
%history (history +.command)
%ships (ships +.command)
%example-flow example-flow
==
::
++ example-flow
^- (quip card _this)
=/ address=@t '0x6deffb0cafdb11d175f123f6891aa64f01c24f7d '
=/ spawn=@t '0xf48062ae8bafd6ef19cd6cb89db93a0d0ca6ce26'
=/ track=@t 'track 0x6deffb0cafdb11d175f123f6891aa64f01c24f7d'
=/ ships=@t 'ships 0x6deffb0cafdb11d175f123f6891aa64f01c24f7d'
=/ tx1=@t
%- crip
:~ 'submit '
address
'[~wanzod own] '
'set-spawn-proxy '
address
==
=/ tx2=@t
%- crip
:~ 'submit '
address
'[~wanzod own] '
'spawn '
'~modlep-fosreg '
spawn
==
=/ failed-tx=@t
%- crip
:~ 'submit '
'0x6deffb0cafdb11d175f123f6891aa64f01c24f7d '
'[~wanzod own] '
'spawn '
'~marzod '
'0xf'
==
=/ example-a=@t '- lists ships controlled by the given address :: '
=/ example-b=@t '- receives updates signed by the given address :: '
=/ example-c=@t '- this tx will fail :: '
:_ this
:_ ~
^- card
:- %shoe
^- [(list _sole-id) shoe-effect:shoe]
:- [sole-id]~
^- shoe-effect:shoe
:- %sole
?. =(src our):bowl
[%txt "1234"]
:- %mor
:~ [%klr ~[[[~ ~ `%g] [example-a]~] [``~ [ships]~]]]
[%klr ~[[[~ ~ `%b] [example-b]~] [``~ [track]~]]]
[%klr ~[[[~ ~ `%r] [example-c]~] [``~ [failed-tx]~]]]
==
::
++ submit
|= [=address:ethereum =tx:naive]
^- (quip card _this)
=/ owner=(unit [=nonce:naive =point:naive])
=/ points=(list [=ship =point:naive])
~(tap in (~(get ju points) address))
|- ^- (unit [nonce:naive point:naive])
?~ points ~
?. =(ship.from.tx ship.i.points)
$(points t.points)
`(get-owner point.i.points proxy.from.tx)
:: =< `[nonce point.i.points]
:: (proxy-from-point:naive proxy.from.tx point.i.points)
?~ owner ~& "empty points" [~ this]
=/ =keccak
%- hash-tx:lib
(unsigned-tx:lib 1.337 nonce.u.owner (gen-tx-octs:lib tx))
=/ sig=octs (fake-sig tx address nonce.u.owner)
=. points
%+ ~(put ju points) address
[ship.from.tx point.u.owner]
:_ this
:_ ~
:* %pass
/pokepath
%agent
[our.bowl %roller]
%poke
roller-action+!>([%submit | address q.sig %don tx])
==
::
++ track
|= =address:ethereum
^- (quip card _this)
=/ [to=(list _sole-id) fec=shoe-effect:shoe]
:- [sole-id]~
:- %sole
=/ =tape "Listening to updates for {(scow %ux address)}"
?. =(src our):bowl
[%txt tape]
[%klr [[`%br ~ `%g] [(crip tape)]~]~]
:: :_ this(keys (snoc keys address))
:_ this
:~ [%shoe to fec]
:^ %pass /points/[(scot %ux address)] %agent
[[our.bowl %roller] %watch /points/[(scot %ux address)]]
::
:^ %pass /txs/[(scot %ux address)] %agent
[[our.bowl %roller] %watch /txs/[(scot %ux address)]]
==
::
++ history
|= =address:ethereum
^- (quip card _this)
:_ this
=; [to=(list _sole-id) fec=shoe-effect:shoe]
[%shoe to fec]~
:- [sole-id]~
:^ %table
:: ~[t+'address' t+'signing ship' t+'type' t+'status' t+'hash']
~[t+'signing ship' t+'type' t+'status' t+'hash']
~[14 20 9 13]
%+ turn ~(tap in (~(get ju history.state) address))
|= roller-tx
|^ ~[p+ship t+type t+status pack-hash]
::
++ pack-address
=+ addr=(scow %ux address)
=+ len=(lent addr)
:- %t
%- crip
;: weld
(swag [0 6] addr)
"..."
(swag [(sub len 4) len] addr)
==
::
++ pack-hash
=+ hash=(scow %ux hash)
=+ len=(lent hash)
:- %t
%- crip
;: weld
(swag [0 6] hash)
"..."
(swag [(sub len 4) len] hash)
==
--
::
++ ships
|= =address:ethereum
^- (quip card _this)
~& ships+(turn ~(tap in (~(get ju points) address)) head)
[~ this]
--
::
++ can-connect
|= sole-id=@ta
^- ?
?| =(~zod src.bowl)
(team:title [our src]:bowl)
==
::
++ on-connect on-connect:des
++ on-disconnect on-disconnect:des
--