-- | Unit tests for our "hand-rolled" transactions as they are used in the
-- "direct" chain component.
module Hydra.Chain.Direct.TxSpec where

import Hydra.Cardano.Api
import Hydra.Prelude hiding (label)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Alonzo.Core (EraTxAuxData (hashTxAuxData))
import Cardano.Ledger.Alonzo.TxAuxData (AlonzoTxAuxData (..))
import Cardano.Ledger.Api (
  ConwayPlutusPurpose (ConwayRewarding, ConwaySpending),
  Metadatum,
  auxDataHashTxBodyL,
  auxDataTxL,
  bodyTxL,
  inputsTxBodyL,
  outputsTxBodyL,
  ppProtocolVersionL,
  rdmrsTxWitsL,
  referenceInputsTxBodyL,
  reqSignerHashesTxBodyL,
  unRedeemers,
  validateTxAuxData,
  vldtTxBodyL,
  witsTxL,
  pattern ShelleyTxAuxData,
 )
import Cardano.Ledger.Credential (Credential (..))
import Control.Lens ((^.))
import Data.Map qualified as Map
import Data.Maybe.Strict (StrictMaybe (..))
import Data.Set qualified as Set
import Hydra.Cardano.Api.Pretty (renderTxWithUTxO)
import Hydra.Chain.Direct.State (ChainContext (..), HasKnownUTxO (getKnownUTxO), genChainStateWithTx)
import Hydra.Chain.Direct.State qualified as Transition
import Hydra.Chain.Direct.Tx (
  HeadObservation (..),
  currencySymbolToHeadId,
  headIdToPolicyId,
  headSeedToTxIn,
  observeHeadTx,
  txInToHeadSeed,
 )
import Hydra.Contract.Dummy (dummyValidatorScript)
import Hydra.Contract.HeadTokens (headPolicyId)
import Hydra.Ledger.Cardano.Builder (addInputs, addReferenceInputs, addVkInputs, emptyTxBody, unsafeBuildTransaction)
import Hydra.Ledger.Cardano.Evaluate (propTransactionEvaluates)
import Hydra.Tx.BlueprintTx (CommitBlueprintTx (..))
import Hydra.Tx.Commit (commitTx)
import Hydra.Tx.HeadId (headIdToCurrencySymbol, mkHeadId)
import Hydra.Tx.Init (mkInitialOutput)
import Hydra.Tx.ScriptRegistry (registryUTxO)
import Hydra.Tx.Utils (verificationKeyToOnChainId)
import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata')
import Test.Hydra.Prelude
import Test.Hydra.Tx.Fixture (
  pparams,
  testNetworkId,
 )
import Test.Hydra.Tx.Fixture qualified as Fixture
import Test.Hydra.Tx.Gen (
  genSigningKey,
  genTxOutWithReferenceScript,
  genUTxO1,
  genUTxOAdaOnlyOfSize,
  genValue,
 )
import Test.QuickCheck (
  Property,
  checkCoverage,
  choose,
  conjoin,
  counterexample,
  cover,
  forAll,
  forAllBlind,
  oneof,
  property,
  (.&&.),
  (===),
 )
import Test.QuickCheck.Instances.Semigroup ()
import Test.QuickCheck.Monadic (monadicIO)

