diff --git a/test/unit/Cardano/Wallet/CoinSelection/LargestFirstSpec.hs b/test/unit/Cardano/Wallet/CoinSelection/LargestFirstSpec.hs index 59b7d816572..e28262bdc35 100644 --- a/test/unit/Cardano/Wallet/CoinSelection/LargestFirstSpec.hs +++ b/test/unit/Cardano/Wallet/CoinSelection/LargestFirstSpec.hs @@ -12,15 +12,10 @@ import Cardano.Wallet.CoinSelection ( CoinSelection (..), CoinSelectionError (..), CoinSelectionOptions (..) ) import Cardano.Wallet.CoinSelection.LargestFirst ( largestFirst ) +import Cardano.Wallet.CoinSelectionSpec + ( CoveringCase (..), Fixture (..), coinSelectionUnitTest ) import Cardano.Wallet.Primitive.Types - ( Address (..) - , Coin (..) - , Hash (..) - , TxIn (..) - , TxOut (..) - , UTxO (..) - , excluding - ) + ( Coin (..), TxOut (..), UTxO (..), excluding ) import Control.Monad ( unless ) import Control.Monad.Trans.Except @@ -31,25 +26,11 @@ import Data.Functor.Identity ( Identity (runIdentity) ) import Data.List.NonEmpty ( NonEmpty (..) ) -import Data.Word - ( Word64, Word8 ) import Test.Hspec - ( Expectation, Spec, describe, it, shouldBe, shouldSatisfy ) + ( Spec, describe, it, shouldSatisfy ) import Test.QuickCheck - ( Arbitrary (..) - , Gen - , Property - , choose - , generate - , oneof - , property - , scale - , vectorOf - , (===) - , (==>) - ) + ( Property, property, (===), (==>) ) -import qualified Data.ByteString as BS import qualified Data.List as L import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map @@ -58,129 +39,91 @@ import qualified Data.Set as Set spec :: Spec spec = do describe "Coin selection : LargestFirst algorithm unit tests" $ do - it "one input per small output" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [10,10,17] - , txOutputs = 17 :| [] - , expectedResult = Right [17] - }) - it "one input per big output" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,10,17] - , txOutputs = 1 :| [] - , expectedResult = Right [17] - }) - it "two inputs per output" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,10,17] - , txOutputs = 18 :| [] - , expectedResult = Right [12, 17] - }) - it "three inputs per output" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,10,17] - , txOutputs = 30 :| [] - , expectedResult = Right [10, 12, 17] - }) - it "NotEnoughMoney error expected when not enough coins" $ do - (coinSelectionUnitTest - Fixture + coinSelectionUnitTest largestFirst "" (Right [17]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [10,10,17] + , txOutputs = 17 :| [] + } + + coinSelectionUnitTest largestFirst "" (Right [17]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,10,17] + , txOutputs = 1 :| [] + } + + coinSelectionUnitTest largestFirst "" (Right [12, 17]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,10,17] + , txOutputs = 18 :| [] + } + + coinSelectionUnitTest largestFirst "" (Right [10, 12, 17]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,10,17] + , txOutputs = 30 :| [] + } + + coinSelectionUnitTest largestFirst "" (Right [6,10,5]) $ Fixture + { maxNumOfInputs = 3 + , utxoInputs = [1,2,10,6,5] + , txOutputs = 11 :| [1] + } + + coinSelectionUnitTest + largestFirst + "not enough coins" + (Left $ NotEnoughMoney 39 40) + $ Fixture { maxNumOfInputs = 100 , utxoInputs = [12,10,17] , txOutputs = 40 :| [] - , expectedResult = Left $ NotEnoughMoney 39 40 - }) - it "NotEnoughMoney error expected when not enough coins and utxo not fragmented enough" $ do - (coinSelectionUnitTest - Fixture + } + + coinSelectionUnitTest + largestFirst + "not enough coin & not fragmented enough" + (Left $ NotEnoughMoney 39 43) + $ Fixture { maxNumOfInputs = 100 , utxoInputs = [12,10,17] , txOutputs = 40 :| [1,1,1] - , expectedResult = Left $ NotEnoughMoney 39 43 - }) - it "UtxoNotEnoughFragmented error expected when enough coins and utxo not fragmented enough" $ do - (coinSelectionUnitTest - Fixture + } + + coinSelectionUnitTest + largestFirst + "enough coins, but not fragmented enough" + (Left $ UtxoNotEnoughFragmented 3 4) + $ Fixture { maxNumOfInputs = 100 , utxoInputs = [12,20,17] , txOutputs = 40 :| [1,1,1] - , expectedResult = Left $ UtxoNotEnoughFragmented 3 4 - }) - it "happy path with correct maximumNumberOfInputs - 3 inputs for 2 outputs" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 3 - , utxoInputs = [1,2,10,6,5] - , txOutputs = 11 :| [1] - , expectedResult = Right [6,10,5] - }) - it "happy path with too strict maximumNumberOfInputs result in error - 3 inputs for 2 outputs" $ do - (coinSelectionUnitTest - Fixture + } + + coinSelectionUnitTest + largestFirst + "enough coins but, strict maximumNumberOfInputs" + (Left $ MaximumInputsReached 2) + $ Fixture { maxNumOfInputs = 2 , utxoInputs = [1,2,10,6,5] , txOutputs = 11 :| [1] - , expectedResult = Left $ MaximumInputsReached 2 - }) + } describe "Coin selection properties : LargestFirst algorithm" $ do - it "forall (UTxO, NonEmpty TxOut), \ - \ running algorithm twice yields exactly the same result" + it "forall (UTxO, NonEmpty TxOut), running algorithm twice yields \ + \exactly the same result" (property propDeterministic) - it "forall (UTxO, NonEmpty TxOut), \ - \ there's at least as many selected inputs as there are requested outputs" + it "forall (UTxO, NonEmpty TxOut), there's at least as many selected \ + \inputs as there are requested outputs" (property propAtLeast) - it "forall (UTxO, NonEmpty TxOut), for all selected input, \ - \ there's no bigger input in the UTxO that is not already in the selected inputs." + it "forall (UTxO, NonEmpty TxOut), for all selected input, there's no \ + \bigger input in the UTxO that is not already in the selected inputs" (property propInputDecreasingOrder) {------------------------------------------------------------------------------- - Properties and unit test generic scenario + Properties -------------------------------------------------------------------------------} -data Fixture = Fixture - { maxNumOfInputs :: Word64 - , utxoInputs :: [Word64] - , txOutputs :: NonEmpty Word64 - , expectedResult :: Either CoinSelectionError [Word64] - } deriving Show - - -coinSelectionUnitTest - :: Fixture - -> Expectation -coinSelectionUnitTest (Fixture n utxoCoins txOutsCoins expected) = do - (utxo,txOuts) <- setup - - result <- runExceptT $ do - CoinSelection inps _ _ <- - largestFirst (CoinSelectionOptions n) utxo txOuts - return $ map (getCoin . coin . snd) inps - - result `shouldBe` expected - where - setup :: IO (UTxO, NonEmpty TxOut) - setup = do - ins <- generate $ vectorOf (L.length utxoCoins) arbitrary - addrs <- generate $ vectorOf (L.length utxoCoins) arbitrary - let utxo = UTxO $ Map.fromList - $ L.zip ins - $ L.zipWith TxOut addrs - $ map Coin utxoCoins - txOutsAddrs <- generate $ vectorOf (L.length txOutsCoins) arbitrary - let txOuts = NE.zipWith TxOut (NE.fromList txOutsAddrs) - $ NE.map Coin txOutsCoins - pure (utxo, txOuts) - - propDeterministic :: CoveringCase -> Property @@ -218,58 +161,3 @@ propInputDecreasingOrder (CoveringCase (utxo, txOuts)) = getExtremumValue f = f . map (getCoin . coin . snd) selection = runIdentity $ runExceptT $ largestFirst (CoinSelectionOptions 100) utxo txOuts - - -{------------------------------------------------------------------------------- - Test Data --------------------------------------------------------------------------------} - -newtype CoveringCase = CoveringCase { getCoveringCase :: (UTxO, NonEmpty TxOut)} - deriving Show - -instance Arbitrary CoveringCase where - arbitrary = do - n <- choose (1, 10) - txOutsNonEmpty <- NE.fromList <$> vectorOf n arbitrary - utxo <- arbitrary - return $ CoveringCase (utxo, txOutsNonEmpty) - -instance Arbitrary (Hash "Tx") where - -- No Shrinking - arbitrary = do - wds <- vectorOf 10 arbitrary :: Gen [Word8] - let bs = BS.pack wds - pure $ Hash bs - -instance Arbitrary Address where - -- No Shrinking - arbitrary = oneof - [ pure $ Address "ADDR01" - , pure $ Address "ADDR02" - , pure $ Address "ADDR03" - ] - -instance Arbitrary Coin where - -- No Shrinking - arbitrary = Coin <$> choose (1, 100000) - -instance Arbitrary TxOut where - -- No Shrinking - arbitrary = TxOut - <$> arbitrary - <*> arbitrary - -instance Arbitrary TxIn where - -- No Shrinking - arbitrary = TxIn - <$> arbitrary - <*> scale (`mod` 3) arbitrary -- No need for a high indexes - -instance Arbitrary UTxO where - shrink (UTxO utxo) = UTxO <$> shrink utxo - arbitrary = do - n <- choose (1, 100) - utxo <- zip - <$> vectorOf n arbitrary - <*> vectorOf n arbitrary - return $ UTxO $ Map.fromList utxo diff --git a/test/unit/Cardano/Wallet/CoinSelection/RandomSpec.hs b/test/unit/Cardano/Wallet/CoinSelection/RandomSpec.hs index d91412b583b..ea9a23cad49 100644 --- a/test/unit/Cardano/Wallet/CoinSelection/RandomSpec.hs +++ b/test/unit/Cardano/Wallet/CoinSelection/RandomSpec.hs @@ -14,8 +14,8 @@ import Cardano.Wallet.CoinSelection.LargestFirst ( largestFirst ) import Cardano.Wallet.CoinSelection.Random ( random ) -import Cardano.Wallet.Primitive.Types - ( Address (..), Coin (..), Hash (..), TxIn (..), TxOut (..), UTxO (..) ) +import Cardano.Wallet.CoinSelectionSpec + ( CoveringCase (..), Fixture (..), coinSelectionUnitTest ) import Control.Monad.Trans.Except ( runExceptT ) import Crypto.Random @@ -28,123 +28,85 @@ import Data.Functor.Identity ( Identity (..) ) import Data.List.NonEmpty ( NonEmpty (..) ) -import Data.Word - ( Word64, Word8 ) import System.IO.Unsafe ( unsafeDupablePerformIO ) import Test.Hspec - ( Expectation, Spec, describe, it, shouldBe, shouldSatisfy ) + ( Spec, describe, it, shouldSatisfy ) import Test.QuickCheck - ( Arbitrary (..) - , Gen - , Property - , choose - , generate - , oneof - , property - , scale - , vectorOf - , (===) - , (==>) - ) + ( Property, property, (===), (==>) ) -import qualified Data.ByteString as BS import qualified Data.List as L -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map spec :: Spec spec = do describe "Coin selection : Random algorithm unit tests" $ do - it "one output (targetMin=2), 6 small inputs should select 4 coins" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [1,1,1,1,1,1] - , txOutputs = 2 :| [] - , expectedResult = Right [1,1,1,1] - }) - it "two outputs (targetMin=2, targetMin=1), 6 small inputs should select 6 coins" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [1,1,1,1,1,1] - , txOutputs = 2 :| [1] - , expectedResult = Right [1,1,1,1,1,1] - }) - it "two outputs (targetMin=2, targetMin=1), 5 small inputs should select 5 coins" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [1,1,1,1,1] - , txOutputs = 2 :| [1] - , expectedResult = Right [1,1,1,1,1] - }) - it "two outputs (targetMin=2, targetMin=1), 4 small inputs should select 3 coins - fallback" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [1,1,1,1] - , txOutputs = 2 :| [1] - , expectedResult = Right [1,1,1] - }) - it "one output (targetMin=2), 3 medium inputs should select 1 coin" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [5,5,5] - , txOutputs = 2 :| [] - , expectedResult = Right [5] - }) - it "two outputs (targetMin=2, targetMin=2), 3 big inputs should select 2 coins" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [10,10,10] - , txOutputs = 2 :| [2] - , expectedResult = Right [10,10] - }) - it "one output (targetMin=3), 6 small inputs should select 4 coins - maxNumOfInputs can cover targetMin but not targetAim" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 4 - , utxoInputs = [1,1,1,1,1,1] - , txOutputs = 3 :| [] - , expectedResult = Right [1,1,1,1] - }) - it "one output (targetMin=3), 6 small inputs result in - maxNumOfInputs cannot cover targetMin - fallback" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 2 - , utxoInputs = [1,1,1,1,1,1] - , txOutputs = 3 :| [] - , expectedResult = Left $ MaximumInputsReached 2 - }) - it "NotEnoughMoney error expected when not enough coins - fallback" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,10,17] - , txOutputs = 40 :| [] - , expectedResult = Left $ NotEnoughMoney 39 40 - }) - it "NotEnoughMoney error expected when not enough coins and utxo not fragmented enough - fallback" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,10,17] - , txOutputs = 40 :| [1,1,1] - , expectedResult = Left $ NotEnoughMoney 39 43 - }) - it "UtxoNotEnoughFragmented error expected when enough coins and utxo not fragmented enough - fallback" $ do - (coinSelectionUnitTest - Fixture - { maxNumOfInputs = 100 - , utxoInputs = [12,20,17] - , txOutputs = 40 :| [1,1,1] - , expectedResult = Left $ UtxoNotEnoughFragmented 3 4 - }) + coinSelectionUnitTest random "" (Right [1,1,1,1]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [1,1,1,1,1,1] + , txOutputs = 2 :| [] + } + + coinSelectionUnitTest random "" (Right [1,1,1,1,1,1]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [1,1,1,1,1,1] + , txOutputs = 2 :| [1] + } + + coinSelectionUnitTest random "" (Right [1,1,1,1,1]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [1,1,1,1,1] + , txOutputs = 2 :| [1] + } + + coinSelectionUnitTest random "with fallback" (Right [1,1,1]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [1,1,1,1] + , txOutputs = 2 :| [1] + } + + coinSelectionUnitTest random "" (Right [5]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [5,5,5] + , txOutputs = 2 :| [] + } + + coinSelectionUnitTest random "" (Right [10,10]) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [10,10,10] + , txOutputs = 2 :| [2] + } + + coinSelectionUnitTest random "cannot cover aim, but only min" + (Right [1,1,1,1]) $ Fixture + { maxNumOfInputs = 4 + , utxoInputs = [1,1,1,1,1,1] + , txOutputs = 3 :| [] + } + + coinSelectionUnitTest random "" (Left $ MaximumInputsReached 2) $ Fixture + { maxNumOfInputs = 2 + , utxoInputs = [1,1,1,1,1,1] + , txOutputs = 3 :| [] + } + + coinSelectionUnitTest random "" (Left $ NotEnoughMoney 39 40) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,10,17] + , txOutputs = 40 :| [] + } + + coinSelectionUnitTest random "" (Left $ NotEnoughMoney 39 43) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,10,17] + , txOutputs = 40 :| [1,1,1] + } + + coinSelectionUnitTest random "" (Left $ UtxoNotEnoughFragmented 3 4) $ Fixture + { maxNumOfInputs = 100 + , utxoInputs = [12,20,17] + , txOutputs = 40 :| [1,1,1] + } describe "Coin selection properties : Random algorithm" $ do it "forall (UTxO, NonEmpty TxOut), \ @@ -159,40 +121,6 @@ spec = do Properties and unit test generic scenario -------------------------------------------------------------------------------} -data Fixture = Fixture - { maxNumOfInputs :: Word64 - , utxoInputs :: [Word64] - , txOutputs :: NonEmpty Word64 - , expectedResult :: Either CoinSelectionError [Word64] - } deriving Show - -coinSelectionUnitTest - :: Fixture - -> Expectation -coinSelectionUnitTest (Fixture n utxoCoins txOutsCoins expected) = do - (utxo,txOuts) <- setup - - result <- runExceptT $ do - CoinSelection inps _ _ <- - random (CoinSelectionOptions n) utxo txOuts - return $ map (getCoin . coin . snd) inps - - result `shouldBe` expected - where - setup :: IO (UTxO, NonEmpty TxOut) - setup = do - ins <- generate $ vectorOf (L.length utxoCoins) arbitrary - addrs <- generate $ vectorOf (L.length utxoCoins) arbitrary - let utxo = UTxO $ Map.fromList - $ L.zip ins - $ L.zipWith TxOut addrs - $ map Coin utxoCoins - txOutsAddrs <- generate $ vectorOf (L.length txOutsCoins) arbitrary - let txOuts = NE.zipWith TxOut (NE.fromList txOutsAddrs) - $ NE.map Coin txOutsCoins - pure (utxo, txOuts) - - propFragmentation :: CoveringCase -> Property @@ -226,58 +154,3 @@ propErrors (CoveringCase (utxo, txOuts)) = do (runExceptT $ random (CoinSelectionOptions 1) utxo txOuts) selection2 = runIdentity $ runExceptT $ largestFirst (CoinSelectionOptions 1) utxo txOuts - - -{------------------------------------------------------------------------------- - Test Data --------------------------------------------------------------------------------} - -newtype CoveringCase = CoveringCase { getCoveringCase :: (UTxO, NonEmpty TxOut)} - deriving Show - -instance Arbitrary CoveringCase where - arbitrary = do - n <- choose (1, 10) - txOutsNonEmpty <- NE.fromList <$> vectorOf n arbitrary - utxo <- arbitrary - return $ CoveringCase (utxo, txOutsNonEmpty) - -instance Arbitrary Address where - -- No Shrinking - arbitrary = oneof - [ pure $ Address "ADDR01" - , pure $ Address "ADDR02" - , pure $ Address "ADDR03" - ] - -instance Arbitrary Coin where - -- No Shrinking - arbitrary = Coin <$> choose (1, 100000) - -instance Arbitrary TxIn where - -- No Shrinking - arbitrary = TxIn - <$> arbitrary - <*> scale (`mod` 3) arbitrary -- No need for a high indexes - -instance Arbitrary (Hash "Tx") where - -- No Shrinking - arbitrary = do - wds <- vectorOf 10 arbitrary :: Gen [Word8] - let bs = BS.pack wds - pure $ Hash bs - -instance Arbitrary TxOut where - -- No Shrinking - arbitrary = TxOut - <$> arbitrary - <*> arbitrary - -instance Arbitrary UTxO where - shrink (UTxO utxo) = UTxO <$> shrink utxo - arbitrary = do - n <- choose (1, 100) - utxo <- zip - <$> vectorOf n arbitrary - <*> vectorOf n arbitrary - return $ UTxO $ Map.fromList utxo diff --git a/test/unit/Cardano/Wallet/CoinSelectionSpec.hs b/test/unit/Cardano/Wallet/CoinSelectionSpec.hs index 2fc4f7447df..a79db52735c 100644 --- a/test/unit/Cardano/Wallet/CoinSelectionSpec.hs +++ b/test/unit/Cardano/Wallet/CoinSelectionSpec.hs @@ -1,14 +1,148 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Cardano.Wallet.CoinSelectionSpec ( spec + , Fixture(..) + , coinSelectionUnitTest + , CoveringCase(..) ) where +-- | This module contains shared logic between the coin selection tests. They +-- ought to share the same interface, and therefore, it makes sense for them to +-- also require the same arbitrary instances and instrument testing in a similar +-- way for both. + import Prelude import Cardano.Wallet.CoinSelection - () + ( CoinSelection (..), CoinSelectionError (..), CoinSelectionOptions (..) ) +import Cardano.Wallet.Primitive.Types + ( Address (..), Coin (..), Hash (..), TxIn (..), TxOut (..), UTxO (..) ) +import Control.Monad.Trans.Except + ( ExceptT, runExceptT ) +import Data.List.NonEmpty + ( NonEmpty (..) ) +import Data.Word + ( Word64, Word8 ) import Test.Hspec - ( Spec ) + ( Spec, SpecWith, it, shouldBe ) +import Test.QuickCheck + ( Arbitrary (..), Gen, choose, generate, oneof, scale, vectorOf ) + +import qualified Data.ByteString as BS +import qualified Data.List as L +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map spec :: Spec spec = return () + +-- | A fixture for testing the coin selection +data Fixture = Fixture + { maxNumOfInputs :: Word64 + -- ^ Maximum number of inputs that can be selected + , utxoInputs :: [Word64] + -- ^ Value (in Lovelace) & number of available coins in the UTxO + , txOutputs :: NonEmpty Word64 + -- ^ Value (in Lovelace) & number of requested outputs + } deriving Show + +-- | Data for running +newtype CoveringCase = CoveringCase { getCoveringCase :: (UTxO, NonEmpty TxOut)} + deriving Show + +-- | Generate a 'UTxO' and 'TxOut' matching the given 'Fixture', and perform +-- given coin selection on it. +coinSelectionUnitTest + :: ( CoinSelectionOptions + -> UTxO + -> NonEmpty TxOut + -> ExceptT CoinSelectionError IO CoinSelection + ) + -> String + -> Either CoinSelectionError [Word64] + -> Fixture + -> SpecWith () +coinSelectionUnitTest run lbl expected (Fixture n utxoCoins txOutsCoins) = + it title $ do + (utxo,txOuts) <- setup + result <- runExceptT $ do + CoinSelection inps _ _ <- + run (CoinSelectionOptions n) utxo txOuts + return $ map (getCoin . coin . snd) inps + result `shouldBe` expected + where + title :: String + title = mempty + <> "max=" <> show n + <> ", UTxO=" <> show utxoCoins + <> ", Output=" <> show (NE.toList txOutsCoins) + <> " --> " <> show expected + <> if null lbl then "" else " (" <> lbl <> ")" + + setup :: IO (UTxO, NonEmpty TxOut) + setup = do + ins <- generate $ vectorOf (L.length utxoCoins) arbitrary + addrs <- generate $ vectorOf (L.length utxoCoins) arbitrary + let utxo = UTxO $ Map.fromList + $ L.zip ins + $ L.zipWith TxOut addrs + $ map Coin utxoCoins + txOutsAddrs <- generate $ vectorOf (L.length txOutsCoins) arbitrary + let txOuts = NE.zipWith TxOut (NE.fromList txOutsAddrs) + $ NE.map Coin txOutsCoins + pure (utxo, txOuts) + +{------------------------------------------------------------------------------- + Arbitrary Instances +-------------------------------------------------------------------------------} + +instance Arbitrary CoveringCase where + arbitrary = do + n <- choose (1, 10) + txOutsNonEmpty <- NE.fromList <$> vectorOf n arbitrary + utxo <- arbitrary + return $ CoveringCase (utxo, txOutsNonEmpty) + +instance Arbitrary Address where + -- No Shrinking + arbitrary = oneof + [ pure $ Address "ADDR01" + , pure $ Address "ADDR02" + , pure $ Address "ADDR03" + ] + +instance Arbitrary Coin where + -- No Shrinking + arbitrary = Coin <$> choose (1, 100000) + +instance Arbitrary TxIn where + -- No Shrinking + arbitrary = TxIn + <$> arbitrary + <*> scale (`mod` 3) arbitrary -- No need for a high indexes + +instance Arbitrary (Hash "Tx") where + -- No Shrinking + arbitrary = do + wds <- vectorOf 10 arbitrary :: Gen [Word8] + let bs = BS.pack wds + pure $ Hash bs + +instance Arbitrary TxOut where + -- No Shrinking + arbitrary = TxOut + <$> arbitrary + <*> arbitrary + +instance Arbitrary UTxO where + shrink (UTxO utxo) = UTxO <$> shrink utxo + arbitrary = do + n <- choose (1, 100) + utxo <- zip + <$> vectorOf n arbitrary + <*> vectorOf n arbitrary + return $ UTxO $ Map.fromList utxo