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

module Cardano.Ledger.Alonzo.Plutus.TxInfo (
  mkPlutusWithContext,
  AlonzoContextError (..),
  transLookupTxOut,
  transTxOut,
  transValidityInterval,
  transPolicyID,
  transAssetName,
  transMultiAsset,
  transMintValue,
  transValue,
  transWithdrawals,
  transDataPair,
  transTxCert,
  transTxCertCommon,
  transPlutusPurpose,
  transTxBodyId,
  transTxBodyCerts,
  transTxBodyWithdrawals,
  transTxBodyReqSignerHashes,
  transTxWitsDatums,

  -- * LegacyPlutusArgs helpers
  toPlutusV1Args,
  toLegacyPlutusArgs,
) where

import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Core
import Cardano.Ledger.Alonzo.Era (AlonzoEra)
import Cardano.Ledger.Alonzo.Plutus.Context
import Cardano.Ledger.Alonzo.Scripts (
  PlutusScript (..),
  toAsItem,
  toAsPurpose,
 )
import Cardano.Ledger.Alonzo.TxWits (unTxDatsL)
import Cardano.Ledger.Alonzo.UTxO (AlonzoEraUTxO (getSpendingDatum))
import Cardano.Ledger.BaseTypes (
  ProtVer (..),
  StrictMaybe (..),
  kindObjectValue,
  strictMaybeToMaybe,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Mary.Value (
  AssetName (..),
  MaryValue (..),
  MultiAsset (..),
  PolicyID (..),
 )
import Cardano.Ledger.Plutus
import Cardano.Ledger.Rules.ValidationMode (Inject (..))
import Cardano.Ledger.State (StakePoolParams (..), UTxO (..))
import Cardano.Ledger.TxIn (TxIn (..), txInToText)
import Cardano.Ledger.Val (zero)
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.Arrow (left)
import Control.DeepSeq (NFData)
import Control.Monad (forM, guard)
import Data.Aeson (ToJSON (..), (.=), pattern String)
import Data.ByteString.Short as SBS (fromShort)
import Data.Foldable as F (Foldable (..))
import qualified Data.Map.Strict as Map
import Data.Maybe (catMaybes, isNothing, mapMaybe)
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2

mkPlutusWithContext ::
  forall era.
  SupportedPlutusRunnable era ->
  PlutusPurpose AsIxItem era ->
  LedgerTxInfo era ->
  TxInfoResult era ->
  Data era ->
  ExUnits ->
  CostModel ->
  Either (ContextError era) PlutusWithContext
mkPlutusWithContext :: forall era.
SupportedPlutusRunnable era
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> TxInfoResult era
-> Data era
-> ExUnits
-> CostModel
-> Either (ContextError era) PlutusWithContext
mkPlutusWithContext SupportedPlutusRunnable era
script PlutusPurpose AsIxItem era
plutusPurpose lti :: LedgerTxInfo era
lti@LedgerTxInfo {ProtVer
ltiProtVer :: ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer} TxInfoResult era
txInfoResult Data era
redeemerData ExUnits
exUnits CostModel
costModel =
  case SupportedPlutusRunnable era
script of
    SupportedPlutusRunnable PlutusRunnable l
plutusRunnable -> do
      let slang :: SLanguage l
slang = SLanguage l
forall (l :: Language). PlutusLanguage l => SLanguage l
isLanguage SLanguage l -> PlutusRunnable l -> SLanguage l
forall (l :: Language) (proxy :: Language -> *)
       (proxyAs :: Language -> *).
PlutusLanguage l =>
proxy l -> proxyAs l -> proxy l
`asSameLanguage` PlutusRunnable l
plutusRunnable
      mkTxInfo <- PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall (l :: Language) era.
PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
unPlutusTxInfoResult (PlutusTxInfoResult l era
 -> Either
      (ContextError era)
      (PlutusPurpose AsPurpose era
       -> Either (ContextError era) (PlutusTxInfo l)))
-> PlutusTxInfoResult l era
-> Either
     (ContextError era)
     (PlutusPurpose AsPurpose era
      -> Either (ContextError era) (PlutusTxInfo l))
forall a b. (a -> b) -> a -> b
$ SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
forall era (l :: Language).
(EraPlutusContext era, EraPlutusTxInfo l era) =>
SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
forall (l :: Language).
EraPlutusTxInfo l era =>
SLanguage l -> TxInfoResult era -> PlutusTxInfoResult l era
lookupTxInfoResult SLanguage l
slang TxInfoResult era
txInfoResult
      txInfo <- mkTxInfo $ hoistPlutusPurpose toAsPurpose plutusPurpose
      plutusArgs <-
        toPlutusArgs
          slang
          lti
          txInfo
          plutusPurpose
          redeemerData
      pure $
        PlutusWithContext
          { pwcProtocolVersion = pvMajor ltiProtVer
          , pwcScript = plutusRunnable
          , pwcArgs = plutusArgs
          , pwcExUnits = exUnits
          , pwcCostModel = costModel
          }

instance EraPlutusTxInfo 'PlutusV1 AlonzoEra where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> TxCert AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxCert 'PlutusV1)
toPlutusTxCert proxy 'PlutusV1
_ ProtVer
_ = TxCert AlonzoEra -> Either (ContextError AlonzoEra) DCert
TxCert AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxCert 'PlutusV1)
forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era,
 Inject (AlonzoContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCert

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> PlutusPurpose AsIxItem AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy LedgerTxInfo AlonzoEra
lti = proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem AlonzoEra
-> Either (ContextError AlonzoEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (AlonzoContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurpose proxy 'PlutusV1
proxy (LedgerTxInfo AlonzoEra -> ProtVer
forall era. LedgerTxInfo era -> ProtVer
ltiProtVer LedgerTxInfo AlonzoEra
lti)

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra -> PlutusTxInfoResult 'PlutusV1 AlonzoEra
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 AlonzoEra
ltiUTxO :: UTxO AlonzoEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx level AlonzoEra
ltiTx :: Tx level AlonzoEra
ltiTx :: ()
ltiTx} =
    Either
  (ContextError AlonzoEra)
  (PlutusPurpose AsPurpose AlonzoEra
   -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 AlonzoEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError AlonzoEra)
   (PlutusPurpose AsPurpose AlonzoEra
    -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1))
 -> PlutusTxInfoResult 'PlutusV1 AlonzoEra)
-> Either
     (ContextError AlonzoEra)
     (PlutusPurpose AsPurpose AlonzoEra
      -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 AlonzoEra
forall a b. (a -> b) -> a -> b
$ Tx level AlonzoEra
-> (Tx TopTx AlonzoEra
    -> Either
         (ContextError AlonzoEra)
         (PlutusPurpose AsPurpose AlonzoEra
          -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError AlonzoEra)
     (PlutusPurpose AsPurpose AlonzoEra
      -> Either (ContextError AlonzoEra) (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 AlonzoEra
ltiTx ((Tx TopTx AlonzoEra
  -> Either
       (ContextError AlonzoEra)
       (PlutusPurpose AsPurpose AlonzoEra
        -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)))
 -> Either
      (ContextError AlonzoEra)
      (PlutusPurpose AsPurpose AlonzoEra
       -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)))
-> (Tx TopTx AlonzoEra
    -> Either
         (ContextError AlonzoEra)
         (PlutusPurpose AsPurpose AlonzoEra
          -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError AlonzoEra)
     (PlutusPurpose AsPurpose AlonzoEra
      -> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx AlonzoEra
tx -> do
      let txBody :: TxBody TopTx AlonzoEra
txBody = Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting
     (TxBody TopTx AlonzoEra)
     (Tx TopTx AlonzoEra)
     (TxBody TopTx AlonzoEra)
-> TxBody TopTx AlonzoEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx AlonzoEra)
  (Tx TopTx AlonzoEra)
  (TxBody TopTx AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxBody l AlonzoEra)
bodyTxL
      timeRange <-
        Tx TopTx AlonzoEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ContextError AlonzoEra) POSIXTimeRange
forall (proxy :: * -> *) era.
Inject (AlonzoContextError era) (ContextError era) =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ContextError era) POSIXTimeRange
transValidityInterval Tx TopTx AlonzoEra
tx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx AlonzoEra
txBody TxBody TopTx AlonzoEra
-> Getting
     ValidityInterval (TxBody TopTx AlonzoEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx AlonzoEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l AlonzoEra) ValidityInterval
vldtTxBodyL)
      txInsMaybes <- forM (Set.toList (txBody ^. inputsTxBodyL)) $ toPlutusTxInInfo proxy ltiUTxO
      txCerts <- transTxBodyCerts proxy ltiProtVer txBody
      -- It is important for memoization for `txInfo` to be a let binding
      let
        txInfo =
          PV1.TxInfo
            { -- A mistake was made in Alonzo of filtering out Byron addresses, so we need to
              -- preserve this behavior by only retaining the Just case:
              txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [Maybe TxInInfo] -> [TxInInfo]
forall a. [Maybe a] -> [a]
catMaybes [Maybe TxInInfo]
txInsMaybes
            , txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = (TxOut AlonzoEra -> Maybe TxOut) -> [TxOut AlonzoEra] -> [TxOut]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe TxOut AlonzoEra -> Maybe TxOut
forall era.
(Value era ~ MaryValue, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
transTxOut ([TxOut AlonzoEra] -> [TxOut]) -> [TxOut AlonzoEra] -> [TxOut]
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxOut AlonzoEra) -> [TxOut AlonzoEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody TopTx AlonzoEra
txBody TxBody TopTx AlonzoEra
-> Getting
     (StrictSeq (TxOut AlonzoEra))
     (TxBody TopTx AlonzoEra)
     (StrictSeq (TxOut AlonzoEra))
-> StrictSeq (TxOut AlonzoEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut AlonzoEra))
  (TxBody TopTx AlonzoEra)
  (StrictSeq (TxOut AlonzoEra))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL)
            , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody TopTx AlonzoEra
txBody TxBody TopTx AlonzoEra
-> Getting Coin (TxBody TopTx AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx AlonzoEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx AlonzoEra) Coin
feeTxBodyL)
            , txInfoMint :: Value
