{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Babbage.TxInfo (
  BabbageContextError (..),
  transReferenceScript,
  transTxOutV1,
  transTxOutV2,
  transTxInInfoV1,
  transTxInInfoV2,
  transTxRedeemers,
  transRedeemer,
  toPlutusV2Args,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusScriptPurpose,
  toPlutusWithContext,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo (
  AlonzoContextError (..),
  toLegacyPlutusArgs,
 )
import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo
import Cardano.Ledger.Alonzo.Scripts (toAsItem)
import Cardano.Ledger.Alonzo.Tx (Data)
import Cardano.Ledger.Alonzo.TxWits (unRedeemers)
import Cardano.Ledger.Babbage.Core
import Cardano.Ledger.Babbage.Era (BabbageEra)
import Cardano.Ledger.Babbage.Scripts (PlutusScript (..))
import Cardano.Ledger.Babbage.UTxO ()
import Cardano.Ledger.BaseTypes (
  Inject (..),
  ProtVer,
  StrictMaybe (..),
  isSJust,
  kindObject,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data (Datum (..), binaryDataToData, getPlutusData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Cardano.Ledger.Plutus.Language (Language (..), PlutusArgs (..))
import Cardano.Ledger.Plutus.TxInfo (
  TxOutSource (..),
  transAddr,
  transCoinToValue,
  transDataHash,
  transScriptHash,
  transTxIn,
  txOutSourceToText,
 )
import Cardano.Ledger.TxIn (TxIn (..), txInToText)
import Cardano.Ledger.UTxO (UTxO (..))
import Control.Arrow (left)
import Control.DeepSeq (NFData)
import Control.Monad (unless, when, zipWithM)
import Data.Aeson (ToJSON (..), (.=), pattern String)
import Data.Foldable as F (Foldable (..))
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T
import GHC.Generics
import Lens.Micro
import NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2

transReferenceScript ::
  forall era.
  EraScript era =>
  StrictMaybe (Script era) ->
  Maybe PV2.ScriptHash
transReferenceScript :: forall era.
EraScript era =>
StrictMaybe (Script era) -> Maybe ScriptHash
transReferenceScript StrictMaybe (Script era)
SNothing = forall a. Maybe a
Nothing
transReferenceScript (SJust Script era
s) = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. ScriptHash c -> ScriptHash
transScriptHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era forall a b. (a -> b) -> a -> b
$ Script era
s

-- | Given a TxOut, translate it for V2 and return (Right transalation).
-- If the transaction contains any Byron addresses or Babbage features, return Left.
transTxOutV1 ::
  forall era.
  ( Inject (BabbageContextError era) (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  TxOutSource (EraCrypto era) ->
  TxOut era ->
  Either (ContextError era) PV1.TxOut
transTxOutV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 TxOutSource (EraCrypto era)
txOutSource TxOut era
txOut = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. StrictMaybe a -> Bool
isSJust (TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL)) forall a b. (a -> b) -> a -> b
$ do
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported @era TxOutSource (EraCrypto era)
txOutSource
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. StrictMaybe a -> Bool
isSJust (TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Data era))
dataTxOutL)) forall a b. (a -> b) -> a -> b
$ do
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported @era TxOutSource (EraCrypto era)
txOutSource
  case forall era c.
(Value era ~ MaryValue c, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
Alonzo.transTxOut TxOut era
txOut of
    Maybe TxOut
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era TxOutSource (EraCrypto era)
txOutSource
    Just TxOut
plutusTxOut -> forall a b. b -> Either a b
Right TxOut
plutusTxOut

-- | Given a TxOut, translate it for V2 and return (Right transalation). It is
--   possible the address part is a Bootstrap Address, in that case return Left.
transTxOutV2 ::
  forall era.
  ( Inject (BabbageContextError era) (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  TxOutSource (EraCrypto era) ->
  TxOut era ->
  Either (ContextError era) PV2.TxOut
transTxOutV2 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 TxOutSource (EraCrypto era)
txOutSource TxOut era
txOut = do
  let val :: MaryValue (EraCrypto era)
val = TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL
      referenceScript :: Maybe ScriptHash
referenceScript = forall era.
EraScript era =>
StrictMaybe (Script era) -> Maybe ScriptHash
transReferenceScript forall a b. (a -> b) -> a -> b
$ TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL
      datum :: OutputDatum
datum =
        case TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraTxOut era =>
SimpleGetter (TxOut era) (Datum era)
datumTxOutF of
          Datum era
NoDatum -> OutputDatum
PV2.NoOutputDatum
          DatumHash DataHash (EraCrypto era)
dh -> DatumHash -> OutputDatum
PV2.OutputDatumHash forall a b. (a -> b) -> a -> b
$ forall c. DataHash c -> DatumHash
transDataHash DataHash (EraCrypto era)
dh
          Datum BinaryData era
binaryData ->
            Datum -> OutputDatum
PV2.OutputDatum
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
PV2.Datum
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV2.dataToBuiltinData
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Data era -> Data
getPlutusData
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Era era => BinaryData era -> Data era
binaryDataToData
              forall a b. (a -> b) -> a -> b
$ BinaryData era
binaryData
  case forall c. Addr c -> Maybe Address
transAddr (TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
addrTxOutL) of
    Maybe Address
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era TxOutSource (EraCrypto era)
txOutSource
    Just Address
addr ->
      forall a b. b -> Either a b
Right (Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV2.TxOut Address
addr (forall c. MaryValue c -> Value
Alonzo.transValue MaryValue (EraCrypto era)
val) OutputDatum
datum Maybe ScriptHash
referenceScript)

-- | Given a TxIn, look it up in the UTxO. If it exists, translate it to the V1 context
transTxInInfoV1 ::
  forall era.
  ( Inject (BabbageContextError era) (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn (EraCrypto era) ->
  Either (ContextError era) PV1.TxInInfo
transTxInInfoV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO era
utxo TxIn (EraCrypto era)
txIn = do
  TxOut era
txOut <- forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) forall a b. (a -> b) -> a -> b
$ forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn (EraCrypto era) -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn (EraCrypto era)
txIn
  TxOut
plutusTxOut <- forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 (forall c. TxIn c -> TxOutSource c
TxOutFromInput TxIn (EraCrypto era)
txIn) TxOut era
txOut
  forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (forall c. TxIn c -> TxOutRef
transTxIn TxIn (EraCrypto era)
txIn) TxOut
plutusTxOut)

-- | Given a TxIn, look it up in the UTxO. If it exists, translate it to the V2 context
transTxInInfoV2 ::
  forall era.
  ( Inject (BabbageContextError era) (ContextError era)
  , Value era ~ MaryValue (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn (EraCrypto era) ->
  Either (ContextError era) PV2.TxInInfo
transTxInInfoV2 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV2 UTxO era
utxo TxIn (EraCrypto era)
txIn = do
  TxOut era
txOut <- forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) forall a b. (a -> b) -> a -> b
$ forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn (EraCrypto era) -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn (EraCrypto era)
txIn
  TxOut
plutusTxOut <- forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 (forall c. TxIn c -> TxOutSource c
TxOutFromInput TxIn (EraCrypto era)
txIn) TxOut era
txOut
  forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV2.TxInInfo (forall c. TxIn c -> TxOutRef
transTxIn TxIn (EraCrypto era)
txIn) TxOut
plutusTxOut)

transRedeemer :: Data era -> PV2.Redeemer
transRedeemer :: forall era. Data era -> Redeemer
transRedeemer = BuiltinData -> Redeemer
PV2.Redeemer forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV2.dataToBuiltinData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Data era -> Data
getPlutusData

transRedeemerPtr ::
  forall proxy l era.
  ( EraPlutusTxInfo l era
  , AlonzoEraTxBody era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  TxBody era ->
  (PlutusPurpose AsIx era, (Data era, ExUnits)) ->
  Either (ContextError era) (PlutusScriptPurpose l, PV2.Redeemer)
transRedeemerPtr :: forall (proxy :: Language -> *) (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraTxBody era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> TxBody era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPtr proxy l
proxy ProtVer
pv TxBody era
txBody (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
_)) =
  case forall era.
AlonzoEraTxBody era =>
TxBody era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
redeemerPointerInverse TxBody era
txBody PlutusPurpose AsIx era
ptr of
    StrictMaybe (PlutusPurpose AsIxItem era)
SNothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr
    SJust PlutusPurpose AsIxItem era
sp -> do
      PlutusScriptPurpose l
plutusScriptPurpose <- forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
toPlutusScriptPurpose proxy l
proxy ProtVer
pv PlutusPurpose AsIxItem era
sp
      forall a b. b -> Either a b
Right (PlutusScriptPurpose l
plutusScriptPurpose, forall era. Data era -> Redeemer
transRedeemer Data era
d)

-- | Translate all `Redeemers` from within a `Tx` into a Map from a `PlutusScriptPurpose`
-- to a `PV2.Redeemer`
transTxRedeemers ::
  ( EraPlutusTxInfo l era
  , AlonzoEraTxBody era
  , EraTx era
  , AlonzoEraTxWits era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  Tx era ->
  Either (ContextError era) (PV2.Map (PlutusScriptPurpose l) PV2.Redeemer)
transTxRedeemers :: forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, AlonzoEraTxBody era, EraTx era,
 AlonzoEraTxWits era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> Tx era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
transTxRedeemers proxy l
proxy ProtVer
pv Tx era
tx =
  forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
      (forall (proxy :: Language -> *) (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraTxBody era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> TxBody era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPtr proxy l
proxy ProtVer
pv (Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL))
      (forall k a. Map k a -> [(k, a)]
Map.toList (forall era.
Redeemers era -> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
unRedeemers forall a b. (a -> b) -> a -> b
$ Tx era
tx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL))

instance Crypto c => EraPlutusContext (BabbageEra c) where
  type ContextError (BabbageEra c) = BabbageContextError (BabbageEra c)

  mkPlutusWithContext :: PlutusScript (BabbageEra c)
-> ScriptHash (EraCrypto (BabbageEra c))
-> PlutusPurpose AsIxItem (BabbageEra c)
-> LedgerTxInfo (BabbageEra c)
-> (Data (BabbageEra c), ExUnits)
-> CostModel
-> Either
     (ContextError (BabbageEra c))
     (PlutusWithContext (EraCrypto (BabbageEra c)))
mkPlutusWithContext = \case
    BabbagePlutusV1 Plutus 'PlutusV1
p -> forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash (EraCrypto era)
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) (PlutusWithContext (EraCrypto era))
toPlutusWithContext forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plutus 'PlutusV1
p
    BabbagePlutusV2 Plutus 'PlutusV2
p -> forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash (EraCrypto era)
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) (PlutusWithContext (EraCrypto era))
toPlutusWithContext forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plutus 'PlutusV2
p

data BabbageContextError era
  = AlonzoContextError !(AlonzoContextError era)
  | ByronTxOutInContext !(TxOutSource (EraCrypto era))
  | RedeemerPointerPointsToNothing !(PlutusPurpose AsIx era)
  | InlineDatumsNotSupported !(TxOutSource (EraCrypto era))
  | ReferenceScriptsNotSupported !(TxOutSource (EraCrypto era))
  | ReferenceInputsNotSupported !(Set.Set (TxIn (EraCrypto era)))
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (BabbageContextError era) x -> BabbageContextError era
forall era x.
BabbageContextError era -> Rep (BabbageContextError era) x
$cto :: forall era x.
Rep (BabbageContextError era) x -> BabbageContextError era
$cfrom :: forall era x.
BabbageContextError era -> Rep (BabbageContextError era) x
Generic)

deriving instance
  (Eq (AlonzoContextError era), Eq (PlutusPurpose AsIx era)) =>
  Eq (BabbageContextError era)

deriving instance
  (Show (AlonzoContextError era), Show (PlutusPurpose AsIx era)) =>
  Show (BabbageContextError era)

instance NoThunks (PlutusPurpose AsIx era) => NoThunks (BabbageContextError era)

instance (Era era, NFData (PlutusPurpose AsIx era)) => NFData (BabbageContextError era)

instance Inject (AlonzoContextError era) (BabbageContextError era) where
  inject :: AlonzoContextError era -> BabbageContextError era
inject = forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError

instance (Era era, EncCBOR (PlutusPurpose AsIx era)) => EncCBOR (BabbageContextError era) where
  encCBOR :: BabbageContextError era -> Encoding
encCBOR = \case
    ByronTxOutInContext TxOutSource (EraCrypto era)
txOutSource ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum (forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era) Word
0 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource (EraCrypto era)
txOutSource
    AlonzoContextError (TranslationLogicMissingInput TxIn (EraCrypto era)
txIn) ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum (forall era. TxIn (EraCrypto era) -> AlonzoContextError era
TranslationLogicMissingInput @era) Word
1 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxIn (EraCrypto era)
txIn
    RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing Word
2 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PlutusPurpose AsIx era
ptr
    InlineDatumsNotSupported TxOutSource (EraCrypto era)
txOutSource ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum (forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported @era) Word
4 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource (EraCrypto era)
txOutSource
    ReferenceScriptsNotSupported TxOutSource (EraCrypto era)
txOutSource ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum (forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported @era) Word
5 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxOutSource (EraCrypto era)
txOutSource
    ReferenceInputsNotSupported Set (TxIn (EraCrypto era))
txIns ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum (forall era. Set (TxIn (EraCrypto era)) -> BabbageContextError era
ReferenceInputsNotSupported @era) Word
6 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Set (TxIn (EraCrypto era))
txIns
    AlonzoContextError (TimeTranslationPastHorizon Text
err) ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. Text -> AlonzoContextError era
TimeTranslationPastHorizon Word
7 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Text
err

instance (Era era, DecCBOR (PlutusPurpose AsIx era)) => DecCBOR (BabbageContextError era) where
  decCBOR :: forall s. Decoder s (BabbageContextError era)
decCBOR = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ContextError" forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> forall t. t -> Decode 'Open t
SumD forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> forall t. t -> Decode 'Open t
SumD (forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. TxIn (EraCrypto era) -> AlonzoContextError era
TranslationLogicMissingInput) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> forall t. t -> Decode 'Open t
SumD forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> forall t. t -> Decode 'Open t
SumD forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> forall t. t -> Decode 'Open t
SumD forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ReferenceScriptsNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
6 -> forall t. t -> Decode 'Open t
SumD forall era. Set (TxIn (EraCrypto era)) -> BabbageContextError era
ReferenceInputsNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
7 -> forall t. t -> Decode 'Open t
SumD (forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Text -> AlonzoContextError era
TimeTranslationPastHorizon) forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance ToJSON (PlutusPurpose AsIx era) => ToJSON (BabbageContextError era) where
  toJSON :: BabbageContextError era -> Value
toJSON = \case
    AlonzoContextError AlonzoContextError era
err -> forall a. ToJSON a => a -> Value
toJSON AlonzoContextError era
err
    ByronTxOutInContext TxOutSource (EraCrypto era)
txOutSource ->
      Text -> Value
String forall a b. (a -> b) -> a -> b
$ Text
"Byron UTxO being created or spent: " forall a. Semigroup a => a -> a -> a
<> forall c. TxOutSource c -> Text
txOutSourceToText TxOutSource (EraCrypto era)
txOutSource
    RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr ->
      Text -> [Pair] -> Value
kindObject Text
"RedeemerPointerPointsToNothing" [Key
"ptr" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsIx era
ptr]
    InlineDatumsNotSupported TxOutSource (EraCrypto era)
txOutSource ->
      Text -> Value
String forall a b. (a -> b) -> a -> b
$ Text
"Inline datums not supported, output source: " forall a. Semigroup a => a -> a -> a
<> forall c. TxOutSource c -> Text
txOutSourceToText TxOutSource (EraCrypto era)
txOutSource
    ReferenceScriptsNotSupported TxOutSource (EraCrypto era)
txOutSource ->
      Text -> Value
String forall a b. (a -> b) -> a -> b
$ Text
"Reference scripts not supported, output source: " forall a. Semigroup a => a -> a -> a
<> forall c. TxOutSource c -> Text
txOutSourceToText TxOutSource (EraCrypto era)
txOutSource
    ReferenceInputsNotSupported Set (TxIn (EraCrypto era))
txIns ->
      Text -> Value
String forall a b. (a -> b) -> a -> b
$
        Text
"Reference inputs not supported: "
          forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " (forall a b. (a -> b) -> [a] -> [b]
map forall c. TxIn c -> Text
txInToText (forall a. Set a -> [a]
Set.toList Set (TxIn (EraCrypto era))
txIns))

instance Crypto c => EraPlutusTxInfo 'PlutusV1 (BabbageEra c) where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> TxCert (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusTxCert 'PlutusV1)
toPlutusTxCert proxy 'PlutusV1
_ ProtVer
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> DCert
Alonzo.transTxCert

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem (BabbageEra c)
-> Either
     (ContextError (BabbageEra c)) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy ProtVer
pv = forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy 'PlutusV1
proxy ProtVer
pv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo proxy 'PlutusV1
proxy LedgerTxInfo {ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart, UTxO (BabbageEra c)
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO (BabbageEra c)
ltiUTxO, Tx (BabbageEra c)
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx :: Tx (BabbageEra c)
ltiTx} = do
    let refInputs :: Set (TxIn (EraCrypto (BabbageEra c)))
refInputs = TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Set a -> Bool
Set.null Set (TxIn (EraCrypto (BabbageEra c)))
refInputs) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall era. Set (TxIn (EraCrypto era)) -> BabbageContextError era
ReferenceInputsNotSupported Set (TxIn (EraCrypto (BabbageEra c)))
refInputs)

    POSIXTimeRange
timeRange <-
      forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx (BabbageEra c)
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO (BabbageEra c)
ltiUTxO) (forall a. Set a -> [a]
Set.toList (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL))
    [TxOut]
