Move common {coarbitrary,gen,shrink}WalletUTxO functions to `CoinSe…

…lection.Gen`.
cardano-foundation · Mar 17, 2022 · 28dabdd · 28dabdd
1 parent 9e99da9
commit 28dabdd
Show file tree

Hide file tree

Showing 7 changed files with 75 additions and 85 deletions.
diff --git a/lib/core/cardano-wallet-core.cabal b/lib/core/cardano-wallet-core.cabal
@@ -263,6 +263,7 @@ library
         -- The following modules define QC generators and shrinkers that can
         -- be used by both `cardano-wallet-core` and `cardano-wallet`:
         --
+      Cardano.Wallet.CoinSelection.Gen
       Cardano.Wallet.CoinSelection.Internal.Balance.Gen
       Cardano.Wallet.Primitive.Types.Address.Gen
       Cardano.Wallet.Primitive.Types.Coin.Gen

diff --git a/lib/core/src/Cardano/Wallet/CoinSelection/Gen.hs b/lib/core/src/Cardano/Wallet/CoinSelection/Gen.hs
@@ -0,0 +1,49 @@
+module Cardano.Wallet.CoinSelection.Gen
+    ( coarbitraryWalletUTxO
+    , genWalletUTxO
+    , genWalletUTxOFunction
+    , genWalletUTxOLargeRange
+    , shrinkWalletUTxO
+    )
+    where
+
+import Prelude
+
+import Cardano.Wallet.CoinSelection
+    ( WalletUTxO (..) )
+import Cardano.Wallet.Primitive.Types.Address.Gen
+    ( genAddress, shrinkAddress )
+import Cardano.Wallet.Primitive.Types.Tx.Gen
+    ( genTxIn, genTxInLargeRange, shrinkTxIn )
+import Generics.SOP
+    ( NP (..) )
+import Test.QuickCheck
+    ( Gen, coarbitrary )
+import Test.QuickCheck.Extra
+    ( genFunction, genSized2, genericRoundRobinShrink, (<:>), (<@>) )
+
+--------------------------------------------------------------------------------
+-- Wallet UTxO identifiers chosen according to the size parameter
+--------------------------------------------------------------------------------
+
+coarbitraryWalletUTxO :: WalletUTxO -> Gen a -> Gen a
+coarbitraryWalletUTxO = coarbitrary . show
+
+genWalletUTxO :: Gen WalletUTxO
+genWalletUTxO = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
+
+shrinkWalletUTxO :: WalletUTxO -> [WalletUTxO]
+shrinkWalletUTxO = genericRoundRobinShrink
+    <@> shrinkTxIn
+    <:> shrinkAddress
+    <:> Nil
+
+genWalletUTxOFunction :: Gen a -> Gen (WalletUTxO -> a)
+genWalletUTxOFunction = genFunction coarbitraryWalletUTxO
+
+--------------------------------------------------------------------------------
+-- Wallet UTxO identifiers chosen from a large range
+--------------------------------------------------------------------------------
+
+genWalletUTxOLargeRange :: Gen WalletUTxO
+genWalletUTxOLargeRange = WalletUTxO <$> genTxInLargeRange <*> genAddress
diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/Internal/BalanceSpec.hs
@@ -42,6 +42,12 @@ import Cardano.Numeric.Util
     ( inAscendingPartialOrder )
 import Cardano.Wallet.CoinSelection
     ( WalletSelectionContext, WalletUTxO (..) )
+import Cardano.Wallet.CoinSelection.Gen
+    ( genWalletUTxO
+    , genWalletUTxOFunction
+    , genWalletUTxOLargeRange
+    , shrinkWalletUTxO
+    )
 import Cardano.Wallet.CoinSelection.Internal.Balance
     ( AssetCount (..)
     , BalanceInsufficientError (..)
@@ -108,7 +114,7 @@ import Cardano.Wallet.CoinSelection.Internal.Balance.Gen
 import Cardano.Wallet.Primitive.Types.Address
     ( Address (..) )
 import Cardano.Wallet.Primitive.Types.Address.Gen
-    ( genAddress, shrinkAddress )
+    ( shrinkAddress )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (..) )
 import Cardano.Wallet.Primitive.Types.Coin.Gen
@@ -147,7 +153,7 @@ import Cardano.Wallet.Primitive.Types.Tx
     , txOutMaxTokenQuantity
     )
 import Cardano.Wallet.Primitive.Types.Tx.Gen
-    ( genTxIn, genTxInLargeRange, genTxOut, shrinkTxIn, shrinkTxOut )
+    ( genTxOut, shrinkTxOut )
 import Cardano.Wallet.Primitive.Types.UTxOIndex
     ( SelectionFilter (..), UTxOIndex )
 import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
@@ -214,7 +220,6 @@ import Test.QuickCheck
     , arbitraryBoundedEnum
     , checkCoverage
     , choose
-    , coarbitrary
     , conjoin
     , counterexample
     , cover
@@ -240,14 +245,7 @@ import Test.QuickCheck
 import Test.QuickCheck.Classes
     ( eqLaws, ordLaws )
 import Test.QuickCheck.Extra
