{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Conway.Imp.UtxowSpec (spec) where

import Cardano.Ledger.Address (Addr (..))
import Cardano.Ledger.Alonzo.Scripts (eraLanguages)
import Cardano.Ledger.Babbage.Tx (ScriptIntegrity (..), getLanguageView)
import Cardano.Ledger.BaseTypes (
  Inject (..),
  Mismatch (..),
  Network (..),
  StrictMaybe (..),
  TxIx (..),
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (..))
import Cardano.Ledger.Conway.Core (
  AlonzoEraTxBody (..),
  AlonzoEraTxWits (..),
  CoinPerByte (..),
  EraIndependentScriptIntegrity,
  EraTx (..),
  EraTxBody (..),
  EraTxOut (..),
  EraTxWits (..),
  InjectRuleFailure (..),
  SafeHash,
  SafeToHash (..),
  TxLevel (..),
  ppCoinsPerUTxOByteL,
  txIdTx,
 )
import Cardano.Ledger.Conway.Governance
import Cardano.Ledger.Conway.Rules (ConwayUtxowPredFailure (..))
import Cardano.Ledger.Conway.TxBody
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Keys (asWitness, witVKeyHash)
import Cardano.Ledger.Plutus (
  Language (..),
  PlutusLanguage,
  SLanguage,
  hashPlutusScript,
  plutusLanguage,
  withSLanguage,
 )
import Cardano.Ledger.TxIn (TxIn (..))
import Data.Foldable (for_)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Set.NonEmpty as NES
import Lens.Micro ((%~), (&), (.~), (^.))
import Test.Cardano.Ledger.Conway.ImpTest
import Test.Cardano.Ledger.Imp.Common
import Test.Cardano.Ledger.Plutus.Examples (alwaysSucceedsWithDatum)

spec ::
  forall era.
  ConwayEraImp era =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era. ConwayEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"UTXOW" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
  [Language]
-> (Language -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall era. AlonzoEraScript era => [Language]
eraLanguages @era) ((Language -> SpecWith (ImpInit (LedgerSpec era)))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> (Language -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ \Language
lang ->
    String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (Language -> String
forall a. Show a => a -> String
show Language
lang) (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
      String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Fails with PPViewHashesDontMatch before PV 11" (ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era)))
-> (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era ()
-> SpecWith (ImpInit (LedgerSpec era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: Natural) era.
(EraGov era, KnownNat v, MinVersion <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtMost @10 (ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era)))
-> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
        fixedTx <- Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx TopTx era -> ImpTestM era (Tx TopTx era)
fixupTx (Tx TopTx era -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era) -> ImpTestM era (Tx TopTx era)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Language
-> (forall (l :: Language).
    PlutusLanguage l =>
    SLanguage l -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era)
forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang SLanguage l -> ImpTestM era (Tx TopTx era)
forall era (l :: Language).
(ConwayEraImp era, PlutusLanguage l) =>
SLanguage l -> ImpTestM era (Tx TopTx era)
forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> ImpTestM era (Tx TopTx era)
setupBadPPViewHashTx
        badScriptIntegrityHash <- arbitrary
        tx <- substituteIntegrityHashAndFixWits badScriptIntegrityHash fixedTx
        scriptIntegrityHash <- computeScriptIntegrityHash tx
        impAnn "Submit a transaction with an invalid script integrity hash"
          . withNoFixup
          $ submitFailingTx
            tx
            [ injectFailure . PPViewHashesDontMatch $
                Mismatch
                  { mismatchSupplied = badScriptIntegrityHash
                  , mismatchExpected = scriptIntegrityHash
                  }
            ]
      -- https://github.com/IntersectMBO/formal-ledger-specifications/issues/1086
      -- TODO: Re-enable after issue is resolved, by removing this override
      String -> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
forall era.
ShelleyEraImp era =>
String -> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
disableInConformanceIt String
"Fails with PPViewHashesDontMatchInformative after PV 11"
        (ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era)))
-> (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era ()
-> SpecWith (ImpInit (LedgerSpec era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: Natural) era.
(EraGov era, KnownNat v, MinVersion <= v, v <= MaxVersion) =>
ImpTestM era () -> ImpTestM era ()
whenMajorVersionAtLeast @11
        (ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era)))
-> ImpTestM era () -> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
          fixedTx <- Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx TopTx era -> ImpTestM era (Tx TopTx era)
fixupTx (Tx TopTx era -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era) -> ImpTestM era (Tx TopTx era)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Language
-> (forall (l :: Language).
    PlutusLanguage l =>
    SLanguage l -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era)
forall a.
Language
-> (forall (l :: Language). PlutusLanguage l => SLanguage l -> a)
-> a
withSLanguage Language
lang SLanguage l -> ImpTestM era (Tx TopTx era)
forall era (l :: Language).
(ConwayEraImp era, PlutusLanguage l) =>
SLanguage l -> ImpTestM era (Tx TopTx era)
forall (l :: Language).
PlutusLanguage l =>
SLanguage l -> ImpTestM era (Tx TopTx era)
setupBadPPViewHashTx
          pp <- getsPParams id
          badScriptIntegrityHash <- arbitrary
          let
            langView = [PParams era -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams era
pp Language
lang]
            scriptIntegrity = forall era.
Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
ScriptIntegrity @era Redeemers era
redeemers TxDats era
dats Set LangDepView
langView
            redeemers = Tx TopTx era
fixedTx Tx TopTx era
-> Getting (Redeemers era) (Tx TopTx era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Redeemers era) (TxWits era))
-> Tx TopTx era -> Const (Redeemers era) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Const (Redeemers era) (TxWits era))
 -> Tx TopTx era -> Const (Redeemers era) (Tx TopTx era))