spec :: Spec
spec :: Spec
spec =
  Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"HeadSeed (cardano)" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
      String -> (TxIn -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"headSeedToTxIn . txInToHeadSeed === id" ((TxIn -> Property) -> Spec) -> (TxIn -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \TxIn
txIn -> do
        let headSeed :: HeadSeed
headSeed = TxIn -> HeadSeed
txInToHeadSeed TxIn
txIn
        HeadSeed -> Maybe TxIn
forall (m :: * -> *). MonadFail m => HeadSeed -> m TxIn
headSeedToTxIn HeadSeed
headSeed Maybe TxIn -> Maybe TxIn -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxIn -> Maybe TxIn
forall a. a -> Maybe a
Just TxIn
txIn
          Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (HeadSeed -> String
forall b a. (Show a, IsString b) => a -> b
show HeadSeed
headSeed)

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"HeadId (cardano)" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> (PolicyId -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"headIdToPolicyId . mkHeadId === id" ((PolicyId -> Property) -> Spec) -> (PolicyId -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \PolicyId
pid -> do
        let headId :: HeadId
headId = PolicyId -> HeadId
mkHeadId PolicyId
pid
        HeadId -> Maybe PolicyId
forall (m :: * -> *). MonadFail m => HeadId -> m PolicyId
headIdToPolicyId HeadId
headId Maybe PolicyId -> Maybe PolicyId -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== PolicyId -> Maybe PolicyId
forall a. a -> Maybe a
Just PolicyId
pid
          Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (HeadId -> String
forall b a. (Show a, IsString b) => a -> b
show HeadId
headId)

      String -> (TxIn -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"curencySymbolToHeadId . headIdToCurrencySymbol === id" ((TxIn -> Property) -> Spec) -> (TxIn -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$ \TxIn
txIn -> PropertyM IO Property -> Property
forall a. Testable a => PropertyM IO a -> Property
monadicIO (PropertyM IO Property -> Property)
-> PropertyM IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
        let headId :: HeadId
headId = PolicyId -> HeadId
mkHeadId (PolicyId -> HeadId) -> PolicyId -> HeadId
forall a b. (a -> b) -> a -> b
$ TxIn -> PolicyId
headPolicyId TxIn
txIn
        let cs :: CurrencySymbol
cs = HeadId -> CurrencySymbol
headIdToCurrencySymbol HeadId
headId
        HeadId
headId' <- CurrencySymbol -> PropertyM IO HeadId
forall (m :: * -> *). MonadFail m => CurrencySymbol -> m HeadId
currencySymbolToHeadId CurrencySymbol
cs
        Property -> PropertyM IO Property
forall a. a -> PropertyM IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> PropertyM IO Property)
-> Property -> PropertyM IO Property
forall a b. (a -> b) -> a -> b
$ HeadId
headId' HeadId -> HeadId -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== HeadId
headId

    -- TODO: DRY with prop_observeAnyTx
    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"observeHeadTx" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"All valid transitions for all possible states can be observed." (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
        Property -> Property
forall prop. Testable prop => prop -> Property
checkCoverage (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          Gen (ChainContext, ChainState, UTxO, Tx, ChainTransition)
-> ((ChainContext, ChainState, UTxO, Tx, ChainTransition)
    -> Property)
-> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (ChainContext, ChainState, UTxO, Tx, ChainTransition)
genChainStateWithTx (((ChainContext, ChainState, UTxO, Tx, ChainTransition)
  -> Property)
 -> Property)
-> ((ChainContext, ChainState, UTxO, Tx, ChainTransition)
    -> Property)
-> Property
forall a b. (a -> b) -> a -> b
$ \(ChainContext
_ctx, ChainState
st, UTxO
additionalUTxO, Tx
tx, ChainTransition
transition) ->
            [ChainTransition] -> Property -> Property
forall a prop.
(Show a, Enum a, Bounded a, Typeable a, Testable prop) =>
[a] -> prop -> Property
genericCoverTable [ChainTransition
transition] (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (ChainTransition -> String
forall b a. (Show a, IsString b) => a -> b
show ChainTransition
transition) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                let utxo :: UTxO
utxo = ChainState -> UTxO
forall a. HasKnownUTxO a => a -> UTxO
getKnownUTxO ChainState
st UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
additionalUTxO
                 in case NetworkId -> UTxO -> Tx -> HeadObservation
observeHeadTx NetworkId
testNetworkId UTxO
utxo Tx
tx of
                      HeadObservation
NoHeadTx -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
                      Init{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Init
                      Abort{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Abort
                      Commit{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Commit
                      CollectCom{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Collect
                      Increment{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Increment
                      Decrement{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Decrement
                      Close{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Close
                      Contest{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Contest
                      Fanout{} -> ChainTransition
transition ChainTransition -> ChainTransition -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ChainTransition
Transition.Fanout
                      -- NOTE: deposit and recover are not Head transactions as
                      -- they are not operating on Hydra state machine. We don't generate them
                      -- in these tests so we don't need to check them.
                      Deposit{} -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
                      Recover{} -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"commitTx" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"genBlueprintTx generates interesting txs" Property
prop_interestingBlueprintTx

      String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"Validate blueprint and commit transactions" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$ do
        Gen ChainContext -> (ChainContext -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen ChainContext
forall a. Arbitrary a => Gen a
arbitrary ((ChainContext -> Property) -> Property)
-> (ChainContext -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ChainContext
chainContext -> do
          let commitSigningKey :: SigningKey PaymentKey
commitSigningKey = Gen (SigningKey PaymentKey)
genSigningKey Gen (SigningKey PaymentKey) -> Int -> SigningKey PaymentKey
forall a. Gen a -> Int -> a
`generateWith` Int
42
          let commitVerificationKey :: VerificationKey PaymentKey
commitVerificationKey = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
commitSigningKey
          let healthyInitialTxOut :: TxOut ctx Era
healthyInitialTxOut =
                PParams LedgerEra -> TxOut CtxUTxO Era -> TxOut ctx Era
forall ctx. PParams LedgerEra -> TxOut CtxUTxO Era -> TxOut ctx Era
setMinUTxOValue PParams LedgerEra
Fixture.pparams (TxOut CtxUTxO Era -> TxOut ctx Era)
-> (TxOut CtxTx Era -> TxOut CtxUTxO Era)
-> TxOut CtxTx Era
-> TxOut ctx Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext (TxOut CtxTx Era -> TxOut ctx Era)
-> TxOut CtxTx Era -> TxOut ctx Era
forall a b. (a -> b) -> a -> b
$
                  NetworkId -> TxIn -> OnChainId -> TxOut CtxTx Era
mkInitialOutput NetworkId
Fixture.testNetworkId TxIn
Fixture.testSeedInput (OnChainId -> TxOut CtxTx Era) -> OnChainId -> TxOut CtxTx Era
forall a b. (a -> b) -> a -> b
$
                    VerificationKey PaymentKey -> OnChainId
verificationKeyToOnChainId VerificationKey PaymentKey
commitVerificationKey
          let healthyInitialTxIn :: TxIn
healthyInitialTxIn = Gen TxIn -> Int -> TxIn
forall a. Gen a -> Int -> a
generateWith Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary Int
42
          let ChainContext{NetworkId
networkId :: NetworkId
$sel:networkId:ChainContext :: ChainContext -> NetworkId
networkId, VerificationKey PaymentKey
ownVerificationKey :: VerificationKey PaymentKey
$sel:ownVerificationKey:ChainContext :: ChainContext -> VerificationKey PaymentKey
ownVerificationKey, Party
ownParty :: Party
$sel:ownParty:ChainContext :: ChainContext -> Party
ownParty, ScriptRegistry
scriptRegistry :: ScriptRegistry
$sel:scriptRegistry:ChainContext :: ChainContext -> ScriptRegistry
scriptRegistry} =
                ChainContext
chainContext{ownVerificationKey = getVerificationKey commitSigningKey, networkId = testNetworkId}
          Gen (UTxO, Tx) -> ((UTxO, Tx) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen (UTxO, Tx)
genBlueprintTxWithUTxO (((UTxO, Tx) -> Property) -> Property)
-> ((UTxO, Tx) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(UTxO
lookupUTxO, Tx
blueprintTx) ->
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Blueprint tx: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UTxO -> Tx -> String
renderTxWithUTxO UTxO
lookupUTxO Tx
blueprintTx) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ do
              let createdTx :: Tx
createdTx =
                    NetworkId
-> ScriptRegistry
-> HeadId
-> Party
-> CommitBlueprintTx Tx
-> (TxIn, TxOut CtxUTxO Era, Hash PaymentKey)
-> Tx
commitTx
                      NetworkId
networkId
                      ScriptRegistry
scriptRegistry
                      (PolicyId -> HeadId
mkHeadId PolicyId
Fixture.testPolicyId)
                      Party
ownParty
                      CommitBlueprintTx{UTxO
UTxOType Tx
lookupUTxO :: UTxO
$sel:lookupUTxO:CommitBlueprintTx :: UTxOType Tx
lookupUTxO, Tx
blueprintTx :: Tx
$sel:blueprintTx:CommitBlueprintTx :: Tx
blueprintTx}
                      (TxIn
healthyInitialTxIn, TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext TxOut CtxTx Era
forall {ctx}. TxOut ctx Era
healthyInitialTxOut, VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
ownVerificationKey)
              String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"\n\n\nCommit tx: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> UTxO -> Tx -> String
renderTxWithUTxO UTxO
lookupUTxO Tx
createdTx) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ do
                let blueprintBody :: TxBody (ConwayEra StandardCrypto)
blueprintBody = Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
blueprintTx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (TxBody (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (TxBody (ConwayEra StandardCrypto))
-> TxBody (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (TxBody (ConwayEra StandardCrypto))
      (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (TxBody (ConwayEra StandardCrypto)) (Tx (ConwayEra StandardCrypto))
Getting
  (TxBody (ConwayEra StandardCrypto))
  (AlonzoTx (ConwayEra StandardCrypto))
  (TxBody (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL
                let commitTxBody :: TxBody (ConwayEra StandardCrypto)
commitTxBody = Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
createdTx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (TxBody (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (TxBody (ConwayEra StandardCrypto))
-> TxBody (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (TxBody (ConwayEra StandardCrypto))
      (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (TxBody (ConwayEra StandardCrypto)) (Tx (ConwayEra StandardCrypto))
Getting
  (TxBody (ConwayEra StandardCrypto))
  (AlonzoTx (ConwayEra StandardCrypto))
  (TxBody (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL
                let spendableUTxO :: UTxO
spendableUTxO =
                      (TxIn, TxOut CtxUTxO Era) -> UTxO
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
healthyInitialTxIn, TxOut CtxTx Era -> TxOut CtxUTxO Era
forall era. TxOut CtxTx era -> TxOut CtxUTxO era
forall {k} (f :: * -> k -> *) (era :: k).
ToUTxOContext f =>
f CtxTx era -> f CtxUTxO era
toUTxOContext TxOut CtxTx Era
forall {ctx}. TxOut ctx Era
healthyInitialTxOut)
                        UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
lookupUTxO
                        UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> ScriptRegistry -> UTxO
registryUTxO ScriptRegistry
scriptRegistry

                [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
                  [ (Tx, UTxO) -> Property
propTransactionEvaluates (Tx
blueprintTx, UTxO
lookupUTxO)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint transaction failed to evaluate"
                  , (Tx, UTxO) -> Property
propTransactionEvaluates (Tx
createdTx, UTxO
spendableUTxO)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Commit transaction failed to evaluate"
                  , [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
                      [ Tx -> Map Word64 Metadatum
getAuxMetadata Tx
blueprintTx Map Word64 Metadatum -> Map Word64 Metadatum -> Property
forall k v.
(Show k, Show v, Ord k, Eq v) =>
Map k v -> Map k v -> Property
`propIsSubmapOf` Tx -> Map Word64 Metadatum
getAuxMetadata Tx
createdTx
                          Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint metadata incomplete"
                      , Tx -> Property
propHasValidAuxData Tx
blueprintTx
                          Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint tx has invalid aux data"
                      , Tx -> Property
propHasValidAuxData Tx
createdTx
                          Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Commit tx has invalid aux data"
                      ]
                  , TxBody (ConwayEra StandardCrypto)
blueprintBody TxBody (ConwayEra StandardCrypto)
-> Getting
     ValidityInterval
     (TxBody (ConwayEra StandardCrypto))
     ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
  ValidityInterval
  (TxBody (ConwayEra StandardCrypto))
  ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody (ConwayEra StandardCrypto)) ValidityInterval
vldtTxBodyL ValidityInterval -> ValidityInterval -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== TxBody (ConwayEra StandardCrypto)
commitTxBody TxBody (ConwayEra StandardCrypto)
-> Getting
     ValidityInterval
     (TxBody (ConwayEra StandardCrypto))
     ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
  ValidityInterval
  (TxBody (ConwayEra StandardCrypto))
  ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody (ConwayEra StandardCrypto)) ValidityInterval
vldtTxBodyL
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Validity range mismatch"
                  , (TxBody (ConwayEra StandardCrypto)
blueprintBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL) Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto))) -> Property
forall a. (Show a, Ord a) => Set a -> Set a -> Property
`propIsSubsetOf` (TxBody (ConwayEra StandardCrypto)
commitTxBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint inputs missing"
                  , Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
-> Int
forall a.
Map (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
blueprintTx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
-> Redeemers (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
(TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxWits (ConwayEra StandardCrypto))
witsTxL ((TxWits (ConwayEra StandardCrypto)
  -> Const
       (Redeemers (ConwayEra StandardCrypto))
       (TxWits (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Redeemers (ConwayEra StandardCrypto)
     -> Const
          (Redeemers (ConwayEra StandardCrypto))
          (Redeemers (ConwayEra StandardCrypto)))
    -> TxWits (ConwayEra StandardCrypto)
    -> Const
         (Redeemers (ConwayEra StandardCrypto))
         (TxWits (ConwayEra StandardCrypto)))
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (Redeemers (ConwayEra StandardCrypto)))
-> TxWits (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (TxWits (ConwayEra StandardCrypto))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ConwayEra StandardCrypto))
  (Redeemers (ConwayEra StandardCrypto))
rdmrsTxWitsL Redeemers (ConwayEra StandardCrypto)
-> (Redeemers (ConwayEra StandardCrypto)
    -> Map
         (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
         (Data (ConwayEra StandardCrypto), ExUnits))
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall a b. a -> (a -> b) -> b
& Redeemers (ConwayEra StandardCrypto)
-> Map
     (PlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
Redeemers (ConwayEra StandardCrypto)
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
-> Int
forall a.
Map (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
createdTx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
-> Redeemers (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
(TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxWits (ConwayEra StandardCrypto))
witsTxL ((TxWits (ConwayEra StandardCrypto)
  -> Const
       (Redeemers (ConwayEra StandardCrypto))
       (TxWits (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Redeemers (ConwayEra StandardCrypto)
     -> Const
          (Redeemers (ConwayEra StandardCrypto))
          (Redeemers (ConwayEra StandardCrypto)))
    -> TxWits (ConwayEra StandardCrypto)
    -> Const
         (Redeemers (ConwayEra StandardCrypto))
         (TxWits (ConwayEra StandardCrypto)))
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (Redeemers (ConwayEra StandardCrypto)))
-> TxWits (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (TxWits (ConwayEra StandardCrypto))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ConwayEra StandardCrypto))
  (Redeemers (ConwayEra StandardCrypto))
rdmrsTxWitsL Redeemers (ConwayEra StandardCrypto)
-> (Redeemers (ConwayEra StandardCrypto)
    -> Map
         (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
         (Data (ConwayEra StandardCrypto), ExUnits))
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall a b. a -> (a -> b) -> b
& Redeemers (ConwayEra StandardCrypto)
-> Map
     (PlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
Redeemers (ConwayEra StandardCrypto)
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint witnesses missing"
                  , Bool -> Property
forall prop. Testable prop => prop -> Property
property
                      (((TxOut (ConwayEra StandardCrypto) -> Bool)
-> StrictSeq (TxOut (ConwayEra StandardCrypto)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` (TxBody (ConwayEra StandardCrypto)
blueprintBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL)) (TxOut (ConwayEra StandardCrypto)
-> StrictSeq (TxOut (ConwayEra StandardCrypto)) -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` (TxBody (ConwayEra StandardCrypto)
commitTxBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
     (TxBody (ConwayEra StandardCrypto))
     (StrictSeq (TxOut (ConwayEra StandardCrypto)))
-> StrictSeq (TxOut (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictSeq (TxOut (ConwayEra StandardCrypto)))
outputsTxBodyL)))
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint outputs not discarded"
                  , (TxBody (ConwayEra StandardCrypto)
blueprintBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
-> Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
reqSignerHashesTxBodyL) Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto)))
-> Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto)))
-> Property
forall a. (Show a, Ord a) => Set a -> Set a -> Property
`propIsSubsetOf` (TxBody (ConwayEra StandardCrypto)
commitTxBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
-> Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
forall era.
AlonzoEraTxBody era =>
Lens' (TxBody era) (Set (KeyHash 'Witness (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (KeyHash 'Witness (EraCrypto (ConwayEra StandardCrypto))))
reqSignerHashesTxBodyL)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint required signatures missing"
                  , (TxBody (ConwayEra StandardCrypto)
blueprintBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
referenceInputsTxBodyL) Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto))) -> Property
forall a. (Show a, Ord a) => Set a -> Set a -> Property
`propIsSubsetOf` (TxBody (ConwayEra StandardCrypto)
commitTxBody TxBody (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
     (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
-> Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. Getting
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
referenceInputsTxBodyL)
                      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Blueprint reference inputs missing"
                  ]

-- | Check auxiliary data of a transaction against 'pparams' and whether the aux
-- data hash is consistent.
propHasValidAuxData :: Tx -> Property
propHasValidAuxData :: Tx -> Property
propHasValidAuxData Tx
tx =
  case Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
-> StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. (StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
 -> Const
      (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
      (StrictMaybe (TxAuxData (ConwayEra StandardCrypto))))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
     (Tx (ConwayEra StandardCrypto))
Getting
  (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
  (AlonzoTx (ConwayEra StandardCrypto))
  (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
Lens'
  (Tx (ConwayEra StandardCrypto))
  (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
auxDataTxL of
    StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
SNothing -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
    SJust TxAuxData (ConwayEra StandardCrypto)
auxData ->
      TxAuxData (ConwayEra StandardCrypto) -> Property
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 0 (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 EraTxAuxData era) =>
TxAuxData era -> Property
isValid TxAuxData (ConwayEra StandardCrypto)
auxData Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. TxAuxData (ConwayEra StandardCrypto) -> Property
hashConsistent TxAuxData (ConwayEra StandardCrypto)
auxData
 where
  isValid :: TxAuxData era -> Property
isValid TxAuxData era
auxData =
    ProtVer -> TxAuxData era -> Bool
forall era. EraTxAuxData era => ProtVer -> TxAuxData era -> Bool
validateTxAuxData (PParams LedgerEra
PParams (ConwayEra StandardCrypto)
pparams PParams (ConwayEra StandardCrypto)
-> Getting ProtVer (PParams (ConwayEra StandardCrypto)) ProtVer
-> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams (ConwayEra StandardCrypto)) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams (ConwayEra StandardCrypto)) ProtVer
ppProtocolVersionL) TxAuxData era
auxData
      Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Auxiliary data validation failed"

  hashConsistent :: TxAuxData (ConwayEra StandardCrypto) -> Property
hashConsistent TxAuxData (ConwayEra StandardCrypto)
auxData =
    Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
-> StrictMaybe
     (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (StrictMaybe
         (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
      (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
     (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Const
      (StrictMaybe
         (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
      (TxBody (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Const
       (StrictMaybe
          (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
       (TxBody (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (StrictMaybe
         (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((StrictMaybe
       (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
     -> Const
          (StrictMaybe
             (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
          (StrictMaybe
             (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))))
    -> TxBody (ConwayEra StandardCrypto)
    -> Const
         (StrictMaybe
            (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
         (TxBody (ConwayEra StandardCrypto)))
-> Getting
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe
   (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (StrictMaybe
         (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
      (StrictMaybe
         (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (StrictMaybe
        (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
     (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (AuxiliaryDataHash (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (StrictMaybe
     (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))))
auxDataHashTxBodyL StrictMaybe
  (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
-> StrictMaybe
     (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))
-> StrictMaybe
     (AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto)))
forall a. a -> StrictMaybe a
SJust (TxAuxData (ConwayEra StandardCrypto)
-> AuxiliaryDataHash (EraCrypto (ConwayEra StandardCrypto))
forall era.
EraTxAuxData era =>
TxAuxData era -> AuxiliaryDataHash (EraCrypto era)
hashTxAuxData TxAuxData (ConwayEra StandardCrypto)
auxData)
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample String
"Auxiliary data hash inconsistent"

-- | Check whether one set 'isSubsetOf' of another with nice counter examples.
propIsSubsetOf :: (Show a, Ord a) => Set a -> Set a -> Property
propIsSubsetOf :: forall a. (Show a, Ord a) => Set a -> Set a -> Property
propIsSubsetOf Set a
as Set a
bs =
  Set a
as Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set a
bs
    Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Set a -> String
forall b a. (Show a, IsString b) => a -> b
show Set a
as String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n  is not a subset of\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Set a -> String
forall b a. (Show a, IsString b) => a -> b
show Set a
bs)

-- | Check whether one map 'isSubmapOf' of another with nice counter examples.
propIsSubmapOf :: (Show k, Show v, Ord k, Eq v) => Map k v -> Map k v -> Property
propIsSubmapOf :: forall k v.
(Show k, Show v, Ord k, Eq v) =>
Map k v -> Map k v -> Property
propIsSubmapOf Map k v
as Map k v
bs =
  Map k v
as Map k v -> Map k v -> Bool
forall k a. (Ord k, Eq a) => Map k a -> Map k a -> Bool
`Map.isSubmapOf` Map k v
bs
    Bool -> (Bool -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (Map k v -> String
forall b a. (Show a, IsString b) => a -> b
show Map k v
as String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n  is not a submap of\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Map k v -> String
forall b a. (Show a, IsString b) => a -> b
show Map k v
bs)

genBlueprintTxWithUTxO :: Gen (UTxO, Tx)
genBlueprintTxWithUTxO :: Gen (UTxO, Tx)
genBlueprintTxWithUTxO =
  ((UTxO, TxBodyContent BuildTx) -> (UTxO, Tx))
-> Gen (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, Tx)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((TxBodyContent BuildTx -> Tx)
-> (UTxO, TxBodyContent BuildTx) -> (UTxO, Tx)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second HasCallStack => TxBodyContent BuildTx -> Tx
TxBodyContent BuildTx -> Tx
unsafeBuildTransaction) (Gen (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, Tx))
-> Gen (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, Tx)
forall a b. (a -> b) -> a -> b
$
    (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
spendingPubKeyOutput (UTxO
forall a. Monoid a => a
mempty, TxBodyContent BuildTx
emptyTxBody)
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
spendSomeScriptInputs
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall {ctx}.
(UTxO' (TxOut ctx), TxBodyContent BuildTx)
-> Gen (UTxO' (TxOut ctx), TxBodyContent BuildTx)
addSomeReferenceInputs
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall {a} {buidl}.
(a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
addValidityRange
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall {a} {buidl}.
(a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
addRandomMetadata
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall {buidl}.
(UTxO, TxBodyContent buidl) -> Gen (UTxO, TxBodyContent buidl)
addCollateralInput
      Gen (UTxO, TxBodyContent BuildTx)
-> ((UTxO, TxBodyContent BuildTx)
    -> Gen (UTxO, TxBodyContent BuildTx))
-> Gen (UTxO, TxBodyContent BuildTx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall {a}.
(a, TxBodyContent BuildTx) -> Gen (a, TxBodyContent BuildTx)
sometimesAddRewardRedeemer
 where
  spendingPubKeyOutput :: (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
spendingPubKeyOutput (UTxO
utxo, TxBodyContent BuildTx
txbody) = do
    UTxO
utxoToSpend <- Int -> Gen UTxO
genUTxOAdaOnlyOfSize (Int -> Gen UTxO) -> Gen Int -> Gen UTxO
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
3)
    (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
utxoToSpend
      , TxBodyContent BuildTx
txbody TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addVkInputs (Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set TxIn -> [TxIn]) -> Set TxIn -> [TxIn]
forall a b. (a -> b) -> a -> b
$ UTxO -> Set TxIn
forall out. UTxO' out -> Set TxIn
UTxO.inputSet UTxO
utxoToSpend)
      )

  spendSomeScriptInputs :: (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
spendSomeScriptInputs (UTxO
utxo, TxBodyContent BuildTx
txbody) = do
    let alwaysSucceedingScript :: PlutusScript
alwaysSucceedingScript = ShortByteString -> PlutusScript
PlutusScriptSerialised ShortByteString
dummyValidatorScript
    HashableScriptData
datum <- ScriptData -> HashableScriptData
unsafeHashableScriptData (ScriptData -> HashableScriptData)
-> (Data -> ScriptData) -> Data -> HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScriptData
fromPlutusData (Data -> HashableScriptData) -> Gen Data -> Gen HashableScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Data
forall a. Arbitrary a => Gen a
arbitrary
    HashableScriptData
redeemer <- ScriptData -> HashableScriptData
unsafeHashableScriptData (ScriptData -> HashableScriptData)
-> (Data -> ScriptData) -> Data -> HashableScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> ScriptData
fromPlutusData (Data -> HashableScriptData) -> Gen Data -> Gen HashableScriptData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Data
forall a. Arbitrary a => Gen a
arbitrary
    let genTxOut :: Gen (TxOut CtxUTxO Era)
genTxOut = do
          Value
value <- Gen Value
genValue
          let scriptAddress :: AddressInEra Era
scriptAddress = NetworkId -> PlutusScript -> AddressInEra Era
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
testNetworkId PlutusScript
alwaysSucceedingScript
          TxOut CtxUTxO Era -> Gen (TxOut CtxUTxO Era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut CtxUTxO Era -> Gen (TxOut CtxUTxO Era))
-> TxOut CtxUTxO Era -> Gen (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ AddressInEra Era
-> Value
-> TxOutDatum CtxUTxO
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra Era
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut AddressInEra Era
scriptAddress Value
value (HashableScriptData -> TxOutDatum CtxUTxO
forall ctx. HashableScriptData -> TxOutDatum ctx
TxOutDatumInline HashableScriptData
datum) ReferenceScript
ReferenceScriptNone
    UTxO
utxoToSpend <- Gen (TxOut CtxUTxO Era) -> Gen UTxO
genUTxO1 Gen (TxOut CtxUTxO Era)
genTxOut
    (UTxO, TxBodyContent BuildTx) -> Gen (UTxO, TxBodyContent BuildTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
utxoToSpend
      , TxBodyContent BuildTx
txbody
          TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addInputs
            ( UTxO' (BuildTxWith BuildTx (Witness WitCtxTxIn Era))
-> TxIns BuildTx
forall out. UTxO' out -> [(TxIn, out)]
UTxO.pairs (UTxO' (BuildTxWith BuildTx (Witness WitCtxTxIn Era))
 -> TxIns BuildTx)
-> UTxO' (BuildTxWith BuildTx (Witness WitCtxTxIn Era))
-> TxIns BuildTx
forall a b. (a -> b) -> a -> b
$
                ( \TxOut CtxUTxO Era
_ ->
                    Witness WitCtxTxIn Era
-> BuildTxWith BuildTx (Witness WitCtxTxIn Era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn Era
 -> BuildTxWith BuildTx (Witness WitCtxTxIn Era))
-> Witness WitCtxTxIn Era
-> BuildTxWith BuildTx (Witness WitCtxTxIn Era)
forall a b. (a -> b) -> a -> b
$
                      ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn Era
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
ScriptWitnessForSpending (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn Era)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn Era
forall a b. (a -> b) -> a -> b
$
                        PlutusScript
-> ScriptDatum WitCtxTxIn
-> HashableScriptData
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
PlutusScript lang
-> ScriptDatum ctx -> HashableScriptData -> ScriptWitness ctx era
mkScriptWitness PlutusScript
alwaysSucceedingScript (Maybe HashableScriptData -> ScriptDatum WitCtxTxIn
ScriptDatumForTxIn (Maybe HashableScriptData -> ScriptDatum WitCtxTxIn)
-> Maybe HashableScriptData -> ScriptDatum WitCtxTxIn
forall a b. (a -> b) -> a -> b
$ HashableScriptData -> Maybe HashableScriptData
forall a. a -> Maybe a
Just HashableScriptData
datum) HashableScriptData
redeemer
                )
                  (TxOut CtxUTxO Era -> BuildTxWith BuildTx (Witness WitCtxTxIn Era))
-> UTxO -> UTxO' (BuildTxWith BuildTx (Witness WitCtxTxIn Era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxO
utxoToSpend
            )
      )

  addSomeReferenceInputs :: (UTxO' (TxOut ctx), TxBodyContent BuildTx)
-> Gen (UTxO' (TxOut ctx), TxBodyContent BuildTx)
addSomeReferenceInputs (UTxO' (TxOut ctx)
utxo, TxBodyContent BuildTx
txbody) = do
    TxOut ctx
txout <- Gen (TxOut ctx)
forall ctx. Gen (TxOut ctx)
genTxOutWithReferenceScript
    TxIn
txin <- Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
    (UTxO' (TxOut ctx), TxBodyContent BuildTx)
-> Gen (UTxO' (TxOut ctx), TxBodyContent BuildTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTxO' (TxOut ctx)
utxo UTxO' (TxOut ctx) -> UTxO' (TxOut ctx) -> UTxO' (TxOut ctx)
forall a. Semigroup a => a -> a -> a
<> (TxIn, TxOut ctx) -> UTxO' (TxOut ctx)
forall out. (TxIn, out) -> UTxO' out
UTxO.singleton (TxIn
txin, TxOut ctx
txout), TxBodyContent BuildTx
txbody TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
addReferenceInputs [TxIn
txin])

  addValidityRange :: (a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
addValidityRange (a
utxo, TxBodyContent buidl
txbody) = do
    (TxValidityLowerBound
start, TxValidityUpperBound
end) <- Gen (TxValidityLowerBound, TxValidityUpperBound)
forall a. Arbitrary a => Gen a
arbitrary
    (a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( a
utxo
      , TxBodyContent buidl
txbody{txValidityLowerBound = start, txValidityUpperBound = end}
      )

  addRandomMetadata :: (a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
addRandomMetadata (a
utxo, TxBodyContent buidl
txbody) = do
    TxMetadataInEra
mtdt <- Gen TxMetadataInEra
genMetadata
    (a, TxBodyContent buidl) -> Gen (a, TxBodyContent buidl)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
utxo, TxBodyContent buidl
txbody{txMetadata = mtdt})

  addCollateralInput :: (UTxO, TxBodyContent buidl) -> Gen (UTxO, TxBodyContent buidl)
addCollateralInput (UTxO
utxo, TxBodyContent buidl
txbody) = do
    UTxO
utxoToSpend <- Int -> Gen UTxO
genUTxOAdaOnlyOfSize Int
1
    (UTxO, TxBodyContent buidl) -> Gen (UTxO, TxBodyContent buidl)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( UTxO
utxo UTxO -> UTxO -> UTxO
forall a. Semigroup a => a -> a -> a
<> UTxO
utxoToSpend
      , TxBodyContent buidl
txbody{txInsCollateral = TxInsCollateral $ toList (UTxO.inputSet utxoToSpend)}
      )

  sometimesAddRewardRedeemer :: (a, TxBodyContent BuildTx) -> Gen (a, TxBodyContent BuildTx)
sometimesAddRewardRedeemer (a
utxo, TxBodyContent BuildTx
txbody) =
    [Gen (a, TxBodyContent BuildTx)] -> Gen (a, TxBodyContent BuildTx)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ (a, TxBodyContent BuildTx) -> Gen (a, TxBodyContent BuildTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
utxo, TxBodyContent BuildTx
txbody)
      , do
          Coin
lovelace <- Gen Coin
forall a. Arbitrary a => Gen a
arbitrary
          let redeemer :: HashableScriptData
redeemer = Gen HashableScriptData
forall a. Arbitrary a => Gen a
arbitrary Gen HashableScriptData -> Int -> HashableScriptData
forall a. Gen a -> Int -> a
`generateWith` Int
42
              alwaysSucceedingScript :: PlutusScript
alwaysSucceedingScript = ShortByteString -> PlutusScript
PlutusScriptSerialised ShortByteString
dummyValidatorScript
              scriptWitness :: ScriptWitness WitCtxStake Era
scriptWitness = PlutusScript
-> ScriptDatum WitCtxStake
-> HashableScriptData
-> ScriptWitness WitCtxStake Era
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
PlutusScript lang
-> ScriptDatum ctx -> HashableScriptData -> ScriptWitness ctx era
mkScriptWitness PlutusScript
alwaysSucceedingScript ScriptDatum WitCtxStake
NoScriptDatumForStake HashableScriptData
redeemer
              stakeAddress :: StakeAddress
stakeAddress = NetworkId -> PlutusScript -> StakeAddress
forall lang.
IsPlutusScriptLanguage lang =>
NetworkId -> PlutusScript lang -> StakeAddress
mkScriptStakeAddress NetworkId
testNetworkId PlutusScript
alwaysSucceedingScript
          (a, TxBodyContent BuildTx) -> Gen (a, TxBodyContent BuildTx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            ( a
utxo
            , TxBodyContent BuildTx
txbody
                TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxWithdrawals BuildTx Era
-> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall build era.
TxWithdrawals build era
-> TxBodyContent build era -> TxBodyContent build era
setTxWithdrawals
                  ( ShelleyBasedEra Era
-> [(StakeAddress, Coin,
     BuildTxWith BuildTx (Witness WitCtxStake Era))]
-> TxWithdrawals BuildTx Era
forall era build.
ShelleyBasedEra era
-> [(StakeAddress, Coin,
     BuildTxWith build (Witness WitCtxStake era))]
-> TxWithdrawals build era
TxWithdrawals
                      ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra
                      [
                        ( StakeAddress
stakeAddress
                        , Coin
lovelace
                        , Witness WitCtxStake Era
-> BuildTxWith BuildTx (Witness WitCtxStake Era)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxStake Era
 -> BuildTxWith BuildTx (Witness WitCtxStake Era))
-> Witness WitCtxStake Era
-> BuildTxWith BuildTx (Witness WitCtxStake Era)
forall a b. (a -> b) -> a -> b
$ ScriptWitnessInCtx WitCtxStake
-> ScriptWitness WitCtxStake Era -> Witness WitCtxStake Era
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxStake
ScriptWitnessForStakeAddr ScriptWitness WitCtxStake Era
scriptWitness
                        )
                      ]
                  )
            )
      ]

genMetadata :: Gen TxMetadataInEra
genMetadata :: Gen TxMetadataInEra
genMetadata = do
  forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata' @LedgerEra Gen (ShelleyTxAuxData (ConwayEra StandardCrypto))
-> (ShelleyTxAuxData (ConwayEra StandardCrypto)
    -> Gen TxMetadataInEra)
-> Gen TxMetadataInEra
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ShelleyTxAuxData Map Word64 Metadatum
m) ->
    TxMetadataInEra -> Gen TxMetadataInEra
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxMetadataInEra -> Gen TxMetadataInEra)
-> (Map Word64 TxMetadataValue -> TxMetadataInEra)
-> Map Word64 TxMetadataValue
-> Gen TxMetadataInEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMetadata -> TxMetadataInEra
TxMetadataInEra (TxMetadata -> TxMetadataInEra)
-> (Map Word64 TxMetadataValue -> TxMetadata)
-> Map Word64 TxMetadataValue
-> TxMetadataInEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Word64 TxMetadataValue -> TxMetadata
TxMetadata (Map Word64 TxMetadataValue -> Gen TxMetadataInEra)
-> Map Word64 TxMetadataValue -> Gen TxMetadataInEra
forall a b. (a -> b) -> a -> b
$ Map Word64 Metadatum -> Map Word64 TxMetadataValue
fromShelleyMetadata Map Word64 Metadatum
m

getAuxMetadata :: Tx -> Map Word64 Metadatum
getAuxMetadata :: Tx -> Map Word64 Metadatum
getAuxMetadata Tx
tx =
  case Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
     (AlonzoTx (ConwayEra StandardCrypto))
     (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
-> StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
  (AlonzoTx (ConwayEra StandardCrypto))
  (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
(StrictMaybe (TxAuxData (ConwayEra StandardCrypto))
 -> Const
      (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
      (StrictMaybe (TxAuxData (ConwayEra StandardCrypto))))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto)))
     (Tx (ConwayEra StandardCrypto))
forall era.
EraTx era =>
Lens' (Tx era) (StrictMaybe (AuxiliaryData era))
Lens'
  (Tx (ConwayEra StandardCrypto))
  (StrictMaybe (TxAuxData (ConwayEra StandardCrypto)))
auxDataTxL of
    StrictMaybe (AlonzoTxAuxData (ConwayEra StandardCrypto))
SNothing -> Map Word64 Metadatum
forall a. Monoid a => a
mempty
    SJust (AlonzoTxAuxData Map Word64 Metadatum
m StrictSeq (Timelock (ConwayEra StandardCrypto))
_ Map Language (NonEmpty PlutusBinary)
_) -> Map Word64 Metadatum
m

prop_interestingBlueprintTx :: Property
prop_interestingBlueprintTx :: Property
prop_interestingBlueprintTx = do
  Gen (UTxO, Tx) -> ((UTxO, Tx) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen (UTxO, Tx)
genBlueprintTxWithUTxO (((UTxO, Tx) -> Property) -> Property)
-> ((UTxO, Tx) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(UTxO
utxo, Tx
tx) ->
    Bool -> Property
forall prop. Testable prop => prop -> Property
checkCoverage
      Bool
True
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
1 ((UTxO, Tx) -> Bool
forall {ctx}. (UTxO' (TxOut ctx), Tx) -> Bool
spendsFromScript (UTxO
utxo, Tx
tx)) String
"blueprint spends script UTxO"
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
1 ((UTxO, Tx) -> Bool
forall {era} {ctx}.
(Share (TxOut (ShelleyLedgerEra era))
 ~ Interns (Credential 'Staking StandardCrypto),
 EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
 Assert
   (OrdCond
      (CmpNat
         (ProtVerLow (ShelleyLedgerEra era))
         (ProtVerHigh (ShelleyLedgerEra era)))
      'True
      'True
      'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerLow (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerHigh (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 EraTx (ShelleyLedgerEra era),
 HashAnnotated
   (TxBody (ShelleyLedgerEra era))
   EraIndependentTxBody
   StandardCrypto,
 HashAnnotated
   (TxAuxData (ShelleyLedgerEra era))
   EraIndependentTxAuxData
   StandardCrypto) =>
(UTxO' (TxOut ctx), Tx era) -> Bool
spendsFromPubKey (UTxO
utxo, Tx
tx)) String
"blueprint spends pub key UTxO"
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
1 ((UTxO, Tx) -> Bool
forall {era} {ctx}.
(Share (TxOut (ShelleyLedgerEra era))
 ~ Interns (Credential 'Staking StandardCrypto),
 EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto,
 Assert
   (OrdCond
      (CmpNat
         (ProtVerLow (ShelleyLedgerEra era))
         (ProtVerHigh (ShelleyLedgerEra era)))
      'True
      'True
      'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerLow (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerHigh (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 EraTx (ShelleyLedgerEra era),
 HashAnnotated
   (TxBody (ShelleyLedgerEra era))
   EraIndependentTxBody
   StandardCrypto,
 HashAnnotated
   (TxAuxData (ShelleyLedgerEra era))
   EraIndependentTxAuxData
   StandardCrypto) =>
(UTxO' (TxOut ctx), Tx era) -> Bool
spendsFromPubKey (UTxO
utxo, Tx
tx) Bool -> Bool -> Bool
&& (UTxO, Tx) -> Bool
forall {ctx}. (UTxO' (TxOut ctx), Tx) -> Bool
spendsFromScript (UTxO
utxo, Tx
tx)) String
"blueprint spends from script AND pub key"
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
1 (Tx -> Bool
forall {era}.
(Assert
   (OrdCond
      (CmpNat
         (ProtVerLow (ShelleyLedgerEra era))
         (ProtVerHigh (ShelleyLedgerEra era)))
      'True
      'True
      'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerLow (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond
      (CmpNat 0 (ProtVerHigh (ShelleyLedgerEra era))) 'True 'True 'False)
   (TypeError ...),
 EraTx (ShelleyLedgerEra era),
 BabbageEraTxBody (ShelleyLedgerEra era)) =>
Tx era -> Bool
hasReferenceInputs Tx
tx) String
"blueprint has reference input"
      Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& Double -> Bool -> String -> Property -> Property
forall prop.
Testable prop =>
Double -> Bool -> String -> prop -> Property
cover Double
1 (Tx -> Bool
hasRewardRedeemer Tx
tx) String
"blueprint has reward redeemer"
 where
  hasRewardRedeemer :: Tx -> Bool
hasRewardRedeemer Tx
tx =
    Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx Tx LedgerEra
-> Getting
     (Redeemers LedgerEra) (Tx LedgerEra) (Redeemers LedgerEra)
-> Redeemers LedgerEra
forall s a. s -> Getting a s a -> a
^. (TxWits LedgerEra
 -> Const (Redeemers LedgerEra) (TxWits LedgerEra))
-> Tx LedgerEra -> Const (Redeemers LedgerEra) (Tx LedgerEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx LedgerEra) (TxWits LedgerEra)
witsTxL ((TxWits LedgerEra
  -> Const (Redeemers LedgerEra) (TxWits LedgerEra))
 -> Tx LedgerEra -> Const (Redeemers LedgerEra) (Tx LedgerEra))
-> ((Redeemers LedgerEra
     -> Const (Redeemers LedgerEra) (Redeemers LedgerEra))
    -> TxWits LedgerEra
    -> Const (Redeemers LedgerEra) (TxWits LedgerEra))
-> Getting
     (Redeemers LedgerEra) (Tx LedgerEra) (Redeemers LedgerEra)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers LedgerEra
 -> Const (Redeemers LedgerEra) (Redeemers LedgerEra))
-> TxWits LedgerEra
-> Const (Redeemers LedgerEra) (TxWits LedgerEra)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits LedgerEra) (Redeemers LedgerEra)
rdmrsTxWitsL
      Redeemers LedgerEra
-> (Redeemers LedgerEra
    -> Map
         (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
         (Data (ConwayEra StandardCrypto), ExUnits))
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall a b. a -> (a -> b) -> b
& forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers @LedgerEra
      Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
-> (Map
      (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
      (Data (ConwayEra StandardCrypto), ExUnits)
    -> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)))
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
forall a b. a -> (a -> b) -> b
& Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
forall k a. Map k a -> Set k
Map.keysSet
      Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
-> (Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
    -> Bool)
-> Bool
forall a b. a -> (a -> b) -> b
& (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto) -> Bool)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
        ( \case
            ConwayRewarding AsIx Word32 (RewardAccount (EraCrypto (ConwayEra StandardCrypto)))
_ -> Bool
True
            ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)
_ -> Bool
False
        )

  hasReferenceInputs :: Tx era -> Bool
hasReferenceInputs Tx era
tx =
    Bool -> Bool
not (Bool -> Bool)
-> (Set (TxIn (EraCrypto (ShelleyLedgerEra era))) -> Bool)
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (TxIn (EraCrypto (ShelleyLedgerEra era))) -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set (TxIn (EraCrypto (ShelleyLedgerEra era))) -> Bool)
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era))) -> Bool
forall a b. (a -> b) -> a -> b
$ Tx era -> Tx (ShelleyLedgerEra era)
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx era
tx Tx (ShelleyLedgerEra era)
-> Getting
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
     (Tx (ShelleyLedgerEra era))
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
-> Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
forall s a. s -> Getting a s a -> a
^. (TxBody (ShelleyLedgerEra era)
 -> Const
      (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
      (TxBody (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
     (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
bodyTxL ((TxBody (ShelleyLedgerEra era)
  -> Const
       (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
       (TxBody (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const
      (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
      (Tx (ShelleyLedgerEra era)))
-> ((Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
     -> Const
          (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
          (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
    -> TxBody (ShelleyLedgerEra era)
    -> Const
         (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
         (TxBody (ShelleyLedgerEra era)))
-> Getting
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
     (Tx (ShelleyLedgerEra era))
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
 -> Const
      (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
      (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
-> TxBody (ShelleyLedgerEra era)
-> Const
     (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
     (TxBody (ShelleyLedgerEra era))
forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
referenceInputsTxBodyL

  spendsFromPubKey :: (UTxO' (TxOut ctx), Tx era) -> Bool
spendsFromPubKey (UTxO' (TxOut ctx)
utxo, Tx era
tx) =
    (TxIn StandardCrypto -> Bool) -> Set (TxIn StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
      ( \TxIn StandardCrypto
txIn -> case TxIn -> UTxO' (TxOut ctx) -> Maybe (TxOut ctx)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolve (TxIn StandardCrypto -> TxIn
fromLedgerTxIn TxIn StandardCrypto
txIn) UTxO' (TxOut ctx)
utxo of
          Just (TxOut (ShelleyAddressInEra (ShelleyAddress Network
_ (KeyHashObj KeyHash 'Payment StandardCrypto
_) StakeReference StandardCrypto
_)) Value
_ TxOutDatum ctx
_ ReferenceScript
_) -> Bool
True
          Maybe (TxOut ctx)
_ -> Bool
False
      )
      (Set (TxIn StandardCrypto) -> Bool)
-> Set (TxIn StandardCrypto) -> Bool
forall a b. (a -> b) -> a -> b
$ Tx era -> Tx (ShelleyLedgerEra era)
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx era
tx Tx (ShelleyLedgerEra era)
-> Getting
     (Set (TxIn StandardCrypto))
     (Tx (ShelleyLedgerEra era))
     (Set (TxIn StandardCrypto))
-> Set (TxIn StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxBody (ShelleyLedgerEra era)
 -> Const
      (Set (TxIn StandardCrypto)) (TxBody (ShelleyLedgerEra era)))
-> Tx (ShelleyLedgerEra era)
-> Const (Set (TxIn StandardCrypto)) (Tx (ShelleyLedgerEra era))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx (ShelleyLedgerEra era)) (TxBody (ShelleyLedgerEra era))
bodyTxL ((TxBody (ShelleyLedgerEra era)
  -> Const
       (Set (TxIn StandardCrypto)) (TxBody (ShelleyLedgerEra era)))
 -> Tx (ShelleyLedgerEra era)
 -> Const (Set (TxIn StandardCrypto)) (Tx (ShelleyLedgerEra era)))
-> ((Set (TxIn StandardCrypto)
     -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
    -> TxBody (ShelleyLedgerEra era)
    -> Const
         (Set (TxIn StandardCrypto)) (TxBody (ShelleyLedgerEra era)))
-> Getting
     (Set (TxIn StandardCrypto))
     (Tx (ShelleyLedgerEra era))
     (Set (TxIn StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (TxIn StandardCrypto)
 -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
-> TxBody (ShelleyLedgerEra era)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ShelleyLedgerEra era))
(Set (TxIn (EraCrypto (ShelleyLedgerEra era)))
 -> Const
      (Set (TxIn StandardCrypto))
      (Set (TxIn (EraCrypto (ShelleyLedgerEra era)))))
-> TxBody (ShelleyLedgerEra era)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ShelleyLedgerEra era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ShelleyLedgerEra era))
  (Set (TxIn (EraCrypto (ShelleyLedgerEra era))))
inputsTxBodyL

  -- XXX: We do check both, the utxo and redeemers, because we
  -- don't do phase 1 validation of the resulting transactions
  -- and would not detect if redeemers are missing.
  spendsFromScript :: (UTxO' (TxOut ctx), Tx) -> Bool
spendsFromScript (UTxO' (TxOut ctx)
utxo, Tx
tx) =
    (TxIn StandardCrypto -> Bool) -> Set (TxIn StandardCrypto) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
      ( \TxIn StandardCrypto
txIn -> case TxIn -> UTxO' (TxOut ctx) -> Maybe (TxOut ctx)
forall out. TxIn -> UTxO' out -> Maybe out
UTxO.resolve (TxIn StandardCrypto -> TxIn
fromLedgerTxIn TxIn StandardCrypto
txIn) UTxO' (TxOut ctx)
utxo of
          Just (TxOut (ShelleyAddressInEra (ShelleyAddress Network
_ (ScriptHashObj ScriptHash StandardCrypto
_) StakeReference StandardCrypto
_)) Value
_ TxOutDatum ctx
_ ReferenceScript
_) -> Bool
True
          Maybe (TxOut ctx)
_ -> Bool
False
      )
      (Tx -> Tx LedgerEra
forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx Tx
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (Set (TxIn StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Set (TxIn StandardCrypto))
-> Set (TxIn StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxBody (ConwayEra StandardCrypto)
 -> Const
      (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (Tx (ConwayEra StandardCrypto))
(TxBody (ConwayEra StandardCrypto)
 -> Const
      (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
bodyTxL ((TxBody (ConwayEra StandardCrypto)
  -> Const
       (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (Set (TxIn StandardCrypto)) (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Set (TxIn StandardCrypto)
     -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
    -> TxBody (ConwayEra StandardCrypto)
    -> Const
         (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto)))
-> Getting
     (Set (TxIn StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Set (TxIn StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set (TxIn StandardCrypto)
 -> Const (Set (TxIn StandardCrypto)) (Set (TxIn StandardCrypto)))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
(Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))
 -> Const
      (Set (TxIn StandardCrypto))
      (Set (TxIn (EraCrypto (ConwayEra StandardCrypto)))))
-> TxBody (ConwayEra StandardCrypto)
-> Const
     (Set (TxIn StandardCrypto)) (TxBody (ConwayEra StandardCrypto))
forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
Lens'
  (TxBody (ConwayEra StandardCrypto))
  (Set (TxIn (EraCrypto (ConwayEra StandardCrypto))))
inputsTxBodyL)
      Bool -> Bool -> Bool
&& (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto) -> Bool)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
        ( \case
            ConwaySpending AsIx Word32 (TxIn (EraCrypto (ConwayEra StandardCrypto)))
_ -> Bool
True
            ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)
_ -> Bool
False
        )
        ( Map
  (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
  (Data (ConwayEra StandardCrypto), ExUnits)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
forall k a. Map k a -> Set k
Map.keysSet
            (Map
   (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
   (Data (ConwayEra StandardCrypto), ExUnits)
 -> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)))
-> (Redeemers (ConwayEra StandardCrypto)
    -> Map
         (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
         (Data (ConwayEra StandardCrypto), ExUnits))
-> Redeemers (ConwayEra StandardCrypto)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redeemers (ConwayEra StandardCrypto)
-> Map
     (PlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
Redeemers (ConwayEra StandardCrypto)
-> Map
     (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
     (Data (ConwayEra StandardCrypto), ExUnits)
forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers
            (Redeemers (ConwayEra StandardCrypto)
 -> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto)))
-> Redeemers (ConwayEra StandardCrypto)
-> Set (ConwayPlutusPurpose AsIx (ConwayEra StandardCrypto))
forall a b. (a -> b) -> a -> b
$ forall era. Tx era -> Tx (ShelleyLedgerEra era)
toLedgerTx @Era Tx
tx AlonzoTx (ConwayEra StandardCrypto)
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
-> Redeemers (ConwayEra StandardCrypto)
forall s a. s -> Getting a s a -> a
^. (TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> Tx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (Tx (ConwayEra StandardCrypto))
(TxWits (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (TxWits (ConwayEra StandardCrypto)))
-> AlonzoTx (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens'
  (Tx (ConwayEra StandardCrypto)) (TxWits (ConwayEra StandardCrypto))
witsTxL ((TxWits (ConwayEra StandardCrypto)
  -> Const
       (Redeemers (ConwayEra StandardCrypto))
       (TxWits (ConwayEra StandardCrypto)))
 -> AlonzoTx (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (AlonzoTx (ConwayEra StandardCrypto)))
-> ((Redeemers (ConwayEra StandardCrypto)
     -> Const
          (Redeemers (ConwayEra StandardCrypto))
          (Redeemers (ConwayEra StandardCrypto)))
    -> TxWits (ConwayEra StandardCrypto)
    -> Const
         (Redeemers (ConwayEra StandardCrypto))
         (TxWits (ConwayEra StandardCrypto)))
-> Getting
     (Redeemers (ConwayEra StandardCrypto))
     (AlonzoTx (ConwayEra StandardCrypto))
     (Redeemers (ConwayEra StandardCrypto))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers (ConwayEra StandardCrypto)
 -> Const
      (Redeemers (ConwayEra StandardCrypto))
      (Redeemers (ConwayEra StandardCrypto)))
-> TxWits (ConwayEra StandardCrypto)
-> Const
     (Redeemers (ConwayEra StandardCrypto))
     (TxWits (ConwayEra StandardCrypto))
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens'
  (TxWits (ConwayEra StandardCrypto))
  (Redeemers (ConwayEra StandardCrypto))
rdmrsTxWitsL
        )