module Hydra.Model.MockChainSpec where import Cardano.Api.UTxO (pairs) import Data.Text (unpack) import Hydra.Cardano.Api (Tx, TxIn (TxIn), UTxO, prettyPrintJSON, renderUTxO) import Hydra.Cardano.Api.Pretty (renderTx) import Hydra.Chain.ChainState (ChainSlot (ChainSlot)) import Hydra.Ledger (Ledger (applyTransactions)) import Hydra.Ledger.Cardano (genSequenceOfSimplePaymentTransactions) import Hydra.Model.MockChain (scriptLedger) import Hydra.Prelude import Hydra.Tx.IsTx (IsTx (txId)) import Test.Hydra.Prelude import Test.QuickCheck (Property, Testable (property), counterexample, forAllBlind, (===)) spec :: Spec spec :: Spec spec = String -> Property -> Spec forall prop. (HasCallStack, Testable prop) => String -> prop -> Spec prop String "works with valid transaction" Property appliesValidTransaction appliesValidTransaction :: Property appliesValidTransaction :: Property appliesValidTransaction = Gen (UTxO, [Tx]) -> ((UTxO, [Tx]) -> Property) -> Property forall prop a. Testable prop => Gen a -> (a -> prop) -> Property forAllBlind Gen (UTxO, [Tx]) genSequenceOfSimplePaymentTransactions (((UTxO, [Tx]) -> Property) -> Property) -> ((UTxO, [Tx]) -> Property) -> Property forall a b. (a -> b) -> a -> b $ \(UTxO utxo, [Tx] txs) -> let result :: Either (Tx, ValidationError) (UTxOType Tx) result = Ledger Tx -> ChainSlot -> UTxOType Tx -> [Tx] -> Either (Tx, ValidationError) (UTxOType Tx) forall tx. Ledger tx -> ChainSlot -> UTxOType tx -> [tx] -> Either (tx, ValidationError) (UTxOType tx) applyTransactions Ledger Tx scriptLedger (Natural -> ChainSlot ChainSlot Natural 0) UTxO UTxOType Tx utxo [Tx] txs in case Either (Tx, ValidationError) (UTxOType Tx) result of Right UTxOType Tx u -> [Tx] -> UTxO -> Property isOutputOfLastTransaction [Tx] txs UTxO UTxOType Tx u Left (Tx tx, ValidationError err) -> Bool -> Property forall prop. Testable prop => prop -> Property property Bool False Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "Error: " String -> String -> String forall a. Semigroup a => a -> a -> a <> ValidationError -> String forall b a. (Show a, IsString b) => a -> b show ValidationError err) Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "Failing tx: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Tx -> String renderTx Tx tx) Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "All txs: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Text -> String unpack (OnDecodeError -> ByteString -> Text decodeUtf8With OnDecodeError lenientDecode (ByteString -> Text) -> ByteString -> Text forall a b. (a -> b) -> a -> b $ [Tx] -> ByteString forall a. ToJSON a => a -> ByteString prettyPrintJSON [Tx] txs)) Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "Initial UTxO: " String -> String -> String forall a. Semigroup a => a -> a -> a <> Text -> String unpack (OnDecodeError -> ByteString -> Text decodeUtf8With OnDecodeError lenientDecode (ByteString -> Text) -> ByteString -> Text forall a b. (a -> b) -> a -> b $ UTxO -> ByteString forall a. ToJSON a => a -> ByteString prettyPrintJSON UTxO utxo)) isOutputOfLastTransaction :: [Tx] -> UTxO -> Property isOutputOfLastTransaction :: [Tx] -> UTxO -> Property isOutputOfLastTransaction [Tx] txs UTxO utxo = case ([Tx] -> Maybe Tx forall a. [a] -> Maybe a listToMaybe ([Tx] -> Maybe Tx) -> [Tx] -> Maybe Tx forall a b. (a -> b) -> a -> b $ [Tx] -> [Tx] forall a. [a] -> [a] reverse [Tx] txs, UTxO -> [(TxIn, TxOut CtxUTxO ConwayEra)] forall out. UTxO' out -> [(TxIn, out)] pairs UTxO utxo) of (Just Tx tx, [(TxIn TxId txid TxIx _, TxOut CtxUTxO ConwayEra _)]) -> Tx -> TxIdType Tx forall tx. IsTx tx => tx -> TxIdType tx txId Tx tx TxId -> TxId -> Property forall a. (Eq a, Show a) => a -> a -> Property === TxId txid (Just Tx _, [(TxIn, TxOut CtxUTxO ConwayEra)] _) -> Bool -> Property forall prop. Testable prop => prop -> Property property Bool False Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "Resulting Utxo: " String -> String -> String forall a. Semigroup a => a -> a -> a <> UTxO -> String forall str. IsString str => UTxO -> str renderUTxO UTxO utxo) Property -> (Property -> Property) -> Property forall a b. a -> (a -> b) -> b & String -> Property -> Property forall prop. Testable prop => String -> prop -> Property counterexample (String "Txs: " String -> String -> String forall a. Semigroup a => a -> a -> a <> [TxId] -> String forall b a. (Show a, IsString b) => a -> b show (Tx -> TxId Tx -> TxIdType Tx forall tx. IsTx tx => tx -> TxIdType tx txId (Tx -> TxId) -> [Tx] -> [TxId] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> [Tx] txs)) (Maybe Tx Nothing, [(TxIn, TxOut CtxUTxO ConwayEra)] _) -> Bool -> Property forall prop. Testable prop => prop -> Property property Bool True