{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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,
  transRedeemer,
  transTxRedeemers,
  toPlutusV2Args,
  transRedeemerPointerV2V3,
) where

import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusScriptPurpose,
  PlutusTxInfoResult (..),
  SupportedLanguage (..),
  SupportedPlutusRunnable (..),
  lookupTxInfoResultImpossible,
 )
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.Alonzo.UTxO (AlonzoEraUTxO, getSpendingDatum)
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 (..),
  StrictMaybe (..),
  isSJust,
  kindObjectValue,
 )
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 (..),
  decodePlutusRunnable,
 )
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 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

transRedeemerPointerV2V3 ::
  forall proxy l era.
  ( EraTx era
  , AlonzoEraTxBody era
  , EraPlutusTxInfo l era
  , Inject (BabbageContextError era) (ContextError era)
  ) =>
  proxy l ->
  LedgerTxInfo era ->
  (PlutusPurpose AsIx era, (Data era, ExUnits)) ->
  Either (ContextError era) (PlutusScriptPurpose l, PV2.Redeemer)
transRedeemerPointerV2V3 :: forall (proxy :: Language -> *) (l :: Language) era.
(EraTx era, AlonzoEraTxBody era, EraPlutusTxInfo l era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> LedgerTxInfo era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPointerV2V3 proxy l
proxy lti :: LedgerTxInfo era
lti@LedgerTxInfo {Tx level era
ltiTx :: Tx level era
ltiTx :: ()
ltiTx} (PlutusPurpose AsIx era
ptr, (Data era
d, ExUnits
_)) =
  case TxBody level 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 (Tx level era
ltiTx Tx level era
-> Getting (TxBody level era) (Tx level era) (TxBody level era)
-> TxBody level era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody level era) (Tx level era) (TxBody level 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) 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
-> LedgerTxInfo era
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (proxy :: Language -> *).
proxy l
-> LedgerTxInfo era
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
toPlutusScriptPurpose proxy l
proxy LedgerTxInfo era
lti 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 ->
  LedgerTxInfo 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
-> LedgerTxInfo era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
transTxRedeemers proxy l
proxy lti :: LedgerTxInfo era
lti@LedgerTxInfo {Tx level era
ltiTx :: ()
ltiTx :: Tx level era
ltiTx} =
  [(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
-> LedgerTxInfo era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
forall (proxy :: Language -> *) (l :: Language) era.
(EraTx era, AlonzoEraTxBody era, EraPlutusTxInfo l era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> LedgerTxInfo era
-> (PlutusPurpose AsIx era, (Data era, ExUnits))
-> Either (ContextError era) (PlutusScriptPurpose l, Redeemer)
transRedeemerPointerV2V3 proxy l
proxy LedgerTxInfo era
lti)
      (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 level era
ltiTx Tx level era
-> Getting
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits))
     (Tx level 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 level era
-> Const
     (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx level 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 level era
 -> Const
      (Map (PlutusPurpose AsIx era) (Data era, ExUnits)) (Tx level 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 level 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
        (PlutusTxInfoResult 'PlutusV1 BabbageEra)
        (PlutusTxInfoResult 'PlutusV2 BabbageEra)

  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

  mkSupportedPlutusRunnable :: Version
-> PlutusScript BabbageEra -> SupportedPlutusRunnable BabbageEra
mkSupportedPlutusRunnable Version
v = \case
    BabbagePlutusV1 Plutus 'PlutusV1
p -> PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable BabbageEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
PlutusRunnable l -> SupportedPlutusRunnable era
SupportedPlutusRunnable (PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable BabbageEra)
-> PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable BabbageEra
forall a b. (a -> b) -> a -> b
$ Version -> Plutus 'PlutusV1 -> PlutusRunnable 'PlutusV1
forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> PlutusRunnable l
decodePlutusRunnable Version
v Plutus 'PlutusV1
p
    BabbagePlutusV2 Plutus 'PlutusV2
p -> PlutusRunnable 'PlutusV2 -> SupportedPlutusRunnable BabbageEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
PlutusRunnable l -> SupportedPlutusRunnable era
SupportedPlutusRunnable (PlutusRunnable 'PlutusV2 -> SupportedPlutusRunnable BabbageEra)
-> PlutusRunnable 'PlutusV2 -> SupportedPlutusRunnable BabbageEra
forall a b. (a -> b) -> a -> b
$ Version -> Plutus 'PlutusV2 -> PlutusRunnable 'PlutusV2
forall (l :: Language).
PlutusLanguage l =>
Version -> Plutus l -> PlutusRunnable l
decodePlutusRunnable Version
v Plutus 'PlutusV2
p

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

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

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
  (Ord (AlonzoContextError era), Ord (PlutusPurpose AsIx era)) =>
  Ord (BabbageContextError era)

deriving instance
  (Show (AlonzoContextError era), Show (PlutusPurpose AsIx era)) =>
  Show (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
kindObjectValue 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
-> LedgerTxInfo BabbageEra
-> PlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy LedgerTxInfo BabbageEra
lti = proxy 'PlutusV1
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy 'PlutusV1
proxy (LedgerTxInfo BabbageEra -> ProtVer
forall era. LedgerTxInfo era -> ProtVer
ltiProtVer LedgerTxInfo BabbageEra
lti)

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> PlutusTxInfoResult 'PlutusV1 BabbageEra
toPlutusTxInfo proxy 'PlutusV1
proxy LedgerTxInfo {ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: 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 level BabbageEra
ltiTx :: ()
ltiTx :: Tx level BabbageEra
ltiTx} =
    Either
  (ContextError BabbageEra)
  (PlutusPurpose AsPurpose BabbageEra
   -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 BabbageEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError BabbageEra)
   (PlutusPurpose AsPurpose BabbageEra
    -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
 -> PlutusTxInfoResult 'PlutusV1 BabbageEra)
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 BabbageEra
forall a b. (a -> b) -> a -> b
$ Tx level BabbageEra
-> (Tx TopTx BabbageEra
    -> Either
         (ContextError BabbageEra)
         (PlutusPurpose AsPurpose BabbageEra
          -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly Tx level BabbageEra
ltiTx ((Tx TopTx BabbageEra
  -> Either
       (ContextError BabbageEra)
       (PlutusPurpose AsPurpose BabbageEra
        -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)))
 -> Either
      (ContextError BabbageEra)
      (PlutusPurpose AsPurpose BabbageEra
       -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)))
-> (Tx TopTx BabbageEra
    -> Either
         (ContextError BabbageEra)
         (PlutusPurpose AsPurpose BabbageEra
          -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV1))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx BabbageEra
tx -> do
      let
        txBody :: TxBody TopTx BabbageEra
txBody = Tx TopTx BabbageEra
tx 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
        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
tx 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
      -- It is important for memoization for `txInfo` to be a let binding
      let
        txInfo =
          PV1.TxInfo
            { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [TxInInfo]
inputs
            , txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = [TxOut]
outputs
            , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting Coin (TxBody TopTx BabbageEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx BabbageEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx BabbageEra) Coin
feeTxBodyL)
            , txInfoMint :: Value
PV1.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting MultiAsset (TxBody TopTx BabbageEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx BabbageEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) MultiAsset
mintTxBodyL)
            , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
            , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = TxBody TopTx BabbageEra -> [(StakingCredential, Integer)]
forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody TopTx BabbageEra
txBody
            , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
            , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = TxBody TopTx BabbageEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody TopTx BabbageEra
txBody
            , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = TxWits BabbageEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx TopTx BabbageEra
tx Tx TopTx BabbageEra
-> Getting
     (TxWits BabbageEra) (Tx TopTx BabbageEra) (TxWits BabbageEra)
-> TxWits BabbageEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxWits BabbageEra) (Tx TopTx BabbageEra) (TxWits BabbageEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l BabbageEra) (TxWits BabbageEra)
witsTxL)
            , txInfoId :: TxId
PV1.txInfoId = TxBody TopTx BabbageEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
Alonzo.transTxBodyId TxBody TopTx BabbageEra
txBody
            }
      Right $ \AlonzoPlutusPurpose AsPurpose BabbageEra
_ -> TxInfo -> Either (BabbageContextError BabbageEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
toPlutusArgs = proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
proxy 'PlutusV1
-> LedgerTxInfo BabbageEra
-> TxInfo
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV1)
forall era (proxy :: Language -> *).
(AlonzoEraUTxO era, EraPlutusTxInfo 'PlutusV1 era) =>
proxy 'PlutusV1
-> LedgerTxInfo era
-> TxInfo
-> PlutusPurpose AsIxItem 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
-> LedgerTxInfo BabbageEra
-> PlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose proxy 'PlutusV2
proxy LedgerTxInfo BabbageEra
lti = proxy 'PlutusV2
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem BabbageEra
-> Either (ContextError BabbageEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy 'PlutusV2
proxy (LedgerTxInfo BabbageEra -> ProtVer
forall era. LedgerTxInfo era -> ProtVer
ltiProtVer LedgerTxInfo BabbageEra
lti)

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> PlutusTxInfoResult 'PlutusV2 BabbageEra
toPlutusTxInfo proxy 'PlutusV2
proxy lti :: LedgerTxInfo BabbageEra
lti@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 level BabbageEra
ltiTx :: ()
ltiTx :: Tx level BabbageEra
ltiTx} =
    Either
  (ContextError BabbageEra)
  (PlutusPurpose AsPurpose BabbageEra
   -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))
-> PlutusTxInfoResult 'PlutusV2 BabbageEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError BabbageEra)
   (PlutusPurpose AsPurpose BabbageEra
    -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))
 -> PlutusTxInfoResult 'PlutusV2 BabbageEra)
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))
-> PlutusTxInfoResult 'PlutusV2 BabbageEra
forall a b. (a -> b) -> a -> b
$ Tx level BabbageEra
-> (Tx TopTx BabbageEra
    -> Either
         (ContextError BabbageEra)
         (PlutusPurpose AsPurpose BabbageEra
          -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)))
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))
forall (l :: TxLevel) era (t :: TxLevel -> * -> *) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly Tx level BabbageEra
ltiTx ((Tx TopTx BabbageEra
  -> Either
       (ContextError BabbageEra)
       (PlutusPurpose AsPurpose BabbageEra
        -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)))
 -> Either
      (ContextError BabbageEra)
      (PlutusPurpose AsPurpose BabbageEra
       -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)))
