Skip to content
This repository has been archived by the owner on Aug 18, 2020. It is now read-only.

Commit

Permalink
[CO-354] Fix wallet-new "example1" test
Browse files Browse the repository at this point in the history
This test was failing, apparently due to the increased sizes of
`AddrAttributes` in the NMJust case. I added 4 bytes to the maximum
byte limit, which is the amount by which `AddrAttributes` grows when
the `NetworkMagic` value is added.
  • Loading branch information
mhuesch committed Sep 10, 2018
1 parent de447f1 commit 864bf74
Show file tree
Hide file tree
Showing 5 changed files with 35 additions and 22 deletions.
32 changes: 19 additions & 13 deletions wallet-new/test/unit/Test/Infrastructure/Generator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -23,7 +23,8 @@ import UTxO.Generator
import Wallet.Inductive
import Wallet.Inductive.Generator

import Pos.Core ( TxSizeLinear, calculateTxSizeLinear )
import Pos.Core (TxSizeLinear, calculateTxSizeLinear)
import Pos.Crypto (RequiresNetworkMagic (..))
import Serokell.Data.Memory.Units (Byte, fromBytes)

{-------------------------------------------------------------------------------
Expand Down Expand Up @@ -51,20 +52,21 @@ data GeneratorModel h a = GeneratorModel {
, gmMaxNumOurs :: Int

-- | Estimate fees
, gmEstimateFee :: Int -> [Value] -> Value
, gmEstimateFee :: RequiresNetworkMagic -> Int -> [Value] -> Value
}

genChainUsingModel :: (Hash h a, Ord a) => GeneratorModel h a -> Gen (Chain h a)
genChainUsingModel GeneratorModel{..} =
genChainUsingModel :: (Hash h a, Ord a)
=> RequiresNetworkMagic -> GeneratorModel h a -> Gen (Chain h a)
genChainUsingModel rnm GeneratorModel{..} =
evalStateT (genChain params) initState
where
params = defChainParams gmEstimateFee gmAllAddresses
params = defChainParams (gmEstimateFee rnm) gmAllAddresses
initUtxo = utxoRestrictToAddr (`elem` gmAllAddresses) $ trUtxo gmBoot
initState = initTrState initUtxo 1

genInductiveUsingModel :: (Hash h a, Ord a)
=> GeneratorModel h a -> Gen (Inductive h a)
genInductiveUsingModel GeneratorModel{..} = do
genInductiveUsingModel :: (Hash h a, Ord a) => RequiresNetworkMagic
-> GeneratorModel h a -> Gen (Inductive h a)
genInductiveUsingModel rnm GeneratorModel{..} = do
numOurs <- choose (1, min (length potentialOurs) gmMaxNumOurs)
addrs' <- shuffle potentialOurs
let ours = Set.fromList (take numOurs addrs')
Expand All @@ -76,7 +78,8 @@ genInductiveUsingModel GeneratorModel{..} = do
}
where
potentialOurs = filter gmPotentialOurs gmAllAddresses
params ours = defEventsParams gmEstimateFee gmAllAddresses ours initUtxo
params ours =
defEventsParams (gmEstimateFee rnm) gmAllAddresses ours initUtxo
initUtxo = utxoRestrictToAddr (`elem` gmAllAddresses) $ trUtxo gmBoot
initState = initEventsGlobalState 1

Expand All @@ -91,7 +94,7 @@ simpleModel :: GeneratorModel GivenHash Char
simpleModel = GeneratorModel {
gmAllAddresses = addrs
, gmPotentialOurs = \_ -> True
, gmEstimateFee = \_ _ -> 0
, gmEstimateFee = \_ _ _ -> 0
, gmMaxNumOurs = 3
, gmBoot = Transaction {
trFresh = fromIntegral (length addrs) * initBal
Expand Down Expand Up @@ -176,9 +179,12 @@ estimateSize saa sta ins outs
-- NOTE: The average size of @Attributes AddrAttributes@ and
-- the transaction attributes @Attributes ()@ are both hard-coded
-- here with some (hopefully) realistic values.
estimateCardanoFee :: TxSizeLinear -> Int -> [Value] -> Value
estimateCardanoFee linearFeePolicy ins outs
= round (calculateTxSizeLinear linearFeePolicy (estimateSize 128 16 ins outs))
estimateCardanoFee :: TxSizeLinear -> RequiresNetworkMagic -> Int -> [Value] -> Value
estimateCardanoFee linearFeePolicy rnm ins outs
= round (calculateTxSizeLinear linearFeePolicy (estimateSize addrAttrSize 16 ins outs))
where
addrAttrSize = 128 + (case rnm of NMMustBeNothing -> 0
NMMustBeJust -> 4)

{-------------------------------------------------------------------------------
Auxiliary
Expand Down
10 changes: 6 additions & 4 deletions wallet-new/test/unit/Test/Infrastructure/Genesis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ import UTxO.Context
import UTxO.DSL

import Pos.Core (TxSizeLinear)
import Pos.Crypto (RequiresNetworkMagic)
import Test.Infrastructure.Generator (estimateCardanoFee)

{-------------------------------------------------------------------------------
Expand All @@ -35,12 +36,13 @@ data GenesisValues h = GenesisValues {
, hashBoot :: h (Transaction h Addr)

-- | Fee policy
, txFee :: Int -> [Value] -> Value
, txFee :: Int -> [Value] -> Value
}

-- | Compute genesis values from the bootstrap transaction
genesisValues :: (Hash h Addr) => TxSizeLinear -> Transaction h Addr -> GenesisValues h
genesisValues txSizeLinear boot@Transaction{..} = GenesisValues{..}
genesisValues :: (Hash h Addr) => TxSizeLinear
-> RequiresNetworkMagic -> Transaction h Addr -> GenesisValues h
genesisValues txSizeLinear rnm boot@Transaction{..} = GenesisValues{..}
where
initR0 = unsafeHead [val | Output a val <- trOuts, a == r0]

Expand All @@ -52,7 +54,7 @@ genesisValues txSizeLinear boot@Transaction{..} = GenesisValues{..}

hashBoot = hash boot

txFee = estimateCardanoFee txSizeLinear
txFee = estimateCardanoFee txSizeLinear rnm

{-------------------------------------------------------------------------------
Auxiliary
Expand Down
3 changes: 2 additions & 1 deletion wallet-new/test/unit/Test/Spec/Kernel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,8 @@ runWithMagic rnm = do
specBody :: ProtocolMagic -> Spec
specBody pm =
it "Compare wallet kernel to pure model" $
forAll (genInductiveUsingModel model) $ \ind -> do
let rnm = getRequiresNetworkMagic pm in
forAll (genInductiveUsingModel rnm model) $ \ind -> do
-- TODO: remove once we have support for rollback in the kernel
let indDontRoll = uptoFirstRollback ind
bracketActiveWallet pm $ \activeWallet -> do
Expand Down
5 changes: 3 additions & 2 deletions wallet-new/test/unit/Test/Spec/Models.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,10 +45,11 @@ runWithMagic rnm = do
specBody :: ProtocolMagic -> Spec
specBody pm =
describe "Test pure wallets" $ do
let rnm = getRequiresNetworkMagic pm
it "Using simple model" $
forAll (genInductiveUsingModel simpleModel) $ testPureWalletWith
forAll (genInductiveUsingModel rnm simpleModel) $ testPureWalletWith
it "Using Cardano model" $
forAll (genInductiveUsingModel (cardanoModel linearFeePolicy boot)) $ testPureWalletWith
forAll (genInductiveUsingModel rnm (cardanoModel linearFeePolicy boot)) $ testPureWalletWith
where
transCtxt = runTranslateNoErrors pm ask
boot = bootstrapTransaction transCtxt
Expand Down
7 changes: 5 additions & 2 deletions wallet-new/test/unit/Test/Spec/Translation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -62,8 +62,9 @@ specBody pm = do

describe "Translation QuickCheck tests" $ do
prop "can translate randomly generated chains" $
let rnm = getRequiresNetworkMagic pm in
forAll
(intAndVerifyGen pm (genChainUsingModel . cardanoModel linearFeePolicy))
(intAndVerifyGen pm (genChainUsingModel rnm . cardanoModel linearFeePolicy))
expectValid

where
Expand Down Expand Up @@ -188,7 +189,9 @@ intAndVerifyPure :: ProtocolMagic
-> (GenesisValues GivenHash -> Chain GivenHash Addr)
-> ValidationResult GivenHash Addr
intAndVerifyPure pm txSizeLinear pc = runIdentity $
intAndVerify pm (Identity . pc . genesisValues txSizeLinear)
intAndVerify pm (Identity . pc . genesisValues txSizeLinear rnm)
where
rnm = getRequiresNetworkMagic pm

-- | Specialization of 'intAndVerify' to 'Gen'
intAndVerifyGen :: ProtocolMagic -> (Transaction GivenHash Addr
Expand Down

0 comments on commit 864bf74

Please sign in to comment.