-    ( genFunction
-    , genSized2
-    , genericRoundRobinShrink
-    , report
-    , verify
-    , (<:>)
-    , (<@>)
-    )
+    ( genericRoundRobinShrink, report, verify, (<:>), (<@>) )
 import Test.QuickCheck.Monadic
     ( PropertyM (..), assert, monadicIO, monitor, run )
 import Test.Utils.Laws
@@ -4378,28 +4376,6 @@ unitTests lbl cases =
     forM_ (zip [1..] cases) $ \(i, test) ->
         it (lbl <> " example #" <> show @Int i) test
 
---------------------------------------------------------------------------------
--- Wallet UTxO identifiers
---------------------------------------------------------------------------------
-
-coarbitraryWalletUTxO :: WalletUTxO -> Gen a -> Gen a
-coarbitraryWalletUTxO = coarbitrary . show
-
-genWalletUTxO :: Gen WalletUTxO
-genWalletUTxO = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
-
-genWalletUTxOLargeRange :: Gen WalletUTxO
-genWalletUTxOLargeRange = WalletUTxO <$> genTxInLargeRange <*> genAddress
-
-shrinkWalletUTxO :: WalletUTxO -> [WalletUTxO]
-shrinkWalletUTxO = genericRoundRobinShrink
-    <@> shrinkTxIn
-    <:> shrinkAddress
-    <:> Nil
-
-genWalletUTxOFunction :: Gen a -> Gen (WalletUTxO -> a)
-genWalletUTxOFunction = genFunction coarbitraryWalletUTxO
-
 --------------------------------------------------------------------------------
 -- Arbitrary instances
 --------------------------------------------------------------------------------

diff --git a/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs b/lib/core/test/unit/Cardano/Wallet/CoinSelection/InternalSpec.hs
@@ -18,6 +18,8 @@ import Prelude
 
 import Cardano.Wallet.CoinSelection
     ( WalletSelectionContext, WalletUTxO (..) )
+import Cardano.Wallet.CoinSelection.Gen
+    ( genWalletUTxO, shrinkWalletUTxO )
 import Cardano.Wallet.CoinSelection.Internal
     ( ComputeMinimumCollateralParams (..)
     , Selection
@@ -82,8 +84,6 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity
     ( TokenQuantity (..) )
 import Cardano.Wallet.Primitive.Types.Tx
     ( txOutMaxTokenQuantity )
-import Cardano.Wallet.Primitive.Types.Tx.Gen
-    ( genTxIn, shrinkTxIn )
 import Cardano.Wallet.Primitive.Types.UTxOSelection
     ( UTxOSelection )
 import Cardano.Wallet.Primitive.Types.UTxOSelection.Gen
@@ -138,7 +138,6 @@ import Test.QuickCheck.Extra
     ( Pretty (..)
     , chooseNatural
     , genMapWith
-    , genSized2
     , genericRoundRobinShrink
     , report
     , shrinkMapWith
@@ -797,9 +796,6 @@ shrinkCollateralRequirement = genericShrink
 -- UTxO available for inputs and collateral
 --------------------------------------------------------------------------------
 
-genWalletUTxO :: Gen WalletUTxO
-genWalletUTxO = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
-
 genUTxOAvailableForCollateral :: Gen (Map WalletUTxO Coin)
 genUTxOAvailableForCollateral = genMapWith genWalletUTxO genCoinPositive
 
@@ -809,12 +805,6 @@ genUTxOAvailableForInputs = frequency
     , (01, pure UTxOSelection.empty)
     ]
 
-shrinkWalletUTxO :: WalletUTxO -> [WalletUTxO]
-shrinkWalletUTxO = genericRoundRobinShrink
-    <@> shrinkTxIn
-    <:> shrinkAddress
-    <:> Nil
-
 shrinkUTxOAvailableForCollateral
     :: Map WalletUTxO Coin -> [Map WalletUTxO Coin]
 shrinkUTxOAvailableForCollateral =

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs
@@ -14,10 +14,12 @@ import Prelude
 
 import Cardano.Wallet.CoinSelection
     ( WalletUTxO (..) )
+import Cardano.Wallet.CoinSelection.Gen
+    ( coarbitraryWalletUTxO, genWalletUTxO, shrinkWalletUTxO )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address )
 import Cardano.Wallet.Primitive.Types.Address.Gen
-    ( coarbitraryAddress, genAddress, shrinkAddress )
+    ( coarbitraryAddress )
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle )
 import Cardano.Wallet.Primitive.Types.TokenBundle.Gen
@@ -29,7 +31,7 @@ import Cardano.Wallet.Primitive.Types.TokenMap.Gen
 import Cardano.Wallet.Primitive.Types.Tx
     ( TxIn, TxOut (..) )
 import Cardano.Wallet.Primitive.Types.Tx.Gen
-    ( coarbitraryTxIn, genTxIn, genTxOut, shrinkTxIn, shrinkTxOut )
+    ( coarbitraryTxIn, genTxOut, shrinkTxOut )
 import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
     ( genUTxOIndex, shrinkUTxOIndex )
 import Cardano.Wallet.Primitive.Types.UTxOIndex.Internal