-> (Tx TopTx BabbageEra
    -> Either
         (ContextError BabbageEra)
         (PlutusPurpose AsPurpose BabbageEra
          -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2)))
-> Either
     (ContextError BabbageEra)
     (PlutusPurpose AsPurpose BabbageEra
      -> Either (ContextError BabbageEra) (PlutusTxInfo 'PlutusV2))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx BabbageEra
tx -> do
      let txBody :: TxBody TopTx BabbageEra
txBody = Tx TopTx BabbageEra
tx 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
      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
tx 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 lti
      -- It is important for memoization for `txInfo` to be a let binding
      let
        txInfo =
          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 TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting Coin (TxBody TopTx BabbageEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx BabbageEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx BabbageEra) Coin
feeTxBodyL)
            , txInfoMint :: Value
PV2.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody TopTx BabbageEra
txBody TxBody TopTx BabbageEra
-> Getting MultiAsset (TxBody TopTx BabbageEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx BabbageEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l BabbageEra) MultiAsset
mintTxBodyL)
            , txInfoDCert :: [DCert]
PV2.txInfoDCert = [DCert]
txCerts
            , txInfoWdrl :: Map StakingCredential Integer
PV2.txInfoWdrl = [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(StakingCredential, Integer)] -> Map StakingCredential Integer)
-> [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall a b. (a -> b) -> a -> b
$ TxBody TopTx BabbageEra -> [(StakingCredential, Integer)]
forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody TopTx BabbageEra
txBody
            , txInfoValidRange :: POSIXTimeRange
PV2.txInfoValidRange = POSIXTimeRange
timeRange
            , txInfoSignatories :: [PubKeyHash]
PV2.txInfoSignatories = TxBody TopTx BabbageEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody TopTx BabbageEra
txBody
            , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV2.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
            , txInfoData :: Map DatumHash Datum
PV2.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ TxWits BabbageEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx TopTx BabbageEra
tx Tx TopTx BabbageEra
-> Getting
     (TxWits BabbageEra) (Tx TopTx BabbageEra) (TxWits BabbageEra)
-> TxWits BabbageEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxWits BabbageEra) (Tx TopTx BabbageEra) (TxWits BabbageEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l BabbageEra) (TxWits BabbageEra)
witsTxL)
            , txInfoId :: TxId
PV2.txInfoId = TxBody TopTx BabbageEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
Alonzo.transTxBodyId TxBody TopTx BabbageEra
txBody
            }
      Right $ \AlonzoPlutusPurpose AsPurpose BabbageEra
_ -> TxInfo -> Either (BabbageContextError BabbageEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
toPlutusArgs = proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
proxy 'PlutusV2
-> LedgerTxInfo BabbageEra
-> TxInfo
-> PlutusPurpose AsIxItem BabbageEra
-> Data BabbageEra
-> Either (ContextError BabbageEra) (PlutusArgs 'PlutusV2)
forall era (proxy :: Language -> *).
(AlonzoEraUTxO era, EraPlutusTxInfo 'PlutusV2 era) =>
proxy 'PlutusV2
-> LedgerTxInfo era
-> TxInfo
-> PlutusPurpose AsIxItem 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 ::
  ( AlonzoEraUTxO era
  , EraPlutusTxInfo 'PlutusV2 era
  ) =>
  proxy 'PlutusV2 ->
  LedgerTxInfo era ->
  PV2.TxInfo ->
  PlutusPurpose AsIxItem era ->
  Data era ->
  Either (ContextError era) (PlutusArgs 'PlutusV2)
toPlutusV2Args :: forall era (proxy :: Language -> *).
(AlonzoEraUTxO era, EraPlutusTxInfo 'PlutusV2 era) =>
proxy 'PlutusV2
-> LedgerTxInfo era
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV2)
toPlutusV2Args proxy 'PlutusV2
proxy lti :: LedgerTxInfo era
lti@LedgerTxInfo {[(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
Map (PlutusPurpose AsIx era) ScriptHash
Map TxId (TxInfoResult era)
Tx level era
UTxO era
EpochInfo (Either Text)
ProtVer
SystemStart
ltiTx :: ()
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiProtVer :: ProtVer
ltiEpochInfo :: EpochInfo (Either Text)
ltiSystemStart :: SystemStart
ltiUTxO :: UTxO era
ltiTx :: Tx level era
ltiScriptsUsed :: [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
ltiScriptHashesUsed :: Map (PlutusPurpose AsIx era) ScriptHash
ltiMemoizedSubTransactions :: Map TxId (TxInfoResult era)
ltiMemoizedSubTransactions :: forall era. LedgerTxInfo era -> Map TxId (TxInfoResult era)
ltiScriptHashesUsed :: forall era.
LedgerTxInfo era -> Map (PlutusPurpose AsIx era) ScriptHash
ltiScriptsUsed :: forall era.
LedgerTxInfo era
-> [(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
..} TxInfo
txInfo PlutusPurpose AsIxItem era
scriptPurpose 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
-> LedgerTxInfo era
-> (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
-> LedgerTxInfo era
-> (PlutusScriptPurpose l -> PlutusScriptContext l)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs l)
toLegacyPlutusArgs
      proxy 'PlutusV2
proxy
      LedgerTxInfo era
lti
      (TxInfo -> ScriptPurpose -> ScriptContext
PV2.ScriptContext TxInfo
txInfo)
      PlutusPurpose AsIxItem era
scriptPurpose
      Maybe (Data era)
maybeSpendingDatum
      Data era
redeemerData
  where
    maybeSpendingDatum :: Maybe (Data era)
maybeSpendingDatum =
      UTxO era
-> Tx level era -> PlutusPurpose AsItem era -> Maybe (Data era)
forall era (l :: TxLevel).
AlonzoEraUTxO era =>
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
forall (l :: TxLevel).
UTxO era
-> Tx l era -> PlutusPurpose AsItem era -> Maybe (Data era)
getSpendingDatum UTxO era
ltiUTxO Tx level era
ltiTx (PlutusPurpose AsItem era -> Maybe (Data era))
-> PlutusPurpose AsItem era -> Maybe (Data era)
forall a b. (a -> b) -> a -> b
$ (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era
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 era -> PlutusPurpose f era
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem PlutusPurpose AsIxItem era
scriptPurpose