{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Test.QuickCheck.ContractModel.ThreatModel.TxModifier where

import Cardano.Api
import Cardano.Api.Shelley
import Cardano.Ledger.Alonzo.Tx qualified as Ledger (indexOf)
import Cardano.Ledger.Alonzo.TxWitness qualified as Ledger
import Cardano.Ledger.Babbage.TxBody qualified as Ledger
import Cardano.Ledger.Serialization qualified as CBOR
import Data.Coerce

import Cardano.Ledger.Alonzo.Scripts qualified as Ledger
import Data.Map qualified as Map
import Data.Maybe
import Data.Maybe.Strict
import Data.Sequence.Strict qualified as Seq
import Data.Set qualified as Set

import Test.QuickCheck.ContractModel.Internal.Common
import Test.QuickCheck.ContractModel.ThreatModel.Cardano.Api

-- | A transaction output paired with its index in the transaction.
data Output = Output { Output -> TxOut CtxTx Era
outputTxOut :: TxOut CtxTx Era
                     , Output -> TxIx
outputIx    :: TxIx }
  deriving Int -> Output -> ShowS
[Output] -> ShowS
Output -> String
(Int -> Output -> ShowS)
-> (Output -> String) -> ([Output] -> ShowS) -> Show Output
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Output] -> ShowS
$cshowList :: [Output] -> ShowS
show :: Output -> String
$cshow :: Output -> String
showsPrec :: Int -> Output -> ShowS
$cshowsPrec :: Int -> Output -> ShowS
Show


-- | A transaction input reference togheter with the corresponding `TxOut` from the `UTxO` set.
data Input = Input { Input -> TxOut CtxUTxO Era
inputTxOut :: TxOut CtxUTxO Era
                   , Input -> TxIn
inputTxIn  :: TxIn }
  deriving Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Show

-- | Functions common to both `Input`s and `Output`s.
class IsInputOrOutput t where
  -- | Change the target address of an input or an output. For outputs this means redirecting an
  --   output to a different address, and for inputs it means modifying the UTxO set, changing the
  --   owner of the given input.
  --
  --   /Note: Does not work for script inputs./
  changeAddressOf :: t -> AddressAny -> TxModifier

  -- | Change the value of an input or an output.
  changeValueOf   :: t -> Value -> TxModifier

  -- | Change the datum on an input or an output.
  changeDatumOf   :: t -> Datum -> TxModifier

  -- | Get the address (pubkey or script address) of an input or an output.
  addressOf       :: t -> AddressAny

  -- | Get the value at an input or an output.
  valueOf         :: t -> Value

instance IsInputOrOutput Output where
  changeAddressOf :: Output -> AddressAny -> TxModifier
changeAddressOf Output
o AddressAny
a = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIx -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeOutput (Output -> TxIx
outputIx Output
o) (AddressAny -> Maybe AddressAny
forall a. a -> Maybe a
Just AddressAny
a) Maybe Value
forall a. Maybe a
Nothing Maybe Datum
forall a. Maybe a
Nothing
  changeValueOf :: Output -> Value -> TxModifier
changeValueOf Output
o Value
v   = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIx -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeOutput (Output -> TxIx
outputIx Output
o) Maybe AddressAny
forall a. Maybe a
Nothing (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v) Maybe Datum
forall a. Maybe a
Nothing
  changeDatumOf :: Output -> Datum -> TxModifier
changeDatumOf Output
o Datum
d   = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIx -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeOutput (Output -> TxIx
outputIx Output
o) Maybe AddressAny
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing (Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
d)
  addressOf :: Output -> AddressAny
addressOf           = TxOut CtxTx Era -> AddressAny
forall ctx. TxOut ctx Era -> AddressAny
addressOfTxOut (TxOut CtxTx Era -> AddressAny)
-> (Output -> TxOut CtxTx Era) -> Output -> AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> TxOut CtxTx Era
outputTxOut
  valueOf :: Output -> Value
valueOf             = TxOut CtxTx Era -> Value
forall ctx. TxOut ctx Era -> Value
valueOfTxOut (TxOut CtxTx Era -> Value)
-> (Output -> TxOut CtxTx Era) -> Output -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Output -> TxOut CtxTx Era
outputTxOut

instance IsInputOrOutput Input where
  changeAddressOf :: Input -> AddressAny -> TxModifier
changeAddressOf Input
i AddressAny
a
    | AddressAny -> Bool
isKeyAddressAny (Input -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Input
i) = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeInput (Input -> TxIn
inputTxIn Input
i) (AddressAny -> Maybe AddressAny
forall a. a -> Maybe a
Just AddressAny
a) Maybe Value
forall a. Maybe a
Nothing Maybe Datum
forall a. Maybe a
Nothing
    | Bool
otherwise                     = String -> TxModifier
forall a. HasCallStack => String -> a
error String
"Cannot changeAddressOf ScriptInput"
  changeValueOf :: Input -> Value -> TxModifier
changeValueOf Input
i Value
v
    | AddressAny -> Bool
isKeyAddressAny (Input -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Input
i) = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeInput (Input -> TxIn
inputTxIn Input
i) Maybe AddressAny
forall a. Maybe a
Nothing (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v) Maybe Datum
forall a. Maybe a
Nothing
    | Bool
otherwise                     = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe Value -> Maybe Datum -> Maybe Redeemer -> TxMod
ChangeScriptInput (Input -> TxIn
inputTxIn Input
i) (Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v) Maybe Datum
forall a. Maybe a
Nothing Maybe Redeemer
forall a. Maybe a
Nothing
  changeDatumOf :: Input -> Datum -> TxModifier
changeDatumOf Input
i Datum
d
    | AddressAny -> Bool
isKeyAddressAny (Input -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Input
i) = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
ChangeInput (Input -> TxIn
inputTxIn Input
i) Maybe AddressAny
forall a. Maybe a
Nothing Maybe Value
forall a. Maybe a
Nothing (Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
d)
    | Bool
otherwise                     = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe Value -> Maybe Datum -> Maybe Redeemer -> TxMod
ChangeScriptInput (Input -> TxIn
inputTxIn Input
i) Maybe Value
forall a. Maybe a
Nothing (Datum -> Maybe Datum
forall a. a -> Maybe a
Just Datum
d) Maybe Redeemer
forall a. Maybe a
Nothing
  addressOf :: Input -> AddressAny
addressOf = TxOut CtxUTxO Era -> AddressAny
forall ctx. TxOut ctx Era -> AddressAny
addressOfTxOut (TxOut CtxUTxO Era -> AddressAny)
-> (Input -> TxOut CtxUTxO Era) -> Input -> AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> TxOut CtxUTxO Era
inputTxOut
  valueOf :: Input -> Value
