naive: comment out unneeded test

This commit is contained in:
drbeefsupreme 2021-08-17 15:41:54 -04:00
parent febe814cce
commit e834033daa
No known key found for this signature in database
GPG Key ID: B70D5683DE7F9EFC

View File

@ -2977,114 +2977,119 @@
=^ f state (n state %bat q:random-tx) =^ f state (n state %bat q:random-tx)
state state
:: ::
++ test-fuzz-after-tx :: I think the following test ought to be trying something else:
:: this creates a valid transaction of each type but then adds :: checking to see if valid transactions followed by garbage still
:: random bits to the end of it :: process the valid tx
:: :: ++ test-fuzz-after-tx
=+ [seed=`@`%test-fuzz-after-tx i=0] :: :: this creates a valid transaction of each type but then adds
=| =^state:naive :: :: random bits to the end of it
=^ f state (init-red-full state) :: ::
=/ init-state state :: =+ [seed=`@`%test-fuzz-after-tx1 i=0]
|- ^- tang :: =| =^state:naive
?: =(i 11) ~ :: 10 attempts for each transaction type :: =^ f state (init-red-full state)
%+ weld $(seed (shas `@`%howmuchisfour seed), i +(i)) :: =/ init-state state
=+ j=0 :: |- ^- tang
|^ ^- tang :: ?: =(i 11) ~ :: 10 attempts for each transaction type
?: =(j 11) ~ :: there are 10 transaction types :: %+ weld $(seed (shas `@`%howmuchisfour seed), i +(i))
%+ weld $(seed (shas `@`%eris seed), j +(j)) :: =+ j=0
=/ rng ~(. og seed) :: |^ ^- tang
=^ junk-length rng (rads:rng 200) :: ?: =(j 11) ~ :: there are 10 transaction types
::increment to prevent zero-length junk :: %+ weld $(seed (shas `@`%eris seed), j +(j))
=^ junk rng (raws:rng +(junk-length)) :: =/ rng ~(. og seed)
=/ tx-octs=octs :: =^ junk-length rng (rads:rng 200)
?+ j !! :: ::increment to prevent zero-length junk
%0 do-spawn :: =^ junk rng (raws:rng +(junk-length))
%1 do-transfer-point :: =/ tx-octs=octs
%2 do-configure-keys :: ?+ j !!
%3 do-escape :: %0 do-spawn
%4 do-cancel-escape :: %1 do-transfer-point
%5 do-adopt :: %2 do-configure-keys
%6 do-reject :: %3 do-escape
%7 do-detach :: %4 do-cancel-escape
%8 do-set-management-proxy :: %5 do-adopt
%9 do-set-spawn-proxy :: %6 do-reject
%10 do-set-transfer-proxy :: %7 do-detach
== :: %8 do-set-management-proxy
=/ fuzz (mix (lsh [3 (met 3 q:tx-octs)] junk) q:tx-octs) :: %9 do-set-spawn-proxy
=/ fuzz-octs=octs [(met 3 fuzz) fuzz] :: %10 do-set-transfer-proxy
:: the conditionals that follow are to ensure the correct key and :: ==
:: nonce are used. :: =/ fuzz (mix (lsh [3 (met 3 q:tx-octs)] junk) q:tx-octs)
=/ random-tx :: =/ fuzz-octs=octs [(met 3 fuzz) fuzz]
?: =(j 4) :: :: the conditionals that follow are to ensure the correct key and
%^ sign-tx %holrut-rr-key-0 1 fuzz-octs :: :: nonce are used.
?: |(=(j 5) =(j 6)) :: =/ random-tx
%^ sign-tx %rigred-key-0 0 fuzz-octs :: ?: =(j 4)
%^ sign-tx %losrut-key-0 2 fuzz-octs :: %^ sign-tx %holrut-rr-key-0 1 fuzz-octs
:: :: ?: |(=(j 5) =(j 6))
=/ state init-state :: %^ sign-tx %rigred-key-0 0 fuzz-octs
%+ expect-eq :: %^ sign-tx %losrut-key-0 2 fuzz-octs
!> init-state :: ::
:: :: =/ state init-state
!> :: %+ category (weld "fuzz tx type " (scow %ud j))
=^ f state (n state %bat q:random-tx) :: %+ expect-eq
state :: !> init-state
:: :: ::
++ do-spawn ^- octs :: !>
=/ from [ship=~losrut proxy=%own] :: =^ f state (n state %bat q:random-tx)
=/ sptx=skim-tx:naive [%spawn ~mishus-loplus (addr %nowhere)] :: ~& ['tx-type' j]
=/ tx=tx:naive [from sptx] :: state
(gen-tx-octs tx) :: ::
++ do-transfer-point ^- octs :: ++ do-spawn ^- octs
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ xrtx=skim-tx:naive [%transfer-point (addr %somewhere) &] :: =/ sptx=skim-tx:naive [%spawn ~mishus-loplus (addr %nowhere)]
=/ tx=tx:naive [from xrtx] :: =/ tx=tx:naive [from sptx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-configure-keys ^- octs :: ++ do-transfer-point ^- octs
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ cftx=skim-tx:naive [%configure-keys (shax 'uno') (shax 'dos') (shax 'tres') |] :: =/ xrtx=skim-tx:naive [%transfer-point (addr %somewhere) &]
=/ tx=tx:naive [from cftx] :: =/ tx=tx:naive [from xrtx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-escape ^- octs :: ++ do-configure-keys ^- octs
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ estx=skim-tx:naive [%escape ~red] :: =/ cftx=skim-tx:naive [%configure-keys (shax 'uno') (shax 'dos') (shax 'tres') |]
=/ tx=tx:naive [from estx] :: =/ tx=tx:naive [from cftx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-cancel-escape ^- octs :: ++ do-escape ^- octs
=/ from [ship=~rabsum-ravtyd proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ cetx=skim-tx:naive [%cancel-escape ~rigred] :: =/ estx=skim-tx:naive [%escape ~red]
=/ tx=tx:naive [from cetx] :: =/ tx=tx:naive [from estx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-adopt ^- octs :: ++ do-cancel-escape ^- octs
=/ from [ship=~rigred proxy=%own] :: =/ from [ship=~rabsum-ravtyd proxy=%own]
=/ adtx=skim-tx:naive [%adopt ~rabsum-ravtyd] :: =/ cetx=skim-tx:naive [%cancel-escape ~rigred]
=/ tx=tx:naive [from adtx] :: =/ tx=tx:naive [from cetx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-reject ^- octs :: ++ do-adopt ^- octs
=/ from [ship=~rigred proxy=%own] :: =/ from [ship=~rigred proxy=%own]
=/ rjtx=skim-tx:naive [%adopt ~rabsum-ravtyd] :: =/ adtx=skim-tx:naive [%adopt ~rabsum-ravtyd]
=/ tx=tx:naive [from rjtx] :: =/ tx=tx:naive [from adtx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-detach :: ++ do-reject ^- octs
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~rigred proxy=%own]
=/ dttx=skim-tx:naive [%detach ~rabsum-ravtyd] :: =/ rjtx=skim-tx:naive [%adopt ~rabsum-ravtyd]
=/ tx=tx:naive [from dttx] :: =/ tx=tx:naive [from rjtx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-set-management-proxy :: ++ do-detach
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ mgtx=skim-tx:naive [%set-management-proxy (addr %new-mgmt)] :: =/ dttx=skim-tx:naive [%detach ~rabsum-ravtyd]
=/ tx=tx:naive [from mgtx] :: =/ tx=tx:naive [from dttx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-set-spawn-proxy :: ++ do-set-management-proxy
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ sptx=skim-tx:naive [%set-spawn-proxy (addr %new-spawn)] :: =/ mgtx=skim-tx:naive [%set-management-proxy (addr %new-mgmt)]
=/ tx=tx:naive [from sptx] :: =/ tx=tx:naive [from mgtx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
++ do-set-transfer-proxy :: ++ do-set-spawn-proxy
=/ from [ship=~losrut proxy=%own] :: =/ from [ship=~losrut proxy=%own]
=/ tftx=skim-tx:naive [%set-transfer-proxy (addr %new-xfer)] :: =/ sptx=skim-tx:naive [%set-spawn-proxy (addr %new-spawn)]
=/ tx=tx:naive [from tftx] :: =/ tx=tx:naive [from sptx]
(gen-tx-octs tx) :: (gen-tx-octs tx)
-- :: ++ do-set-transfer-proxy
:: =/ from [ship=~losrut proxy=%own]
:: =/ tftx=skim-tx:naive [%set-transfer-proxy (addr %new-xfer)]
:: =/ tx=tx:naive [from tftx]
:: (gen-tx-octs tx)
:: --
:: ::
:: the following tests are to ensure that padding of zeroes creates :: the following tests are to ensure that padding of zeroes creates
:: no issues :: no issues
@ -3160,9 +3165,6 @@
=/ tx-1=full-tx [0 marbud-transfer %marbud-key-0] =/ tx-1=full-tx [0 marbud-transfer %marbud-key-0]
=/ tx-2=full-tx [1 marbud-transfer-2 %marbud-key-0] =/ tx-2=full-tx [1 marbud-transfer-2 %marbud-key-0]
=/ txs=tx-list (limo ~[tx-1 tx-2]) =/ txs=tx-list (limo ~[tx-1 tx-2])
~& ['tx-1' `@ux`(tx-list-to-batch (limo ~[tx-1]))]
~& ['tx-2' `@ux`(tx-list-to-batch (limo ~[tx-2]))]
~& ['txs' `@ux`(tx-list-to-batch txs)]
%+ expect-eq %+ expect-eq
!> [(addr %marbud-key-1) 2] !> [(addr %marbud-key-1) 2]
:: ::