{-# 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.Plutus.Context (EraPlutusTxInfo)
import Cardano.Ledger.Babbage.Tx (ScriptIntegrity (..), getLanguageView)
import Cardano.Ledger.BaseTypes (
  Inject (..),
  Mismatch (..),
  Network (..),
  StrictMaybe (..),
  TxIx (..),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core (
  AlonzoEraTxBody (..),
  AlonzoEraTxWits (..),
  CoinPerByte (..),
  EraIndependentScriptIntegrity,
  EraTx (..),
  EraTxBody (..),
  EraTxOut (..),
  EraTxWits (..),
  InjectRuleFailure (..),
  SafeHash,
  SafeToHash (..),
  ppCoinsPerUTxOByteL,
  txIdTx,
 )
import Cardano.Ledger.Conway.Rules (ConwayUtxowPredFailure (..))
import Cardano.Ledger.Credential (Credential (..), StakeReference)
import Cardano.Ledger.Plutus (Language (..), SLanguage (..), hashPlutusScript)
import Cardano.Ledger.TxIn (TxIn (..))
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
  , InjectRuleFailure "LEDGER" ConwayUtxowPredFailure era
  , EraPlutusTxInfo PlutusV2 era
  ) =>
  SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
(ConwayEraImp era,
 InjectRuleFailure "LEDGER" ConwayUtxowPredFailure era,
 EraPlutusTxInfo 'PlutusV2 era) =>
SpecWith (ImpInit (LedgerSpec era))
spec = 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
    Tx era
fixedTx <- Tx era -> ImpTestM era (Tx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era -> ImpTestM era (Tx era)
fixupTx (Tx era -> ImpTestM era (Tx era))
-> ImpTestM era (Tx era) -> ImpTestM era (Tx era)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpTestM era (Tx era)
forall era. ConwayEraImp era => ImpTestM era (Tx era)
setupBadPPViewHashTx
    StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash <- ImpM
  (LedgerSpec era)
  (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    Tx era
tx <- StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era -> ImpTestM era (Tx era)
forall era.
ConwayEraImp era =>
StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era -> ImpTestM era (Tx era)
substituteIntegrityHashAndFixWits StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash Tx era
fixedTx
    StrictMaybe (SafeHash EraIndependentScriptIntegrity)
scriptIntegrityHash <- Tx era
-> ImpM
     (LedgerSpec era)
     (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall era.
AlonzoEraImp era =>
Tx era
-> ImpTestM
     era (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
computeScriptIntegrityHash Tx era
tx
    String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Submit a transaction with an invalid script integrity hash"
      (ImpTestM era () -> ImpTestM era ())
-> (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era ()
-> ImpTestM era ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImpTestM era () -> ImpTestM era ()
forall era a. ImpTestM era a -> ImpTestM era a
withNoFixup
      (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        Tx era
tx
        [ ConwayUtxowPredFailure era
-> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
ConwayUtxowPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayUtxowPredFailure era
 -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))))
-> (Mismatch
      'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
    -> ConwayUtxowPredFailure era)
-> Mismatch
     'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mismatch
  'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> ConwayUtxowPredFailure era
forall era.
Mismatch
  'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> ConwayUtxowPredFailure era
PPViewHashesDontMatch (Mismatch
   'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
 -> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era))))
-> Mismatch
     'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> Item (NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
forall a b. (a -> b) -> a -> b
$
            Mismatch
              { mismatchSupplied :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchSupplied = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash
              , mismatchExpected :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchExpected = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
scriptIntegrityHash
              }
        ]
  String -> ImpTestM era () -> SpecWith (Arg (ImpTestM era ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it 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
    Tx era
fixedTx <- Tx era -> ImpTestM era (Tx era)
forall era.
(ShelleyEraImp era, HasCallStack) =>
Tx era -> ImpTestM era (Tx era)
fixupTx (Tx era -> ImpTestM era (Tx era))
-> ImpTestM era (Tx era) -> ImpTestM era (Tx era)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ImpTestM era (Tx era)
forall era. ConwayEraImp era => ImpTestM era (Tx era)
setupBadPPViewHashTx
    PParams era
pp <- Lens' (PParams era) (PParams era) -> ImpTestM era (PParams era)
forall era a. EraGov era => Lens' (PParams era) a -> ImpTestM era a
getsPParams (PParams era -> f (PParams era)) -> PParams era -> f (PParams era)
forall a. a -> a
Lens' (PParams era) (PParams era)
id
    StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash <- ImpM
  (LedgerSpec era)
  (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary
    let
      langView :: Set LangDepView
langView = [PParams era -> Language -> LangDepView
forall era.
AlonzoEraPParams era =>
PParams era -> Language -> LangDepView
getLanguageView PParams era
pp Language
PlutusV2]
      scriptIntegrity :: ScriptIntegrity era
scriptIntegrity = forall era.
Redeemers era
-> TxDats era -> Set LangDepView -> ScriptIntegrity era
ScriptIntegrity @era Redeemers era
redeemers TxDats era
dats Set LangDepView
langView
      redeemers :: Redeemers era
redeemers = Tx era
fixedTx Tx era
-> Getting (Redeemers era) (Tx era) (Redeemers era)
-> Redeemers era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (Redeemers era) (TxWits era))
-> Tx era -> Const (Redeemers era) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (Redeemers era) (TxWits era))
 -> Tx era -> Const (Redeemers era) (Tx era))
-> ((Redeemers era -> Const (Redeemers era) (Redeemers era))
    -> TxWits era -> Const (Redeemers era) (TxWits era))
-> Getting (Redeemers era) (Tx 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 :: TxDats era
dats = Tx era
fixedTx Tx era -> Getting (TxDats era) (Tx era) (TxDats era) -> TxDats era
forall s a. s -> Getting a s a -> a
^. (TxWits era -> Const (TxDats era) (TxWits era))
-> Tx era -> Const (TxDats era) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Const (TxDats era) (TxWits era))
 -> Tx era -> Const (TxDats era) (Tx era))