@@ -44,8 +46,6 @@ import Data.Ratio
     ( (%) )
 import Data.Word
     ( Word8 )
-import Generics.SOP
-    ( NP (..) )
 import Test.Hspec
     ( Spec, describe, it )
 import Test.Hspec.Extra
@@ -59,7 +59,6 @@ import Test.QuickCheck
     , Testable
     , checkCoverage
     , checkCoverageWith
-    , coarbitraryShow
     , conjoin
     , counterexample
     , cover
@@ -73,8 +72,6 @@ import Test.QuickCheck
     )
 import Test.QuickCheck.Classes
     ( eqLaws )
-import Test.QuickCheck.Extra
-    ( genSized2, genericRoundRobinShrink, (<:>), (<@>) )
 import Test.QuickCheck.Monadic
     ( assert, monadicIO, monitor, run )
 import Test.Utils.Laws
@@ -784,18 +781,10 @@ tokenBundleIsAdaOnly = TokenBundle.isCoin
 
 instance Arbitrary WalletUTxO where
     arbitrary = genWalletUTxO
-
-genWalletUTxO :: Gen WalletUTxO
-genWalletUTxO = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
-
-shrinkWalletUTxO :: WalletUTxO -> [WalletUTxO]
-shrinkWalletUTxO = genericRoundRobinShrink
-    <@> shrinkTxIn
-    <:> shrinkAddress
-    <:> Nil
+    shrink = shrinkWalletUTxO
 
 instance CoArbitrary WalletUTxO where
-    coarbitrary = coarbitraryShow
+    coarbitrary = coarbitraryWalletUTxO
 
 instance CoArbitrary Address where
     coarbitrary = coarbitraryAddress

diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOSelectionSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOSelectionSpec.hs
@@ -12,14 +12,16 @@ import Prelude
 
 import Cardano.Wallet.CoinSelection
     ( WalletUTxO (..) )
+import Cardano.Wallet.CoinSelection.Gen
+    ( coarbitraryWalletUTxO, genWalletUTxO, shrinkWalletUTxO )
 import Cardano.Wallet.Primitive.Types.Address
     ( Address )
 import Cardano.Wallet.Primitive.Types.Address.Gen
-    ( coarbitraryAddress, genAddress, shrinkAddress )
+    ( coarbitraryAddress )
 import Cardano.Wallet.Primitive.Types.Tx
     ( TxIn )
 import Cardano.Wallet.Primitive.Types.Tx.Gen
-    ( coarbitraryTxIn, genTxIn, shrinkTxIn )
+    ( coarbitraryTxIn )
 import Cardano.Wallet.Primitive.Types.UTxOIndex
     ( UTxOIndex )
 import Cardano.Wallet.Primitive.Types.UTxOIndex.Gen
@@ -32,28 +34,22 @@ import Cardano.Wallet.Primitive.Types.UTxOSelection.Gen
     , shrinkUTxOSelection
     , shrinkUTxOSelectionNonEmpty
     )
-import Generics.SOP
-    ( NP (..) )
 import Test.Hspec
     ( Spec, describe, it )
 import Test.Hspec.Extra
     ( parallel )
 import Test.QuickCheck
     ( Arbitrary (..)
     , CoArbitrary (..)
-    , Gen
     , Property
     , Testable
     , checkCoverage
-    , coarbitraryShow
     , conjoin
     , cover
     , forAll
     , property
     , (===)
     )
-import Test.QuickCheck.Extra
-    ( genSized2, genericRoundRobinShrink, (<:>), (<@>) )
 
 import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Cardano.Wallet.Primitive.Types.UTxOIndex as UTxOIndex
@@ -433,20 +429,8 @@ isValidSelectionNonEmpty s =
 -- of input identifier has been made into a type parameter.
 --
 instance Arbitrary WalletUTxO where
-    arbitrary = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
-    shrink = genericRoundRobinShrink
-        <@> shrinkTxIn
-        <:> shrinkAddress
-        <:> Nil
-
-genWalletUTxO :: Gen WalletUTxO
-genWalletUTxO = uncurry WalletUTxO <$> genSized2 genTxIn genAddress
-
-shrinkWalletUTxO :: WalletUTxO -> [WalletUTxO]
-shrinkWalletUTxO = genericRoundRobinShrink
-    <@> shrinkTxIn
-    <:> shrinkAddress
-    <:> Nil
+    arbitrary = genWalletUTxO
+    shrink = shrinkWalletUTxO
 
 instance Arbitrary (UTxOIndex WalletUTxO) where
     arbitrary = genUTxOIndex genWalletUTxO
@@ -471,7 +455,7 @@ instance CoArbitrary TxIn where
     coarbitrary = coarbitraryTxIn
 
 instance CoArbitrary WalletUTxO where
-    coarbitrary = coarbitraryShow
+    coarbitrary = coarbitraryWalletUTxO
 
 --------------------------------------------------------------------------------
 -- Show instances

diff --git a/nix/materialized/stack-nix/cardano-wallet-core.nix b/nix/materialized/stack-nix/cardano-wallet-core.nix