{-# 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,
  PlutusTxInfo,
  SupportedLanguage (..),
  lookupTxInfoResultImpossible,
  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 (unRedeemersL)
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.Mary.Value (MaryValue)
import Cardano.Ledger.Plutus.Data (Datum (..), binaryDataToData, getPlutusData)
import Cardano.Ledger.Plutus.ExUnits (ExUnits (..))
import Cardano.Ledger.Plutus.Language (Language (..), PlutusArgs (..), SLanguage (..))
import Cardano.Ledger.Plutus.TxInfo (
  TxOutSource (..),
  transAddr,
  transCoinToValue,
  transDataHash,
  transScriptHash,
  transTxIn,
  txOutSourceToText,
 )
import Cardano.Ledger.State (UTxO (..))
import Cardano.Ledger.TxIn (TxIn (..), txInToText)
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 = Maybe ScriptHash
forall a. Maybe a
Nothing
transReferenceScript (SJust Script era
s) = ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> Maybe ScriptHash)
-> (Script era -> ScriptHash) -> Script era -> Maybe ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptHash -> ScriptHash
transScriptHash (ScriptHash -> ScriptHash)
-> (Script era -> ScriptHash) -> Script era -> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraScript era => Script era -> ScriptHash
hashScript @era (Script era -> Maybe ScriptHash) -> Script era -> Maybe ScriptHash
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
  , BabbageEraTxOut era
  ) =>
  TxOutSource ->
  TxOut era ->
  Either (ContextError era) PV1.TxOut
transTxOutV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 TxOutSource
txOutSource TxOut era
txOut = do
  Bool
-> Either (ContextError era) () -> Either (ContextError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe (Script era) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (TxOut era
txOut TxOut era
-> Getting
     (StrictMaybe (Script era)) (TxOut era) (StrictMaybe (Script era))
-> StrictMaybe (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Script era)) (TxOut era) (StrictMaybe (Script era))
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL)) (Either (ContextError era) () -> Either (ContextError era) ())
-> Either (ContextError era) () -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ do
    ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported @era TxOutSource
txOutSource
  Bool
-> Either (ContextError era) () -> Either (ContextError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StrictMaybe (Data era) -> Bool
forall a. StrictMaybe a -> Bool
isSJust (TxOut era
txOut TxOut era
-> Getting
     (StrictMaybe (Data era)) (TxOut era) (StrictMaybe (Data era))
-> StrictMaybe (Data era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Data era)) (TxOut era) (StrictMaybe (Data era))
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Data era))
Lens' (TxOut era) (StrictMaybe (Data era))
dataTxOutL)) (Either (ContextError era) () -> Either (ContextError era) ())
-> Either (ContextError era) () -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ do
    ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported @era TxOutSource
txOutSource
  case TxOut era -> Maybe TxOut
forall era.
(Value era ~ MaryValue, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
Alonzo.transTxOut TxOut era
txOut of
    Maybe TxOut
Nothing -> ContextError era -> Either (ContextError era) TxOut
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) TxOut)
-> ContextError era -> Either (ContextError era) TxOut
forall a b. (a -> b) -> a -> b
$ BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era TxOutSource
txOutSource
    Just TxOut
plutusTxOut -> TxOut -> Either (ContextError era) TxOut
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
  , BabbageEraTxOut era
  ) =>
  TxOutSource ->
  TxOut era ->
  Either (ContextError era) PV2.TxOut
transTxOutV2 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 TxOutSource
txOutSource TxOut era
txOut = do
  let val :: MaryValue
val = TxOut era
txOut TxOut era -> Getting MaryValue (TxOut era) MaryValue -> MaryValue
forall s a. s -> Getting a s a -> a
^. (Value era -> Const MaryValue (Value era))
-> TxOut era -> Const MaryValue (TxOut era)
Getting MaryValue (TxOut era) MaryValue
forall era. EraTxOut era => Lens' (TxOut era) (Value era)
Lens' (TxOut era) (Value era)
valueTxOutL
      referenceScript :: Maybe ScriptHash
referenceScript = StrictMaybe (Script era) -> Maybe ScriptHash
forall era.
EraScript era =>
StrictMaybe (Script era) -> Maybe ScriptHash
transReferenceScript (StrictMaybe (Script era) -> Maybe ScriptHash)
-> StrictMaybe (Script era) -> Maybe ScriptHash
forall a b. (a -> b) -> a -> b
$ TxOut era
txOut TxOut era
-> Getting
     (StrictMaybe (Script era)) (TxOut era) (StrictMaybe (Script era))