valueOf   = TxOut CtxUTxO Era -> Value
forall ctx. TxOut ctx Era -> Value
valueOfTxOut   (TxOut CtxUTxO Era -> Value)
-> (Input -> TxOut CtxUTxO Era) -> Input -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Input -> TxOut CtxUTxO Era
inputTxOut

-- | Type synonym for datums. The `CtxTx` context means that the actual datum value can be present,
--   not just the hash.
type Datum    = TxOutDatum CtxTx Era

-- | Redeemers are plain `ScriptData`.
type Redeemer = ScriptData

-- | The type of transaction modifiers. When combined using the monoid instance, individual
--   modifications are applied in left-to-right order.
newtype TxModifier = TxModifier [TxMod]
  deriving newtype (b -> TxModifier -> TxModifier
NonEmpty TxModifier -> TxModifier
TxModifier -> TxModifier -> TxModifier
(TxModifier -> TxModifier -> TxModifier)
-> (NonEmpty TxModifier -> TxModifier)
-> (forall b. Integral b => b -> TxModifier -> TxModifier)
-> Semigroup TxModifier
forall b. Integral b => b -> TxModifier -> TxModifier
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> TxModifier -> TxModifier
$cstimes :: forall b. Integral b => b -> TxModifier -> TxModifier
sconcat :: NonEmpty TxModifier -> TxModifier
$csconcat :: NonEmpty TxModifier -> TxModifier
<> :: TxModifier -> TxModifier -> TxModifier
$c<> :: TxModifier -> TxModifier -> TxModifier
Semigroup, Semigroup TxModifier
TxModifier
Semigroup TxModifier
-> TxModifier
-> (TxModifier -> TxModifier -> TxModifier)
-> ([TxModifier] -> TxModifier)
-> Monoid TxModifier
[TxModifier] -> TxModifier
TxModifier -> TxModifier -> TxModifier
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [TxModifier] -> TxModifier
$cmconcat :: [TxModifier] -> TxModifier
mappend :: TxModifier -> TxModifier -> TxModifier
$cmappend :: TxModifier -> TxModifier -> TxModifier
mempty :: TxModifier
$cmempty :: TxModifier
$cp1Monoid :: Semigroup TxModifier
Monoid)

data TxMod where

  RemoveInput    :: TxIn
                 -> TxMod

  RemoveOutput   :: TxIx
                 -> TxMod

  ChangeOutput :: TxIx -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod
  ChangeInput  :: TxIn -> Maybe AddressAny -> Maybe Value -> Maybe Datum -> TxMod

  ChangeScriptInput :: TxIn
                    -> Maybe Value
                    -> Maybe Datum
                    -> Maybe Redeemer
                    -> TxMod

  ChangeValidityRange :: Maybe (TxValidityLowerBound Era)
                      -> Maybe (TxValidityUpperBound Era)
                      -> TxMod

  AddOutput :: AddressAny -> Value -> Datum -> TxMod
  AddInput  :: AddressAny -> Value -> Datum -> TxMod

  AddPlutusScriptInput :: PlutusScript PlutusScriptV2
                       -> Value
                       -> Datum
                       -> Redeemer
                       -> TxMod


  AddSimpleScriptInput :: SimpleScript SimpleScriptV2
                       -> Value
                       -> TxMod

  ReplaceTx :: Tx Era -> UTxO Era -> TxMod

  deriving stock (Int -> TxMod -> ShowS
[TxMod] -> ShowS
TxMod -> String
(Int -> TxMod -> ShowS)
-> (TxMod -> String) -> ([TxMod] -> ShowS) -> Show TxMod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxMod] -> ShowS
$cshowList :: [TxMod] -> ShowS
show :: TxMod -> String
$cshow :: TxMod -> String
showsPrec :: Int -> TxMod -> ShowS
$cshowsPrec :: Int -> TxMod -> ShowS
Show)

txMod :: TxMod -> TxModifier
txMod :: TxMod -> TxModifier
txMod TxMod
m = [TxMod] -> TxModifier
TxModifier [TxMod
m]

applyTxModifier :: Tx Era -> UTxO Era -> TxModifier -> (Tx Era, UTxO Era)
applyTxModifier :: Tx Era -> UTxO Era -> TxModifier -> (Tx Era, UTxO Era)
applyTxModifier Tx Era
tx UTxO Era
utxos (TxModifier [TxMod]
ms) = ((Tx Era, UTxO Era) -> TxMod -> (Tx Era, UTxO Era))
-> (Tx Era, UTxO Era) -> [TxMod] -> (Tx Era, UTxO Era)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Tx Era -> UTxO Era -> TxMod -> (Tx Era, UTxO Era))
-> (Tx Era, UTxO Era) -> TxMod -> (Tx Era, UTxO Era)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Tx Era -> UTxO Era -> TxMod -> (Tx Era, UTxO Era)
applyTxMod) (Tx Era
tx, UTxO Era
utxos) [TxMod]
ms

applyTxMod :: Tx Era -> UTxO Era -> TxMod -> (Tx Era, UTxO Era)

applyTxMod :: Tx Era -> UTxO Era -> TxMod -> (Tx Era, UTxO Era)
applyTxMod Tx Era
tx UTxO Era
utxos (ChangeValidityRange Maybe (TxValidityLowerBound Era)
mlo Maybe (TxValidityUpperBound Era)
mhi) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{txvldt :: ValidityInterval
Ledger.txvldt=ValidityInterval
validity'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
scriptValidity) [KeyWitness Era]
wits, UTxO Era
utxos)
  where
    Tx bdy :: TxBody Era
