mirror of
https://github.com/urbit/shrub.git
synced 2024-11-24 13:06:09 +03:00
naive: |^ify gen-tx-octs
This commit is contained in:
drbeefsupreme
parent
189edd2e48
commit
2b6a795c8b
@ -8,24 +8,25 @@
|
||||
::
|
||||
|%
|
||||
::
|
||||
++ 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
|
||||
:: ++ 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
|
||||
@ -72,47 +73,63 @@
|
||||
~
|
||||
==
|
||||
::
|
||||
++ bits
|
||||
++ gen-tx-octs
|
||||
:: takes in a nonce, tx:naive, and private key and returned a signed transactions as octs
|
||||
::
|
||||
|%
|
||||
::
|
||||
:: TODO: Shouldn't need to pass all these arguments along - they should already be in the subject somewhere
|
||||
|= [=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
|
||||
|= [from=[=ship =proxy] child=ship =address] ^- octs
|
||||
|= [child=ship to=address] ^- octs
|
||||
%: cad:naive 3
|
||||
(from-proxy:bits proxy.from)
|
||||
4^ship.from
|
||||
(from-proxy proxy.from.tx)
|
||||
4^ship.from.tx
|
||||
1^%1 :: %spawn
|
||||
4^child
|
||||
20^address
|
||||
20^to
|
||||
~
|
||||
==
|
||||
::
|
||||
++ get-transfer
|
||||
|= [from=[=ship =proxy] =address reset=?] ^- octs
|
||||
|= [=address reset=?] ^- octs
|
||||
%: cad:naive 3
|
||||
(from-proxy:bits proxy.from)
|
||||
4^ship.from
|
||||
(from-proxy proxy.from.tx)
|
||||
4^ship.from.tx
|
||||
1^(can 0 7^%0 1^reset ~) :: %transfer-point
|
||||
20^address
|
||||
~
|
||||
==
|
||||
::
|
||||
++ get-keys
|
||||
|= [from=[=ship =proxy] suite=@ud encrypt=@ auth=@ breach=?] ^- octs
|
||||
|= [suite=@ud crypt=@ auth=@ breach=?] ^- octs
|
||||
%: cad:naive 3
|
||||
(from-proxy:bits proxy.from)
|
||||
4^ship.from
|
||||
(from-proxy proxy.from.tx)
|
||||
4^ship.from.tx
|
||||
1^(can 0 7^%2 1^breach ~) :: %configure-keys
|
||||
32^encrypt
|
||||
32^crypt
|
||||
32^auth
|
||||
4^suite
|
||||
~
|
||||
==
|
||||
::
|
||||
++ get-escape
|
||||
|= [from=[=ship =proxy] action=@tas other=ship] ^- octs
|
||||
|= [action=@tas other=ship] ^- octs
|
||||
=/ op
|
||||
?+ action !!
|
||||
%escape %3
|
||||
@ -122,15 +139,15 @@
|
||||
%detach %7
|
||||
==
|
||||
%: cad:naive 3
|
||||
(from-proxy proxy.from)
|
||||
4^ship.from
|
||||
(from-proxy proxy.from.tx)
|
||||
4^ship.from.tx
|
||||
1^(can 0 7^op 1^0 ~)
|
||||
4^other
|
||||
~
|
||||
==
|
||||
::
|
||||
++ get-ship-address
|
||||
|= [from=[=ship =proxy] action=@tas =address] ^- octs
|
||||
|= [action=@tas =address] ^- octs
|
||||
=/ op
|
||||
?+ action !!
|
||||
%set-management-proxy %8
|
||||
@ -138,8 +155,8 @@
|
||||
%set-transfer-proxy %10
|
||||
==
|
||||
%: cad:naive 3
|
||||
(from-proxy proxy.from)
|
||||
4^ship.from
|
||||
(from-proxy proxy.from.tx)
|
||||
4^ship.from.tx
|
||||
1^(can 0 7^op 1^0 ~)
|
||||
20^address
|
||||
~
|
||||
|
||||
@ -161,141 +161,140 @@
|
||||
:: Tests
|
||||
::
|
||||
|%
|
||||
++ test-log ^- tang
|
||||
%+ expect-eq
|
||||
!>
|
||||
:- [%point ~bud %owner (addr %bud-key-0)]~
|
||||
:_ [~ ~] :_ [~ ~]
|
||||
:- ~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) (addr %bud-key-0) ~
|
||||
==
|
||||
::
|
||||
:: ++ test-log ^- tang
|
||||
:: %+ expect-eq
|
||||
:: !>
|
||||
:: :- [%point ~bud %owner (addr %bud-key-0)]~
|
||||
:: :_ [~ ~] :_ [~ ~]
|
||||
:: :- ~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) (addr %bud-key-0) ~
|
||||
:: ==
|
||||
:: ::
|
||||
:: ++ test-deposit ^- tang
|
||||
:: %+ expect-eq
|
||||
:: !> %l2
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-marbud state)
|
||||
:: dominion:(~(got by points.state) ~marbud)
|
||||
:: ::
|
||||
:: ++ test-batch ^- tang
|
||||
:: =/ marbud-transfer [%transfer-point (addr %marbud-key-0) |]
|
||||
:: =/ marbud-transfer-2 [%transfer-point (addr %marbud-key-1) |]
|
||||
:: ::
|
||||
:: %+ expect-eq
|
||||
:: !> [(addr %marbud-key-1) 2]
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-marbud state)
|
||||
:: =^ f state (n state %bat q:(gen-tx-octs 0 marbud-own marbud-transfer))
|
||||
:: =^ f state (n state %bat q:(gen-tx-octs 1 marbud-own marbud-transfer-2))
|
||||
:: owner.own:(~(got by points.state) ~marbud)
|
||||
:: ::
|
||||
:: ++ test-l1-changed-spawn-proxy ^- tang
|
||||
:: %+ expect-eq
|
||||
:: !> [(addr %bud-skey) 0]
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-bud state)
|
||||
:: =^ 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
|
||||
:: !> [(addr %bud-key-1) 0]
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-bud state)
|
||||
:: =^ 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
|
||||
:: !> [(addr %bud-mkey) 0]
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-bud state)
|
||||
:: =^ 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
|
||||
:: !> [(addr %bud-vkey) 0]
|
||||
:: ::
|
||||
:: !>
|
||||
:: =| =^state:naive
|
||||
:: =^ f state (init-bud state)
|
||||
:: =^ f state (n state (changed-voting-proxy:l1 ~bud (addr %bud-vkey)))
|
||||
:: voting-proxy.own:(~(got by points.state) ~bud)
|
||||
:: ::
|
||||
:: ++ test-l1-changed-keys ^- tang
|
||||
:: =/ life 1
|
||||
:: =/ new-keys [~bud suit encr auth life]
|
||||
:: ::
|
||||
:: %+ expect-eq
|
||||
:: !> [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)
|
||||
++ test-deposit ^- tang
|
||||
%+ expect-eq
|
||||
!> %l2
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-marbud state)
|
||||
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
|
||||
!> [(addr %marbud-key-1) 2]
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-marbud state)
|
||||
=^ 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
|
||||
!> [(addr %bud-skey) 0]
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-bud state)
|
||||
=^ 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
|
||||
!> [(addr %bud-key-1) 0]
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-bud state)
|
||||
=^ 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
|
||||
!> [(addr %bud-mkey) 0]
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-bud state)
|
||||
=^ 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
|
||||
!> [(addr %bud-vkey) 0]
|
||||
::
|
||||
!>
|
||||
=| =^state:naive
|
||||
=^ f state (init-bud state)
|
||||
=^ f state (n state (changed-voting-proxy:l1 ~bud (addr %bud-vkey)))
|
||||
voting-proxy.own:(~(got by points.state) ~bud)
|
||||
::
|
||||
++ test-l1-changed-keys ^- tang
|
||||
=/ life 1
|
||||
=/ new-keys [~bud suit encr auth life]
|
||||
::
|
||||
%+ expect-eq
|
||||
!> [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
|
||||
::
|
||||
|
||||
Loading…
Reference in New Issue
Block a user