mirror of
https://github.com/urbit/shrub.git
synced 2024-12-19 00:13:12 +03:00
595 lines
16 KiB
Plaintext
595 lines
16 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]
|
|
:: Point data for a given ship
|
|
::
|
|
[%point address:ethereum ship]
|
|
:: 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
|
|
|= [=mark =vase]
|
|
^- (quip card _this)
|
|
~&
|
|
=/ addr=@ux
|
|
0x6def.fb0c.afdb.11d1.75f1.23f6.891a.a64f.01c2.4f7d
|
|
:: %+ turn
|
|
~(tap in (~(get ju points) addr))
|
|
:: head
|
|
[~ this]
|
|
++ 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)
|
|
=+ !<(new-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 ship.new-point)})"
|
|
=. points.state
|
|
:: FIXME: doesn't properly update point
|
|
:: handle proper insert/deletion of points
|
|
:: to account for ownership changes/nonce updates
|
|
::
|
|
=; [is-owner=? old=(unit [=ship =point:naive])]
|
|
?~ old points.state
|
|
=. points.state
|
|
(~(del ju points.state) u.addr u.old)
|
|
?. is-owner points.state
|
|
(~(put ju points.state) [u.addr new-point])
|
|
=/ points=(list [=ship =point:naive])
|
|
~(tap in (~(get ju points.state) u.addr))
|
|
|- ^- [? (unit [ship point:naive])]
|
|
|^
|
|
?~ points [| ~]
|
|
?. =(ship.i.points ship.new-point)
|
|
$(points t.points)
|
|
:- is-owner
|
|
`[ship.new-point point.i.points]
|
|
::
|
|
++ is-owner
|
|
=* own own.point.new-point
|
|
?| =(u.addr address.owner.own)
|
|
=(u.addr address.spawn-proxy.own)
|
|
=(u.addr address.management-proxy.own)
|
|
=(u.addr address.voting-proxy.own)
|
|
=(u.addr address.transfer-proxy.own)
|
|
==
|
|
--
|
|
:: %- ~(run in points)
|
|
:: |= old=[=ship =point:naive]
|
|
:: ?. =(ship.old ship.new)
|
|
:: old
|
|
:: point.new
|
|
:: (~(put ju points.state) [u.addr point])
|
|
~& :- %ships
|
|
(turn ~(tap in (~(get ju points.state) u.addr)) head)
|
|
:_ 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)
|
|
;~((glue ace) (tag %point) address ;~(pfix sig fed:ag))
|
|
==
|
|
::
|
|
++ 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)
|
|
%point (point +.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' t+'time']
|
|
~[14 20 9 13 26]
|
|
%+ turn
|
|
%+ sort ~(tap in (~(get ju history.state) address))
|
|
|=([a=roller-tx b=roller-tx] (lth time.a time.b))
|
|
|= roller-tx
|
|
|^ ~[p+ship t+type t+status pack-hash t+(scot %da time)]
|
|
::
|
|
++ 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]
|
|
::
|
|
++ point
|
|
|= [=address:ethereum =ship]
|
|
^- (quip card _this)
|
|
=/ points=(set [@p point:naive])
|
|
(~(get ju points.state) address)
|
|
~& %+ skim ~(tap in points)
|
|
|=([s=@p =point:naive] =(s ship))
|
|
[~ this]
|
|
--
|
|
::
|
|
++ can-connect
|
|
|= sole-id=@ta
|
|
^- ?
|
|
?| =(~zod src.bowl)
|
|
(team:title [our src]:bowl)
|
|
==
|
|
::
|
|
++ on-connect on-connect:des
|
|
++ on-disconnect on-disconnect:des
|
|
--
|