outputs <-
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TxIx -> TxOutSource c
TxOutFromOutput)
        [forall a. Bounded a => a
minBound ..]
        (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL))
    [DCert]
txCerts <- forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
Alonzo.transTxBodyCerts proxy 'PlutusV1
proxy ProtVer
ltiProtVer TxBody (BabbageEra c)
txBody
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PV1.TxInfo
        { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [TxInInfo]
inputs
        , txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = [TxOut]
outputs
        , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV1.txInfoMint = forall c. MultiAsset c -> Value
Alonzo.transMintValue (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody (BabbageEra c)
txBody
        , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody (BabbageEra c)
txBody
        , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx (BabbageEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL)
        , txInfoId :: TxId
PV1.txInfoId = forall era. EraTxBody era => TxBody era -> TxId
Alonzo.transTxBodyId TxBody (BabbageEra c)
txBody
        }
    where
      txBody :: TxBody (BabbageEra c)
txBody = Tx (BabbageEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem (BabbageEra c)
-> Maybe (Data (BabbageEra c))
-> Data (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusArgs 'PlutusV1)
toPlutusArgs = forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV1 era =>
proxy 'PlutusV1
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV1)
Alonzo.toPlutusV1Args

instance Crypto c => EraPlutusTxInfo 'PlutusV2 (BabbageEra c) where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> TxCert (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusTxCert 'PlutusV2)
toPlutusTxCert proxy 'PlutusV2
_ ProtVer
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> DCert
Alonzo.transTxCert

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusPurpose AsIxItem (BabbageEra c)
-> Either
     (ContextError (BabbageEra c)) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose proxy 'PlutusV2
proxy ProtVer
pv = forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy 'PlutusV2
proxy ProtVer
pv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo proxy 'PlutusV2
proxy LedgerTxInfo {ProtVer
ltiProtVer :: ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart, UTxO (BabbageEra c)
ltiUTxO :: UTxO (BabbageEra c)
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx (BabbageEra c)
ltiTx :: Tx (BabbageEra c)
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx} = do
    POSIXTimeRange
timeRange <-
      forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx (BabbageEra c)
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV2 UTxO (BabbageEra c)
ltiUTxO) (forall a. Set a -> [a]
Set.toList (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL))
    [TxInInfo]