-> ((Redeemers era -> Const (Redeemers era) (Redeemers era))
    -> TxWits era -> Const (Redeemers era) (TxWits era))
-> Getting (Redeemers era) (Tx TopTx era) (Redeemers era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era -> Const (Redeemers era) (Redeemers era))
-> TxWits era -> Const (Redeemers era) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL
            dats = Tx TopTx era
fixedTx Tx TopTx era
-> Getting (TxDats era) (Tx TopTx era) (TxDats era) -> TxDats era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (TxDats era) (TxWits era))
-> Tx TopTx era -> Const (TxDats era) (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Const (TxDats era) (TxWits era))
 -> Tx TopTx era -> Const (TxDats era) (Tx TopTx era))
-> ((TxDats era -> Const (TxDats era) (TxDats era))
    -> TxWits era -> Const (TxDats era) (TxWits era))
-> Getting (TxDats era) (Tx TopTx era) (TxDats era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxDats era -> Const (TxDats era) (TxDats era))
-> TxWits era -> Const (TxDats era) (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL
          tx <- substituteIntegrityHashAndFixWits badScriptIntegrityHash fixedTx
          scriptIntegrityHash <- computeScriptIntegrityHash tx
          let
            mismatch =
              Mismatch
                { mismatchSupplied :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchSupplied = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash
                , mismatchExpected :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchExpected = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
scriptIntegrityHash
                }
          impAnn "Submit a transaction with an invalid script integrity hash"
            . withNoFixup
            $ submitFailingTx
              tx
              [ injectFailure $ ScriptIntegrityHashMismatch mismatch (SJust $ originalBytes scriptIntegrity)
              ]
  String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"Transaction containing SPO vote but no witness for it fails" (ImpTestM era () -> SpecWith (Arg (ImpTestM era ())))
-> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a b. (a -> b) -> a -> b
$ do
    spoKh <- ImpM (LedgerSpec era) (KeyHash StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
    registerPool spoKh
    gaId <- mkProposal InfoAction >>= submitProposal
    submitVote_ @era VoteYes (StakePoolVoter spoKh) gaId
    let tx =
          TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
            Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((VotingProcedures era -> Identity (VotingProcedures era))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (VotingProcedures era -> Identity (VotingProcedures era))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VotingProcedures era -> Identity (VotingProcedures era))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL
              ((VotingProcedures era -> Identity (VotingProcedures era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> VotingProcedures era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
forall era.
Map Voter (Map GovActionId (VotingProcedure era))
-> VotingProcedures era
VotingProcedures
                ( Voter
-> Map GovActionId (VotingProcedure era)
-> Map Voter (Map GovActionId (VotingProcedure era))
forall k a. k -> a -> Map k a
Map.singleton
                    (KeyHash StakePool -> Voter
StakePoolVoter KeyHash StakePool
spoKh)
                    ( GovActionId
-> VotingProcedure era -> Map GovActionId (VotingProcedure era)
forall k a. k -> a -> Map k a
Map.singleton
                        GovActionId
gaId
                        ( VotingProcedure
                            { vProcVote :: Vote
vProcVote = Vote
VoteYes
                            , vProcAnchor :: StrictMaybe Anchor
vProcAnchor = StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                            }
                        )
                    )
                )
    let isSPOWitness WitVKey kr
wit = WitVKey kr -> KeyHash Witness
forall (kr :: KeyRole). WitVKey kr -> KeyHash Witness
witVKeyHash WitVKey kr
wit KeyHash Witness -> KeyHash Witness -> Bool
forall a. Eq a => a -> a -> Bool
== KeyHash StakePool -> KeyHash Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a Witness
asWitness KeyHash StakePool
spoKh
    withPostFixup (pure . (witsTxL . addrTxWitsL %~ Set.filter (not . isSPOWitness))) $
      submitFailingTx
        tx
        [ injectFailure $
            MissingVKeyWitnessesUTXOW $
              NES.singleton $
                asWitness spoKh
        ]

setupBadPPViewHashTx ::
  forall era l.
  ( ConwayEraImp era
  , PlutusLanguage l
  ) =>
  SLanguage l ->
  ImpTestM era (Tx TopTx era)
setupBadPPViewHashTx :: forall era (l :: Language).
(ConwayEraImp era, PlutusLanguage l) =>
SLanguage l -> ImpTestM era (Tx TopTx era)
setupBadPPViewHashTx SLanguage l
slang = do
  (PParams era -> PParams era) -> ImpTestM era ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpTestM era ())
-> (PParams era -> PParams era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (CoinPerByte -> Identity CoinPerByte)
-> PParams era -> Identity (PParams era)
forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL ((CoinPerByte -> Identity CoinPerByte)
 -> PParams era -> Identity (PParams era))
-> CoinPerByte -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ CompactForm Coin -> CoinPerByte
CoinPerByte (Word64 -> CompactForm Coin
CompactCoin Word64
1)
  stakeRef <-
    if SLanguage l -> Language
forall (l :: Language) (proxy :: Language -> *).
PlutusLanguage l =>
proxy l -> Language
plutusLanguage SLanguage l
slang Language -> Language -> Bool
forall a. Ord a => a -> a -> Bool
>= Language
PlutusV4
      then [ImpM (LedgerSpec era) StakeReference]
-> ImpM (LedgerSpec era) StakeReference
forall (m :: * -> *) a. MonadGen m => [m a] -> m a
oneof [Credential Staking -> StakeReference
StakeRefBase (Credential Staking -> StakeReference)
-> ImpM (LedgerSpec era) (Credential Staking)
-> ImpM (LedgerSpec era) StakeReference
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (Credential Staking)
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary, StakeReference -> ImpM (LedgerSpec era) StakeReference
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeReference
StakeRefNull]
      else forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary @StakeReference
  let scriptTxOut =
        Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
          ( Network -> Credential Payment -> StakeReference -> Addr
Addr
              Network
Testnet
              (ScriptHash -> Credential Payment
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Plutus l -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (Plutus l -> ScriptHash) -> Plutus l -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SLanguage l -> Plutus l
forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsWithDatum SLanguage l
slang))
              StakeReference
stakeRef
          )
          (Coin -> Value era
forall t s. Inject t s => t -> s
inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
1_000_000)
  scriptTxIn <-
    impAnn "Submit a transaction that has a script output"
      . submitTx
      $ mkBasicTx mkBasicTxBody
        & bodyTxL . outputsTxBodyL .~ [scriptTxOut]
  pure $
    mkBasicTx mkBasicTxBody
      & bodyTxL . inputsTxBodyL .~ [TxIn (txIdTx scriptTxIn) (TxIx 0)]

substituteIntegrityHashAndFixWits ::
  forall era.
  ConwayEraImp era =>
  StrictMaybe (SafeHash EraIndependentScriptIntegrity) ->
  Tx TopTx era ->
  ImpTestM era (Tx TopTx era)
substituteIntegrityHashAndFixWits :: forall era.
ConwayEraImp era =>
StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx TopTx era -> ImpTestM era (Tx TopTx era)
substituteIntegrityHashAndFixWits StrictMaybe (SafeHash EraIndependentScriptIntegrity)
hash Tx TopTx era
tx =
  let txWithNewHash :: Tx TopTx era
txWithNewHash =
        Tx TopTx era
tx
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxBody TopTx era -> Identity (TxBody TopTx era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody TopTx era -> Identity (TxBody TopTx era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> ((StrictMaybe (SafeHash EraIndependentScriptIntegrity)
     -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
    -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> (StrictMaybe (SafeHash EraIndependentScriptIntegrity)
    -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
-> Tx TopTx era
-> Identity (Tx TopTx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (SafeHash EraIndependentScriptIntegrity)
 -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
Lens'
  (TxBody l era)
  (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall (l :: TxLevel).
Lens'
  (TxBody l era)
  (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
scriptIntegrityHashTxBodyL ((StrictMaybe (SafeHash EraIndependentScriptIntegrity)
  -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx TopTx era
-> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (SafeHash EraIndependentScriptIntegrity)
hash
          Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> TxWits era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
forall era. EraTxWits era => TxWits era
mkBasicTxWits
   in Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era (l :: TxLevel).
AlonzoEraImp era =>
Tx l era -> ImpTestM era (Tx l era)
fixupScriptWits Tx TopTx era
txWithNewHash
        ImpTestM era (Tx TopTx era)
-> (Tx TopTx era -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era (l :: TxLevel).
(HasCallStack, AlonzoEraImp era) =>
Tx l era -> ImpTestM era (Tx l era)
fixupDatums
        ImpTestM era (Tx TopTx era)
-> (Tx TopTx era -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era.
(AlonzoEraImp era, HasCallStack) =>
Tx TopTx era -> ImpTestM era (Tx TopTx era)
fixupRedeemers
        ImpTestM era (Tx TopTx era)
-> (Tx TopTx era -> ImpTestM era (Tx TopTx era))
-> ImpTestM era (Tx TopTx era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tx TopTx era -> ImpTestM era (Tx TopTx era)
forall era (l :: TxLevel).
(HasCallStack, ShelleyEraImp era) =>
Tx l era -> ImpTestM era (Tx l era)
updateAddrTxWits