Exercise partial amounts in TxTraceSpec

Signed-off-by: Sasha Bogicevic <[email protected]>

Author: v0d1ch

hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs

@@ -21,12 +21,13 @@ module Hydra.Chain.Direct.TxTraceSpec where
 import Hydra.Prelude hiding (Any, State, label, show)
 import Test.Hydra.Prelude
 
-import Cardano.Api.UTxO (UTxO)
+import Cardano.Api.UTxO (UTxO, totalLovelace)
 import Cardano.Api.UTxO qualified as UTxO
 import Data.List (nub, (\\))
 import Data.Map.Strict qualified as Map
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Hydra.Cardano.Api (
+  Coin (..),
   CtxUTxO,
   PaymentKey,
   SlotNo (..),
@@ -72,7 +73,7 @@ import Test.Hydra.Tx.Gen (
   genUTxO1,
   genVerificationKey,
  )
-import Test.Hydra.Tx.Mutation (addParticipationTokens)
+import Test.Hydra.Tx.Mutation (addParticipationTokens, randomBetween)
 import Test.QuickCheck (Confidence (..), Property, Smart (..), Testable, checkCoverage, checkCoverageWith, cover, elements, frequency, ioProperty)
 import Test.QuickCheck.Monadic (monadic)
 import Test.QuickCheck.StateModel (
@@ -817,6 +818,7 @@ newDepositTx _ utxoToDeposit = do
   let validBefore = SlotNo 0
   deadline <- liftIO getCurrentTime
   let depositUTxO = realWorldModelUTxO utxoToDeposit
+  amount <- liftIO $ randomBetween 1_000_000 (unCoin $ totalLovelace depositUTxO)
   let blueprint = CommitBlueprintTx{blueprintTx = txSpendingUTxO depositUTxO, lookupUTxO = depositUTxO}
   pure $
     Right $
@@ -826,7 +828,7 @@ newDepositTx _ utxoToDeposit = do
         blueprint
         validBefore
         deadline
-        Nothing
+        (Just $ Coin amount)
 
 -- | Creates a increment transaction using given utxo and given snapshot.
 newIncrementTx :: Actor -> ConfirmedSnapshot Tx -> AppM (Either IncrementTxError Tx)

hydra-tx/hydra-tx.cabal

@@ -144,6 +144,7 @@ library testlib
     , QuickCheck
     , quickcheck-arbitrary-adt
     , quickcheck-instances
+    , random
 
   ghc-options:     -haddock
 

hydra-tx/testlib/Test/Hydra/Tx/Mutation.hs

@@ -157,6 +157,7 @@ import Hydra.Tx.Utils (findFirst, onChainIdToAssetName, verificationKeyToOnChain
 import PlutusLedgerApi.V3 (CurrencySymbol, POSIXTime, toData)
 import PlutusLedgerApi.V3 qualified as Plutus
 import System.Directory.Internal.Prelude qualified as Prelude
+import System.Random (newStdGen, randomR)
 import Test.Hydra.Prelude
 import Test.Hydra.Tx.Fixture (testPolicyId)
 import Test.Hydra.Tx.Fixture qualified as Fixture
@@ -945,3 +946,7 @@ removePTFromMintedValue output tx =
     (AssetId pid asset, _) ->
       pid == headId && asset == assetName
     _ -> False
+
+randomBetween :: Integer -> Integer -> IO Integer
+randomBetween min' max' =
+  fst . randomR (min', max') <$> newStdGen