-> StrictMaybe (Script era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe (Script era)) (TxOut era) (StrictMaybe (Script era))
forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Script era))
Lens' (TxOut era) (StrictMaybe (Script era))
referenceScriptTxOutL
      datum :: OutputDatum
datum =
        case TxOut era
txOut TxOut era
-> Getting (Datum era) (TxOut era) (Datum era) -> Datum era
forall s a. s -> Getting a s a -> a
^. Getting (Datum era) (TxOut era) (Datum era)
forall era.
AlonzoEraTxOut era =>
SimpleGetter (TxOut era) (Datum era)
SimpleGetter (TxOut era) (Datum era)
datumTxOutF of
          Datum era
NoDatum -> OutputDatum
PV2.NoOutputDatum
          DatumHash DataHash
dh -> DatumHash -> OutputDatum
PV2.OutputDatumHash (DatumHash -> OutputDatum) -> DatumHash -> OutputDatum
forall a b. (a -> b) -> a -> b
$ DataHash -> DatumHash
transDataHash DataHash
dh
          Datum BinaryData era
binaryData ->
            Datum -> OutputDatum
PV2.OutputDatum
              (Datum -> OutputDatum)
-> (BinaryData era -> Datum) -> BinaryData era -> OutputDatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Datum
PV2.Datum
              (BuiltinData -> Datum)
-> (BinaryData era -> BuiltinData) -> BinaryData era -> Datum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data -> BuiltinData
PV2.dataToBuiltinData
              (Data -> BuiltinData)
-> (BinaryData era -> Data) -> BinaryData era -> BuiltinData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Data era -> Data
forall era. Data era -> Data
getPlutusData
              (Data era -> Data)
-> (BinaryData era -> Data era) -> BinaryData era -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryData era -> Data era
forall era. Era era => BinaryData era -> Data era
binaryDataToData
              (BinaryData era -> OutputDatum) -> BinaryData era -> OutputDatum
forall a b. (a -> b) -> a -> b
$ BinaryData era
binaryData
  case Addr -> Maybe Address
transAddr (TxOut era
txOut TxOut era -> Getting Addr (TxOut era) Addr -> Addr
forall s a. s -> Getting a s a -> a
^. Getting Addr (TxOut era) Addr
forall era. EraTxOut era => Lens' (TxOut era) Addr
Lens' (TxOut era) Addr
addrTxOutL) of
    Maybe Address
Nothing -> ContextError era -> Either (ContextError era) TxOut
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) TxOut)
-> ContextError era -> Either (ContextError era) TxOut
forall a b. (a -> b) -> a -> b
$ BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era TxOutSource
txOutSource
    Just Address
addr ->
      TxOut -> Either (ContextError era) TxOut
