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 -> TxIdType Tx
Tx -> TxId
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