-> ((TxDats era -> Const (TxDats era) (TxDats era))
    -> TxWits era -> Const (TxDats era) (TxWits era))
-> Getting (TxDats era) (Tx 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 era
tx <- StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era -> ImpTestM era (Tx era)
forall era.
ConwayEraImp era =>
StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era -> ImpTestM era (Tx era)
substituteIntegrityHashAndFixWits StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash Tx era
fixedTx
    StrictMaybe (SafeHash EraIndependentScriptIntegrity)
scriptIntegrityHash <- Tx era
-> ImpM
     (LedgerSpec era)
     (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall era.
AlonzoEraImp era =>
Tx era
-> ImpTestM
     era (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
computeScriptIntegrityHash Tx era
tx
    let
      mismatch :: Mismatch r (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
mismatch =
        Mismatch
          { mismatchSupplied :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchSupplied = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
badScriptIntegrityHash
          , mismatchExpected :: StrictMaybe (SafeHash EraIndependentScriptIntegrity)
mismatchExpected = StrictMaybe (SafeHash EraIndependentScriptIntegrity)
scriptIntegrityHash
          }
    String -> ImpTestM era () -> ImpTestM era ()
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Submit a transaction with an invalid script integrity hash"
      (ImpTestM era () -> ImpTestM era ())
-> (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era ()
-> ImpTestM era ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImpTestM era () -> ImpTestM era ()
forall era a. ImpTestM era a -> ImpTestM era a
withNoFixup
      (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx
        Tx era
tx
        [ ConwayUtxowPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ConwayUtxowPredFailure era -> EraRuleFailure "LEDGER" era)
-> ConwayUtxowPredFailure era -> EraRuleFailure "LEDGER" era
forall a b. (a -> b) -> a -> b
$ Mismatch
  'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> StrictMaybe ByteString -> ConwayUtxowPredFailure era
forall era.
Mismatch
  'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
-> StrictMaybe ByteString -> ConwayUtxowPredFailure era
ScriptIntegrityHashMismatch Mismatch
  'RelEQ (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
forall {r :: Relation}.
Mismatch r (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
mismatch (ByteString -> StrictMaybe ByteString
forall a. a -> StrictMaybe a
SJust (ByteString -> StrictMaybe ByteString)
-> ByteString -> StrictMaybe ByteString
forall a b. (a -> b) -> a -> b
$ ScriptIntegrity era -> ByteString
forall t. SafeToHash t => t -> ByteString
originalBytes ScriptIntegrity era
scriptIntegrity)
        ]

setupBadPPViewHashTx ::
  forall era.
  ConwayEraImp era =>
  ImpTestM era (Tx era)
setupBadPPViewHashTx :: forall era. ConwayEraImp era => ImpTestM era (Tx era)
setupBadPPViewHashTx = 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
.~ Coin -> CoinPerByte
CoinPerByte (Integer -> Coin
Coin Integer
1)
  StakeReference
someKeyHash <- forall a (m :: * -> *). (Arbitrary a, MonadGen m) => m a
arbitrary @StakeReference
  let scriptTxOut :: TxOut era
scriptTxOut =
        Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut
          ( Network -> PaymentCredential -> StakeReference -> Addr
Addr
              Network
Testnet
              (ScriptHash -> PaymentCredential
forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj (Plutus 'PlutusV2 -> ScriptHash
forall (l :: Language). PlutusLanguage l => Plutus l -> ScriptHash
hashPlutusScript (Plutus 'PlutusV2 -> ScriptHash) -> Plutus 'PlutusV2 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> Plutus 'PlutusV2
forall (l :: Language). SLanguage l -> Plutus l
alwaysSucceedsWithDatum SLanguage 'PlutusV2
SPlutusV2))
              StakeReference
someKeyHash
          )
          (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)
  Tx era
scriptTxIn <-
    String -> ImpTestM era (Tx era) -> ImpTestM era (Tx era)
forall a t. NFData a => String -> ImpM t a -> ImpM t a
impAnn String
"Submit a transaction that has a script output"
      (ImpTestM era (Tx era) -> ImpTestM era (Tx era))
-> (Tx era -> ImpTestM era (Tx era))
-> Tx era
-> ImpTestM era (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx era -> ImpTestM era (Tx era)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
submitTx
      (Tx era -> ImpTestM era (Tx era))
-> Tx era -> ImpTestM era (Tx era)
forall a b. (a -> b) -> a -> b
$ TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
        Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> Tx era -> Identity (Tx era))
-> StrictSeq (TxOut era) -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Item (StrictSeq (TxOut era))
TxOut era
scriptTxOut]
  Tx era -> ImpTestM era (Tx era)
forall a. a -> ImpM (LedgerSpec era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tx era -> ImpTestM era (Tx era))
-> Tx era -> ImpTestM era (Tx era)
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
mkBasicTx TxBody era
forall era. EraTxBody era => TxBody era
mkBasicTxBody
      Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((Set TxIn -> Identity (Set TxIn))
    -> TxBody era -> Identity (TxBody era))
-> (Set TxIn -> Identity (Set TxIn))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL ((Set TxIn -> Identity (Set TxIn)) -> Tx era -> Identity (Tx era))
-> Set TxIn -> Tx era -> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TxId -> TxIx -> TxIn
TxIn (Tx era -> TxId
forall era. EraTx era => Tx era -> TxId
txIdTx Tx era
scriptTxIn) (Word16 -> TxIx
TxIx Word16
0)]

substituteIntegrityHashAndFixWits ::
  forall era.
  ConwayEraImp era =>
  StrictMaybe (SafeHash EraIndependentScriptIntegrity) ->
  Tx era ->
  ImpTestM era (Tx era)
substituteIntegrityHashAndFixWits :: forall era.
ConwayEraImp era =>
StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era -> ImpTestM era (Tx era)
substituteIntegrityHashAndFixWits StrictMaybe (SafeHash EraIndependentScriptIntegrity)
hash Tx era
tx =
  let txWithNewHash :: Tx era
txWithNewHash =
        Tx era
tx
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxBody era -> Identity (TxBody era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Identity (TxBody era))
 -> Tx era -> Identity (Tx era))
-> ((StrictMaybe (SafeHash EraIndependentScriptIntegrity)
     -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
    -> TxBody era -> Identity (TxBody era))
-> (StrictMaybe (SafeHash EraIndependentScriptIntegrity)
    -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
-> Tx era
-> Identity (Tx era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictMaybe (SafeHash EraIndependentScriptIntegrity)
 -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
-> TxBody era -> Identity (TxBody era)
forall era.
AlonzoEraTxBody era =>
Lens'
  (TxBody era) (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
Lens'
  (TxBody era) (StrictMaybe (SafeHash EraIndependentScriptIntegrity))
scriptIntegrityHashTxBodyL ((StrictMaybe (SafeHash EraIndependentScriptIntegrity)
  -> Identity (StrictMaybe (SafeHash EraIndependentScriptIntegrity)))
 -> Tx era -> Identity (Tx era))
-> StrictMaybe (SafeHash EraIndependentScriptIntegrity)
-> Tx era
-> Tx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (SafeHash EraIndependentScriptIntegrity)
hash
          Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> TxWits era -> Tx era -> Tx 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 era -> ImpTestM era (Tx era)
forall era. AlonzoEraImp era => Tx era -> ImpTestM era (Tx era)
fixupScriptWits Tx era
txWithNewHash
        ImpTestM era (Tx era)
-> (Tx era -> ImpTestM era (Tx era)) -> ImpTestM era (Tx 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 era -> ImpTestM era (Tx era)
forall era.
(HasCallStack, AlonzoEraImp era) =>
Tx era -> ImpTestM era (Tx era)
fixupDatums
        ImpTestM era (Tx era)
-> (Tx era -> ImpTestM era (Tx era)) -> ImpTestM era (Tx 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 era -> ImpTestM era (Tx era)
forall era.
(AlonzoEraImp era, HasCallStack) =>
Tx era -> ImpTestM era (Tx era)
fixupRedeemers
        ImpTestM era (Tx era)
-> (Tx era -> ImpTestM era (Tx era)) -> ImpTestM era (Tx 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 era -> ImpTestM era (Tx era)
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx era -> ImpTestM era (Tx era)
updateAddrTxWits