bdy@(ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
body [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
scriptValidity) [KeyWitness Era]
wits = Tx Era
tx
    TxBody TxBodyContent{txValidityRange :: forall build era.
TxBodyContent build era
-> (TxValidityLowerBound era, TxValidityUpperBound era)
txValidityRange = (TxValidityLowerBound Era
lo, TxValidityUpperBound Era
hi)} = TxBody Era
bdy
    validity' :: ValidityInterval
validity' = (TxValidityLowerBound Era, TxValidityUpperBound Era)
-> ValidityInterval
forall era.
(TxValidityLowerBound era, TxValidityUpperBound era)
-> ValidityInterval
convValidityInterval (TxValidityLowerBound Era
-> Maybe (TxValidityLowerBound Era) -> TxValidityLowerBound Era
forall a. a -> Maybe a -> a
fromMaybe TxValidityLowerBound Era
lo Maybe (TxValidityLowerBound Era)
mlo, TxValidityUpperBound Era
-> Maybe (TxValidityUpperBound Era) -> TxValidityUpperBound Era
forall a. a -> Maybe a -> a
fromMaybe TxValidityUpperBound Era
hi Maybe (TxValidityUpperBound Era)
mhi)

applyTxMod Tx Era
tx UTxO Era
utxos (RemoveInput TxIn
i) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{inputs :: Set (TxIn (Crypto (BabbageEra StandardCrypto)))
Ledger.inputs = Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos)
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    inputs' :: Set (TxIn StandardCrypto)
inputs' = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> Set (TxIn StandardCrypto)
forall a. Ord a => a -> Set a -> Set a
Set.delete (TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
i) Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs
    SJust Word64
idx = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
Ledger.indexOf (TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
i) Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs
    idxUpdate :: Word64 -> Word64
idxUpdate Word64
idx'
      | Word64
idx' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
idx = Word64
idx' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1
      | Bool
otherwise  = Word64
idx'
    scriptData' :: TxBodyScriptData Era
scriptData' = Maybe Word64
-> (Word64 -> Word64)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
recomputeScriptData (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
idx) Word64 -> Word64
idxUpdate TxBodyScriptData Era
scriptData

applyTxMod Tx Era
tx UTxO Era
utxos (RemoveOutput (TxIx Word
i)) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{outputs :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
Ledger.outputs = StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos)
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    outputs' :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs' = case Int
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))),
    StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))))
forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
Seq.splitAt (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
i) StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs of
                 (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
before, Sized (TxOut (BabbageEra StandardCrypto))
_ Seq.:<| StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
after) -> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
before StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a. Semigroup a => a -> a -> a
<> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
after
                 (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
_, StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
Seq.Empty)            -> String -> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a. HasCallStack => String -> a
error (String -> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))))
-> String -> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a b. (a -> b) -> a -> b
$ String
"RemoveOutput: Can't remove index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" from "
                                                   String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))) -> Int
forall a. StrictSeq a -> Int
Seq.length StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" outputs"

applyTxMod Tx Era
tx UTxO Era
utxos (AddOutput AddressAny
addr Value
value Datum
datum) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{outputs :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
Ledger.outputs = StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos)
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    outputs' :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs' = StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> Sized (TxOut (BabbageEra StandardCrypto))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a. StrictSeq a -> a -> StrictSeq a
Seq.:|> TxOut (BabbageEra StandardCrypto)
-> Sized (TxOut (BabbageEra StandardCrypto))
forall a. ToCBOR a => a -> Sized a
CBOR.mkSized TxOut (BabbageEra StandardCrypto)
TxOut (BabbageEra StandardCrypto)
out
    out :: TxOut (BabbageEra StandardCrypto)
out = ShelleyBasedEra Era
-> TxOut CtxUTxO Era -> TxOut (BabbageEra StandardCrypto)
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (AddressAny
-> Value -> Datum -> ReferenceScript Era -> TxOut CtxUTxO Era
makeTxOut AddressAny
addr Value
value Datum
datum ReferenceScript Era
forall era. ReferenceScript era
ReferenceScriptNone)
    scriptData' :: TxBodyScriptData Era
scriptData' = case Datum
datum of
      Datum
TxOutDatumNone       -> TxBodyScriptData Era
scriptData
      TxOutDatumHash{}     -> TxBodyScriptData Era
scriptData
      TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d   -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData
      TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData

applyTxMod Tx Era
tx UTxO Era
utxos (AddInput AddressAny
addr Value
value Datum
datum) =
    ( TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{inputs :: Set (TxIn (Crypto (BabbageEra StandardCrypto)))
Ledger.inputs = Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData'' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits
    , UTxO Era
utxos' )
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx

    txIn :: TxIn
txIn    = TxId -> TxIx -> TxIn
TxIn TxId
dummyTxId (Word -> TxIx
TxIx Word
txIx)
    txIx :: Word
txIx    = [Word] -> Word
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word] -> Word) -> [Word] -> Word
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: (Word -> Word) -> [Word] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) [ Word
ix | TxIn TxId
txId (TxIx Word
ix) <- Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys (Map TxIn (TxOut CtxUTxO Era) -> [TxIn])
-> Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO Era
utxos, TxId
txId TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
dummyTxId ]
    input :: TxIn StandardCrypto
input   = TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
txIn
    inputs' :: Set (TxIn StandardCrypto)
inputs' = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> Set (TxIn StandardCrypto)
forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn StandardCrypto
input Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs
    SJust Word64
idx = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
Ledger.indexOf TxIn StandardCrypto
input Set (TxIn StandardCrypto)
inputs'

    txOut :: TxOut CtxUTxO Era
txOut   = AddressAny
-> Value -> Datum -> ReferenceScript Era -> TxOut CtxUTxO Era
makeTxOut AddressAny
addr Value
value Datum
datum ReferenceScript Era
forall era. ReferenceScript era
ReferenceScriptNone
    utxos' :: UTxO Era
utxos'  = Map TxIn (TxOut CtxUTxO Era) -> UTxO Era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO Era)
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> UTxO Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
txIn TxOut CtxUTxO Era
txOut (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO (UTxO Era -> UTxO Era) -> UTxO Era -> UTxO Era
forall a b. (a -> b) -> a -> b
$ UTxO Era
utxos

    idxUpdate :: Word64 -> Word64
idxUpdate Word64
idx'
      | Word64
idx' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
idx = Word64
idx' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
      | Bool
otherwise   = Word64
idx'

    scriptData'' :: TxBodyScriptData Era
scriptData'' = case Datum
datum of
      Datum
TxOutDatumNone       -> TxBodyScriptData Era
scriptData'
      TxOutDatumHash{}     -> TxBodyScriptData Era
scriptData'
      TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d   -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData'
      TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData'

    scriptData' :: TxBodyScriptData Era
scriptData' = Maybe Word64
-> (Word64 -> Word64)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
recomputeScriptData Maybe Word64
forall a. Maybe a
Nothing Word64 -> Word64
idxUpdate TxBodyScriptData Era
scriptData

applyTxMod Tx Era
tx UTxO Era
utxos (AddPlutusScriptInput PlutusScript PlutusScriptV2
script Value
value Datum
datum Redeemer
redeemer) =
    ( TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{inputs :: Set (TxIn (Crypto (BabbageEra StandardCrypto)))
Ledger.inputs = Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs'} [Script (BabbageEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts' TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits
    , UTxO Era
utxos' )
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx

    txIx :: Word
txIx   = [Word] -> Word
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word] -> Word) -> [Word] -> Word
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: (Word -> Word) -> [Word] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) [ Word
ix | TxIn TxId
txId (TxIx Word
ix) <- Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys (Map TxIn (TxOut CtxUTxO Era) -> [TxIn])
-> Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO Era
utxos, TxId
txId TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
dummyTxId ]
    txIn :: TxIn