forall a b. b -> Either a b
Right (Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PV2.TxOut Address
addr (MaryValue -> Value
Alonzo.transValue MaryValue
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
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn ->
  Either (ContextError era) PV1.TxInInfo
transTxInInfoV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO era
utxo TxIn
txIn = do
  txOut <- (AlonzoContextError era -> ContextError era)
-> Either (AlonzoContextError era) (TxOut era)
-> Either (ContextError era) (TxOut era)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> (AlonzoContextError era -> BabbageContextError era)
-> AlonzoContextError era
-> ContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) (Either (AlonzoContextError era) (TxOut era)
 -> Either (ContextError era) (TxOut era))
-> Either (AlonzoContextError era) (TxOut era)
-> Either (ContextError era) (TxOut era)
forall a b. (a -> b) -> a -> b
$ UTxO era -> TxIn -> Either (AlonzoContextError era) (TxOut era)
forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn
txIn
  plutusTxOut <- transTxOutV1 (TxOutFromInput txIn) txOut
  Right (PV1.TxInInfo (transTxIn txIn) 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
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn ->
  Either (ContextError era) PV2.TxInInfo
transTxInInfoV2 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV2 UTxO era
utxo TxIn
txIn = do
  txOut <- (AlonzoContextError era -> ContextError era)
-> Either (AlonzoContextError era) (TxOut era)
-> Either (ContextError era) (TxOut era)
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> (AlonzoContextError era -> BabbageContextError era)
-> AlonzoContextError era
-> ContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) (Either (AlonzoContextError era) (TxOut era)
 -> Either (ContextError era) (TxOut era))
-> Either (AlonzoContextError era) (TxOut era)
-> Either (ContextError era) (TxOut era)
forall a b. (a -> b) -> a -> b
$ UTxO era -> TxIn -> Either (AlonzoContextError era) (TxOut era)
forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn
txIn
  plutusTxOut <- transTxOutV2 (TxOutFromInput txIn) txOut
  Right (PV2.TxInInfo (transTxIn txIn) plutusTxOut)

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

transRedeemerPtr ::
  forall proxy l era t.
  ( EraPlutusTxInfo l era
  , AlonzoEraTxBody era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  TxBody t era ->
  (PlutusPurpose AsIx era, (Data era, ExUnits)) ->
  Either (ContextError era) (PlutusScriptPurpose l, PV2.Redeemer)
transRedeemerPtr :: forall (proxy :: Language -> *) (l :: Language) era (t :: TxLevel).
(EraPlutusTxInfo l era, AlonzoEraTxBody era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> TxBody t era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPtr proxy l
proxy ProtVer
pv TxBody t era
txBody (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
_)) =
  case TxBody t era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
TxBody l era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
forall (l :: TxLevel).
TxBody l era
-> PlutusPurpose AsIx era
-> StrictMaybe (PlutusPurpose AsIxItem era)
redeemerPointerInverse TxBody t era
txBody PlutusPurpose AsIx era
ptr of
    StrictMaybe (PlutusPurpose AsIxItem era)
SNothing -> ContextError era
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
forall a b. a -> Either a b
Left (ContextError era
 -> Either (ContextError era) (PlutusScriptPurpose l, Redeemer))
-> ContextError era
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
forall a b. (a -> b) -> a -> b
$ BabbageContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (BabbageContextError era -> ContextError era)
-> BabbageContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ PlutusPurpose AsIx era -> BabbageContextError era
forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr
    SJust PlutusPurpose AsIxItem era
sp -> do
      plutusScriptPurpose <- proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (proxy :: Language -> *).
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
toPlutusScriptPurpose proxy l
proxy ProtVer
pv PlutusPurpose AsIxItem era
sp
      Right (plutusScriptPurpose, transRedeemer 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 t era ->
  Either (ContextError era) (PV2.Map (PlutusScriptPurpose l) PV2.Redeemer)
transTxRedeemers :: forall (l :: Language) era (proxy :: Language -> *) (t :: TxLevel).
(EraPlutusTxInfo l era, AlonzoEraTxBody era, EraTx era,
 AlonzoEraTxWits era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> Tx t era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
transTxRedeemers proxy l
proxy ProtVer
pv Tx t era
tx =
  [(PlutusScriptPurpose l, Redeemer)]
-> Map (PlutusScriptPurpose l) Redeemer
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList
    ([(PlutusScriptPurpose l, Redeemer)]
 -> Map (PlutusScriptPurpose l) Redeemer)
-> Either (ContextError era) [(PlutusScriptPurpose l, Redeemer)]
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((PlutusPurpose AsIx era, (Data era, ExUnits))
 -> Either (ContextError era) (PlutusScriptPurpose l, Redeemer))
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
-> Either (ContextError era) [(PlutusScriptPurpose l, Redeemer)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      (proxy l
-> ProtVer
-> TxBody t era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
forall (proxy :: Language -> *) (l :: Language) era (t :: TxLevel).
(EraPlutusTxInfo l era, AlonzoEraTxBody era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> TxBody t era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPtr proxy l
proxy ProtVer
pv (TxBody t era
 -> (PlutusPurpose AsIx era, (Data era, ExUnits))
 -> Either (ContextError era) (PlutusScriptPurpose l, Redeemer))
-> TxBody t era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
forall a b. (a -> b) -> a -> b
$ Tx t era
tx Tx t era
-> Getting (TxBody t era) (Tx t era) (TxBody t era) -> TxBody t era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody t era) (Tx t era) (TxBody t era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL)
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall k a. Map k a -> [(k, a)]
Map.toList (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> [(PlutusPurpose AsIx era, (Data era, ExUnits))])
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))]
forall a b. (a -> b) -> a -> b
$ Tx t era
tx Tx t era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx t era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
-> Map (PlutusPurpose AsIx era) (Data era, ExUnits)
forall s a. s -> Getting a s a -> a
^. (TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Tx t era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx t era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
witsTxL ((TxWits era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
 -> Tx t era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx t era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> TxWits era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx t era)
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Redeemers era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall era.
AlonzoEraTxWits era =>
Lens' (TxWits era) (Redeemers era)
Lens' (TxWits era) (Redeemers era)
rdmrsTxWitsL ((Redeemers era
  -> Const
       (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
 -> TxWits era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era))
-> ((Map (PlutusPurpose AsIx era) (Data era, ExUnits)
     -> Const
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
          (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
    -> Redeemers era
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era))
-> (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
    -> Const
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
         (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> TxWits era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (TxWits era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (PlutusPurpose AsIx era) (Data era, ExUnits)
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)))
-> Redeemers era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Redeemers era)
forall era.
AlonzoEraScript era =>
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
Lens'
  (Redeemers era) (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
unRedeemersL)

instance EraPlutusContext BabbageEra where
  type ContextError BabbageEra = BabbageContextError BabbageEra
  data TxInfoResult BabbageEra
    = BabbageTxInfoResult -- Fields must be kept lazy
        (Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
        (Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))

  mkSupportedLanguage :: Language -> Maybe (SupportedLanguage BabbageEra)
mkSupportedLanguage = \case
    Language
PlutusV1 -> SupportedLanguage BabbageEra
-> Maybe (SupportedLanguage BabbageEra)
forall a. a -> Maybe a
Just (SupportedLanguage BabbageEra
 -> Maybe (SupportedLanguage BabbageEra))
-> SupportedLanguage BabbageEra
-> Maybe (SupportedLanguage BabbageEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV1 -> SupportedLanguage BabbageEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV1
SPlutusV1
    Language
PlutusV2 -> SupportedLanguage BabbageEra
-> Maybe (SupportedLanguage BabbageEra)
forall a. a -> Maybe a
Just (SupportedLanguage BabbageEra
 -> Maybe (SupportedLanguage BabbageEra))
-> SupportedLanguage BabbageEra
-> Maybe (SupportedLanguage BabbageEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> SupportedLanguage BabbageEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV2
SPlutusV2
    Language
_lang -> Maybe (SupportedLanguage BabbageEra)
forall a. Maybe a
Nothing

  mkTxInfoResult :: LedgerTxInfo BabbageEra -> TxInfoResult BabbageEra
mkTxInfoResult LedgerTxInfo BabbageEra
lti = Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
-> TxInfoResult BabbageEra
BabbageTxInfoResult (SLanguage 'PlutusV1
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1 LedgerTxInfo BabbageEra
lti) (SLanguage 'PlutusV2
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo SLanguage 'PlutusV2
SPlutusV2 LedgerTxInfo BabbageEra
lti)

  lookupTxInfoResult :: forall (l :: Language).
EraPlutusTxInfo l BabbageEra =>
SLanguage l
-> TxInfoResult BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo l)
lookupTxInfoResult SLanguage l
SPlutusV1 (BabbageTxInfoResult Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1 Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
_) = Either (ContextError BabbageEra) (PlutusTxInfo l)
Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1
  lookupTxInfoResult SLanguage l
SPlutusV2 (BabbageTxInfoResult Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2) = Either (ContextError BabbageEra) (PlutusTxInfo l)
Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2
  lookupTxInfoResult SLanguage l
slang TxInfoResult BabbageEra
_ = SLanguage l -> Either (ContextError BabbageEra) (PlutusTxInfo l)
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
SLanguage l -> Either (ContextError era) (PlutusTxInfo l)
lookupTxInfoResultImpossible SLanguage l
slang

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

data BabbageContextError era
  = AlonzoContextError !(AlonzoContextError era)
  | ByronTxOutInContext !TxOutSource
  | RedeemerPointerPointsToNothing !(PlutusPurpose AsIx era)
  | InlineDatumsNotSupported !TxOutSource
  | ReferenceScriptsNotSupported !TxOutSource
  | ReferenceInputsNotSupported !(Set.Set TxIn)
  deriving ((forall x.
 BabbageContextError era -> Rep (BabbageContextError era) x)
-> (forall x.
    Rep (BabbageContextError era) x -> BabbageContextError era)
-> Generic (BabbageContextError era)
forall x.
Rep (BabbageContextError era) x -> BabbageContextError era
forall x.
BabbageContextError era -> Rep (BabbageContextError era) x
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
$cfrom :: forall era x.
BabbageContextError era -> Rep (BabbageContextError era) x
from :: forall x.
BabbageContextError era -> Rep (BabbageContextError era) x
$cto :: forall era x.
Rep (BabbageContextError era) x -> BabbageContextError era
to :: forall x.
Rep (BabbageContextError era) x -> BabbageContextError era
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 = AlonzoContextError era -> BabbageContextError era
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
txOutSource ->
      Encode Open (BabbageContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (BabbageContextError era) -> Encoding)
-> Encode Open (BabbageContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource -> BabbageContextError era)
-> Word -> Encode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext @era) Word
0 Encode Open (TxOutSource -> BabbageContextError era)
-> Encode (Closed Dense) TxOutSource
-> Encode Open (BabbageContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxOutSource -> Encode (Closed Dense) TxOutSource
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxOutSource
txOutSource
    AlonzoContextError (TranslationLogicMissingInput TxIn
txIn) ->
      Encode Open (AlonzoContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (AlonzoContextError era) -> Encoding)
-> Encode Open (AlonzoContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxIn -> AlonzoContextError era)
-> Word -> Encode Open (TxIn -> AlonzoContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. TxIn -> AlonzoContextError era
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era) Word
1 Encode Open (TxIn -> AlonzoContextError era)
-> Encode (Closed Dense) TxIn
-> Encode Open (AlonzoContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxIn -> Encode (Closed Dense) TxIn
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxIn
txIn
    RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr ->
      Encode Open (BabbageContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (BabbageContextError era) -> Encoding)
-> Encode Open (BabbageContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsIx era -> BabbageContextError era)
-> Word
-> Encode Open (PlutusPurpose AsIx era -> BabbageContextError era)
forall t. t -> Word -> Encode Open t
Sum PlutusPurpose AsIx era -> BabbageContextError era
forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing Word
2 Encode Open (PlutusPurpose AsIx era -> BabbageContextError era)
-> Encode (Closed Dense) (PlutusPurpose AsIx era)
-> Encode Open (BabbageContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PlutusPurpose AsIx era
-> Encode (Closed Dense) (PlutusPurpose AsIx era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PlutusPurpose AsIx era
ptr
    InlineDatumsNotSupported TxOutSource
txOutSource ->
      Encode Open (BabbageContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (BabbageContextError era) -> Encoding)
-> Encode Open (BabbageContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource -> BabbageContextError era)
-> Word -> Encode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported @era) Word
4 Encode Open (TxOutSource -> BabbageContextError era)
-> Encode (Closed Dense) TxOutSource
-> Encode Open (BabbageContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxOutSource -> Encode (Closed Dense) TxOutSource
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxOutSource
txOutSource
    ReferenceScriptsNotSupported TxOutSource
txOutSource ->
      Encode Open (BabbageContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (BabbageContextError era) -> Encoding)
-> Encode Open (BabbageContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxOutSource -> BabbageContextError era)
-> Word -> Encode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported @era) Word
5 Encode Open (TxOutSource -> BabbageContextError era)
-> Encode (Closed Dense) TxOutSource
-> Encode Open (BabbageContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxOutSource -> Encode (Closed Dense) TxOutSource
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxOutSource
txOutSource
    ReferenceInputsNotSupported Set TxIn
txIns ->
      Encode Open (BabbageContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (BabbageContextError era) -> Encoding)
-> Encode Open (BabbageContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Set TxIn -> BabbageContextError era)
-> Word -> Encode Open (Set TxIn -> BabbageContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported @era) Word
6 Encode Open (Set TxIn -> BabbageContextError era)
-> Encode (Closed Dense) (Set TxIn)
-> Encode Open (BabbageContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Set TxIn -> Encode (Closed Dense) (Set TxIn)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Set TxIn
txIns
    AlonzoContextError (TimeTranslationPastHorizon Text
err) ->
      Encode Open (AlonzoContextError (ZonkAny 8)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (AlonzoContextError (ZonkAny 8)) -> Encoding)
-> Encode Open (AlonzoContextError (ZonkAny 8)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Text -> AlonzoContextError (ZonkAny 8))
-> Word -> Encode Open (Text -> AlonzoContextError (ZonkAny 8))
forall t. t -> Word -> Encode Open t
Sum Text -> AlonzoContextError (ZonkAny 8)
forall {k} (era :: k). Text -> AlonzoContextError era
TimeTranslationPastHorizon Word
7 Encode Open (Text -> AlonzoContextError (ZonkAny 8))
-> Encode (Closed Dense) Text
-> Encode Open (AlonzoContextError (ZonkAny 8))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Text -> Encode (Closed Dense) Text
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 = Decode (Closed Dense) (BabbageContextError era)
-> Decoder s (BabbageContextError era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (BabbageContextError era)
 -> Decoder s (BabbageContextError era))
-> Decode (Closed Dense) (BabbageContextError era)
-> Decoder s (BabbageContextError era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (BabbageContextError era))
-> Decode (Closed Dense) (BabbageContextError era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ContextError" ((Word -> Decode Open (BabbageContextError era))
 -> Decode (Closed Dense) (BabbageContextError era))
-> (Word -> Decode Open (BabbageContextError era))
-> Decode (Closed Dense) (BabbageContextError era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
0 -> (TxOutSource -> BabbageContextError era)
-> Decode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Decode Open t
SumD TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
ByronTxOutInContext Decode Open (TxOutSource -> BabbageContextError era)
-> Decode (Closed (ZonkAny 0)) TxOutSource
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 0)) TxOutSource
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
1 -> (TxIn -> BabbageContextError era)
-> Decode Open (TxIn -> BabbageContextError era)
forall t. t -> Decode Open t
SumD (AlonzoContextError era -> BabbageContextError era
forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError (AlonzoContextError era -> BabbageContextError era)
-> (TxIn -> AlonzoContextError era)
-> TxIn
-> BabbageContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIn -> AlonzoContextError era
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput) Decode Open (TxIn -> BabbageContextError era)
-> Decode (Closed (ZonkAny 1)) TxIn
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 1)) TxIn
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
2 -> (PlutusPurpose AsIx era -> BabbageContextError era)
-> Decode Open (PlutusPurpose AsIx era -> BabbageContextError era)
forall t. t -> Decode Open t
SumD PlutusPurpose AsIx era -> BabbageContextError era
forall era. PlutusPurpose AsIx era -> BabbageContextError era
RedeemerPointerPointsToNothing Decode Open (PlutusPurpose AsIx era -> BabbageContextError era)
-> Decode (Closed (ZonkAny 2)) (PlutusPurpose AsIx era)
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) (PlutusPurpose AsIx era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
4 -> (TxOutSource -> BabbageContextError era)
-> Decode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Decode Open t
SumD TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
InlineDatumsNotSupported Decode Open (TxOutSource -> BabbageContextError era)
-> Decode (Closed (ZonkAny 3)) TxOutSource
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 3)) TxOutSource
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
5 -> (TxOutSource -> BabbageContextError era)
-> Decode Open (TxOutSource -> BabbageContextError era)
forall t. t -> Decode Open t
SumD TxOutSource -> BabbageContextError era
forall era. TxOutSource -> BabbageContextError era
ReferenceScriptsNotSupported Decode Open (TxOutSource -> BabbageContextError era)
-> Decode (Closed (ZonkAny 4)) TxOutSource
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) TxOutSource
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
6 -> (Set TxIn -> BabbageContextError era)
-> Decode Open (Set TxIn -> BabbageContextError era)
forall t. t -> Decode Open t
SumD Set TxIn -> BabbageContextError era
forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported Decode Open (Set TxIn -> BabbageContextError era)
-> Decode (Closed (ZonkAny 5)) (Set TxIn)
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) (Set TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
7 -> (Text -> BabbageContextError era)
-> Decode Open (Text -> BabbageContextError era)
forall t. t -> Decode Open t
SumD (AlonzoContextError era -> BabbageContextError era
forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError (AlonzoContextError era -> BabbageContextError era)
-> (Text -> AlonzoContextError era)
-> Text
-> BabbageContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> AlonzoContextError era
forall {k} (era :: k). Text -> AlonzoContextError era
TimeTranslationPastHorizon) Decode Open (Text -> BabbageContextError era)
-> Decode (Closed (ZonkAny 6)) Text
-> Decode Open (BabbageContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (BabbageContextError era)
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 -> AlonzoContextError era -> Value
forall a. ToJSON a => a -> Value
toJSON AlonzoContextError era
err
    ByronTxOutInContext TxOutSource
txOutSource ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Byron UTxO being created or spent: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutSource -> Text
txOutSourceToText TxOutSource
txOutSource
    RedeemerPointerPointsToNothing PlutusPurpose AsIx era
ptr ->
      Text -> [Pair] -> Value
kindObject Text
"RedeemerPointerPointsToNothing" [Key
"ptr" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PlutusPurpose AsIx era -> Value
forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsIx era
ptr]
    InlineDatumsNotSupported TxOutSource
txOutSource ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Inline datums not supported, output source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutSource -> Text
txOutSourceToText TxOutSource
txOutSource
    ReferenceScriptsNotSupported TxOutSource
txOutSource ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Reference scripts not supported, output source: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxOutSource -> Text
txOutSourceToText TxOutSource
txOutSource
    ReferenceInputsNotSupported Set TxIn
txIns ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
        Text
"Reference inputs not supported: "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " ((TxIn -> Text) -> [TxIn] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> Text
txInToText (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList Set TxIn
txIns))

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

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy ProtVer
pv = proxy 'PlutusV1
-> ProtVer
-> AlonzoPlutusPurpose AsItem BabbageEra
-> Either (ContextError BabbageEra) ScriptPurpose
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 (AlonzoPlutusPurpose AsItem BabbageEra
 -> Either (BabbageContextError BabbageEra) ScriptPurpose)
-> (AlonzoPlutusPurpose AsIxItem BabbageEra
    -> AlonzoPlutusPurpose AsItem BabbageEra)
-> AlonzoPlutusPurpose AsIxItem BabbageEra
-> Either (BabbageContextError BabbageEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem BabbageEra
-> PlutusPurpose AsItem BabbageEra
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g BabbageEra -> PlutusPurpose f BabbageEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo proxy 'PlutusV1
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
ltiUTxO :: UTxO BabbageEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx TopTx BabbageEra
ltiTx :: Tx TopTx BabbageEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx} = do
    let refInputs :: Set TxIn
refInputs = TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting (Set TxIn) (TxBody TopTx BabbageEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx BabbageEra) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) (Set TxIn)
referenceInputsTxBodyL
    Bool
-> Either (BabbageContextError BabbageEra) ()
-> Either (BabbageContextError BabbageEra) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set TxIn -> Bool
forall a. Set a -> Bool
Set.null Set TxIn
refInputs) (Either (BabbageContextError BabbageEra) ()
 -> Either (BabbageContextError BabbageEra) ())
-> Either (BabbageContextError BabbageEra) ()
-> Either (BabbageContextError BabbageEra) ()
forall a b. (a -> b) -> a -> b
$ BabbageContextError BabbageEra
-> Either (BabbageContextError BabbageEra) ()
forall a b. a -> Either a b
Left (Set TxIn -> BabbageContextError BabbageEra
forall era. Set TxIn -> BabbageContextError era
ReferenceInputsNotSupported Set TxIn
refInputs)

    timeRange <-
      Tx TopTx BabbageEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (BabbageContextError BabbageEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx TopTx BabbageEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting
     ValidityInterval (TxBody TopTx BabbageEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx BabbageEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) ValidityInterval
vldtTxBodyL)
    inputs <- mapM (transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
    outputs <-
      zipWithM
        (transTxOutV1 . TxOutFromOutput)
        [minBound ..]
        (F.toList (txBody ^. outputsTxBodyL))
    txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
    pure
      PV1.TxInfo
        { PV1.txInfoInputs = inputs
        , PV1.txInfoOutputs = outputs
        , PV1.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
        , PV1.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
        , PV1.txInfoDCert = txCerts
        , PV1.txInfoWdrl = Alonzo.transTxBodyWithdrawals txBody
        , PV1.txInfoValidRange = timeRange
        , PV1.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
        , PV1.txInfoData = Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
        , PV1.txInfoId = Alonzo.transTxBodyId txBody
        }
    where
      txBody :: TxBody TopTx BabbageEra
txBody = Tx TopTx BabbageEra
ltiTx Tx TopTx BabbageEra
-> Getting
     (TxBody TopTx BabbageEra)
     (Tx TopTx BabbageEra)
     (TxBody TopTx BabbageEra)
-> TxBody TopTx BabbageEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx BabbageEra)
  (Tx TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l BabbageEra) (TxBody l BabbageEra)
bodyTxL

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
toPlutusArgs = proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
proxy 'PlutusV1
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
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

  toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> UTxO BabbageEra
-> TxIn
-> Either
     (ContextError BabbageEra) (PlutusTxInInfo BabbageEra 'PlutusV1)
toPlutusTxInInfo proxy 'PlutusV1
_ = UTxO BabbageEra
-> TxIn
-> Either
     (ContextError BabbageEra) (PlutusTxInInfo BabbageEra 'PlutusV1)
UTxO BabbageEra
-> TxIn -> Either (ContextError BabbageEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV1

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

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose proxy 'PlutusV2
proxy ProtVer
pv = proxy 'PlutusV2
-> ProtVer
-> AlonzoPlutusPurpose AsItem BabbageEra
-> Either (ContextError BabbageEra) ScriptPurpose
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 (AlonzoPlutusPurpose AsItem BabbageEra
 -> Either (BabbageContextError BabbageEra) ScriptPurpose)
-> (AlonzoPlutusPurpose AsIxItem BabbageEra
    -> AlonzoPlutusPurpose AsItem BabbageEra)
-> AlonzoPlutusPurpose AsIxItem BabbageEra
-> Either (BabbageContextError BabbageEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem BabbageEra
-> PlutusPurpose AsItem BabbageEra
forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
forall (g :: * -> * -> *) (f :: * -> * -> *).
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g BabbageEra -> PlutusPurpose f BabbageEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo proxy 'PlutusV2
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
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO BabbageEra
ltiUTxO, Tx TopTx BabbageEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx BabbageEra
ltiTx} = do
    timeRange <-
      Tx TopTx BabbageEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (BabbageContextError BabbageEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx TopTx BabbageEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting
     ValidityInterval (TxBody TopTx BabbageEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx BabbageEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) ValidityInterval
vldtTxBodyL)
    inputs <- mapM (transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
    refInputs <- mapM (transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
    outputs <-
      zipWithM
        (transTxOutV2 . TxOutFromOutput)
        [minBound ..]
        (F.toList (txBody ^. outputsTxBodyL))
    txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
    plutusRedeemers <- transTxRedeemers proxy ltiProtVer ltiTx
    pure
      PV2.TxInfo
        { PV2.txInfoInputs = inputs
        , PV2.txInfoOutputs = outputs
        , PV2.txInfoReferenceInputs = refInputs
        , PV2.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
        , PV2.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
        , PV2.txInfoDCert = txCerts
        , PV2.txInfoWdrl = PV2.unsafeFromList $ Alonzo.transTxBodyWithdrawals txBody
        , PV2.txInfoValidRange = timeRange
        , PV2.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
        , PV2.txInfoRedeemers = plutusRedeemers
        , PV2.txInfoData = PV2.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
        , PV2.txInfoId = Alonzo.transTxBodyId txBody
        }
    where
      txBody :: TxBody TopTx BabbageEra
txBody = Tx TopTx BabbageEra
ltiTx Tx TopTx BabbageEra
-> Getting
     (TxBody TopTx BabbageEra)
     (Tx TopTx BabbageEra)
     (TxBody TopTx BabbageEra)
-> TxBody TopTx BabbageEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx BabbageEra)
  (Tx TopTx BabbageEra)
  (TxBody TopTx BabbageEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l BabbageEra) (TxBody l BabbageEra)
bodyTxL

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
toPlutusArgs = proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
proxy 'PlutusV2
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem BabbageEra
-> Maybe (Data BabbageEra)
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
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

  toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> UTxO BabbageEra
-> TxIn
-> Either
     (ContextError BabbageEra) (PlutusTxInInfo BabbageEra 'PlutusV2)
toPlutusTxInInfo proxy 'PlutusV2
_ = UTxO BabbageEra
-> TxIn
-> Either
     (ContextError BabbageEra) (PlutusTxInInfo BabbageEra 'PlutusV2)
UTxO BabbageEra
-> TxIn -> Either (ContextError BabbageEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV2

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
    (LegacyPlutusArgs 'PlutusV2 -> PlutusArgs 'PlutusV2)
-> Either (ContextError era) (LegacyPlutusArgs 'PlutusV2)
-> Either (ContextError era) (PlutusArgs 'PlutusV2)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy 'PlutusV2
-> ProtVer
-> (PlutusScriptPurpose 'PlutusV2 -> PlutusScriptContext 'PlutusV2)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs 'PlutusV2)
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