PV1.txInfoMint = MultiAsset -> Value
transMintValue (TxBody TopTx AlonzoEra
txBody TxBody TopTx AlonzoEra
-> Getting MultiAsset (TxBody TopTx AlonzoEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx AlonzoEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l AlonzoEra) MultiAsset
mintTxBodyL)
            , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
            , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = TxBody TopTx AlonzoEra -> [(StakingCredential, Integer)]
forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
transTxBodyWithdrawals TxBody TopTx AlonzoEra
txBody
            , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
            , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = TxBody TopTx AlonzoEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
transTxBodyReqSignerHashes TxBody TopTx AlonzoEra
txBody
            , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = TxWits AlonzoEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
transTxWitsDatums (Tx TopTx AlonzoEra
tx Tx TopTx AlonzoEra
-> Getting
     (TxWits AlonzoEra) (Tx TopTx AlonzoEra) (TxWits AlonzoEra)
-> TxWits AlonzoEra
forall s a. s -> Getting a s a -> a
^. Getting (TxWits AlonzoEra) (Tx TopTx AlonzoEra) (TxWits AlonzoEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l AlonzoEra) (TxWits AlonzoEra)
witsTxL)
            , txInfoId :: TxId
PV1.txInfoId = TxBody TopTx AlonzoEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
transTxBodyId TxBody TopTx AlonzoEra
txBody
            }
      Right $ \AlonzoPlutusPurpose AsPurpose AlonzoEra
_ -> TxInfo -> Either (AlonzoContextError AlonzoEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

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

  toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> UTxO AlonzoEra
-> TxIn
-> Either
     (ContextError AlonzoEra) (PlutusTxInInfo AlonzoEra 'PlutusV1)
toPlutusTxInInfo proxy 'PlutusV1
_ UTxO AlonzoEra
utxo TxIn
txIn = do
    txOut <- UTxO AlonzoEra
-> TxIn -> Either (ContextError AlonzoEra) (TxOut AlonzoEra)
forall era.
Inject (AlonzoContextError era) (ContextError era) =>
UTxO era -> TxIn -> Either (ContextError era) (TxOut era)
transLookupTxOut UTxO AlonzoEra
utxo TxIn
txIn
    pure $ PV1.TxInInfo (transTxIn txIn) <$> transTxOut txOut

toPlutusV1Args ::
  ( AlonzoEraUTxO era
  , EraPlutusTxInfo 'PlutusV1 era
  ) =>
  proxy 'PlutusV1 ->
  LedgerTxInfo era ->
  PV1.TxInfo ->
  PlutusPurpose AsIxItem era ->
  Data era ->
  Either (ContextError era) (PlutusArgs 'PlutusV1)
toPlutusV1Args :: forall era (proxy :: Language -> *).
(AlonzoEraUTxO era, EraPlutusTxInfo 'PlutusV1 era) =>
proxy 'PlutusV1
-> LedgerTxInfo era
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV1)
toPlutusV1Args proxy 'PlutusV1
proxy lti :: LedgerTxInfo era
lti@LedgerTxInfo {[(PlutusPurpose AsIxItem era, SupportedPlutusRunnable era)]
Map TxId (TxInfoResult era)
Map (PlutusPurpose AsIx era) ScriptHash
Tx level era
UTxO era
EpochInfo (Either Text)
ProtVer
SystemStart
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
ltiTx :: ()
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
plutusPurpose Data era
redeemerData =
  LegacyPlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1
PlutusV1Args
    (LegacyPlutusArgs 'PlutusV1 -> PlutusArgs 'PlutusV1)
-> Either (ContextError era) (LegacyPlutusArgs 'PlutusV1)
-> Either (ContextError era) (PlutusArgs 'PlutusV1)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy 'PlutusV1
-> LedgerTxInfo era
-> (PlutusScriptPurpose 'PlutusV1 -> PlutusScriptContext 'PlutusV1)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs 'PlutusV1)
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 'PlutusV1
proxy
      LedgerTxInfo era
lti
      (TxInfo -> ScriptPurpose -> ScriptContext
PV1.ScriptContext TxInfo
txInfo)
      PlutusPurpose AsIxItem era
plutusPurpose
      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
plutusPurpose

toLegacyPlutusArgs ::
  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 :: 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 l
proxy LedgerTxInfo era
lti PlutusScriptPurpose l -> PlutusScriptContext l
mkScriptContext PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData = do
  scriptContext <- PlutusScriptPurpose l -> PlutusScriptContext l
mkScriptContext (PlutusScriptPurpose l -> PlutusScriptContext l)
-> Either (ContextError era) (PlutusScriptPurpose l)
-> Either (ContextError era) (PlutusScriptContext l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
scriptPurpose
  let redeemer = Data era -> Data
forall era. Data era -> Data
getPlutusData Data era
redeemerData
  pure $ case maybeSpendingData of
    Maybe (Data era)
Nothing -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
forall (l :: Language).
Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs2 Data
redeemer PlutusScriptContext l
scriptContext
    Just Data era
spendingData -> Data -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
forall (l :: Language).
Data -> Data -> PlutusScriptContext l -> LegacyPlutusArgs l
LegacyPlutusArgs3 (Data era -> Data
forall era. Data era -> Data
getPlutusData Data era
spendingData) Data
redeemer PlutusScriptContext l
scriptContext

instance EraPlutusContext AlonzoEra where
  type ContextError AlonzoEra = AlonzoContextError AlonzoEra
  newtype TxInfoResult AlonzoEra
    = AlonzoTxInfoResult (PlutusTxInfoResult 'PlutusV1 AlonzoEra)

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

  mkSupportedPlutusRunnable :: Version
-> PlutusScript AlonzoEra -> SupportedPlutusRunnable AlonzoEra
mkSupportedPlutusRunnable Version
v = \case
    AlonzoPlutusV1 Plutus 'PlutusV1
p -> PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable AlonzoEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
PlutusRunnable l -> SupportedPlutusRunnable era
SupportedPlutusRunnable (PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable AlonzoEra)
-> PlutusRunnable 'PlutusV1 -> SupportedPlutusRunnable AlonzoEra
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

  mkTxInfoResult :: LedgerTxInfo AlonzoEra -> TxInfoResult AlonzoEra
mkTxInfoResult = PlutusTxInfoResult 'PlutusV1 AlonzoEra -> TxInfoResult AlonzoEra
AlonzoTxInfoResult (PlutusTxInfoResult 'PlutusV1 AlonzoEra -> TxInfoResult AlonzoEra)
-> (LedgerTxInfo AlonzoEra
    -> PlutusTxInfoResult 'PlutusV1 AlonzoEra)
-> LedgerTxInfo AlonzoEra
-> TxInfoResult AlonzoEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SLanguage 'PlutusV1
-> LedgerTxInfo AlonzoEra -> PlutusTxInfoResult 'PlutusV1 AlonzoEra
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l -> LedgerTxInfo era -> PlutusTxInfoResult l era
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra -> PlutusTxInfoResult 'PlutusV1 AlonzoEra
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1

  lookupTxInfoResult :: forall (l :: Language).
EraPlutusTxInfo l AlonzoEra =>
SLanguage l
-> TxInfoResult AlonzoEra -> PlutusTxInfoResult l AlonzoEra
lookupTxInfoResult SLanguage l
SPlutusV1 (AlonzoTxInfoResult PlutusTxInfoResult 'PlutusV1 AlonzoEra
tirPlutusV1) = PlutusTxInfoResult l AlonzoEra
PlutusTxInfoResult 'PlutusV1 AlonzoEra
tirPlutusV1
  lookupTxInfoResult SLanguage l
slang TxInfoResult AlonzoEra
_ = SLanguage l -> PlutusTxInfoResult l AlonzoEra
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
SLanguage l -> PlutusTxInfoResult l era
lookupTxInfoResultImpossible SLanguage l
slang

data AlonzoContextError era
  = TranslationLogicMissingInput TxIn
  | TimeTranslationPastHorizon Text
  | CertificateNotSupported (TxCert era)
  | PlutusPurposeNotSupported (PlutusPurpose AsItem era)
  deriving ((forall x.
 AlonzoContextError era -> Rep (AlonzoContextError era) x)
-> (forall x.
    Rep (AlonzoContextError era) x -> AlonzoContextError era)
-> Generic (AlonzoContextError era)
forall x. Rep (AlonzoContextError era) x -> AlonzoContextError era
forall x. AlonzoContextError era -> Rep (AlonzoContextError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (AlonzoContextError era) x -> AlonzoContextError era
forall era x.
AlonzoContextError era -> Rep (AlonzoContextError era) x
$cfrom :: forall era x.
AlonzoContextError era -> Rep (AlonzoContextError era) x
from :: forall x. AlonzoContextError era -> Rep (AlonzoContextError era) x
$cto :: forall era x.
Rep (AlonzoContextError era) x -> AlonzoContextError era
to :: forall x. Rep (AlonzoContextError era) x -> AlonzoContextError era
Generic)

deriving instance
  ( Eq (TxCert era)
  , Eq (PlutusPurpose AsItem era)
  , EraPParams era
  ) =>
  Eq (AlonzoContextError era)

deriving instance
  ( Ord (TxCert era)
  , Ord (PlutusPurpose AsItem era)
  , EraPParams era
  ) =>
  Ord (AlonzoContextError era)

deriving instance
  ( Show (TxCert era)
  , Show (PlutusPurpose AsItem era)
  , EraPParams era
  ) =>
  Show (AlonzoContextError era)

instance
  ( Era era
  , NFData (TxCert era)
  , NFData (PlutusPurpose AsItem era)
  ) =>
  NFData (AlonzoContextError era)

instance
  (Era era, EncCBOR (TxCert era), EncCBOR (PlutusPurpose AsItem era)) =>
  EncCBOR (AlonzoContextError era)
  where
  encCBOR :: AlonzoContextError era -> Encoding
encCBOR = \case
    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
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
    TimeTranslationPastHorizon Text
err ->
      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
$ (Text -> AlonzoContextError era)
-> Word -> Encode Open (Text -> AlonzoContextError era)
forall t. t -> Word -> Encode Open t
Sum (forall era. Text -> AlonzoContextError era
TimeTranslationPastHorizon @era) Word
7 Encode Open (Text -> AlonzoContextError era)
-> Encode (Closed Dense) Text
-> Encode Open (AlonzoContextError era)
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
    CertificateNotSupported TxCert era
txCert ->
      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
$ (TxCert era -> AlonzoContextError era)
-> Word -> Encode Open (TxCert era -> AlonzoContextError era)
forall t. t -> Word -> Encode Open t
Sum TxCert era -> AlonzoContextError era
forall era. TxCert era -> AlonzoContextError era
CertificateNotSupported Word
9 Encode Open (TxCert era -> AlonzoContextError era)
-> Encode (Closed Dense) (TxCert era)
-> Encode Open (AlonzoContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> TxCert era -> Encode (Closed Dense) (TxCert era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To TxCert era
txCert
    PlutusPurposeNotSupported PlutusPurpose AsItem era
purpose ->
      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
$ (PlutusPurpose AsItem era -> AlonzoContextError era)
-> Word
-> Encode Open (PlutusPurpose AsItem era -> AlonzoContextError era)
forall t. t -> Word -> Encode Open t
Sum PlutusPurpose AsItem era -> AlonzoContextError era
forall era. PlutusPurpose AsItem era -> AlonzoContextError era
PlutusPurposeNotSupported Word
10 Encode Open (PlutusPurpose AsItem era -> AlonzoContextError era)
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
-> Encode Open (AlonzoContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PlutusPurpose AsItem era
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PlutusPurpose AsItem era
purpose

instance
  ( Era era
  , DecCBOR (TxCert era)
  , DecCBOR (PlutusPurpose AsItem era)
  ) =>
  DecCBOR (AlonzoContextError era)
  where
  decCBOR :: forall s. Decoder s (AlonzoContextError era)
decCBOR = Decode (Closed Dense) (AlonzoContextError era)
-> Decoder s (AlonzoContextError era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (AlonzoContextError era)
 -> Decoder s (AlonzoContextError era))
-> Decode (Closed Dense) (AlonzoContextError era)
-> Decoder s (AlonzoContextError era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (AlonzoContextError era))
-> Decode (Closed Dense) (AlonzoContextError era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ContextError" ((Word -> Decode Open (AlonzoContextError era))
 -> Decode (Closed Dense) (AlonzoContextError era))
-> (Word -> Decode Open (AlonzoContextError era))
-> Decode (Closed Dense) (AlonzoContextError era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
1 -> (TxIn -> AlonzoContextError era)
-> Decode Open (TxIn -> AlonzoContextError era)
forall t. t -> Decode Open t
SumD (forall era. TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era) Decode Open (TxIn -> AlonzoContextError era)
-> Decode (Closed (ZonkAny 0)) TxIn
-> Decode Open (AlonzoContextError 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)) TxIn
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
7 -> (Text -> AlonzoContextError era)
-> Decode Open (Text -> AlonzoContextError era)
forall t. t -> Decode Open t
SumD (forall era. Text -> AlonzoContextError era
TimeTranslationPastHorizon @era) Decode Open (Text -> AlonzoContextError era)
-> Decode (Closed (ZonkAny 1)) Text
-> Decode Open (AlonzoContextError 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)) Text
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> (TxCert era -> AlonzoContextError era)
-> Decode Open (TxCert era -> AlonzoContextError era)
forall t. t -> Decode Open t
SumD (forall era. TxCert era -> AlonzoContextError era
CertificateNotSupported @era) Decode Open (TxCert era -> AlonzoContextError era)
-> Decode (Closed (ZonkAny 2)) (TxCert era)
-> Decode Open (AlonzoContextError 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)) (TxCert era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> (PlutusPurpose AsItem era -> AlonzoContextError era)
-> Decode Open (PlutusPurpose AsItem era -> AlonzoContextError era)
forall t. t -> Decode Open t
SumD (forall era. PlutusPurpose AsItem era -> AlonzoContextError era
PlutusPurposeNotSupported @era) Decode Open (PlutusPurpose AsItem era -> AlonzoContextError era)
-> Decode (Closed (ZonkAny 3)) (PlutusPurpose AsItem era)
-> Decode Open (AlonzoContextError 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)) (PlutusPurpose AsItem era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (AlonzoContextError era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  (ToJSON (TxCert era), ToJSON (PlutusPurpose AsItem era)) =>
  ToJSON (AlonzoContextError era)
  where
  toJSON :: AlonzoContextError era -> Value
toJSON = \case
    TranslationLogicMissingInput TxIn
txin ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Transaction input does not exist in the UTxO: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TxIn -> Text
txInToText TxIn
txin
    TimeTranslationPastHorizon Text
msg ->
      Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
"Time translation requested past the horizon: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    CertificateNotSupported TxCert era
txCert ->
      Text -> [Pair] -> Value
kindObjectValue Text
"CertificateNotSupported" [Key
"certificate" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= TxCert era -> Value
forall a. ToJSON a => a -> Value
toJSON TxCert era
txCert]
    PlutusPurposeNotSupported PlutusPurpose AsItem era
purpose ->
      Text -> [Pair] -> Value
kindObjectValue Text
"PlutusPurposeNotSupported" [Key
"purpose" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= PlutusPurpose AsItem era -> Value
forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsItem era
purpose]

transLookupTxOut ::
  forall era.
  Inject (AlonzoContextError era) (ContextError era) =>
  UTxO era ->
  TxIn ->
  Either (ContextError era) (TxOut era)
transLookupTxOut :: forall era.
Inject (AlonzoContextError era) (ContextError era) =>
UTxO era -> TxIn -> Either (ContextError era) (TxOut era)
transLookupTxOut (UTxO Map TxIn (TxOut era)
utxo) TxIn
txIn =
  case TxIn -> Map TxIn (TxOut era) -> Maybe (TxOut era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
txIn Map TxIn (TxOut era)
utxo of
    Maybe (TxOut era)
Nothing -> ContextError era -> Either (ContextError era) (TxOut era)
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) (TxOut era))
-> ContextError era -> Either (ContextError era) (TxOut era)
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> ContextError era)
-> AlonzoContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era TxIn
txIn
    Just TxOut era
txOut -> TxOut era -> Either (ContextError era) (TxOut era)
forall a b. b -> Either a b
Right TxOut era
txOut

-- | Translate a validity interval to POSIX time
transValidityInterval ::
  forall proxy era.
  Inject (AlonzoContextError era) (ContextError era) =>
  proxy era ->
  EpochInfo (Either Text) ->
  SystemStart ->
  ValidityInterval ->
  Either (ContextError era) PV1.POSIXTimeRange
transValidityInterval :: forall (proxy :: * -> *) era.
Inject (AlonzoContextError era) (ContextError era) =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ContextError era) POSIXTimeRange
transValidityInterval proxy era
_ EpochInfo (Either Text)
epochInfo SystemStart
systemStart = \case
  ValidityInterval StrictMaybe SlotNo
SNothing StrictMaybe SlotNo
SNothing -> POSIXTimeRange -> Either (ContextError era) POSIXTimeRange
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure POSIXTimeRange
forall a. Interval a
PV1.always
  ValidityInterval (SJust SlotNo
i) StrictMaybe SlotNo
SNothing -> POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
PV1.from (POSIXTime -> POSIXTimeRange)
-> Either (ContextError era) POSIXTime
-> Either (ContextError era) POSIXTimeRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> Either (ContextError era) POSIXTime
transSlotToPOSIXTime SlotNo
i
  ValidityInterval StrictMaybe SlotNo
SNothing (SJust SlotNo
i) -> POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
PV1.to (POSIXTime -> POSIXTimeRange)
-> Either (ContextError era) POSIXTime
-> Either (ContextError era) POSIXTimeRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> Either (ContextError era) POSIXTime
transSlotToPOSIXTime SlotNo
i
  ValidityInterval (SJust SlotNo
i) (SJust SlotNo
j) -> do
    t1 <- SlotNo -> Either (ContextError era) POSIXTime
transSlotToPOSIXTime SlotNo
i
    t2 <- transSlotToPOSIXTime j
    pure $
      PV1.Interval
        (PV1.lowerBound t1)
        (PV1.strictUpperBound t2)
  where
    transSlotToPOSIXTime :: SlotNo -> Either (ContextError era) POSIXTime
transSlotToPOSIXTime =
      (Text -> ContextError era)
-> Either Text POSIXTime -> Either (ContextError era) POSIXTime
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 (AlonzoContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> ContextError era)
-> (Text -> AlonzoContextError era) -> Text -> ContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Text -> AlonzoContextError era
TimeTranslationPastHorizon @era)
        (Either Text POSIXTime -> Either (ContextError era) POSIXTime)
-> (SlotNo -> Either Text POSIXTime)
-> SlotNo
-> Either (ContextError era) POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text POSIXTime
slotToPOSIXTime EpochInfo (Either Text)
epochInfo SystemStart
systemStart

-- | Translate a TxOut. Returns `Nothing` if a Byron address is present in the TxOut.
transTxOut ::
  (Value era ~ MaryValue, AlonzoEraTxOut era) => TxOut era -> Maybe PV1.TxOut
transTxOut :: forall era.
(Value era ~ MaryValue, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
transTxOut TxOut era
txOut = do
  -- Minor optimization:
  -- We can check for Byron address without decompacting the address in the TxOut
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe BootstrapAddress -> Bool
forall a. Maybe a -> Bool
isNothing (TxOut era
txOut TxOut era
-> Getting
     (Maybe BootstrapAddress) (TxOut era) (Maybe BootstrapAddress)
-> Maybe BootstrapAddress
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe BootstrapAddress) (TxOut era) (Maybe BootstrapAddress)
forall era.
EraTxOut era =>
SimpleGetter (TxOut era) (Maybe BootstrapAddress)
SimpleGetter (TxOut era) (Maybe BootstrapAddress)
bootAddrTxOutF)
  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
      dataHash :: StrictMaybe DataHash
dataHash = TxOut era
txOut TxOut era
-> Getting
     (StrictMaybe DataHash) (TxOut era) (StrictMaybe DataHash)
-> StrictMaybe DataHash
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe DataHash) (TxOut era) (StrictMaybe DataHash)
forall era.
AlonzoEraTxOut era =>
Lens' (TxOut era) (StrictMaybe DataHash)
Lens' (TxOut era) (StrictMaybe DataHash)
dataHashTxOutL
  address <- 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)
  pure $ PV1.TxOut address (transValue val) (transDataHash <$> strictMaybeToMaybe dataHash)

transTxBodyId :: EraTxBody era => TxBody l era -> PV1.TxId
transTxBodyId :: forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
transTxBodyId TxBody l era
txBody = BuiltinByteString -> TxId
PV1.TxId (SafeHash EraIndependentTxBody -> BuiltinByteString
forall i. SafeHash i -> BuiltinByteString
transSafeHash (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated @_ @EraIndependentTxBody TxBody l era
txBody))

-- | Translate all `TxCert`s from within a `TxBody`
transTxBodyCerts ::
  (EraPlutusTxInfo l era, EraTxBody era) =>
  proxy l ->
  ProtVer ->
  TxBody t era ->
  Either (ContextError era) [PlutusTxCert l]
transTxBodyCerts :: forall (l :: Language) era (proxy :: Language -> *) (t :: TxLevel).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody t era
-> Either (ContextError era) [PlutusTxCert l]
transTxBodyCerts proxy l
proxy ProtVer
pv TxBody t era
txBody =
  (TxCert era -> Either (ContextError era) (PlutusTxCert l))
-> [TxCert era] -> Either (ContextError era) [PlutusTxCert l]
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
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (proxy :: Language -> *).
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
toPlutusTxCert proxy l
proxy ProtVer
pv) ([TxCert era] -> Either (ContextError era) [PlutusTxCert l])
-> [TxCert era] -> Either (ContextError era) [PlutusTxCert l]
forall a b. (a -> b) -> a -> b
$ StrictSeq (TxCert era) -> [TxCert era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody t era
txBody TxBody t era
-> Getting
     (StrictSeq (TxCert era)) (TxBody t era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody t era) (StrictSeq (TxCert era))
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL)

transWithdrawals :: Withdrawals -> Map.Map PV1.StakingCredential Integer
transWithdrawals :: Withdrawals -> Map StakingCredential Integer
transWithdrawals (Withdrawals Map AccountAddress Coin
mp) = (Map StakingCredential Integer
 -> AccountAddress -> Coin -> Map StakingCredential Integer)
-> Map StakingCredential Integer
-> Map AccountAddress Coin
-> Map StakingCredential Integer
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map StakingCredential Integer
-> AccountAddress -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
forall k a. Map k a
Map.empty Map AccountAddress Coin
mp
  where
    accum :: Map StakingCredential Integer
-> AccountAddress -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
ans AccountAddress
accountAddress (Coin Integer
n) =
      StakingCredential
-> Integer
-> Map StakingCredential Integer
-> Map StakingCredential Integer
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Credential -> StakingCredential
PV1.StakingHash (AccountAddress -> Credential
transAccountAddress AccountAddress
accountAddress)) Integer
n Map StakingCredential Integer
ans

-- | Translate all `Withdrawal`s from within a `TxBody`
transTxBodyWithdrawals :: EraTxBody era => TxBody t era -> [(PV1.StakingCredential, Integer)]
transTxBodyWithdrawals :: forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
transTxBodyWithdrawals TxBody t era
txBody = Map StakingCredential Integer -> [(StakingCredential, Integer)]
forall k a. Map k a -> [(k, a)]
Map.toList (Withdrawals -> Map StakingCredential Integer
transWithdrawals (TxBody t era
txBody TxBody t era
-> Getting Withdrawals (TxBody t era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody t era) Withdrawals
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL))

-- | Translate all required signers produced by `reqSignerHashesTxBodyL`s from within a
-- `TxBody`
transTxBodyReqSignerHashes :: AlonzoEraTxBody era => TxBody t era -> [PV1.PubKeyHash]
transTxBodyReqSignerHashes :: forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
transTxBodyReqSignerHashes TxBody t era
txBody = KeyHash Guard -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash (KeyHash Guard -> PubKeyHash) -> [KeyHash Guard] -> [PubKeyHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set (KeyHash Guard) -> [KeyHash Guard]
forall a. Set a -> [a]
Set.toList (TxBody t era
txBody TxBody t era
-> Getting
     (Set (KeyHash Guard)) (TxBody t era) (Set (KeyHash Guard))
-> Set (KeyHash Guard)
forall s a. s -> Getting a s a -> a
^. Getting (Set (KeyHash Guard)) (TxBody t era) (Set (KeyHash Guard))
forall era (l :: TxLevel).
AlonzoEraTxBody era =>
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
forall (l :: TxLevel).
SimpleGetter (TxBody l era) (Set (KeyHash Guard))
reqSignerHashesTxBodyG)

-- | Translate all `TxDats`s from within `TxWits`
transTxWitsDatums :: AlonzoEraTxWits era => TxWits era -> [(PV1.DatumHash, PV1.Datum)]
transTxWitsDatums :: forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
transTxWitsDatums TxWits era
txWits = (DataHash, Data era) -> (DatumHash, Datum)
forall era. (DataHash, Data era) -> (DatumHash, Datum)
transDataPair ((DataHash, Data era) -> (DatumHash, Datum))
-> [(DataHash, Data era)] -> [(DatumHash, Datum)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map DataHash (Data era) -> [(DataHash, Data era)]
forall k a. Map k a -> [(k, a)]
Map.toList (TxWits era
txWits TxWits era
-> Getting
     (Map DataHash (Data era)) (TxWits era) (Map DataHash (Data era))
-> Map DataHash (Data era)
forall s a. s -> Getting a s a -> a
^. (TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> TxWits era -> Const (Map DataHash (Data era)) (TxWits era)
forall era. AlonzoEraTxWits era => Lens' (TxWits era) (TxDats era)
Lens' (TxWits era) (TxDats era)
datsTxWitsL ((TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
 -> TxWits era -> Const (Map DataHash (Data era)) (TxWits era))
-> ((Map DataHash (Data era)
     -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
    -> TxDats era -> Const (Map DataHash (Data era)) (TxDats era))
-> Getting
     (Map DataHash (Data era)) (TxWits era) (Map DataHash (Data era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map DataHash (Data era)
 -> Const (Map DataHash (Data era)) (Map DataHash (Data era)))
-> TxDats era -> Const (Map DataHash (Data era)) (TxDats era)
forall era. Era era => Lens' (TxDats era) (Map DataHash (Data era))
Lens' (TxDats era) (Map DataHash (Data era))
unTxDatsL)

-- ==================================
-- translate Values

transPolicyID :: PolicyID -> PV1.CurrencySymbol
transPolicyID :: PolicyID -> CurrencySymbol
transPolicyID (PolicyID (ScriptHash Hash ADDRHASH EraIndependentScript
x)) = BuiltinByteString -> CurrencySymbol
PV1.CurrencySymbol (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV1.toBuiltin (Hash ADDRHASH EraIndependentScript -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash ADDRHASH EraIndependentScript
x))

transAssetName :: AssetName -> PV1.TokenName
transAssetName :: AssetName -> TokenName
transAssetName (AssetName ShortByteString
bs) = BuiltinByteString -> TokenName
PV1.TokenName (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV1.toBuiltin (ShortByteString -> ByteString
SBS.fromShort ShortByteString
bs))

transMultiAsset :: MultiAsset -> PV1.Value
transMultiAsset :: MultiAsset -> Value
transMultiAsset (MultiAsset Map PolicyID (Map AssetName Integer)
m) = Map CurrencySymbol (Map TokenName Integer) -> Value
PV1.Value ((PolicyID -> CurrencySymbol)
-> (Map AssetName Integer -> Map TokenName Integer)
-> Map PolicyID (Map AssetName Integer)
-> Map CurrencySymbol (Map TokenName Integer)
forall k pk v pv. (k -> pk) -> (v -> pv) -> Map k v -> Map pk pv
toAssocMap PolicyID -> CurrencySymbol
transPolicyID ((AssetName -> TokenName)
-> (Integer -> Integer)
-> Map AssetName Integer
-> Map TokenName Integer
forall k pk v pv. (k -> pk) -> (v -> pv) -> Map k v -> Map pk pv
toAssocMap AssetName -> TokenName
transAssetName Integer -> Integer
forall a. a -> a
id) Map PolicyID (Map AssetName Integer)
m)
  where
    toAssocMap :: (k -> pk) -> (v -> pv) -> Map.Map k v -> PV2.Map pk pv
    toAssocMap :: forall k pk v pv. (k -> pk) -> (v -> pv) -> Map k v -> Map pk pv
toAssocMap k -> pk
transKey v -> pv
transVal =
      [(pk, pv)] -> Map pk pv
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(pk, pv)] -> Map pk pv)
-> (Map k v -> [(pk, pv)]) -> Map k v -> Map pk pv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> v -> [(pk, pv)] -> [(pk, pv)])
-> [(pk, pv)] -> Map k v -> [(pk, pv)]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey' k -> v -> [(pk, pv)] -> [(pk, pv)]
accWithKey []
      where
        accWithKey :: k -> v -> [(pk, pv)] -> [(pk, pv)]
accWithKey k
key v
value ![(pk, pv)]
acc = (k -> pk
transKey k
key, v -> pv
transVal v
value) (pk, pv) -> [(pk, pv)] -> [(pk, pv)]
forall a. a -> [a] -> [a]
: [(pk, pv)]
acc

-- | Hysterical raisins:
--
-- Previously transaction body contained a mint field with MaryValue instead of a
-- MultiAsset, which has changed since then to just MultiAsset (because minting ADA
-- makes no sense). However, if we don't preserve previous translation, scripts that
-- previously succeeded will fail.
transMintValue :: MultiAsset -> PV1.Value
transMintValue :: MultiAsset -> Value
transMintValue MultiAsset
m = Coin -> Value
transCoinToValue Coin
forall t. Val t => t
zero Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> Value
transMultiAsset MultiAsset
m

transValue :: MaryValue -> PV1.Value
transValue :: MaryValue -> Value
transValue (MaryValue Coin
c MultiAsset
m) = Coin -> Value
transCoinToValue Coin
c Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> MultiAsset -> Value
transMultiAsset MultiAsset
m

-- =============================================
-- translate fields like TxCert, Withdrawals, and similar

transTxCert ::
  ( ShelleyEraTxCert era
  , AtMostEra "Babbage" era
  , Inject (AlonzoContextError era) (ContextError era)
  ) =>
  TxCert era -> Either (ContextError era) PV1.DCert
transTxCert :: forall era.
(ShelleyEraTxCert era, AtMostEra "Babbage" era,
 Inject (AlonzoContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCert = \case
  GenesisDelegTxCert {} -> DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right DCert
PV1.DCertGenesis
  MirTxCert {} -> DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right DCert
PV1.DCertMir
  TxCert era
txCert -> TxCert era -> Either (ContextError era) DCert
forall era.
(ShelleyEraTxCert era,
 Inject (AlonzoContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertCommon TxCert era
txCert

-- | Just like `transTxCert`, but do not translate certificates that were deprecated in Conway
transTxCertCommon ::
  ( ShelleyEraTxCert era
  , Inject (AlonzoContextError era) (ContextError era)
  ) =>
  TxCert era -> Either (ContextError era) PV1.DCert
transTxCertCommon :: forall era.
(ShelleyEraTxCert era,
 Inject (AlonzoContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertCommon = \case
  RegTxCert Credential Staking
stakeCred ->
    DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right (DCert -> Either (ContextError era) DCert)
-> DCert -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegRegKey (Credential -> StakingCredential
PV1.StakingHash (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred))
  UnRegTxCert Credential Staking
stakeCred ->
    DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right (DCert -> Either (ContextError era) DCert)
-> DCert -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegDeRegKey (Credential -> StakingCredential
PV1.StakingHash (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred))
  DelegStakeTxCert Credential Staking
stakeCred KeyHash StakePool
keyHash ->
    DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right (DCert -> Either (ContextError era) DCert)
-> DCert -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> PubKeyHash -> DCert
PV1.DCertDelegDelegate (Credential -> StakingCredential
PV1.StakingHash (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred)) (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
keyHash)
  RegPoolTxCert (StakePoolParams {KeyHash StakePool
sppId :: KeyHash StakePool
sppId :: forall era. StakePoolParams era -> KeyHash StakePool
sppId, VRFVerKeyHash StakePoolVRF
sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf :: forall era. StakePoolParams era -> VRFVerKeyHash StakePoolVRF
sppVrf}) ->
    DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right (DCert -> Either (ContextError era) DCert)
-> DCert -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$
      PubKeyHash -> PubKeyHash -> DCert
PV1.DCertPoolRegister
        (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
sppId)
        (BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV1.toBuiltin (Hash HASH KeyRoleVRF -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (VRFVerKeyHash StakePoolVRF -> Hash HASH KeyRoleVRF
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash VRFVerKeyHash StakePoolVRF
sppVrf))))
  RetirePoolTxCert KeyHash StakePool
poolId EpochNo
retireEpochNo ->
    DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right (DCert -> Either (ContextError era) DCert)
-> DCert -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$ PubKeyHash -> Integer -> DCert
PV1.DCertPoolRetire (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId) (EpochNo -> Integer
transEpochNo EpochNo
retireEpochNo)
  TxCert era
txCert -> ContextError era -> Either (ContextError era) DCert
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) DCert)
-> ContextError era -> Either (ContextError era) DCert
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> ContextError era)
-> AlonzoContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ TxCert era -> AlonzoContextError era
forall era. TxCert era -> AlonzoContextError era
CertificateNotSupported TxCert era
txCert

transPlutusPurpose ::
  forall l era proxy.
  ( PlutusTxCert l ~ PV1.DCert
  , EraPlutusTxInfo l era
  , Inject (AlonzoContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  PlutusPurpose AsIxItem era ->
  Either (ContextError era) PV1.ScriptPurpose
transPlutusPurpose :: forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (AlonzoContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurpose proxy l
proxy ProtVer
pv = \case
  SpendingPurpose (AsIxItem Word32
_ TxIn
txIn) -> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptPurpose -> Either (ContextError era) ScriptPurpose)
-> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ TxOutRef -> ScriptPurpose
PV1.Spending (TxIn -> TxOutRef
transTxIn TxIn
txIn)
  MintingPurpose (AsIxItem Word32
_ PolicyID
policyId) -> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptPurpose -> Either (ContextError era) ScriptPurpose)
-> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ CurrencySymbol -> ScriptPurpose
PV1.Minting (PolicyID -> CurrencySymbol
transPolicyID PolicyID
policyId)
  CertifyingPurpose (AsIxItem Word32
_ TxCert era
txCert) -> DCert -> ScriptPurpose
PV1.Certifying (DCert -> ScriptPurpose)
-> Either (ContextError era) DCert
-> Either (ContextError era) ScriptPurpose
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (proxy :: Language -> *).
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
toPlutusTxCert proxy l
proxy ProtVer
pv TxCert era
txCert
  WithdrawingPurpose (AsIxItem Word32
_ AccountAddress
accountAddress) ->
    ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptPurpose -> Either (ContextError era) ScriptPurpose)
-> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ StakingCredential -> ScriptPurpose
PV1.Rewarding (Credential -> StakingCredential
PV1.StakingHash (AccountAddress -> Credential
transAccountAddress AccountAddress
accountAddress))
  PlutusPurpose AsIxItem era
purpose -> ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ScriptPurpose)
-> ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> ContextError era)
-> AlonzoContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> AlonzoContextError era
PlutusPurposeNotSupported @era (PlutusPurpose AsItem era -> AlonzoContextError era)
-> PlutusPurpose AsItem era -> AlonzoContextError 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
purpose