urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2025-01-03 01:54:43 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/poprox/naive-tests' into philip/naive

Browse Source
This commit is contained in:
Philip Monk 2021-05-20 13:09:53 -10:00
commit c5b17bdb7a
No known key found for this signature in database
GPG Key ID: B66E1F02604E44EC
11 changed files with 2046 additions and 248 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

454
pkg/arvo/app/aggregator.hoon Normal file
View File

@ -0,0 +1,454 @@
:: aggregator: Azimuth L2 roll aggregator
::
:: general flow is as described below, to ensure transactions actually go
:: through once we start sending it out, in the dumbest reasonable way.
::
:: periodic timer fires:
:: if there are no pending l2 txs, do nothing.
:: else kick off tx submission flow:
:: "freeze" pending txs, store alongside nonce, then increment nonce,
:: kick off thread for sending the corresponding l1 tx:
:: if nonce doesn't match on-chain expected nonce, bail.
:: if we can't afford the tx fee, bail.
:: construct, sign, submit the l1 tx.
:: if thread bailed, retry in five minutes.
:: if thread succeeded, retry in five minutes with higher gas price.
:: when retrying, only do so if l2 txs remain in the "frozen" txs group.
:: on %tx diff from naive, remove the matching tx from the frozen group.
::
::TODO remaining general work:
:: - hook up subscription to azimuth for %tx diffs
:: - hook up thread updates/results
:: - hook up timer callbacks
:: - cache state, upate after every azimuth %fact
:: - properly support private key changes
::
::TODO questions:
:: - it's a bit weird how we just assume the raw and tx in raw-tx to match...
::
/+ naive, default-agent, ethereum, dbug, verb
/= ttttt /tests/lib/naive ::TODO use new lib
::
::TODO /sur file for public types
|%
+$ state-0
$: %0
:: pending: the next l2 txs to be sent
:: sending: the l2 txs currently sending/awaiting l2 confirmation
::TODO should maybe key by [address nonce] instead. same for wires
:: finding: raw-tx-hash reverse lookup for sending map
:: next-nonce: next l1 nonce to use
::
pending=(list pend-tx)
sending=(map nonce:naive [next-gas-price=@ud txs=(list raw-tx:naive)])
finding=(map keccak $?(%confirmed %failed l1-tx-pointer))
next-nonce=@ud
::
:: pk: private key to send the roll
:: frequency: time to wait between sending batches (TODO fancier)
:: endpoint: ethereum rpc endpoint to use
::
pk=@
frequency=@dr
endpoint=@t
==
::
+$ keccak @ux
::
+$ tx-status
$: status=?(%unknown %pending %sending %confirmed %failed)
pointer=(unit l1-tx-pointer)
==
::
+$ l1-tx-pointer
$: =address:ethereum
nonce=@ud
==
::
::TODO cache sender address?
+$ pend-tx [force=? =raw-tx:naive]
::
+$ part-tx
$% [%raw raw=octs]
[%don =tx:naive]
[%ful raw=octs =tx:naive] ::TODO redundant?
==
::
+$ action
$% [%submit force=? sig=@ tx=part-tx]
[%cancel sig=@ keccak=@]
::
[%commit ~] ::TODO maybe pk=(unit @) later
[%config frequency=@dr]
[%setkey pk=@]
::TODO configure endpoint, contract address, chain..?
==
::
+$ card card:agent:gall
::
::TODO config?
++ contract 0xb581.01cd.3bbb.cc6f.a40b.cdb0.4bb7.1623.b5c7.d39b
++ chain-id '1'
::
++ resend-time ~m5
::
++ lverb &
--
::
=| state-0
=* state -
::
%- agent:dbug
%+ verb |
^- agent:gall
::
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
::TODO set default frequency and endpoint?
=. frequency ~h1
[~ this]
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
=^ cards state
?+ mark (on-poke:def mark vase)
%aggregator-action
=+ !<(poke=action vase)
(on-action:do poke)
==
[cards this]
:: +on-peek: scry paths
::TODO reevaluate wrt recent flow changes
::
:: /x/pending -> %noun (list pend-tx)
:: /x/pending/[~ship] -> %noun (list pend-tx)
:: /x/pending/[0xadd.ress] -> %noun (list pend-tx)
:: /x/tx/[0xke.ccak]/status -> %noun tx-status
:: /x/nonce/[~ship]/[0xadd.ress] -> %atom @
::
++ on-peek
|= =path
^- (unit (unit cage))
?+ path ~
[%x %pending ~] ``noun+!>(pending)
::
[%x %pending @ ~]
=* wat i.t.t.path
?~ who=(slaw %p wat)
:: by-address
::
?~ wer=(slaw %ux wat)
[~ ~]
=; pending=(list pend-tx)
``noun+!>(pending)
%+ skim pending
|= pend-tx
::TODO deduce address from sig.raw-tx ?
!!
:: by-ship
::
=; pending=(list pend-tx)
``noun+!>(pending)
%+ skim pending
|= pend-tx
=(u.who ship.from.tx.raw-tx)
::
[%x %tx @ %status ~]
?~ keccak=(slaw %ux i.t.t.path)
[~ ~]
:+ ~ ~
:- %noun
!> ^- tx-status
?^ status=(~(get by finding) u.keccak)
?@ u.status [u.status ~]
[%sending status]
::TODO potentially slow!
=; known=?
[?:(known %pending %unknown) ~]
%+ lien pending
|= [* raw-tx:naive]
=(u.keccak (hash-tx raw))
::
[%x %nonce @ @ ~]
?~ who=(slaw %p i.t.t.path)
[~ ~]
=+ proxy=i.t.t.t.path
?. ?=(proxy:naive proxy)
[~ ~]
=/ [* nas=^state:naive] pending-state:do
::TODO or should we ~ when !(~(has by points.nas) who) ?
=/ =point:naive (~(gut by points.nas) u.who *point:naive)
=+ (proxy-from-point:naive proxy point)
``atom+!>(nonce)
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ +<.sign-arvo (on-arvo:def wire sign-arvo)
%wake =^(cards state on-timer:do [cards this])
==
::
++ on-fail
|= [=term =tang]
::TODO if crashed during timer, set new timer? how to detect?
(on-fail:def term tang)
::
++ on-watch on-watch:def
++ on-leave on-leave:def
++ on-agent on-agent:def
--
::
|_ =bowl:gall
::TODO /lib/sys.hoon?
++ sys
|%
++ b
|%
++ wait
|= [=wire =time]
^- card
[%pass wire %arvo %b %wait time]
--
--
::TODO /lib/spider.hoon?
++ spider
|%
++ start-thread
|= [=wire thread=term arg=vase]
^- (list card)
=/ tid=@ta (rap 3 thread '--' (scot %uv eny.bowl) ~)
:~ (poke wire %spider-start !>([~ `tid thread arg]))
(watch wire %spider-start /thread-result/[tid])
==
::
++ poke
|= [=path =cage]
^- card
[%pass path %agent [our.bowl %spider] %poke cage]
::
++ watch
|= [=path =sub=path]
^- card
[%pass path %agent [our.bowl %spider] %watch sub-path]
::
++ leave
|= =path
^- card
[%pass path %agent [our.bowl %spider] %leave ~]
--
::
++ hash-tx keccak-256:keccak:crypto
::
++ hash-raw-tx
|= =raw-tx:naive
(hash-tx raw.raw-tx)
::
++ part-tx-to-full
|= =part-tx
^- [octs tx:naive]
?+ -.part-tx !!
:: %raw [+.part-tx (decode-tx:naive +.part-tx)]
:: %don [(encode-tx:naive +.part-tx) +.part-tx]
%ful +.part-tx
==
:: +pending-state
::
:: derives tentative state from pending txs and canonical state,
:: discarding invalid pending txs in the process.
::
::TODO maybe want to cache locally, refresh on %fact from azimuth?
::
++ pending-state
^- (quip pend-tx ^state:naive)
:: load current, canonical state
::
=+ .^ nas=^state:naive
%gx
(scot %p our.bowl)
%azimuth
(scot %da now.bowl)
/nas/nas
==
:: apply our pending transactions
::TODO should also apply txs from sending map!
::
=| valid=_pending
|- ^+ [valid nas]
?~ pending [(flop valid) nas]
::
=^ gud=? nas (try-apply nas i.pending)
=? valid gud [i.pending valid]
$(pending t.pending)
:: +try-apply:
::
++ try-apply
|= [nas=^state:naive force=? =raw-tx:naive]
^- [success=? _nas]
?. (verify-sig-and-nonce:naive verifier:ttttt chain-id nas raw-tx)
[force nas]
::
=^ out points.nas (increment-nonce:naive nas from.tx.raw-tx)
::
?~ nex=(receive-tx:naive nas tx.raw-tx)
[force nas]
[& +.u.nex]
::
++ on-action
|= =action
^- (quip card _state)
?- -.action
%commit !! :: TODO send-roll
%config [~ state(frequency frequency.action)]
%setkey [~ state(pk pk.action)] ::TODO what about existing sending entries?
::
%submit
=^ success state
^- [? _state]
%^ take-tx
force.action
sig.action
(part-tx-to-full tx.action)
:: TODO: consider failure case
?> success
[~ state]
::
%cancel
!! ::TODO
==
:: +take-tx: accept submitted l2 tx into the :pending list
::TODO rewrite
::
++ take-tx
|= [force=? =raw-tx:naive]
^- [success=? _state]
=/ [nep=_pending nas=^state:naive] pending-state
=| success=?
:: TODO: actually use try-apply when proper Tx signing in place
::
:: =^ success nas
:: (try-apply nas force raw-tx)
::TODO want to notify about dropped pendings, or no? client prolly polls...
=? pending success (snoc nep [force raw-tx])
::TODO cache nas?
[success state]
:: +set-timer: %wait until next whole :frequency
::
++ set-timer
^- card
%+ wait:b:sys /timer
(mul +((div now.bowl frequency)) frequency)
:: +on-timer: every :frequency, freeze :pending txs roll and start sending it
::
++ on-timer
^- (quip card _state)
=^ cards state
?~ pending [~ state]
=/ nonce=@ud next-nonce
=: :: FIXME: what's up with this? `pending ~` also fails
:: pending *(list pend-tx)
next-nonce +(next-nonce)
::
sending
%+ ~(put by sending) nonce
[0 (turn pending tail)]
==
[(send-roll nonce) state]
[[set-timer cards] state]
:: +send-roll: start thread to submit roll from :sending to l1
::
++ send-roll
|= nonce=@ud
^- (list card)
:: if this nonce isn't in the sending queue anymore, it's done
::
?. (~(has by sending) nonce)
~? lverb [dap.bowl %done-sending nonce]
~
:: start the thread, passing in the l2 txs to use
::
::TODO should go ahead and set resend timer in case thread hangs, or nah?
%+ start-thread:spider
/send/(scot %ud nonce)
:- %aggregator-send
!>
:* endpoint
contract
chain-id
0x1234.5678
nonce
(~(got by sending) nonce)
==
:: +on-thread-result: await resend after thread success or failure
::
++ on-thread-result
|= [nonce=@ud result=(each @ud term)]
^- (quip card _state)
:: update gas price for this tx in state
::
=? sending ?=(%& -.result)
%+ ~(jab by sending) nonce
(cork tail (lead p.result))
:: print error if there was one
::
~? ?=(%| -.result) [dap.bowl %send-error p.result]
:: resend the l1 tx in five minutes
::
:_ state
[(wait:b:sys /resend/(scot %ud nonce) (add resend-time now.bowl))]~
:: +on-naive-diff: process l2 tx confirmations
::
++ on-naive-diff
|= =diff:naive
^- (quip card _state)
?. ?=(%tx -.diff)
[~ state]
=/ =keccak (hash-raw-tx raw-tx.diff)
?~ wer=(~(get by finding) keccak)
[~ state]
:: if we had already seen the tx, no-op
::
?@ u.wer
~? &(?=(%confirmed u.wer) ?=(~ err.diff))
[dap.bowl %weird-double-confirm from.tx.raw-tx.diff]
[~ state]
=* nonce nonce.u.wer
:: remove the tx from the sending map
::
=. sending
?~ sen=(~(get by sending) nonce)
~& [dap.bowl %weird-double-remove]
sending
?~ nin=(find [raw-tx.diff]~ txs.u.sen)
~& [dap.bowl %weird-unknown]
sending
=. txs.u.sen (oust [u.nin 1] txs.u.sen)
?~ txs.u.sen
~? lverb [dap.bowl %done-with-nonce nonce]
(~(del by sending) nonce)
(~(put by sending) nonce u.sen)
:: update the finding map with the new status
::
=. finding
%+ ~(put by finding) keccak
?~ err.diff %confirmed
:: if we kept the forced flag around for longer, we could notify of
:: unexpected tx failures here. would that be useful? probably not?
:: ~? !forced [dap.bowl %aggregated-tx-failed-anyway err.diff]
%failed
[~ state]
::
--

235
pkg/arvo/app/azimuth-rpc.hoon Normal file
View File

@ -0,0 +1,235 @@
:: Azimuth JSON-RPC API
::
/- rpc=json-rpc
/+ naive,
azimuth-rpc,
json-rpc,
*server,
default-agent,
verb,
dbug,
version,
agentio
|%
:: FIXME: import tx-status, pend-tx from aggregator
::
+$ tx-status
$: status=?(%unknown %pending %sent %confirmed %failed)
tx=(unit @ux)
==
::
+$ pend-tx [force=? =raw-tx:naive]
::
+$ card card:agent:gall
::
+$ state-0 [%0 ~]
--
::
%+ verb |
%- agent:dbug
::
=| state-0
=* state -
::
^- agent:gall
=<
|_ =bowl:gall
+* this .
do ~(. +> bowl)
def ~(. (default-agent this %|) bowl)
::
++ on-init
^- (quip card _this)
~& > 'init'
:_ this
[%pass /bind %arvo %e %connect [~ [%v1 %azimuth ~]] dap.bowl]~
::
++ on-save !>(state)
++ on-load
|= old=vase
^- (quip card _this)
[~ this(state !<(state-0 old))]
::
++ on-poke
|= [=mark =vase]
^- (quip card _this)
|^
?> (team:title our.bowl src.bowl)
?+ mark (on-poke:def mark vase)
%handle-http-request
=+ !<([id=@ta req=inbound-request:eyre] vase)
:_ this
(handle-http-request id req)
::
%azimuth-action
=+ !<([%disconnect bind=binding:eyre] vase)
~& >>> "disconnecting at {<bind>}"
:_ this
[[%pass /bind %arvo %e %disconnect bind]]~
==
::
++ handle-http-request
|= [id=@ta =inbound-request:eyre]
^- (list card)
|^
=* req request.inbound-request
=* headers header-list.req
=/ req-line (parse-request-line url.req)
?. =(method.req %'POST')
:: TODO: method not supported
::
(give-simple-payload:app id not-found:gen)
?~ rpc-request=(validate-request:json-rpc body.req parse-method)
:: TODO: malformed request
::
(give-simple-payload:app id not-found:gen)
=/ [data=(unit cage) response=simple-payload:http]
(process-rpc-request:do u.rpc-request)
%+ weld
(give-simple-payload:app id response)
?~ data ~
:_ ~
^- card
[%pass / %agent [our.bowl %aggregator] %poke u.data]
:: TODO: validate that format is e.g. 'getPoint'
:: TODO: maybe use getPoint and translate to %get-point
::
++ parse-method |=(t=@t `term`t)
--
--
::
++ on-watch
|= =path
^- (quip card _this)
?> (team:title our.bowl src.bowl)
?+ path (on-watch:def path)
[%http-response *] [~ this]
==
::
++ on-arvo
|= [=wire =sign-arvo]
^- (quip card _this)
?+ sign-arvo (on-arvo:def wire sign-arvo)
[%eyre %bound *]
~? !accepted.sign-arvo
[dap.bowl 'bind rejected!' binding.sign-arvo]
[~ this]
==
::
++ on-leave on-leave:def
++ on-peek on-peek:def
++ on-agent on-agent:def
++ on-fail on-fail:def
--
::
|_ =bowl:gall
++ process-rpc-request
|= request:rpc
^- [(unit cage) simple-payload:http]
=; [data=(unit cage) =response:rpc]
:- data
%- json-response:gen
(response-to-json:json-rpc response)
=, azimuth-rpc
?. ?=([%map *] params)
[~ ~(parse error id)]
?+ method [~ ~(method error id)]
%get-point [~ (get-point id +.params point:scry)]
%transfer-point (transfer-point id +.params)
%configure-keys (configure-keys id +.params)
%spawn (spawn id +.params)
%escape (escape id +.params method)
%cancel-escape (cancel-escape id +.params method)
%adopt (adopt id +.params method)
%detach (detach id +.params method)
%reject (reject id +.params method)
%set-management-proxy (management-proxy id +.params method)
%set-spawn-proxy (spawn-proxy id +.params method)
%set-transfer-proxy (transfer-proxy id +.params method)
%pending [~ (all:pending id +.params all:pending:scry)]
%pending-by-ship [~ (ship:pending id +.params ship:pending:scry)]
%pending-by-address [~ (addr:pending id +.params addr:pending:scry)]
%status [~ (status id +.params tx-status:scry)]
:: %history [~ (history id +.params all:history:scry)]
==
::
++ scry
|%
++ point
|= =ship
.^ (unit point:naive)
%gx
(~(scry agentio bowl) %azimuth /nas/[(scot %p ship)]/noun)
==
::
++ pending
|%
++ all
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/noun)
==
::
++ ship
|= =^ship
.^ (list pend-tx)
%gx
(~(scry agentio bowl) %aggregator /pending/[(scot %p ship)]/noun)
==
::
++ addr
|= =address:naive
.^ (list pend-tx)
%gx
%+ ~(scry agentio bowl) %aggregator
/pending/[(scot %ux address)]/noun
==
--
::
++ history
|%
++ all
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/noun)
==
::
++ ship
|= =^ship
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/[(scot %p ship)]/noun)
==
::
++ addr
|= =address:naive
:: FIXME: use proper type from aggregator/index
::
.^ (list tx:naive)
%gx
(~(scry agentio bowl) %aggregator /history/[(scot %ux address)]/noun)
==
--
::
++ tx-status
|= keccak=@ux
.^ ^tx-status
%gx
(~(scry agentio bowl) %aggregator /tx/[(scot %ux keccak)]/status/noun)
==
::
++ nonce
|= [=ship =address:naive]
:: FIXME: use proper type from aggregator/index
.^ @
%gx
%+ ~(scry agentio bowl)
%aggregator
/nonce/[(scot %p ship)]/[(scot %ux address)]/atom
==
--
--

16
pkg/arvo/app/azimuth.hoon
View File

@ -256,11 +256,19 @@
++ on-leave on-leave:def
++ on-peek
|= =path
?: =(/x/nas path)
``nas+!>(nas.state)
?: =(/x/logs path)
^- (unit (unit cage))
?+ path (on-peek:def path)
[%x %logs ~]
``logs+!>(logs.state)
~
::
[%x %nas ~]
``nas+!>(nas.state)
::
[%x %nas @t ~]
?~ ship=(rush i.t.t.path ;~(pfix sig fed:ag))
``noun+!>(*(unit point:naive))
``noun+!>((~(get by points.nas.state) u.ship))
==
::
++ on-agent
|= [=wire =sign:agent:gall]

4
pkg/arvo/gen/azimuth-rpc/disconnect.hoon Normal file
View File

@ -0,0 +1,4 @@
::
:- %say
|= [* [=binding:eyre ~] ~]
[%azimuth-action %disconnect binding]

503
pkg/arvo/lib/azimuth-rpc.hoon Normal file
View File

@ -0,0 +1,503 @@
:: azimuth-rpc: command parsing and utilities
::
/- rpc=json-rpc
/+ naive
::
=> :: Utilities
::
|%
+$ spawn-action
$? %escape
%cancel-escape
%adopt
%reject
%detach
==
::
+$ proxy-action
$? %set-management-proxy
%set-spawn-proxy
%set-transfer-proxy
==
:: FIXME: import tx-status, pend-tx from aggregator
::
+$ tx-status
$: status=?(%unknown %pending %sent %confirmed %failed)
tx=(unit @ux)
==
::
+$ pend-tx [force=? =raw-tx:naive]
::
++ from-json
|%
++ keys
|= params=(map @t json)
^- (unit [encrypt=@ auth=@ crypto-suite=@ breach=?])
?~ data=(~(get by params) 'data') ~
%. u.data
=, dejs-soft:format
%- ot
:~ ['encrypt' so]
['auth' so]
['crypto-suite' so]
['breach' bo]
==
::
++ data
|%
++ address-transfer
|= params=(map @t json)
^- (unit [@ux ?])
?~ data=(~(get by params) 'data') ~
=; ans=(unit [add=(unit @ux) r=?])
?~ ans ~
?~ add.u.ans ~
(some [u.add.u.ans r.u.ans])
%. u.data
=, dejs-soft:format
%- ot
~[['address' (cu to-hex so)] ['reset' bo]]
::
++ address-ship
|= params=(map @t json)
^- (unit [@p @ux])
?~ data=(~(get by params) 'data') ~
=; ans=(unit [ship=@p add=(unit @ux)])
?~ ans ~
?~ add.u.ans ~
(some [ship.u.ans u.add.u.ans])
%. u.data
=, dejs-soft:format
%- ot
:~ ['ship' (su ;~(pfix sig fed:ag))]
['address' (cu to-hex so)]
==
::
++ address
|= params=(map @t json)
^- (unit @ux)
?~ data=(~(get by params) 'data') ~
=; ans=(unit (unit @ux))
?~(ans ~ u.ans)
=, dejs-soft:format
%. u.data
(ot ['address' (cu to-hex so)]~)
::
++ ship
|= params=(map @t json)
^- (unit @p)
?~ data=(~(get by params) 'data') ~
=, dejs-soft:format
%. u.data
(ot ['ship' (su ;~(pfix sig fed:ag))]~)
--
::
++ ship
|= params=(map @t json)
^- (unit @p)
?~ data=(~(get by params) 'ship') ~
=, dejs-soft:format
%. u.data
(su ;~(pfix sig fed:ag))
::
++ address
|= params=(map @t json)
^- (unit @ux)
?~ data=(~(get by params) 'address') ~
=; ans=(unit (unit @ux))
?~(ans ~ u.ans)
=, dejs-soft:format
((cu to-hex so) u.data)
::
++ sig
|= params=(map @t json)
^- (unit @)
?~ sig=(~(get by params) 'sig') ~
(so:dejs-soft:format u.sig)
::
++ from
|= params=(map @t json)
^- (unit [@p proxy:naive])
?~ from=(~(get by params) 'from') ~
=, dejs-soft:format
%. u.from
%- ot
:~ ['ship' (su ;~(pfix sig fed:ag))]
['proxy' (cu proxy:naive so)]
==
::
++ keccak
|= params=(map @t json)
^- (unit @ux)
?~ keccak=(~(get by params) 'keccak') ~
=; ans=(unit (unit @ux))
?~(ans ~ u.ans)
=, dejs-soft:format
((cu to-hex so) u.keccak)
::
++ raw
|= params=(map @t json)
^- (unit octs)
?~ raw=(~(get by params) 'raw') ~
=; ans=(unit (unit @ux))
?~ ans ~
?~ u.ans ~
(some (as-octs:mimes:html u.u.ans))
=, dejs-soft:format
((cu to-hex so) u.raw)
--
::
++ to-json
|%
++ pending
|= pending=(list pend-tx)
^- json
=, enjs:format
:- %a
%+ turn pending
|= pend-tx
^- json
=, enjs:format
%- pairs
:~ ['force' b+force]
::
:- 'raw-tx'
%- pairs
:~ ['sig' (numb sig.raw-tx)]
['tx' (tx:to-json tx.raw-tx)]
== ==
::
++ tx
|= =tx:naive
^- json
=, enjs:format
|^
%- pairs
:~ ['tx' (parse-tx +.tx)]
::
:- 'from'
%- pairs
~[['ship' (ship ship.from.tx)] ['proxy' s+proxy.from.tx]]
==
::
++ parse-tx
|= tx=skim-tx:naive
^- json
%- pairs
:~ ['type' s+-.tx]
::
:- 'data'
%- pairs
?- -.tx
%transfer-point (en-transfer +.tx)
%spawn (en-spawn +.tx)
%configure-keys (en-keys +.tx)
%escape ~[(en-ship parent.tx)]
%cancel-escape ~[(en-ship parent.tx)]
%adopt ~[(en-ship ship.tx)]
%reject ~[(en-ship ship.tx)]
%detach ~[(en-ship ship.tx)]
%set-management-proxy ~[(en-address address.tx)]
%set-spawn-proxy ~[(en-address address.tx)]
%set-transfer-proxy ~[(en-address address.tx)]
== ==
::
++ en-ship |=(s=@p ship+(ship s))
++ en-address |=(a=@ux address+s+(crip "0x{((x-co:co 20) a)}"))
++ en-spawn |=([s=@p a=@ux] ~[(en-ship s) (en-address a)])
++ en-transfer |=([a=@ux r=?] ~[(en-address a) reset+b+r])
++ en-keys
|= [encrypt=@ auth=@ crypto-suite=@ breach=?]
^- (list [@t json])
:~ ['encrypt' (numb encrypt)]
['auth' (numb auth)]
['crypto-suite' (numb crypto-suite)]
['breach' b+breach]
==
--
::
++ txs
|= txs=(list tx:naive)
^- json
a+(turn txs |=(=tx:naive (tx:to-json tx)))
::
++ point
|= =point:naive
^- json
=, enjs:format
%- pairs
:~ ['dominion' s+dominion.point]
::
:- 'ownership'
%- pairs
=* own own.point
^- (list [@t json])
:~ ['owner' (ownership owner.own)]
['spawnProxy' (ownership spawn-proxy.own)]
['managementProxy' (ownership management-proxy.own)]
['votingProxy' (ownership voting-proxy.own)]
['transferProxy' (ownership transfer-proxy.own)]
==
::
:- 'network'
%- pairs
=* net net.point
:* ['rift' (numb rift.net)]
::
:- 'keys'
%- pairs
:~ ['life' (numb life.keys.net)]
['suite' (numb suite.keys.net)]
['auth' (numb auth.keys.net)]
['crypt' (numb crypt.keys.net)]
==
::
['rift' (numb rift.net)]
:- 'sponsor'
%- pairs
~[['has' b+has.sponsor.net] ['who' (ship who.sponsor.net)]]
::
?~ escape.net ~
['escape' (ship u.escape.net)]~
== ==
::
++ ownership
|= [=address:naive =nonce:naive]
^- json
=, enjs:format
%- pairs
:~ ['address' s+(crip "0x{((x-co:co 20) address)}")]
['nonce' (numb nonce)]
==
::
++ tx-status
|= =^tx-status
^- json
=, enjs:format
%- pairs
:~ ['status' s+status.tx-status]
::
:- 'tx'
?~ tx.tx-status ~
s+(crip "0x{((x-co:co 20) u.tx.tx-status)}")
==
--
::
++ to-hex
|= =cord
^- (unit @ux)
=/ parsed=(unit (pair @ud @ux)) (de:base16:mimes:html cord)
?~ parsed
::~|(%non-hex-cord !!)
~
(some q.u.parsed)
::
++ rpc-res
|%
++ sponsor
|= [id=@t params=(map @t json) action=spawn-action]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit @p) (ship:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
:- %aggregator-action
!>
=; =skim-tx:naive
[%submit | u.sig %ful u.raw u.from skim-tx]
?- action
%escape [%escape u.data]
%cancel-escape [%cancel-escape u.data]
%adopt [%adopt u.data]
%reject [%reject u.data]
%detach [%detach u.data]
==
::
++ proxy
|= [id=@t params=(map @t json) action=proxy-action]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit @ux) (address:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
:- %aggregator-action
!>
=; =skim-tx:naive
[%submit | u.sig %ful u.raw u.from skim-tx]
?- action
%set-management-proxy [%set-management-proxy u.data]
%set-spawn-proxy [%set-spawn-proxy u.data]
%set-transfer-proxy [%set-transfer-proxy u.data]
==
--
::
++ error
|_ id=@t
:: https://www.jsonrpc.org/specification#error_object
::
++ parse [%error id '-32700' 'Failed to parsed']
++ request [%error id '-32600' 'Invalid Request']
++ method [%error id '-32601' 'Method not found']
++ params [%error id '-32602' 'Invalid params']
++ internal [%error id '-32603' 'Internal error']
++ not-found [%error id '-32000' 'Resource not found']
--
::
++ validate
|%
++ params
|= params=(map @t json)
^- ?
=((lent ~(tap by params)) 4)
--
--
|%
++ get-point
|= [id=@t params=(map @t json) scry=$-(ship (unit point:naive))]
^- response:rpc
?. =((lent ~(tap by params)) 1)
~(params error id)
?~ ship=(~(get by params) 'ship')
~(params error id)
?~ ship=(rush (so:dejs:format u.ship) ;~(pfix sig fed:ag))
~(params error id)
?~ point=(scry u.ship)
~(params error id)
[%result id (point:to-json u.point)]
::
++ transfer-point
|= [id=@t params=(map @t json)]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [ship @t]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit [@ux ?]) (address-transfer:data:from-json params)
?: |(?=(~ sig) ?=(~ from) ?=(~ raw) ?=(~ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
noun+!>([u.sig u.from u.data])
::
++ configure-keys
|= [id=@t params=(map @t json)]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [ship @t]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit [encrypt=@ auth=@ crypto-suite=@ breach=?])
(keys:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
noun+!>([u.sig u.from u.data])
::
++ spawn
|= [id=@t params=(map @t json)]
^- [(unit cage) response:rpc]
?. (params:validate params)
[~ ~(params error id)]
=/ sig=(unit @) (sig:from-json params)
=/ from=(unit [@p proxy:naive]) (from:from-json params)
=/ raw=(unit octs) (raw:from-json params)
=/ data=(unit [@p @ux]) (address-ship:data:from-json params)
?. &(?=(^ sig) ?=(^ from) ?=(^ raw) ?=(^ data))
[~ ~(parse error id)]
:_ [%result id s+'ok']
%- some
aggregator-action+!>([%submit | u.sig %ful u.raw u.from %spawn u.data])
::
++ escape sponsor:rpc-res
++ cancel-escape sponsor:rpc-res
++ adopt sponsor:rpc-res
++ detach sponsor:rpc-res
++ reject sponsor:rpc-res
++ management-proxy proxy:rpc-res
++ spawn-proxy proxy:rpc-res
++ transfer-proxy proxy:rpc-res
:: - readNonce(from=[ship proxy]) -> @ :: automatically increment for pending wraps
::
++ read-nonce
|= [id=@t params=(map @t json) scry=$-([ship proxy:naive] (unit @))]
^- response:rpc
?. =((lent ~(tap by params)) 3)
~(params error id)
?~ from=(from:from-json params)
~(parse error id)
?~ nonce=(scry u.from)
~(params error id)
[%result id (numb:enjs:format u.nonce)]
::
++ pending
:: FIXME: send raw-tx (i.e. tx with signature) instead?
::
|%
:: - readPendingRoll() -> (list pend-tx)
::
++ all
|= [id=@t params=(map @t json) pending=(list pend-tx)]
^- response:rpc
?. =((lent ~(tap by params)) 0)
~(params error id)
[%result id (pending:to-json pending)]
:: - readPendingByShip(ship) -> (list pend-tx)
::
++ ship
|= [id=@t params=(map @t json) scry=$-(@p (list pend-tx))]
^- response:rpc
?. =((lent ~(tap by params)) 1)
~(params error id)
?~ ship=(ship:from-json params)
~(parse error id)
[%result id (pending:to-json (scry u.ship))]
:: - readPendingByAddress(address) -> (list pend-tx)
::
++ addr
|= [id=@t params=(map @t json) scry=$-(@ux (list pend-tx))]
^- response:rpc
?. =((lent ~(tap by params)) 1)
~(params error id)
?~ address=(address:from-json params)
~(parse error id)
[%result id (pending:to-json (scry u.address))]
--
::
++ status
|= [id=@t params=(map @t json) scry=$-(@ tx-status)]
^- response:rpc
?. =((lent ~(tap by params)) 1)
~(params error id)
?~ keccak=(keccak:from-json params)
~(parse error id)
[%result id (tx-status:to-json (scry u.keccak))]
::
:: ++ history
:: |= $: id=@t
:: params=(map @t json)
:: :: FIXME: use proper type from aggregator/index
:: ::
:: scry=$-([@p proxy:naive] (list tx:naive))
:: ==
:: ^- response:rpc
:: ?. =((lent ~(tap by params)) 1)
:: ~(params error id)
:: ?~ from=(from:from-json params)
:: ~(parse error id)
:: [%result id (txs:to-json (scry u.from))]
--

63
pkg/arvo/lib/json/rpc.hoon
View File

@ -24,8 +24,65 @@
:- %params
^- json
?- -.params
%list [%a +.params]
%object [%o (~(gas by *(map @t json)) +.params)]
==
%list [%a +.params]
%map [%o +.params]
%object [%o (~(gas by *(map @t json)) +.params)]
== ==
::
++ response-to-json
|= =response
^- json
:: TODO: consider all cases
::
?+ -.response ~|([%unsupported-rpc-response response] !!)
%result
:- %o
%- molt
^- (list [@t json])
:: FIXME: return 'id' as string, number or NULL
::
:~ ['jsonrpc' s+'2.0']
['id' s+id.response]
['result' res.response]
==
::
%error
:- %o
%- molt
^- (list [@t json])
:~ ['jsonrpc' s+'2.0']
['id' ?~(id.response ~ s+id.response)]
['code' n+code.response]
['message' s+message.response]
==
==
::
++ validate-request
|= [body=(unit octs) parse-method=$-(@t term)]
^- (unit request)
?~ body ~
?~ jon=(de-json:html q.u.body) ~
:: ignores non-object responses
::
:: ?. ?=([%o *] json) ~|([%format-not-valid json] !!)
?. ?=([%o *] u.jon) ~
%- some
%. u.jon
=, dejs:format
:: TODO: If parsing fails, return a proper error (not 500)
::
%- ot
:~ :: FIXME: parse 'id' as string, number or NULL
::
['id' so]
['jsonrpc' (su (jest '2.0'))]
['method' (cu parse-method so)]
::
:- 'params'
|= =json
^- request-params
?+ -.json !!
%a [%list ((ar same) json)]
%o [%map ((om same) json)]
== ==
--

180
pkg/arvo/lib/naive-transactions.hoon Normal file
View File

@ -0,0 +1,180 @@
/+ naive, ethereum
:: Types
|%
+$ address address:ethereum
+$ nonce @ud
+$ proxy ?(%own %spawn %manage %vote %transfer)
--
::
|%
::
:: ++ gen-tx-octs
:: :: takes in a nonce, tx:naive, and private key and returned a signed transactions as octs
:: ::
:: |= [=nonce tx=tx:naive pk=@] ^- octs
:: =/ raw=octs
:: ?- +<.tx
:: %spawn (get-spawn:bits -.tx +>.tx)
:: %transfer-point (get-transfer:bits -.tx +>.tx)
:: %configure-keys (get-keys:bits -.tx +>.tx)
:: %escape (get-escape:bits -.tx +.tx)
:: %cancel-escape (get-escape:bits -.tx +.tx)
:: %adopt (get-escape:bits -.tx +.tx)
:: %reject (get-escape:bits -.tx +.tx)
:: %detach (get-escape:bits -.tx +.tx)
:: %set-management-proxy (get-ship-address:bits -.tx +.tx)
:: %set-spawn-proxy (get-ship-address:bits -.tx +.tx)
:: %set-transfer-proxy (get-ship-address:bits -.tx +.tx)
:: ==
:: %^ sign-tx pk nonce raw
::
:: TODO: does this uniquely produce the pubkey?
++ verifier
^- ^verifier:naive
|= [dat=octs v=@ r=@ s=@]
?: (gth v 3) ~ :: TODO: move to jet
=/ result
%- mule
|.
=, secp256k1:secp:crypto
%- address-from-pub:key:ethereum
%- serialize-point
(ecdsa-raw-recover (keccak-256:keccak:crypto dat) v r s)
?- -.result
%| ~
%& `p.result
==
::
++ sign-tx
|= [pk=@ =nonce tx=octs] ^- octs
=/ prepared-data (prepare-for-sig 1.337 nonce tx)
=/ sign-data
=/ len (rsh [3 2] (scot %ui p.prepared-data))
%- keccak-256:keccak:crypto
%: cad:naive 3
26^'\19Ethereum Signed Message:\0a'
(met 3 len)^len
prepared-data
~
==
=+ (ecdsa-raw-sign:secp256k1:secp:crypto sign-data pk)
(cad:naive 3 1^v 32^s 32^r tx ~)
::
++ prepare-for-sig
|= [chain-id=@ud =nonce tx=octs]
^- octs
=/ chain-t (rsh [3 2] (scot %ui chain-id))
%: cad:naive 3
14^'UrbitIDV1Chain'
(met 3 chain-t)^chain-t
1^':'
4^nonce
tx
~
==
::
++ gen-tx-octs
:: takes in a nonce, tx:naive, and private key and returned a signed transactions as octs
::
|= [=nonce tx=tx:naive pk=@]
|^
^- octs
=/ raw=octs
?- +<.tx
%spawn (get-spawn +>.tx)
%transfer-point (get-transfer +>.tx)
%configure-keys (get-keys +>.tx)
%escape (get-escape +.tx)
%cancel-escape (get-escape +.tx)
%adopt (get-escape +.tx)
%reject (get-escape +.tx)
%detach (get-escape +.tx)
%set-management-proxy (get-ship-address +.tx)
%set-spawn-proxy (get-ship-address +.tx)
%set-transfer-proxy (get-ship-address +.tx)
==
%^ sign-tx pk nonce raw
::
++ get-spawn
|= [child=ship to=address] ^- octs
%: cad:naive 3
(from-proxy proxy.from.tx)
4^ship.from.tx
1^%1 :: %spawn
4^child
20^to
~
==
::
++ get-transfer
|= [=address reset=?] ^- octs
%: cad:naive 3
(from-proxy proxy.from.tx)
4^ship.from.tx
1^(can 0 7^%0 1^reset ~) :: %transfer-point
20^address
~
==
::
++ get-keys
|= [suite=@ud crypt=@ auth=@ breach=?] ^- octs
%: cad:naive 3
(from-proxy proxy.from.tx)
4^ship.from.tx
1^(can 0 7^%2 1^breach ~) :: %configure-keys
32^crypt
32^auth
4^suite
~
==
::
++ get-escape
|= [action=@tas other=ship] ^- octs
=/ op
?+ action !!
%escape %3
%cancel-escape %4
%adopt %5
%reject %6
%detach %7
==
%: cad:naive 3
(from-proxy proxy.from.tx)
4^ship.from.tx
1^(can 0 7^op 1^0 ~)
4^other
~
==
::
++ get-ship-address
|= [action=@tas =address] ^- octs
=/ op
?+ action !!
%set-management-proxy %8
%set-spawn-proxy %9
%set-transfer-proxy %10
==
%: cad:naive 3
(from-proxy proxy.from.tx)
4^ship.from.tx
1^(can 0 7^op 1^0 ~)
20^address
~
==
::
++ from-proxy
|= prx=@tas
^- [@ @]
=/ proxy
?+ prx !!
%own %0
%spawn %1
%manage %2
%vote %3
%transfer %4
==
1^(can 0 3^proxy 5^0 ~)
::
--
::
--

19
pkg/arvo/lib/naive.hoon
View File

@ -340,6 +340,17 @@
[other batch]
--
::
++ proxy-from-point
|= [=proxy point]
^- [=address =nonce]
?- proxy
%own owner.own
%spawn spawn-proxy.own
%manage management-proxy.own
%vote voting-proxy.own
%transfer transfer-proxy.own
==
::
++ verify-sig-and-nonce
|= [=verifier chain-t=@t =state =raw-tx]
^- ?
@ -347,13 +358,7 @@
=/ point (get-point state ship.from.tx.raw-tx)
?> ?=(^ point) :: we never parse more than four bytes for a ship
=/ need=[=address =nonce]
?- proxy.from.tx.raw-tx
%own owner.own.u.point
%spawn spawn-proxy.own.u.point
%manage management-proxy.own.u.point
%vote voting-proxy.own.u.point
%transfer transfer-proxy.own.u.point
==
(proxy-from-point proxy.from.tx.raw-tx u.point)
:: We include a domain separator to avoid letting signatures be
:: accidentally reused with other applications. We include the name
:: UrbitID, a signature format version number, and the EIP-155 chain

2
pkg/arvo/sur/json/rpc.hoon
View File

@ -3,12 +3,14 @@
|%
+$ request
$: id=@t
jsonrpc=@t
method=@t
params=request-params
==
::
+$ request-params
$% [%list (list json)]
[%map (map @t json)]
[%object (list (pair @t json))]
==
+$ response

100
pkg/arvo/ted/aggregator/send.hoon Normal file
View File

@ -0,0 +1,100 @@
:: aggregator/send: send rollup tx
::
/- rpc=json-rpc
/+ naive, ethereum, ethio, strandio
::
=/ gas-limit=@ud 30.000 ::TODO verify, maybe scale with roll size
::
|= args=vase
=+ !< $: endpoint=@t
contract=address:ethereum
chain-id=@
pk=@
::
nonce=@ud
next-gas-price=@ud
txs=(list raw-tx:naive)
==
args
=/ m (strand:strandio ,vase)
|^
^- form:m
=* not-sent (pure:m !>(next-gas-price))
::
=/ =address:ethereum
(address-from-pub:key:ethereum pk)
;< expected-nonce=@ud bind:m
(get-next-nonce:ethio endpoint address)
:: if chain expects a different nonce, don't send this transaction
::
?. =(nonce expected-nonce)
not-sent
:: if a gas-price of 0 was specified, fetch the recommended one
::
;< use-gas-price=@ud bind:m
?: =(0 next-gas-price) fetch-gas-price
(pure:(strand:strandio @ud) next-gas-price)
:: if we cannot pay for the transaction, don't bother sending it out
::
=/ max-cost=@ud (mul gas-limit use-gas-price)
;< balance=@ud bind:m
::TODO implement %eth-get-balance in /lib/ethio and /lib/ethereum
!!
?: (gth max-cost balance)
~& [%insufficient-aggregator-balance address]
not-sent
::
=/ tx=@ux
=; tx=transaction:rpc:ethereum
(sign-transaction:key:ethereum tx pk)
:* nonce
use-gas-price
gas-limit
contract
0
roll ::TODO tx data
chain-id
==
::
::NOTE this fails the thread if sending fails, which in the app gives us
:: the "retry with same gas price" behavior we want
;< jon=json bind:m
%+ request-rpc:ethio endpoint
[~ %eth-send-raw-transaction tx]
::TODO check that tx-hash in jon is non-zero?
::TODO enforce max here, or in app?
:: add five gwei to gas price of next attempt
::
(pure:m !>((add use-gas-price 5.000.000.000)))
::
::TODO should be distilled further, partially added to strandio?
++ fetch-gas-price
=/ m (strand:strandio @ud) ::NOTE return in wei
^- form:m
=/ =request:http
:* method=%'GET'
url='https://api.etherscan.io/api?module=gastracker&action=gasoracle'
header-list=~
~
==
;< ~ bind:m
(send-request:strandio request)
;< rep=(unit client-response:iris) bind:m
take-maybe-response:strandio
=* fallback
~& %fallback-gas-price
(pure:m 40.000.000.000) ::TODO maybe even lower, considering we increment?
?. ?& ?=([~ %finished *] rep)
?=(^ full-file.u.rep)
==
fallback
?~ jon=(de-json:html q.data.u.full-file.u.rep)
fallback
=; res=(unit @ud)
?~ res fallback
%- pure:m
(mul 1.000.000.000 u.res) ::NOTE gwei to wei
%. u.jon
=, dejs-soft:format
(ot 'result'^(ot 'FastGasPrice'^ni) ~)
--

718
pkg/arvo/tests/lib/naive.hoon
View File

@ -1,24 +1,7 @@
/+ *test, naive, ethereum
|%
++ address @ux
++ n |=([=^state:naive =^input:naive] (%*(. naive lac |) verifier 1.337 +<))
:: TODO: does this uniquely produce the pubkey?
/+ *test, naive, ethereum, azimuth, *naive-transactions
::
++ verifier
^- ^verifier:naive
|= [dat=octs v=@ r=@ s=@]
?: (gth v 3) ~ :: TODO: move to jet
=/ result
%- mule
|.
=, secp256k1:secp:crypto
%- address-from-pub:key:ethereum
%- serialize-point
(ecdsa-raw-recover (keccak-256:keccak:crypto dat) v r s)
?- -.result
%| ~
%& `p.result
==
|%
++ n |=([=^state:naive =^input:naive] (%*(. naive lac |) verifier 1.337 +<))
::
++ addr address-from-prv:key:ethereum
::
@ -32,7 +15,14 @@
++ init-bud
|= =^state:naive
^- [effects:naive ^state:naive]
(n state (owner-changed:l1 ~bud (addr ~bud)))
(n state (owner-changed:l1 ~bud (addr %bud-key-0)))
::
:: ~wes is for testing sponsors of stars
::
++ init-wes
|= =^state:naive
^- [effects:naive ^state:naive]
(n state (owner-changed:l1 ~wes (addr %wes-key-0)))
::
:: ~dopbud is for testing L1 ownership with L2 spawn proxy
::
@ -54,7 +44,18 @@
=^ f3 state (n state (owner-changed:l1 ~marbud deposit-address:naive))
[:(welp f1 f2 f3) state]
::
:: ~sambud is for testing L1 stars attempting L2 actions
:: ~litbud is for testing L2 sponsorship
::
++ init-litbud
|= =^state:naive
^- [effects:naive ^state:naive]
:: ~bud should already be spawned, though trying to init ~bud again shouldn't matter i think?
:: =^ f1 state (init-bud state)
=^ f2 state (n state (owner-changed:l1 ~litbud (addr %litbud-key-0)))
=^ f3 state (n state (owner-changed:l1 ~litbud deposit-address:naive))
[:(welp f2 f3) state]
::
:: ~sambud is for testing L1 stars
::
++ init-sambud
|= =^state:naive
@ -63,34 +64,6 @@
=^ f2 state (n state (owner-changed:l1 ~sambud (addr %sambud-key-0)))
[:(welp f1 f2) state]
::
++ sign-tx
|= [pk=@ nonce=@ud tx=octs] ^- octs
=/ prepared-data (prepare-for-sig 1.337 nonce tx)
=/ sign-data
=/ len (rsh [3 2] (scot %ui p.prepared-data))
%- keccak-256:keccak:crypto
%: cad:naive 3
26^'\19Ethereum Signed Message:\0a'
(met 3 len)^len
prepared-data
~
==
=+ (ecdsa-raw-sign:secp256k1:secp:crypto sign-data pk)
(cad:naive 3 1^v 32^s 32^r tx ~)
::
++ prepare-for-sig
|= [chain-id=@ud nonce=@ud tx=octs]
^- octs
=/ chain-t (rsh [3 2] (scot %ui chain-id))
%: cad:naive 3
14^'UrbitIDV1Chain'
(met 3 chain-t)^chain-t
1^':'
4^nonce
tx
~
==
::
++ l1
|%
::
@ -121,7 +94,7 @@
(log lost-sponsor:log-names:naive *@ux lost parent ~)
::
++ changed-keys
|= [=ship encr=@ auth=@ suite=@ life=@]
|= [=ship suite=@ encr=@ auth=@ life=@]
=/ keys=@ux
%: can 8
1^life
@ -162,162 +135,44 @@
::
--
::
++ l2
::
|%
::
++ spawn
|= [nonce=@ud parent=ship pk=@ proxy=@tas child=ship =address] ^- octs
%^ sign-tx pk nonce
%: cad:naive 3
(from-proxy:bits proxy)
4^parent
1^%1 :: %spawn
4^child
20^address
~
==
::
++ transfer-point
|= [nonce=@ud =ship pk=@ =address proxy=@tas reset=?] ^- octs
%^ sign-tx pk nonce
%: cad:naive 3
(from-proxy:bits proxy)
4^ship
1^(can 0 7^%0 1^reset ~) :: %transfer-point
20^address
~
==
::
++ configure-keys
|= $: nonce=@ud =ship pk=@ proxy=@tas
breach=@ encrypt=@ auth=@ crypto-suite=@
==
^- octs
%^ sign-tx pk nonce
%: cad:naive 3
(from-proxy:bits proxy)
4^ship
1^(can 0 7^%2 1^breach ~) :: %configure-keys
32^encrypt
32^auth
4^crypto-suite
~
==
::
++ escape
|= [nonce=@ud child=ship pk=@ proxy=@tas parent=ship] ^- octs
%^ sign-tx pk nonce
(take-escape:bits %escape child proxy parent)
::
++ cancel-escape
|= [nonce=@ud child=ship pk=@ proxy=@tas parent=ship] ^- octs
%^ sign-tx pk nonce
(take-escape:bits %cancel-escape child proxy parent)
::
++ adopt
|= [nonce=@ud child=ship pk=@ proxy=@tas parent=ship] ^- octs
%^ sign-tx pk nonce
(take-escape:bits %adopt parent proxy child)
::
++ reject
|= [nonce=@ud child=ship pk=@ proxy=@tas parent=ship] ^- octs
%^ sign-tx pk nonce
(take-escape:bits %reject parent proxy child)
::
++ detach
|= [nonce=@ud child=ship pk=@ proxy=@tas parent=ship] ^- octs
%^ sign-tx pk nonce
(take-escape:bits %detach parent proxy child)
::
++ set-management-proxy
|= [nonce=@ud =ship pk=@ proxy=@tas =address] ^- octs
%^ sign-tx pk nonce
^- octs
(take-ship-address:bits %set-management-proxy ship proxy address)
::
++ set-spawn-proxy
|= [nonce=@ud =ship pk=@ proxy=@tas =address] ^- octs
%^ sign-tx pk nonce
(take-ship-address:bits %set-spawn-proxy ship proxy address)
::
++ set-transfer-proxy
|= [nonce=@ud =ship pk=@ proxy=@tas =address] ^- octs
%^ sign-tx pk nonce
(take-ship-address:bits %set-transfer-proxy ship proxy address)
::
++ bits
::
|%
::
:: TODO: Shouldn't need to pass all these arguments along - they should already be in the subject somewhere
::
++ take-escape
|= [action=@tas from=ship proxy=@tas other=ship] ^- octs
=/ op
?+ action !!
%escape %3
%cancel-escape %4
%adopt %5
%reject %6
%detach %7
==
%: cad:naive 3
(from-proxy proxy)
4^from
1^(can 0 7^op 1^0 ~)
4^other
~
==
::
++ take-ship-address
|= [action=@tas from=ship proxy=@tas =address] ^- octs
=/ op
?+ action !!
%set-management-proxy %8
%set-spawn-proxy %9
%set-transfer-proxy %10
==
%: cad:naive 3
(from-proxy proxy)
4^from
1^(can 0 7^op 1^0 ~)
20^address
~
==
::
++ from-proxy
|= prx=@tas
^- [@ @]
=/ proxy
?+ prx !!
%own %0
%spawn %1
%manage %2
%vote %3
%transfer %4
==
1^(can 0 3^proxy 5^0 ~)
::
--
::
--
::
--
::
:: Common values used for tests
::
|%
::
++ encr (shax 'You will forget that you ever read this sentence.')
++ auth (shax 'You cant know that this sentence is true.')
++ suit 1
::
++ marbud-own [~marbud %own] ::key %marbud-key-0
++ marbud-spn [~marbud %spawn] :: key %marbud-skey
++ marbud-mgt [~marbud %manage] :: key %marbud-mkey
++ marbud-xfr [~marbud %transfer] :: key %marbud-key-1
::
++ dopbud-own [~dopbud %own] :: key %dopbud-key-0
::
++ litbud-own [~litbud %own] :: key %litbud-key-0
::
++ lt-own [~linnup-torsyx %own] :: key %lt-key-0
++ lt-xfr [~linnup-torsyx %transfer] :: key %lt-key-0
--
::
:: Tests
::
|%
++ test-log ^- tang
%+ expect-eq
!>
:- [%point ~bud %owner 0x123]~
:- [%point ~bud %owner (addr %bud-key-0)]~
:_ [~ ~] :_ [~ ~]
:- ~bud
%*(. *point:naive dominion %l1, owner.own 0x123^0, who.sponsor.net ~bud)
%*(. *point:naive dominion %l1, owner.own (addr %bud-key-0)^0, who.sponsor.net ~bud)
::
!>
%^ naive verifier 1.337 :- *^state:naive
:* %log *@ux *@ux
owner-changed:log-names:naive (@ux ~bud) 0x123 ~
owner-changed:log-names:naive (@ux ~bud) (addr %bud-key-0) ~
==
::
++ test-deposit ^- tang
@ -330,84 +185,153 @@
dominion:(~(got by points.state) ~marbud)
::
++ test-batch ^- tang
=/ marbud-transfer [marbud-own %transfer-point (addr %marbud-key-0) |]
=/ marbud-transfer-2 [marbud-own %transfer-point (addr %marbud-key-1) |]
::
%+ expect-eq
!> [0x234 2]
!> [(addr %marbud-key-1) 2]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(transfer-point:l2 0 ~marbud %marbud-key-0 (addr %marbud-key-0) %own |))
=^ f state (n state %bat q:(transfer-point:l2 1 ~marbud %marbud-key-0 0x234 %own |))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-transfer %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-transfer-2 %marbud-key-0))
owner.own:(~(got by points.state) ~marbud)
::
++ test-l1-changed-spawn-proxy ^- tang
%+ expect-eq
!> [0x123 0]
!> [(addr %bud-skey) 0]
::
!>
=| =^state:naive
=^ f state (init-bud state)
=^ f state (n state (changed-spawn-proxy:l1 ~bud 0x123))
=^ f state (n state (changed-spawn-proxy:l1 ~bud (addr %bud-skey)))
spawn-proxy.own:(~(got by points.state) ~bud)
::
++ test-l1-changed-transfer-proxy ^- tang
%+ expect-eq
!> [0x123 0]
!> [(addr %bud-key-1) 0]
::
!>
=| =^state:naive
=^ f state (init-bud state)
=^ f state (n state (changed-transfer-proxy:l1 ~bud 0x123))
=^ f state (n state (changed-transfer-proxy:l1 ~bud (addr %bud-key-1)))
transfer-proxy.own:(~(got by points.state) ~bud)
::
++ test-l1-changed-management-proxy ^- tang
%+ expect-eq
!> [0x123 0]
!> [(addr %bud-mkey) 0]
::
!>
=| =^state:naive
=^ f state (init-bud state)
=^ f state (n state (changed-management-proxy:l1 ~bud 0x123))
=^ f state (n state (changed-management-proxy:l1 ~bud (addr %bud-mkey)))
management-proxy.own:(~(got by points.state) ~bud)
::
++ test-l1-changed-voting-proxy ^- tang
%+ expect-eq
!> [0x123 0]
!> [(addr %bud-vkey) 0]
::
!>
=| =^state:naive
=^ f state (init-bud state)
=^ f state (n state (changed-voting-proxy:l1 ~bud 0x123))
=^ f state (n state (changed-voting-proxy:l1 ~bud (addr %bud-vkey)))
voting-proxy.own:(~(got by points.state) ~bud)
::
++ test-l2-set-spawn-proxy ^- tang
++ test-l1-changed-keys ^- tang
=/ life 1
=/ new-keys [~bud suit encr auth life]
::
%+ expect-eq
!> [0x123 0]
!> [suit auth encr]
::
!>
=| =^state:naive
=^ f state (init-bud state)
=^ f state (n state (changed-keys:l1 new-keys))
|1:keys.net:(~(got by points.state) ~bud)
::
++ test-l1-star-escape-requested ^- tang
%+ expect-eq
!> [~ ~wes]
::
!>
=| =^state:naive
=^ f state (init-wes state)
=^ f state (init-sambud state)
=^ f state (n state (escape-requested:l1 ~sambud ~wes))
escape.net:(~(got by points.state) ~sambud)
::
++ test-l1-star-escape-canceled ^- tang
%+ expect-eq
!> ~
::
!>
=| =^state:naive
=^ f state (init-wes state)
=^ f state (init-sambud state)
=^ f state (n state (escape-requested:l1 ~sambud ~wes))
=^ f state (n state (escape-canceled:l1 ~sambud ~wes))
escape.net:(~(got by points.state) ~sambud)
::
++ test-l1-star-adopt-accept ^- tang
%+ expect-eq
!> [~ %.y ~wes]
::
!>
=| =^state:naive
=^ f state (init-wes state)
=^ f state (init-sambud state)
=^ f state (n state (escape-requested:l1 ~sambud ~wes))
=^ f state (n state (escape-accepted:l1 ~sambud ~wes))
[escape.net sponsor.net]:(~(got by points.state) ~sambud)
::
++ test-l1-star-lost-sponsor ^- tang
%+ expect-eq
!> [~ %.n ~bud]
::
!>
=| =^state:naive
=^ f state (init-sambud state)
=^ f state (n state (lost-sponsor:l1 ~sambud ~bud))
[escape.net sponsor.net]:(~(got by points.state) ~sambud)
::
:: TODO: sponsorship tests for l1 planets, and L1/L2 sponsorship tests
::
++ test-l2-set-spawn-proxy ^- tang
=/ marbud-sproxy [marbud-own %set-spawn-proxy (addr %marbud-skey)]
::
%+ expect-eq
!> [(addr %marbud-skey) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(set-spawn-proxy:l2 0 ~marbud %marbud-key-0 %own 0x123))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-sproxy %marbud-key-0))
spawn-proxy.own:(~(got by points.state) ~marbud)
::
++ test-l2-set-transfer-proxy ^- tang
=/ marbud-tproxy [marbud-own %set-transfer-proxy (addr %marbud-tkey)]
::
%+ expect-eq
!> [0x123 0]
!> [(addr %marbud-tkey) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(set-transfer-proxy:l2 0 ~marbud %marbud-key-0 %own 0x123))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-tproxy %marbud-key-0))
transfer-proxy.own:(~(got by points.state) ~marbud)
::
++ test-l2-set-management-proxy ^- tang
=/ marbud-mproxy [marbud-own %set-management-proxy (addr %marbud-mkey)]
::
%+ expect-eq
!> [0x123 0]
!> [(addr %marbud-mkey) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(set-management-proxy:l2 0 ~marbud %marbud-key-0 %own 0x123))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-mproxy %marbud-key-0))
management-proxy.own:(~(got by points.state) ~marbud)
::
++ test-l2-spawn-proxy-deposit ^- tang
@ -420,46 +344,281 @@
dominion:(~(got by points.state) ~dopbud)
::
++ test-marbud-l2-spawn ^- tang
%+ expect-eq
!> [`@ux`(addr %ll-key-0) 0]
=/ marbud-sproxy [marbud-own %set-spawn-proxy (addr %marbud-skey)]
=/ lt-spawn [%spawn ~linnup-torsyx (addr %lt-key-0)]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(spawn:l2 0 ~marbud %marbud-key-0 %own ~linnup-torsyx (addr %ll-key-0)))
transfer-proxy.own:(~(got by points.state) ~linnup-torsyx)
;: weld
%+ expect-eq
:: Tests l2 spawning with ownership
!> [`@ux`(addr %lt-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 [marbud-own lt-spawn] %marbud-key-0))
transfer-proxy.own:(~(got by points.state) ~linnup-torsyx)
::
%+ expect-eq
:: Tests l2 spawning with spawn proxy
!> [`@ux`(addr %lt-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-sproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [marbud-spn lt-spawn] %marbud-skey))
transfer-proxy.own:(~(got by points.state) ~linnup-torsyx)
==
::
++ test-marbud-l2-spawn-w-proxy ^- tang
%+ expect-eq
!> [`@ux`(addr %ll-key-0) 0]
++ test-marbud-l2-double-spawn ^- tang
:: Attempts to spawn the same planet twice, once with ownership and once with spawn proxy
=/ marbud-sproxy [marbud-own %set-spawn-proxy (addr %marbud-skey)]
=/ lt-spawn-0 [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-spawn-1 [marbud-spn %spawn ~linnup-torsyx (addr %lt-key-1)]
::
!>
%- expect-fail
|.
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(set-spawn-proxy:l2 0 ~marbud %marbud-key-0 %own (addr %marbud-spawn-0)))
=^ f state (n state %bat q:(spawn:l2 0 ~marbud %marbud-spawn-0 %spawn ~linnup-torsyx (addr %ll-key-0)))
transfer-proxy.own:(~(got by points.state) ~linnup-torsyx)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-sproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 lt-spawn-0 %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn-1 %marbud-skey))
state
::
++ test-marbud-l2-change-keys ^- tang
=/ new-keys [%configure-keys suit encr auth |]
=/ marbud-mproxy [marbud-own %set-management-proxy (addr %marbud-mkey)]
::
;: weld
%+ expect-eq
!> [suit auth encr]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 [marbud-own new-keys] %marbud-key-0))
|1:keys.net:(~(got by points.state) ~marbud)
::
%+ expect-eq
!> [suit auth encr]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-mproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [marbud-mgt new-keys] %marbud-mkey))
|1:keys.net:(~(got by points.state) ~marbud)
::
:: TODO: make sure nobody else can change these keys
==
::
:: TODO: transfer breach via transfer proxy
++ test-marbud-l2-proxies-transfer ^- tang
=/ marbud-new-keys [marbud-own %configure-keys suit encr auth |]
=/ marbud-sproxy [marbud-own %set-spawn-proxy (addr %marbud-skey)]
=/ marbud-mproxy [marbud-own %set-management-proxy (addr %marbud-mkey)]
=/ marbud-tproxy [marbud-own %set-transfer-proxy (addr %marbud-key-1)]
=/ marbud-transfer-breach [marbud-own %transfer-point (addr %marbud-key-1) &]
=/ marbud-transfer-no-breach [marbud-own %transfer-point (addr %marbud-key-1) |]
=/ marbud-xfr-breach [marbud-xfr %transfer-point (addr %marbud-key-1) &]
=/ marbud-xfr-no-breach [marbud-xfr %transfer-point (addr %marbud-key-1) |]
::
;: weld
%+ expect-eq
:: Tests that proxies are reset on transfer with breach
::
!>
:* [(addr %marbud-key-1) 3] :: ownership
[0 0] :: spawn-proxy
[0 0] :: management-proxy
[0 0] :: voting-proxy
[0 1] :: transfer-proxy
==
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-sproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-mproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 2 marbud-tproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-xfr-breach %marbud-key-1))
^- [[@ @] [@ @] [@ @] [@ @] [@ @]]
own:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: Tests that networking keys are reset on transfer with breach
!>
[0 0 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-new-keys %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-transfer-breach %marbud-key-0))
|1:keys.net:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: Tests that proxies are not reset when transfering without breach
!>
:* [(addr %marbud-key-1) 3] :: ownership
[(addr %marbud-skey) 0] :: spawn-proxy
[(addr %marbud-mkey) 0] :: management-proxy
[0 0] :: voting-proxy
[0 1] :: transfer-proxy
==
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-sproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-mproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 2 marbud-tproxy %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-xfr-no-breach %marbud-key-1))
^- [[@ @] [@ @] [@ @] [@ @] [@ @]]
own:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: Tests that networking keys are not reset when transfering without breach
!>
[suit auth encr]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 marbud-new-keys %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-transfer-no-breach %marbud-key-0))
|1:keys.net:(~(got by points.state) ~marbud)
==
::
:: TODO: life+rift changes via transfer proxy
::
++ test-marbud-life-rift ^- tang
=/ new-keys-no-reset [marbud-own %configure-keys suit encr auth |]
=/ new-keys-yes-reset [marbud-own %configure-keys suit encr auth &]
=/ zero-keys-no-reset [marbud-own %configure-keys 0 0 0 |]
=/ zero-keys-yes-reset [marbud-own %configure-keys 0 0 0 &]
=/ marbud-transfer-no-breach [marbud-own %transfer-point (addr %marbud-key-1) |]
=/ marbud-transfer-yes-breach [marbud-own %transfer-point (addr %marbud-key-1) &]
=/ marbud-own-1 [~marbud %marbud-key-1 %own]
::
;: weld
%+ expect-eq
:: breach=%.n
!> [0 1] :: [rift life]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-no-reset %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 new-keys-no-reset %marbud-key-0))
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: breach=%.y
!> [1 1]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-yes-reset %marbud-key-0))
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: networking keys set incremenets life, reset=%.y
:: then zero keys and transfer, should increment rift but not life
::
!> [2 2]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-yes-reset %marbud-key-0)) :: inc life and rift
=^ f state (n state %bat q:(gen-tx-octs 1 zero-keys-no-reset %marbud-key-0)) :: inc life
=^ f state (n state %bat q:(gen-tx-octs 2 zero-keys-yes-reset %marbud-key-0)) :: inc rift
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: Keep the same keys while breaching via %configure-keys
::
!> [2 1]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-yes-reset %marbud-key-0)) :: inc life and rift
=^ f state (n state %bat q:(gen-tx-octs 1 new-keys-yes-reset %marbud-key-0)) :: inc life and rift
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
::
!> [1 2]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-no-reset %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-transfer-no-breach %marbud-key-0))
:: TODO: shouldn't the nonce by zero for the next tx?
=^ f state (n state %bat q:(gen-tx-octs 2 zero-keys-yes-reset %marbud-key-1))
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: set networking keys, then transfer and set networking keys with breach
::
!> [1 3]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-no-reset %marbud-key-0)) :: inc life
=^ f state (n state %bat q:(gen-tx-octs 1 marbud-transfer-yes-breach %marbud-key-0)) :: inc life and rift
:: TODO: shouldn't the nonce by zero for the next tx?
=^ f state (n state %bat q:(gen-tx-octs 2 new-keys-no-reset %marbud-key-1)) ::inc life
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
%+ expect-eq
:: networking keys set incremenets life, reset=%.y
:: then zero keys and transfer, should increment rift but not life
:: TODO: transferring and reset with already zeroed keys ought to incr rift but not life, right?
:: but currently the transfer w/ reset increments both life and rift, despite keys already being 0
::
!> [2 2]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 new-keys-yes-reset %marbud-key-0)) :: inc life and rift
=^ f state (n state %bat q:(gen-tx-octs 1 zero-keys-no-reset %marbud-key-0)) :: inc life
=^ f state (n state %bat q:(gen-tx-octs 2 marbud-transfer-yes-breach %marbud-key-0)) :: inc rift
[rift.net life.keys.net]:(~(got by points.state) ~marbud)
::
==
::
++ test-dopbud-l2-spawn ^- tang
=/ pp-spawn [dopbud-own %spawn ~palsep-picdun (addr %pp-key-0)]
::
%+ expect-eq
!> [`@ux`(addr %pp-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-dopbud state)
=^ f state (n state %bat q:(spawn:l2 0 ~dopbud %dopbud-key-0 %own ~palsep-picdun (addr %pp-key-0)))
=^ f state (n state %bat q:(gen-tx-octs 0 pp-spawn %dopbud-key-0))
transfer-proxy.own:(~(got by points.state) ~palsep-picdun)
::
++ test-dopbud-l2-spawn-after-transfer ^- tang
=/ pp-spawn [dopbud-own %spawn ~palsep-picdun (addr %pp-key-0)]
=/ lr-spawn [dopbud-own %spawn ~laclur-rachul (addr %lr-key-0)]
::
%+ expect-eq
!> [`@ux`(addr %lr-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-dopbud state)
=^ f state (n state %bat q:(spawn:l2 0 ~dopbud %dopbud-key-0 %own ~palsep-picdun (addr %pp-key-0)))
=^ f state (n state %bat q:(gen-tx-octs 0 pp-spawn %dopbud-key-0))
=^ f state (n state (owner-changed:l1 ~dopbud (addr %dopbud-key-1)))
=^ f state (n state %bat q:(spawn:l2 1 ~dopbud %dopbud-key-1 %own ~laclur-rachul (addr %lr-key-0)))
=^ f state (n state %bat q:(gen-tx-octs 1 lr-spawn %dopbud-key-1))
transfer-proxy.own:(~(got by points.state) ~laclur-rachul)
::
:: ++ test-sambud-double-spawn ^- tang
@ -493,27 +652,118 @@
:: state
::
++ test-linnup-torsyx-l2-transfer-ownership ^- tang
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [%transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> [`@ux`(addr %lt-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (n state %bat q:(spawn:l2 0 ~marbud %marbud-key-0 %own ~linnup-torsyx (addr %lt-key-0)))
=^ f state (n state %bat q:(transfer-point:l2 0 ~linnup-torsyx %lt-key-0 (addr %lt-key-0) %transfer &))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [lt-xfr lt-transfer-yes-breach] %lt-key-0))
owner.own:(~(got by points.state) ~linnup-torsyx)
::
++ test-palsep-picdun-l2-transfer-ownership ^- tang
=/ pp-xfr [~palsep-picdun %transfer]
=/ pp-spawn [dopbud-own %spawn ~palsep-picdun (addr %pp-key-0)]
=/ pp-transfer-yes-breach [pp-xfr %transfer-point (addr %pp-key-0) &]
%+ expect-eq
!> [`@ux`(addr %pp-key-0) 0]
::
!>
=| =^state:naive
=^ f state (init-dopbud state)
=^ f state (n state %bat q:(spawn:l2 0 ~dopbud %dopbud-key-0 %own ~palsep-picdun (addr %pp-key-0)))
=^ f state (n state %bat q:(transfer-point:l2 0 ~palsep-picdun %pp-key-0 (addr %pp-key-0) %transfer &))
=^ f state (n state %bat q:(gen-tx-octs 0 pp-spawn %dopbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 pp-transfer-yes-breach %pp-key-0))
owner.own:(~(got by points.state) ~palsep-picdun)
::
++ test-linnup-torsyx-l2-escape-request ^- tang
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [lt-xfr %transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> [~ ~litbud]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (init-litbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-transfer-yes-breach %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [lt-own [%escape ~litbud]] %lt-key-0))
escape.net:(~(got by points.state) ~linnup-torsyx)
::
++ test-linnup-torsyx-l2-cancel-escape-request ^- tang
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [lt-xfr %transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> ~
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (init-litbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-transfer-yes-breach %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [lt-own [%escape ~litbud]] %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 [lt-own [%cancel-escape ~litbud]] %lt-key-0))
escape.net:(~(got by points.state) ~linnup-torsyx)
::
++ test-linnup-torsyx-l2-adopt-accept ^- tang
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [lt-xfr %transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> [~ %.y ~litbud]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (init-litbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-transfer-yes-breach %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [lt-own [%escape ~litbud]] %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [litbud-own [%adopt ~linnup-torsyx]] %litbud-key-0))
[escape.net sponsor.net]:(~(got by points.state) ~linnup-torsyx)
::
++ test-linnup-torsyx-l2-adopt-reject ^- tang
:: TODO: at the moment the default sponsor is always ~zod, but it should probably
:: be ~marbud here
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [lt-xfr %transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> ~
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (init-litbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-transfer-yes-breach %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [lt-own [%escape ~litbud]] %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 [litbud-own [%reject ~linnup-torsyx]] %litbud-key-0))
escape.net:(~(got by points.state) ~linnup-torsyx)
::
++ test-linnup-torsyx-l2-detach ^- tang
=/ lt-spawn [marbud-own %spawn ~linnup-torsyx (addr %lt-key-0)]
=/ lt-transfer-yes-breach [lt-xfr %transfer-point (addr %lt-key-0) &]
::
%+ expect-eq
!> [~ %.n ~marbud]
::
!>
=| =^state:naive
=^ f state (init-marbud state)
=^ f state (init-litbud state)
=^ f state (n state %bat q:(gen-tx-octs 0 lt-spawn %marbud-key-0))
=^ f state (n state %bat q:(gen-tx-octs 0 lt-transfer-yes-breach %lt-key-0))
=^ f state (n state %bat q:(gen-tx-octs 1 [marbud-own [%detach ~linnup-torsyx]] %marbud-key-0))
[escape.net sponsor.net]:(~(got by points.state) ~linnup-torsyx)
::
:: TODO: signature format changed; regenerate
::
:: ++ test-metamask-signature ^- tang