Update properties for quantity -> coin

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -185,6 +185,10 @@ import Cardano.Wallet.Primitive.Types.Hash
     ( Hash (..) )
 import Cardano.Wallet.Primitive.Types.RewardAccount
     ( RewardAccount (..) )
+import Cardano.Wallet.Primitive.Types.TokenBundle
+    ( TokenBundle )
+import Cardano.Wallet.Primitive.Types.TokenBundle.Gen
+    ( genTokenBundleSmallRange, shrinkTokenBundleSmallRange )
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( TokenMap )
 import Cardano.Wallet.Primitive.Types.TokenMap.Gen
@@ -326,7 +330,6 @@ import Web.HttpApiData
     ( FromHttpApiData (..) )
 
 import qualified Cardano.Wallet.Api.Types as Api
-import qualified Cardano.Wallet.Primitive.Types.TokenBundle as TokenBundle
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.ByteArray as BA
@@ -1304,10 +1307,6 @@ instance Arbitrary ApiWalletAssetsBalance where
     arbitrary = genericArbitrary
     shrink = genericShrink
 
-instance Arbitrary TokenMap where
-    arbitrary = genTokenMapSmallRange
-    shrink = shrinkTokenMapSmallRange
-
 instance Arbitrary WalletDelegationStatus where
     arbitrary = genericArbitrary
     shrink = genericShrink
@@ -1666,6 +1665,7 @@ instance Arbitrary (ApiTransaction t) where
             <*> arbitrary
             <*> arbitrary
             <*> arbitrary
+            <*> arbitrary
             <*> pure txInsertedAt
             <*> pure txPendingSince
             <*> pure txExpiresAt
@@ -1674,6 +1674,7 @@ instance Arbitrary (ApiTransaction t) where
             <*> genInputs
             <*> genOutputs
             <*> genWithdrawals
+            <*> arbitrary
             <*> pure txStatus
             <*> arbitrary
       where
@@ -1705,11 +1706,18 @@ instance Arbitrary UTxO where
             <*> vector n
         return $ UTxO $ Map.fromList utxo
 
+instance Arbitrary TokenBundle where
+    shrink = shrinkTokenBundleSmallRange
+    arbitrary = genTokenBundleSmallRange
+
+instance Arbitrary TokenMap where
+    shrink = shrinkTokenMapSmallRange
+    arbitrary = genTokenMapSmallRange
+
 instance Arbitrary TxOut where
-    -- No Shrinking
-    arbitrary = TxOut
-        <$> arbitrary
-        <*> fmap TokenBundle.fromCoin genCoinLargePositive
+    -- Shrink token bundle but not address
+    shrink (TxOut a t) = TxOut a <$> shrink t
+    arbitrary = TxOut <$> arbitrary <*> arbitrary
 
 instance Arbitrary TxIn where
     -- No Shrinking

lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MigrationSpec.hs

@@ -33,9 +33,7 @@ import Data.ByteString
 import Data.Function
     ( (&) )
 import Data.Word
-    ( Word8 )
-import Numeric.Natural
-    ( Natural )
+    ( Word64, Word8 )
 import Test.Hspec
     ( Spec, SpecWith, describe, it, parallel, shouldSatisfy )
 import Test.QuickCheck
@@ -77,17 +75,17 @@ spec = parallel $ do
                 feeOpts <- pick (genFeeOptions dust)
                 let selections = depleteUTxO feeOpts batchSize utxo
                 monitor $ label $ accuracy dust
-                    (balance utxo)
-                    (fromIntegral $ sum $ inputBalance <$> selections)
+                    (TokenBundle.getCoin $ balance utxo)
+                    (sum $ inputBalance <$> selections)
               where
                 title :: String
                 title = "dust=" <> show (round (100 * r) :: Int) <> "%"
 
-                accuracy :: Coin -> Natural -> Natural -> String
-                accuracy (Coin dust) sup real
+                accuracy :: Coin -> Coin -> Word64 -> String
+                accuracy (Coin dust) (Coin sup) real
                     | a >= 1.0 =
                         "PERFECT  (== 100%)"
-                    | a > 0.99 || (sup - real) < fromIntegral dust =
+                    | a > 0.99 || (sup - real) < dust =
                         "OKAY     (>   99%)"
                     | otherwise =
                         "MEDIOCRE (<=  99%)"
@@ -177,8 +175,8 @@ prop_inputsGreaterThanOutputs
 prop_inputsGreaterThanOutputs feeOpts batchSize utxo = do
     let selections  = depleteUTxO feeOpts batchSize utxo
     let totalChange = sum (changeBalance <$> selections)
-    let balanceUTxO = TokenBundle.getCoin $ balance utxo
-    property (balanceUTxO >= fromIntegral totalChange)
+    let Coin balanceUTxO = TokenBundle.getCoin $ balance utxo
+    property (balanceUTxO >= totalChange)
         & counterexample ("Total change balance: " <> show totalChange)
         & counterexample ("Total UTxO balance: " <> show balanceUTxO)
         & counterexample ("Selections: " <> show selections)

lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs

@@ -204,7 +204,7 @@ prop_applyBlockBasic s =
         in
             (ShowFmt utxo === ShowFmt utxo') .&&.
             (availableBalance mempty wallet === balance utxo') .&&.
-            (totalBalance mempty (Quantity 0) wallet === balance utxo')
+            (totalBalance mempty (Coin 0) wallet === balance utxo')
 
 -- Each transaction must have at least one output belonging to us
 prop_applyBlockTxHistoryIncoming :: WalletState -> Property

lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs

@@ -980,7 +980,7 @@ prop_2_6_1 (u, v) =
     -- a v' that has no overlap with u.
     v' = v `excluding` dom u
     cond = not (u `isSubsetOf` mempty || v' `isSubsetOf` mempty)
-    prop = balance (u <> v') === balance u + balance v'
+    prop = balance (u <> v') === balance u `TokenBundle.add` balance v'
 
 prop_2_6_2 :: (Set TxIn, UTxO) -> Property
 prop_2_6_2 (ins, u) =
@@ -1002,7 +1002,7 @@ propUtxoTotalIsBalance
     -> ShowFmt UTxO
     -> Property
 propUtxoTotalIsBalance bType (ShowFmt utxo) =
-    totalStake == TokenBundle.getCoin (balance utxo)
+    Coin totalStake == TokenBundle.getCoin (balance utxo)
     & cover 75 (utxo /= mempty) "UTxO /= empty"
   where
     UTxOStatistics _ totalStake _ = computeUtxoStatistics bType utxo
@@ -1015,7 +1015,7 @@ propUtxoSumDistribution
     -> ShowFmt UTxO
     -> Property
 propUtxoSumDistribution bType (ShowFmt utxo) =
-    sum (upperVal <$> bars) >= fromIntegral (balance utxo)
+    sum (upperVal <$> bars) >= unCoin (TokenBundle.getCoin (balance utxo))
     & cover 75 (utxo /= mempty) "UTxO /= empty"
     & counterexample ("Histogram: " <> pretty bars)
   where

lib/core/test/unit/Cardano/WalletSpec.hs

@@ -286,26 +286,26 @@ spec = parallel $ do
                 `shouldBe` Left (W.ErrNoSuchPool pidUnknown)
         it "Cannot quit when active: not_delegating, next = []" $ do
             let dlg = WalletDelegation {active = NotDelegating, next = []}
-            W.guardQuit dlg (Quantity 0)
+            W.guardQuit dlg (Coin 0)
                 `shouldBe` Left (W.ErrNotDelegatingOrAboutTo)
         it "Cannot quit when active: A, next = [not_delegating]" $ do
             let next1 = next (EpochNo 1) NotDelegating
             let dlg = WalletDelegation
                     {active = Delegating pidA, next = [next1]}
-            W.guardQuit dlg (Quantity 0)
+            W.guardQuit dlg (Coin 0)
                 `shouldBe` Left (W.ErrNotDelegatingOrAboutTo)
         it "Cannot quit when active: A, next = [B, not_delegating]" $ do
             let next1 = next (EpochNo 1) (Delegating pidB)
             let next2 = next (EpochNo 2) NotDelegating
             let dlg = WalletDelegation
                     {active = Delegating pidA, next = [next1, next2]}
-            W.guardQuit dlg (Quantity 0)
+            W.guardQuit dlg (Coin 0)
                 `shouldBe` Left (W.ErrNotDelegatingOrAboutTo)
         it "Can quit when active: not_delegating, next = [A]" $ do
             let next1 = next (EpochNo 1) (Delegating pidA)
             let dlg = WalletDelegation
                     {active = NotDelegating, next = [next1]}
-            W.guardQuit dlg (Quantity 0) `shouldBe` Right ()
+            W.guardQuit dlg (Coin 0) `shouldBe` Right ()
      where
          pidA = PoolId "A"
          pidB = PoolId "B"
@@ -339,7 +339,7 @@ prop_guardJoinQuit knownPoolsList dlg pid mRetirementInfo = checkCoverage
             label "ErrNoSuchPool" $ property True
         Left W.ErrAlreadyDelegating{} ->
             label "ErrAlreadyDelegating"
-                (W.guardQuit dlg (Quantity 0) === Right ())
+                (W.guardQuit dlg (Coin 0) === Right ())
   where
     knownPools = Set.fromList knownPoolsList
     retirementNotPlanned =
@@ -361,7 +361,7 @@ prop_guardQuitJoin
 prop_guardQuitJoin (NonEmpty knownPoolsList) dlg rewards =
     let knownPools = Set.fromList knownPoolsList in
     let noRetirementPlanned = Nothing in
-    case W.guardQuit dlg (Quantity rewards) of
+    case W.guardQuit dlg (Coin rewards) of
         Right () ->
             label "I can quit" $ property True
         Left W.ErrNotDelegatingOrAboutTo ->
@@ -924,7 +924,7 @@ instance Arbitrary TxMeta where
         <*> elements [Incoming, Outgoing]
         <*> genSlotNo
         <*> fmap Quantity arbitrary
-        <*> fmap (Quantity . fromIntegral . unCoin) arbitrary
+        <*> arbitrary
         <*> liftArbitrary genSlotNo
 
 instance Arbitrary TxMetadata where