{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Ledger.Alonzo.Imp.UtxowSpec.Valid (spec) where import Cardano.Ledger.Alonzo.Core import Cardano.Ledger.Alonzo.Rules ( AlonzoUtxosPredFailure, ) import Cardano.Ledger.Alonzo.Scripts (eraLanguages) import Cardano.Ledger.Credential (Credential (..)) import Cardano.Ledger.Plutus ( hashPlutusScript, withSLanguage, ) import Control.Monad ((<=<)) import Lens.Micro ((&), (.~)) import Test.Cardano.Ledger.Alonzo.Arbitrary () import Test.Cardano.Ledger.Alonzo.ImpTest import Test.Cardano.Ledger.Imp.Common import Test.Cardano.Ledger.Plutus.Examples spec :: forall era. ( AlonzoEraImp era , InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era ) => SpecWith (ImpInit (LedgerSpec era)) spec :: forall era. (AlonzoEraImp era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) => SpecWith (ImpInit (LedgerSpec era)) spec = forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe String "Valid transactions" forall a b. (a -> b) -> a -> b $ do forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => t a -> (a -> m b) -> m () forM_ (forall era. AlonzoEraScript era => [Language] eraLanguages @era) forall a b. (a -> b) -> a -> b $ \Language lang -> forall a. Language -> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a) -> a withSLanguage Language lang forall a b. (a -> b) -> a -> b $ \SLanguage l slang -> forall a. HasCallStack => String -> SpecWith a -> SpecWith a describe (forall a. Show a => a -> String show Language lang) forall a b. (a -> b) -> a -> b $ do let alwaysSucceedsWithDatumHash :: ScriptHash alwaysSucceedsWithDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript forall a b. (a -> b) -> a -> b $ forall (l :: Language). SLanguage l -> Plutus l alwaysSucceedsWithDatum SLanguage l slang :: ScriptHash alwaysSucceedsNoDatumHash :: ScriptHash alwaysSucceedsNoDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript forall a b. (a -> b) -> a -> b $ forall (l :: Language). SLanguage l -> Plutus l alwaysSucceedsNoDatum SLanguage l slang :: ScriptHash alwaysFailsWithDatumHash :: ScriptHash alwaysFailsWithDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript forall a b. (a -> b) -> a -> b $ forall (l :: Language). SLanguage l -> Plutus l alwaysFailsWithDatum SLanguage l slang :: ScriptHash alwaysFailsNoDatumHash :: ScriptHash alwaysFailsNoDatumHash = forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash hashPlutusScript forall a b. (a -> b) -> a -> b $ forall (l :: Language). SLanguage l -> Plutus l alwaysFailsNoDatum SLanguage l slang :: ScriptHash forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Validating SPEND script" forall a b. (a -> b) -> a -> b $ do TxIn txIn <- forall era. (ShelleyEraImp era, HasCallStack) => ScriptHash -> ImpTestM era TxIn produceScript ScriptHash alwaysSucceedsWithDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era) submitTx forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn) inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxIn txIn] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Not validating SPEND script" forall a b. (a -> b) -> a -> b $ do TxIn txIn <- forall era. (ShelleyEraImp era, HasCallStack) => ScriptHash -> ImpTestM era TxIn produceScript ScriptHash alwaysFailsWithDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, AlonzoEraImp era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) => Tx era -> ImpTestM era (Tx era) submitPhase2Invalid forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn) inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxIn txIn] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Validating CERT script" forall a b. (a -> b) -> a -> b $ do TxIn txIn <- forall era. (ShelleyEraImp era, HasCallStack) => ScriptHash -> ImpTestM era TxIn produceScript ScriptHash alwaysSucceedsWithDatumHash let txCert :: TxCert era txCert = forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era RegTxCert forall a b. (a -> b) -> a -> b $ forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj ScriptHash alwaysSucceedsNoDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era) submitTx forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn) inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxIn txIn] forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (StrictSeq (TxCert era)) certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxCert era txCert] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Not validating CERT script" forall a b. (a -> b) -> a -> b $ do TxIn txIn <- forall era. (ShelleyEraImp era, HasCallStack) => ScriptHash -> ImpTestM era TxIn produceScript ScriptHash alwaysFailsWithDatumHash let txCert :: TxCert era txCert = forall era. ShelleyEraTxCert era => StakeCredential -> TxCert era RegTxCert forall a b. (a -> b) -> a -> b $ forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj ScriptHash alwaysSucceedsNoDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, AlonzoEraImp era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) => Tx era -> ImpTestM era (Tx era) submitPhase2Invalid forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn) inputsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxIn txIn] forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) (StrictSeq (TxCert era)) certsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ [TxCert era txCert] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b $ do RewardAccount account <- forall era. (HasCallStack, ShelleyEraImp era) => StakeCredential -> ImpTestM era RewardAccount registerStakeCredential @era forall a b. (a -> b) -> a -> b $ forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj ScriptHash alwaysSucceedsNoDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era) submitTx forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) Withdrawals withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount account, forall a. Monoid a => a mempty)] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Not validating WITHDRAWAL script" forall a b. (a -> b) -> a -> b $ do RewardAccount account <- forall era. (HasCallStack, ShelleyEraImp era) => StakeCredential -> ImpTestM era RewardAccount registerStakeCredential @era forall a b. (a -> b) -> a -> b $ forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj ScriptHash alwaysFailsNoDatumHash forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, AlonzoEraImp era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) => Tx era -> ImpTestM era (Tx era) submitPhase2Invalid forall a b. (a -> b) -> a -> b $ forall era. EraTx era => TxBody era -> Tx era mkBasicTx forall a b. (a -> b) -> a -> b $ forall era. EraTxBody era => TxBody era mkBasicTxBody forall a b. a -> (a -> b) -> b & forall era. EraTxBody era => Lens' (TxBody era) Withdrawals withdrawalsTxBodyL forall s t a b. ASetter s t a b -> b -> s -> t .~ Map RewardAccount Coin -> Withdrawals Withdrawals [(RewardAccount account, forall a. Monoid a => a mempty)] forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Validating MINT script" forall a b. (a -> b) -> a -> b $ do forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, ShelleyEraImp era) => Tx era -> ImpTestM era (Tx era) submitTx forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. MaryEraImp era => ScriptHash -> ImpTestM era (Tx era) mkTokenMintingTx forall a b. (a -> b) -> a -> b $ ScriptHash alwaysSucceedsNoDatumHash forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Not validating MINT script" forall a b. (a -> b) -> a -> b $ do forall era. (HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era () expectTxSuccess forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. (HasCallStack, AlonzoEraImp era, InjectRuleFailure "LEDGER" AlonzoUtxosPredFailure era) => Tx era -> ImpTestM era (Tx era) submitPhase2Invalid forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< forall era. MaryEraImp era => ScriptHash -> ImpTestM era (Tx era) mkTokenMintingTx forall a b. (a -> b) -> a -> b $ ScriptHash alwaysFailsNoDatumHash forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Validating scripts everywhere" forall a b. (a -> b) -> a -> b $ do forall a b. a -> b -> a const forall a b. (a -> b) -> a -> b $ HasCallStack => String -> Expectation pendingWith String "not implemented yet" forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Acceptable supplimentary datum" forall a b. (a -> b) -> a -> b $ do forall a b. a -> b -> a const forall a b. (a -> b) -> a -> b $ HasCallStack => String -> Expectation pendingWith String "not implemented yet" forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Multiple identical certificates" forall a b. (a -> b) -> a -> b $ do forall a b. a -> b -> a const forall a b. (a -> b) -> a -> b $ HasCallStack => String -> Expectation pendingWith String "not implemented yet" forall a. (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) it String "Non-script output with datum" forall a b. (a -> b) -> a -> b $ do forall a b. a -> b -> a const forall a b. (a -> b) -> a -> b $ HasCallStack => String -> Expectation pendingWith String "not implemented yet"