txIn   = TxId -> TxIx -> TxIn
TxIn TxId
dummyTxId (Word -> TxIx
TxIx Word
txIx)
    input :: TxIn StandardCrypto
input  = TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
txIn
    inputs' :: Set (TxIn StandardCrypto)
inputs' = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> Set (TxIn StandardCrypto)
forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn StandardCrypto
input Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs

    txOut :: TxOut CtxUTxO Era
txOut  = AddressAny
-> Value -> Datum -> ReferenceScript Era -> TxOut CtxUTxO Era
makeTxOut AddressAny
addr Value
value Datum
datum ReferenceScript Era
forall era. ReferenceScript era
ReferenceScriptNone
    utxos' :: UTxO Era
utxos' = Map TxIn (TxOut CtxUTxO Era) -> UTxO Era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO Era)
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> UTxO Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
txIn TxOut CtxUTxO Era
txOut (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO (UTxO Era -> UTxO Era) -> UTxO Era -> UTxO Era
forall a b. (a -> b) -> a -> b
$ UTxO Era
utxos

    scriptInEra :: ScriptInEra Era
scriptInEra = ScriptLanguageInEra PlutusScriptV2 Era
-> Script PlutusScriptV2 -> ScriptInEra Era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra PlutusScriptV2 Era
PlutusScriptV2InBabbage
                  (PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 PlutusScript PlutusScriptV2
script)
    newScript :: Script (ShelleyLedgerEra Era)
newScript = ScriptInEra Era -> Script (ShelleyLedgerEra Era)
forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript @Era ScriptInEra Era
scriptInEra
    scripts' :: [Script (BabbageEra StandardCrypto)]
scripts'  = [Script (BabbageEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts [Script (BabbageEra StandardCrypto)]
-> [Script (BabbageEra StandardCrypto)]
-> [Script (BabbageEra StandardCrypto)]
forall a. [a] -> [a] -> [a]
++ [Script (BabbageEra StandardCrypto)
Script (ShelleyLedgerEra Era)
newScript]

    SJust Word64
idx = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
Ledger.indexOf TxIn StandardCrypto
input Set (TxIn StandardCrypto)
inputs'
    idxUpdate :: Word64 -> Word64
idxUpdate Word64
idx'
      | Word64
idx' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
idx = Word64
idx' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
      | Bool
otherwise   = Word64
idx'

    datum' :: Data (BabbageEra StandardCrypto)
datum' = case Datum
datum of
      Datum
TxOutDatumNone       -> String -> Data (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error String
"Bad test!"
      TxOutDatumHash{}     -> String -> Data (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error String
"Bad test!"
      TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d   -> Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d
      TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d -> Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d

    scriptData' :: TxBodyScriptData Era
scriptData' = Word64
-> Data (ShelleyLedgerEra Era)
-> (Data (ShelleyLedgerEra Era), ExUnits)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
addScriptData Word64
idx Data (ShelleyLedgerEra Era)
Data (BabbageEra StandardCrypto)
datum' (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
redeemer, ExecutionUnits -> ExUnits
toAlonzoExUnits (ExecutionUnits -> ExUnits) -> ExecutionUnits -> ExUnits
forall a b. (a -> b) -> a -> b
$ Natural -> Natural -> ExecutionUnits
ExecutionUnits Natural
0 Natural
0)
                (TxBodyScriptData Era -> TxBodyScriptData Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
forall a b. (a -> b) -> a -> b
$ Maybe Word64
-> (Word64 -> Word64)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
recomputeScriptData Maybe Word64
forall a. Maybe a
Nothing Word64 -> Word64
idxUpdate TxBodyScriptData Era
scriptData

    hash :: ScriptHash
hash = Script PlutusScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script PlutusScriptV2 -> ScriptHash)
-> Script PlutusScriptV2 -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion PlutusScriptV2
-> PlutusScript PlutusScriptV2 -> Script PlutusScriptV2
forall lang.
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion PlutusScriptV2
PlutusScriptV2 PlutusScript PlutusScriptV2
script
    addr :: AddressAny
addr = ScriptHash -> AddressAny
scriptAddressAny ScriptHash
hash

applyTxMod Tx Era
tx UTxO Era
utxos (AddSimpleScriptInput SimpleScript SimpleScriptV2
script Value
value) =
    ( TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{inputs :: Set (TxIn (Crypto (BabbageEra StandardCrypto)))
Ledger.inputs = Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs'} [Script (BabbageEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts' TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits
    , UTxO Era
utxos' )
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx

    txIx :: Word
txIx   = [Word] -> Word
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word] -> Word) -> [Word] -> Word
forall a b. (a -> b) -> a -> b
$ Word
0 Word -> [Word] -> [Word]
forall a. a -> [a] -> [a]
: (Word -> Word) -> [Word] -> [Word]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1) [ Word
ix | TxIn TxId
txId (TxIx Word
ix) <- Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys (Map TxIn (TxOut CtxUTxO Era) -> [TxIn])
-> Map TxIn (TxOut CtxUTxO Era) -> [TxIn]
forall a b. (a -> b) -> a -> b
$ UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO Era
utxos, TxId
txId TxId -> TxId -> Bool
forall a. Eq a => a -> a -> Bool
== TxId
dummyTxId ]
    txIn :: TxIn
txIn   = TxId -> TxIx -> TxIn
TxIn TxId
dummyTxId (Word -> TxIx
TxIx Word
txIx)
    input :: TxIn StandardCrypto
input  = TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
txIn
    inputs' :: Set (TxIn StandardCrypto)
inputs' = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> Set (TxIn StandardCrypto)
forall a. Ord a => a -> Set a -> Set a
Set.insert TxIn StandardCrypto
input Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs

    txOut :: TxOut CtxUTxO Era
txOut  = AddressAny
-> Value -> Datum -> ReferenceScript Era -> TxOut CtxUTxO Era
makeTxOut AddressAny
addr Value
value Datum
forall ctx era. TxOutDatum ctx era
TxOutDatumNone ReferenceScript Era
forall era. ReferenceScript era
ReferenceScriptNone
    utxos' :: UTxO Era
utxos' = Map TxIn (TxOut CtxUTxO Era) -> UTxO Era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO Era)
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> UTxO Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
txIn TxOut CtxUTxO Era
txOut (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO (UTxO Era -> UTxO Era) -> UTxO Era -> UTxO Era
forall a b. (a -> b) -> a -> b
$ UTxO Era
utxos

    scriptInEra :: ScriptInEra Era
scriptInEra = ScriptLanguageInEra SimpleScriptV2 Era
-> Script SimpleScriptV2 -> ScriptInEra Era
forall lang era.
ScriptLanguageInEra lang era -> Script lang -> ScriptInEra era
ScriptInEra ScriptLanguageInEra SimpleScriptV2 Era
SimpleScriptV2InBabbage
                  (SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 SimpleScript SimpleScriptV2
script)
    newScript :: Script (ShelleyLedgerEra Era)
newScript = ScriptInEra Era -> Script (ShelleyLedgerEra Era)
forall era. ScriptInEra era -> Script (ShelleyLedgerEra era)
toShelleyScript @Era ScriptInEra Era
scriptInEra
    scripts' :: [Script (BabbageEra StandardCrypto)]
scripts'  = [Script (BabbageEra StandardCrypto)]
[Script (ShelleyLedgerEra Era)]
scripts [Script (BabbageEra StandardCrypto)]
-> [Script (BabbageEra StandardCrypto)]
-> [Script (BabbageEra StandardCrypto)]
forall a. [a] -> [a] -> [a]
++ [Script (BabbageEra StandardCrypto)
Script (ShelleyLedgerEra Era)
newScript]

    SJust Word64
idx = TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
Ledger.indexOf TxIn StandardCrypto
input Set (TxIn StandardCrypto)
inputs'
    idxUpdate :: Word64 -> Word64
idxUpdate Word64
idx'
      | Word64
idx' Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
idx = Word64
idx' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1
      | Bool
otherwise   = Word64
idx'

    scriptData' :: TxBodyScriptData Era
scriptData' = Maybe Word64
-> (Word64 -> Word64)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
recomputeScriptData Maybe Word64
forall a. Maybe a
Nothing Word64 -> Word64
idxUpdate TxBodyScriptData Era
scriptData

    addr :: AddressAny
addr = ScriptHash -> AddressAny
scriptAddressAny (ScriptHash -> AddressAny) -> ScriptHash -> AddressAny
forall a b. (a -> b) -> a -> b
$ Script SimpleScriptV2 -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (SimpleScriptVersion SimpleScriptV2
-> SimpleScript SimpleScriptV2 -> Script SimpleScriptV2
forall lang.
SimpleScriptVersion lang -> SimpleScript lang -> Script lang
SimpleScript SimpleScriptVersion SimpleScriptV2
SimpleScriptV2 SimpleScript SimpleScriptV2
script)

applyTxMod Tx Era
tx UTxO Era
utxos (ChangeOutput TxIx
ix Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
TxBody (BabbageEra StandardCrypto)
body{outputs :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
Ledger.outputs = StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs'} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos)
  where
    TxIx (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
idx) = TxIx
ix
    Tx bdy :: TxBody Era
bdy@(ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    TxBody (TxBodyContent{txOuts :: forall build era. TxBodyContent build era -> [TxOut CtxTx era]
txOuts=[TxOut CtxTx Era]
txOuts}) = TxBody Era
bdy
    TxOut (AddressInEra AddressTypeInEra addrtype Era
_ (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny -> AddressAny
addr)) (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue -> Value
value) Datum
datum ReferenceScript Era
rscript = [TxOut CtxTx Era]
txOuts [TxOut CtxTx Era] -> Int -> TxOut CtxTx Era
forall a. [a] -> Int -> a
!! Int
idx
    (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputsStart, Sized (TxOut (BabbageEra StandardCrypto))
_ Seq.:<| StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputsEnd) = Int
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> (StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))),
    StrictSeq (Sized (TxOut (BabbageEra StandardCrypto))))
forall a. Int -> StrictSeq a -> (StrictSeq a, StrictSeq a)
Seq.splitAt Int
idx StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs
    outputs' :: StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputs' = StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputsStart StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a. StrictSeq a -> StrictSeq a -> StrictSeq a
Seq.>< (TxOut (BabbageEra StandardCrypto)
-> Sized (TxOut (BabbageEra StandardCrypto))
forall a. ToCBOR a => a -> Sized a
CBOR.mkSized TxOut (BabbageEra StandardCrypto)
TxOut (BabbageEra StandardCrypto)
out Sized (TxOut (BabbageEra StandardCrypto))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
-> StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
forall a. a -> StrictSeq a -> StrictSeq a
Seq.:<| StrictSeq (Sized (TxOut (BabbageEra StandardCrypto)))
outputsEnd)
    out :: TxOut (BabbageEra StandardCrypto)
out = ShelleyBasedEra Era
-> TxOut CtxUTxO Era -> TxOut (BabbageEra StandardCrypto)
forall era ledgerera.
(ShelleyLedgerEra era ~ ledgerera) =>
ShelleyBasedEra era -> TxOut CtxUTxO era -> TxOut ledgerera
toShelleyTxOut ShelleyBasedEra Era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra (AddressAny
-> Value -> Datum -> ReferenceScript Era -> TxOut CtxUTxO Era
makeTxOut (AddressAny -> Maybe AddressAny -> AddressAny
forall a. a -> Maybe a -> a
fromMaybe AddressAny
addr Maybe AddressAny
maddr)
                                                    (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
value Maybe Value
mvalue)
                                                    (Datum -> Maybe Datum -> Datum
forall a. a -> Maybe a -> a
fromMaybe Datum
datum Maybe Datum
mdatum)
                                                    ReferenceScript Era
rscript)
    scriptData' :: TxBodyScriptData Era
scriptData' = case Maybe Datum
mdatum of
      Maybe Datum
Nothing -> TxBodyScriptData Era
scriptData
      Just Datum
d -> case Datum
d of
        Datum
TxOutDatumNone       -> TxBodyScriptData Era
scriptData
        TxOutDatumHash{}     -> TxBodyScriptData Era
scriptData
        TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d   -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData
        TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData


applyTxMod Tx Era
tx UTxO Era
utxos (ChangeInput TxIn
txIn Maybe AddressAny
maddr Maybe Value
mvalue Maybe Datum
mdatum) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
body [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos')
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
body [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    (AddressAny
addr, Value
value, TxOutDatum CtxUTxO Era
utxoDatum, ReferenceScript Era
rscript) = case TxIn -> Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn (Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era))
-> Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO Era
utxos of
      Just (TxOut (AddressInEra AddressTypeInEra addrtype Era
_ (Address addrtype -> AddressAny
forall addr. Address addr -> AddressAny
toAddressAny -> AddressAny
addr)) (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue -> Value
value) TxOutDatum CtxUTxO Era
datum ReferenceScript Era
rscript) ->
        (AddressAny
addr, Value
value, TxOutDatum CtxUTxO Era
datum, ReferenceScript Era
rscript)
      Maybe (TxOut CtxUTxO Era)
Nothing -> String
-> (AddressAny, Value, TxOutDatum CtxUTxO Era, ReferenceScript Era)
forall a. HasCallStack => String -> a
error (String
 -> (AddressAny, Value, TxOutDatum CtxUTxO Era,
     ReferenceScript Era))
-> String
-> (AddressAny, Value, TxOutDatum CtxUTxO Era, ReferenceScript Era)
forall a b. (a -> b) -> a -> b
$ String
"Index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxIn -> String
forall a. Show a => a -> String
show TxIn
txIn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" doesn't exist."

    txOut :: TxOut CtxUTxO Era
txOut = AddressInEra Era
-> TxOutValue Era
-> TxOutDatum CtxUTxO Era
-> ReferenceScript Era
-> TxOut CtxUTxO Era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut (AddressAny -> AddressInEra Era
forall era. IsShelleyBasedEra era => AddressAny -> AddressInEra era
anyAddressInShelleyBasedEra (AddressAny -> Maybe AddressAny -> AddressAny
forall a. a -> Maybe a -> a
fromMaybe AddressAny
addr Maybe AddressAny
maddr))
                  (MultiAssetSupportedInEra Era -> Value -> TxOutValue Era
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra Era
MultiAssetInBabbageEra (Value -> TxOutValue Era) -> Value -> TxOutValue Era
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
value Maybe Value
mvalue)
                  (TxOutDatum CtxUTxO Era
-> Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era
forall a. a -> Maybe a -> a
fromMaybe TxOutDatum CtxUTxO Era
utxoDatum (Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era)
-> Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era
forall a b. (a -> b) -> a -> b
$ Datum -> TxOutDatum CtxUTxO Era
toCtxUTxODatum (Datum -> TxOutDatum CtxUTxO Era)
-> Maybe Datum -> Maybe (TxOutDatum CtxUTxO Era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Datum
mdatum)
                  ReferenceScript Era
rscript
    utxos' :: UTxO Era
utxos' = Map TxIn (TxOut CtxUTxO Era) -> UTxO Era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO Era)
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> UTxO Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
txIn TxOut CtxUTxO Era
txOut (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO (UTxO Era -> UTxO Era) -> UTxO Era -> UTxO Era
forall a b. (a -> b) -> a -> b
$ UTxO Era
utxos

    scriptData' :: TxBodyScriptData Era
scriptData' = case Maybe Datum
mdatum of
      Maybe Datum
Nothing                     -> TxBodyScriptData Era
scriptData
      Just Datum
TxOutDatumNone         -> TxBodyScriptData Era
scriptData
      Just TxOutDatumHash{}       -> TxBodyScriptData Era
scriptData
      Just (TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d)   -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData
      Just (TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d) -> Data (ShelleyLedgerEra Era)
-> TxBodyScriptData Era -> TxBodyScriptData Era
addDatum (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d) TxBodyScriptData Era
scriptData

applyTxMod Tx Era
tx UTxO Era
utxos (ChangeScriptInput TxIn
txIn Maybe Value
mvalue Maybe Datum
mdatum Maybe Redeemer
mredeemer) =
    (TxBody Era -> [KeyWitness Era] -> Tx Era
forall era. TxBody era -> [KeyWitness era] -> Tx era
Tx (ShelleyBasedEra Era
-> TxBody (ShelleyLedgerEra Era)
-> [Script (ShelleyLedgerEra Era)]
-> TxBodyScriptData Era
-> Maybe (AuxiliaryData (ShelleyLedgerEra Era))
-> TxScriptValidity Era
-> TxBody Era
forall era.
ShelleyBasedEra era
-> TxBody (ShelleyLedgerEra era)
-> [Script (ShelleyLedgerEra era)]
-> TxBodyScriptData era
-> Maybe (AuxiliaryData (ShelleyLedgerEra era))
-> TxScriptValidity era
-> TxBody era
ShelleyTxBody ShelleyBasedEra Era
era TxBody (ShelleyLedgerEra Era)
body [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData' Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits, UTxO Era
utxos')
  where
    Tx (ShelleyTxBody ShelleyBasedEra Era
era body :: TxBody (ShelleyLedgerEra Era)
body@Ledger.TxBody{..} [Script (ShelleyLedgerEra Era)]
scripts TxBodyScriptData Era
scriptData Maybe (AuxiliaryData (ShelleyLedgerEra Era))
auxData TxScriptValidity Era
validity) [KeyWitness Era]
wits = Tx Era
tx
    (AddressInEra Era
addr, Value
value, TxOutDatum CtxUTxO Era
utxoDatum, ReferenceScript Era
rscript) = case TxIn -> Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn (Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era))
-> Map TxIn (TxOut CtxUTxO Era) -> Maybe (TxOut CtxUTxO Era)
forall a b. (a -> b) -> a -> b
$ UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO UTxO Era
utxos of
      Just (TxOut AddressInEra Era
addr (TxOutValue Era -> Value
forall era. TxOutValue era -> Value
txOutValueToValue -> Value
value) TxOutDatum CtxUTxO Era
utxoDatum ReferenceScript Era
rscript) ->
        (AddressInEra Era
addr, Value
value, TxOutDatum CtxUTxO Era
utxoDatum, ReferenceScript Era
rscript)
      Maybe (TxOut CtxUTxO Era)
Nothing -> String
-> (AddressInEra Era, Value, TxOutDatum CtxUTxO Era,
    ReferenceScript Era)
forall a. HasCallStack => String -> a
error (String
 -> (AddressInEra Era, Value, TxOutDatum CtxUTxO Era,
     ReferenceScript Era))
-> String
-> (AddressInEra Era, Value, TxOutDatum CtxUTxO Era,
    ReferenceScript Era)
forall a b. (a -> b) -> a -> b
$ String
"The index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TxIn -> String
forall a. Show a => a -> String
show TxIn
txIn String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" doesn't exist."

    (Data (BabbageEra StandardCrypto)
datum, (Data (BabbageEra StandardCrypto)
redeemer, ExUnits
exunits)) = case TxBodyScriptData Era
scriptData of
      TxBodyScriptData Era
TxBodyNoScriptData -> String
-> (Data (BabbageEra StandardCrypto),
    (Data (BabbageEra StandardCrypto), ExUnits))
forall a. HasCallStack => String -> a
error String
"No script data available"
      TxBodyScriptData ScriptDataSupportedInEra Era
_ (Ledger.TxDats dats) (Ledger.Redeemers rdmrs) ->
        (Maybe (Data (BabbageEra StandardCrypto))
-> Data (BabbageEra StandardCrypto)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Data (BabbageEra StandardCrypto))
 -> Data (BabbageEra StandardCrypto))
-> Maybe (Data (BabbageEra StandardCrypto))
-> Data (BabbageEra StandardCrypto)
forall a b. (a -> b) -> a -> b
$ DataHash StandardCrypto
-> Map (DataHash StandardCrypto) (Data (BabbageEra StandardCrypto))
-> Maybe (Data (BabbageEra StandardCrypto))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup DataHash StandardCrypto
utxoDatumHash Map (DataHash StandardCrypto) (Data (BabbageEra StandardCrypto))
Map
  (DataHash (Crypto (BabbageEra StandardCrypto)))
  (Data (BabbageEra StandardCrypto))
dats,
         Maybe (Data (BabbageEra StandardCrypto), ExUnits)
-> (Data (BabbageEra StandardCrypto), ExUnits)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Data (BabbageEra StandardCrypto), ExUnits)
 -> (Data (BabbageEra StandardCrypto), ExUnits))
-> Maybe (Data (BabbageEra StandardCrypto), ExUnits)
-> (Data (BabbageEra StandardCrypto), ExUnits)
forall a b. (a -> b) -> a -> b
$ RdmrPtr
-> Map RdmrPtr (Data (BabbageEra StandardCrypto), ExUnits)
-> Maybe (Data (BabbageEra StandardCrypto), ExUnits)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Tag -> Word64 -> RdmrPtr
Ledger.RdmrPtr Tag
Ledger.Spend Word64
idx) Map RdmrPtr (Data (BabbageEra StandardCrypto), ExUnits)
rdmrs)

    utxoDatumHash :: DataHash StandardCrypto
utxoDatumHash = case TxOutDatum CtxUTxO Era
utxoDatum of
      TxOutDatum CtxUTxO Era
TxOutDatumNone       -> String -> DataHash StandardCrypto
forall a. HasCallStack => String -> a
error String
"No existing datum"
      TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d -> Hash Redeemer -> DataHash StandardCrypto
coerce (Hash Redeemer -> DataHash StandardCrypto)
-> Hash Redeemer -> DataHash StandardCrypto
forall a b. (a -> b) -> a -> b
$ Redeemer -> Hash Redeemer
hashScriptData Redeemer
d
      TxOutDatumHash ScriptDataSupportedInEra Era
_ Hash Redeemer
h   -> Hash Redeemer -> DataHash StandardCrypto
coerce Hash Redeemer
h

    adatum :: Data (BabbageEra StandardCrypto)
adatum = case Maybe Datum
mdatum of
      Just Datum
TxOutDatumNone         -> String -> Data (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error String
"Bad test!"
      Just TxOutDatumHash{}       -> String -> Data (BabbageEra StandardCrypto)
forall a. HasCallStack => String -> a
error String
"Bad test!"
      Just (TxOutDatumInTx ScriptDataSupportedInEra Era
_ Redeemer
d)   -> Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d
      Just (TxOutDatumInline ReferenceTxInsScriptsInlineDatumsSupportedInEra Era
_ Redeemer
d) -> Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData Redeemer
d
      Maybe Datum
Nothing                     -> Data (BabbageEra StandardCrypto)
datum

    txOut :: TxOut CtxUTxO Era
txOut = AddressInEra Era
-> TxOutValue Era
-> TxOutDatum CtxUTxO Era
-> ReferenceScript Era
-> TxOut CtxUTxO Era
forall ctx era.
AddressInEra era
-> TxOutValue era
-> TxOutDatum ctx era
-> ReferenceScript era
-> TxOut ctx era
TxOut AddressInEra Era
addr
                  (MultiAssetSupportedInEra Era -> Value -> TxOutValue Era
forall era. MultiAssetSupportedInEra era -> Value -> TxOutValue era
TxOutValue MultiAssetSupportedInEra Era
MultiAssetInBabbageEra (Value -> TxOutValue Era) -> Value -> TxOutValue Era
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
value Maybe Value
mvalue)
                  (TxOutDatum CtxUTxO Era
-> Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era
forall a. a -> Maybe a -> a
fromMaybe TxOutDatum CtxUTxO Era
utxoDatum (Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era)
-> Maybe (TxOutDatum CtxUTxO Era) -> TxOutDatum CtxUTxO Era
forall a b. (a -> b) -> a -> b
$ Datum -> TxOutDatum CtxUTxO Era
toCtxUTxODatum (Datum -> TxOutDatum CtxUTxO Era)
-> Maybe Datum -> Maybe (TxOutDatum CtxUTxO Era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Datum
mdatum)
                  ReferenceScript Era
rscript

    utxos' :: UTxO Era
utxos' = Map TxIn (TxOut CtxUTxO Era) -> UTxO Era
forall era. Map TxIn (TxOut CtxUTxO era) -> UTxO era
UTxO (Map TxIn (TxOut CtxUTxO Era) -> UTxO Era)
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> UTxO Era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn
-> TxOut CtxUTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
-> Map TxIn (TxOut CtxUTxO Era)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert TxIn
txIn TxOut CtxUTxO Era
txOut (Map TxIn (TxOut CtxUTxO Era) -> Map TxIn (TxOut CtxUTxO Era))
-> (UTxO Era -> Map TxIn (TxOut CtxUTxO Era))
-> UTxO Era
-> Map TxIn (TxOut CtxUTxO Era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTxO Era -> Map TxIn (TxOut CtxUTxO Era)
forall era. UTxO era -> Map TxIn (TxOut CtxUTxO era)
unUTxO (UTxO Era -> UTxO Era) -> UTxO Era -> UTxO Era
forall a b. (a -> b) -> a -> b
$ UTxO Era
utxos

    idx :: Word64
idx = case TxIn StandardCrypto
-> Set (TxIn StandardCrypto) -> StrictMaybe Word64
forall elem container.
Indexable elem container =>
elem -> container -> StrictMaybe Word64
Ledger.indexOf (TxIn -> TxIn StandardCrypto
toShelleyTxIn TxIn
txIn) Set (TxIn StandardCrypto)
Set (TxIn (Crypto (BabbageEra StandardCrypto)))
inputs of
      SJust Word64
idx -> Word64
idx
      StrictMaybe Word64
_         -> String -> Word64
forall a. HasCallStack => String -> a
error String
"The impossible happened!"

    scriptData' :: TxBodyScriptData Era
scriptData' = Word64
-> Data (ShelleyLedgerEra Era)
-> (Data (ShelleyLedgerEra Era), ExUnits)
-> TxBodyScriptData Era
-> TxBodyScriptData Era
addScriptData Word64
idx Data (ShelleyLedgerEra Era)
Data (BabbageEra StandardCrypto)
adatum
                                    (Data (BabbageEra StandardCrypto)
-> Maybe (Data (BabbageEra StandardCrypto))
-> Data (BabbageEra StandardCrypto)
forall a. a -> Maybe a -> a
fromMaybe Data (BabbageEra StandardCrypto)
redeemer (Redeemer -> Data (BabbageEra StandardCrypto)
forall ledgerera. Redeemer -> Data ledgerera
toAlonzoData (Redeemer -> Data (BabbageEra StandardCrypto))
-> Maybe Redeemer -> Maybe (Data (BabbageEra StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Redeemer
mredeemer), ExUnits
exunits)
                                    TxBodyScriptData Era
scriptData

applyTxMod Tx Era
_ UTxO Era
_ (ReplaceTx Tx Era
tx UTxO Era
utxos) = (Tx Era
tx, UTxO Era
utxos)

-- | Add a new output of any type (public key or script)
addOutput :: AddressAny -> Value -> Datum -> TxModifier
addOutput :: AddressAny -> Value -> Datum -> TxModifier
addOutput AddressAny
addr Value
value Datum
datum = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ AddressAny -> Value -> Datum -> TxMod
AddOutput AddressAny
addr Value
value Datum
datum

-- | Remove an output of any type.
removeOutput :: Output -> TxModifier
removeOutput :: Output -> TxModifier
removeOutput Output
output = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIx -> TxMod
RemoveOutput (TxIx -> TxMod) -> TxIx -> TxMod
forall a b. (a -> b) -> a -> b
$ Output -> TxIx
outputIx Output
output

-- | Add a new public key input.
addKeyInput :: AddressAny -> Value -> Datum -> TxModifier
addKeyInput :: AddressAny -> Value -> Datum -> TxModifier
addKeyInput AddressAny
addr Value
value Datum
datum = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ AddressAny -> Value -> Datum -> TxMod
AddInput AddressAny
addr Value
value Datum
datum

-- | Remove an input of any type.
removeInput :: Input -> TxModifier
removeInput :: Input -> TxModifier
removeInput Input
inp = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> TxMod
RemoveInput (TxIn -> TxMod) -> TxIn -> TxMod
forall a b. (a -> b) -> a -> b
$ Input -> TxIn
inputTxIn Input
inp

-- | Add a plutus script input.
addPlutusScriptInput :: PlutusScript PlutusScriptV2 -> Value -> Datum -> Redeemer -> TxModifier
addPlutusScriptInput :: PlutusScript PlutusScriptV2
-> Value -> Datum -> Redeemer -> TxModifier
addPlutusScriptInput PlutusScript PlutusScriptV2
script Value
value Datum
datum Redeemer
redeemer = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ PlutusScript PlutusScriptV2 -> Value -> Datum -> Redeemer -> TxMod
AddPlutusScriptInput PlutusScript PlutusScriptV2
script Value
value Datum
datum Redeemer
redeemer

-- | Add a simple script input.
addSimpleScriptInput :: SimpleScript SimpleScriptV2 -> Value -> TxModifier
addSimpleScriptInput :: SimpleScript SimpleScriptV2 -> Value -> TxModifier
addSimpleScriptInput SimpleScript SimpleScriptV2
script Value
value = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ SimpleScript SimpleScriptV2 -> Value -> TxMod
AddSimpleScriptInput SimpleScript SimpleScriptV2
script Value
value

-- | Change the redeemer of a script input.
changeRedeemerOf :: Input -> Redeemer -> TxModifier
changeRedeemerOf :: Input -> Redeemer -> TxModifier
changeRedeemerOf Input
i Redeemer
r
  | AddressAny -> Bool
isKeyAddressAny (Input -> AddressAny
forall t. IsInputOrOutput t => t -> AddressAny
addressOf Input
i) = String -> TxModifier
forall a. HasCallStack => String -> a
error String
"Cannot changeRedeemerOf public key input"
  | Bool
otherwise                     = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ TxIn -> Maybe Value -> Maybe Datum -> Maybe Redeemer -> TxMod
ChangeScriptInput (Input -> TxIn
inputTxIn Input
i) Maybe Value
forall a. Maybe a
Nothing Maybe Datum
forall a. Maybe a
Nothing (Redeemer -> Maybe Redeemer
forall a. a -> Maybe a
Just Redeemer
r)

-- | Change the validity range of the transaction.
changeValidityRange :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> TxModifier
changeValidityRange :: (TxValidityLowerBound Era, TxValidityUpperBound Era) -> TxModifier
changeValidityRange (TxValidityLowerBound Era
lo, TxValidityUpperBound Era
hi) = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ Maybe (TxValidityLowerBound Era)
-> Maybe (TxValidityUpperBound Era) -> TxMod
ChangeValidityRange (TxValidityLowerBound Era -> Maybe (TxValidityLowerBound Era)
forall a. a -> Maybe a
Just TxValidityLowerBound Era
lo) (TxValidityUpperBound Era -> Maybe (TxValidityUpperBound Era)
forall a. a -> Maybe a
Just TxValidityUpperBound Era
hi)

-- | Change the validity lower bound of the transaction.
changeValidityLowerBound :: TxValidityLowerBound Era -> TxModifier
changeValidityLowerBound :: TxValidityLowerBound Era -> TxModifier
changeValidityLowerBound TxValidityLowerBound Era
lo = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ Maybe (TxValidityLowerBound Era)
-> Maybe (TxValidityUpperBound Era) -> TxMod
ChangeValidityRange (TxValidityLowerBound Era -> Maybe (TxValidityLowerBound Era)
forall a. a -> Maybe a
Just TxValidityLowerBound Era
lo) Maybe (TxValidityUpperBound Era)
forall a. Maybe a
Nothing

-- | Change the validity upper bound of the transaction.
changeValidityUpperBound :: TxValidityUpperBound Era -> TxModifier
changeValidityUpperBound :: TxValidityUpperBound Era -> TxModifier
changeValidityUpperBound TxValidityUpperBound Era
hi = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ Maybe (TxValidityLowerBound Era)
-> Maybe (TxValidityUpperBound Era) -> TxMod
ChangeValidityRange Maybe (TxValidityLowerBound Era)
forall a. Maybe a
Nothing (TxValidityUpperBound Era -> Maybe (TxValidityUpperBound Era)
forall a. a -> Maybe a
Just TxValidityUpperBound Era
hi)

-- | The most general transaction modifier. Simply replace the original transaction and `UTxO` set
--   by the given values. In most cases the modifiers above should be sufficient.
replaceTx :: Tx Era -> UTxO Era -> TxModifier
replaceTx :: Tx Era -> UTxO Era -> TxModifier
replaceTx Tx Era
tx UTxO Era
utxos = TxMod -> TxModifier
txMod (TxMod -> TxModifier) -> TxMod -> TxModifier
forall a b. (a -> b) -> a -> b
$ Tx Era -> UTxO Era -> TxMod
ReplaceTx Tx Era
tx UTxO Era
utxos