refInputs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV2 UTxO (BabbageEra c)
ltiUTxO) (forall a. Set a -> [a]
Set.toList (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL))
    [TxOut]
outputs <-
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TxIx -> TxOutSource c
TxOutFromOutput)
        [forall a. Bounded a => a
minBound ..]
        (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL))
    [DCert]
txCerts <- forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
Alonzo.transTxBodyCerts proxy 'PlutusV2
proxy ProtVer
ltiProtVer TxBody (BabbageEra c)
txBody
    Map ScriptPurpose Redeemer
plutusRedeemers <- forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, AlonzoEraTxBody era, EraTx era,
 AlonzoEraTxWits era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> Tx era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
transTxRedeemers proxy 'PlutusV2
proxy ProtVer
ltiProtVer Tx (BabbageEra c)
ltiTx
    forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PV2.TxInfo
        { txInfoInputs :: [TxInInfo]
PV2.txInfoInputs = [TxInInfo]
inputs
        , txInfoOutputs :: [TxOut]
PV2.txInfoOutputs = [TxOut]
outputs
        , txInfoReferenceInputs :: [TxInInfo]
PV2.txInfoReferenceInputs = [TxInInfo]
refInputs
        , txInfoFee :: Value
PV2.txInfoFee = Coin -> Value
transCoinToValue (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV2.txInfoMint = forall c. MultiAsset c -> Value
Alonzo.transMintValue (TxBody (BabbageEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV2.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: Map StakingCredential Integer
PV2.txInfoWdrl = forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList forall a b. (a -> b) -> a -> b
$ forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody (BabbageEra c)
txBody
        , txInfoValidRange :: POSIXTimeRange
PV2.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV2.txInfoSignatories = forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody (BabbageEra c)
txBody
        , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV2.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
        , txInfoData :: Map DatumHash Datum
PV2.txInfoData = forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList forall a b. (a -> b) -> a -> b
$ forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx (BabbageEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL)
        , txInfoId :: TxId
PV2.txInfoId = forall era. EraTxBody era => TxBody era -> TxId
Alonzo.transTxBodyId TxBody (BabbageEra c)
txBody
        }
    where
      txBody :: TxBody (BabbageEra c)
txBody = Tx (BabbageEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem (BabbageEra c)
-> Maybe (Data (BabbageEra c))
-> Data (BabbageEra c)
-> Either (ContextError (BabbageEra c)) (PlutusArgs 'PlutusV2)
toPlutusArgs = forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV2 era =>
proxy 'PlutusV2
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV2)
toPlutusV2Args

toPlutusV2Args ::
  EraPlutusTxInfo 'PlutusV2 era =>
  proxy 'PlutusV2 ->
  ProtVer ->
  PV2.TxInfo ->
  PlutusPurpose AsIxItem era ->
  Maybe (Data era) ->
  Data era ->
  Either (ContextError era) (PlutusArgs 'PlutusV2)
toPlutusV2Args :: forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV2 era =>
proxy 'PlutusV2
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV2)
toPlutusV2Args proxy 'PlutusV2
proxy ProtVer
pv TxInfo
txInfo PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData =
  LegacyPlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2
PlutusV2Args
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> (PlutusScriptPurpose l -> PlutusScriptContext l)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs l)
toLegacyPlutusArgs proxy 'PlutusV2
proxy ProtVer
pv (TxInfo -> ScriptPurpose -> ScriptContext
PV2.ScriptContext TxInfo
txInfo) PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData