diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index f1185718f1e..5c39e7fa433 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MigrationSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MigrationSpec.hs index 2898bd8bf3a..b6d64c9ba5c 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/CoinSelection/MigrationSpec.hs +++ b/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) diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs index abd69b06dc2..6ac5ed08108 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs index f0edd2f475e..fc8f047f5a2 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/TypesSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/WalletSpec.hs b/lib/core/test/unit/Cardano/WalletSpec.hs index 5c7daac968a..bb4e3bbb13f 100644 --- a/lib/core/test/unit/Cardano/WalletSpec.hs +++ b/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