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

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

  -- * LgacyPlutusArgs 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 (AlonzoPlutusPurpose (..), PlutusScript (..), toAsItem)
import Cardano.Ledger.Alonzo.TxWits (unTxDatsL)
import Cardano.Ledger.BaseTypes (ProtVer, StrictMaybe (..), 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.Data (Data, getPlutusData)
import Cardano.Ledger.Plutus.Language (
  Language (..),
  LegacyPlutusArgs (..),
  PlutusArgs (..),
  SLanguage (..),
 )
import Cardano.Ledger.Plutus.TxInfo
import Cardano.Ledger.PoolParams (PoolParams (..))
import Cardano.Ledger.Rules.ValidationMode (Inject (..))
import qualified Cardano.Ledger.Shelley.HardForks as HardForks
import Cardano.Ledger.State (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 NoThunks.Class (NoThunks)
import qualified PlutusLedgerApi.V1 as PV1

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

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy ProtVer
pv = proxy 'PlutusV1
-> ProtVer
-> AlonzoPlutusPurpose AsItem AlonzoEra
-> Either (ContextError AlonzoEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurpose proxy 'PlutusV1
proxy ProtVer
pv (AlonzoPlutusPurpose AsItem AlonzoEra
 -> Either (AlonzoContextError AlonzoEra) ScriptPurpose)
-> (AlonzoPlutusPurpose AsIxItem AlonzoEra
    -> AlonzoPlutusPurpose AsItem AlonzoEra)
-> AlonzoPlutusPurpose AsIxItem AlonzoEra
-> Either (AlonzoContextError AlonzoEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem AlonzoEra
-> PlutusPurpose AsItem AlonzoEra
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 AlonzoEra -> PlutusPurpose f AlonzoEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo AlonzoEra
-> Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo proxy 'PlutusV1
proxy LedgerTxInfo {ProtVer
ltiProtVer :: ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart, UTxO AlonzoEra
ltiUTxO :: UTxO AlonzoEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx AlonzoEra
ltiTx :: Tx AlonzoEra
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx} = do
    POSIXTimeRange
timeRange <-
      AlonzoTx AlonzoEra
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (AlonzoContextError AlonzoEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval Tx AlonzoEra
AlonzoTx AlonzoEra
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting ValidityInterval (TxBody AlonzoEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody AlonzoEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody AlonzoEra) ValidityInterval
vldtTxBodyL)
    [Maybe TxInInfo]
txInsMaybes <- [TxIn]
-> (TxIn -> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo))
-> Either (AlonzoContextError AlonzoEra) [Maybe TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody AlonzoEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody AlonzoEra) (Set TxIn)
inputsTxBodyL)) ((TxIn -> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo))
 -> Either (AlonzoContextError AlonzoEra) [Maybe TxInInfo])
-> (TxIn -> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo))
-> Either (AlonzoContextError AlonzoEra) [Maybe TxInInfo]
forall a b. (a -> b) -> a -> b
$ \TxIn
txIn -> do
      AlonzoTxOut AlonzoEra
txOut <- UTxO AlonzoEra
-> TxIn -> Either (AlonzoContextError AlonzoEra) (TxOut AlonzoEra)
forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn -> Either a (TxOut era)
transLookupTxOut UTxO AlonzoEra
ltiUTxO TxIn
txIn
      Maybe TxInInfo
-> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo)
forall a. a -> Either (AlonzoContextError AlonzoEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TxInInfo
 -> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo))
-> Maybe TxInInfo
-> Either (AlonzoContextError AlonzoEra) (Maybe TxInInfo)
forall a b. (a -> b) -> a -> b
$ TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (TxIn -> TxOutRef
transTxIn TxIn
txIn) (TxOut -> TxInInfo) -> Maybe TxOut -> Maybe TxInInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxOut AlonzoEra -> Maybe TxOut
forall era.
(Value era ~ MaryValue, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
transTxOut TxOut AlonzoEra
AlonzoTxOut AlonzoEra
txOut
    [DCert]
txCerts <- proxy 'PlutusV1
-> ProtVer
-> TxBody AlonzoEra
-> Either (ContextError AlonzoEra) [PlutusTxCert 'PlutusV1]
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
transTxBodyCerts proxy 'PlutusV1
proxy ProtVer
ltiProtVer TxBody AlonzoEra
txBody
    TxInfo -> Either (AlonzoContextError AlonzoEra) TxInfo
forall a b. b -> Either a b
Right (TxInfo -> Either (AlonzoContextError AlonzoEra) TxInfo)
-> TxInfo -> Either (AlonzoContextError AlonzoEra) TxInfo
forall a b. (a -> b) -> a -> b
$
      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 AlonzoEra
txBody TxBody AlonzoEra
-> Getting
     (StrictSeq (TxOut AlonzoEra))
     (TxBody AlonzoEra)
     (StrictSeq (TxOut AlonzoEra))
-> StrictSeq (TxOut AlonzoEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut AlonzoEra))
  (TxBody AlonzoEra)
  (StrictSeq (TxOut AlonzoEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody AlonzoEra) (StrictSeq (TxOut AlonzoEra))
outputsTxBodyL)
        , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody AlonzoEra
txBody TxBody AlonzoEra -> Getting Coin (TxBody AlonzoEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody AlonzoEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody AlonzoEra) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV1.txInfoMint = MultiAsset -> Value
transMintValue (TxBody AlonzoEra
txBody TxBody AlonzoEra
-> Getting MultiAsset (TxBody AlonzoEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody AlonzoEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody AlonzoEra) MultiAsset
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = TxBody AlonzoEra -> [(StakingCredential, Integer)]
forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
transTxBodyWithdrawals TxBody AlonzoEra
txBody
        , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = TxBody AlonzoEra -> [PubKeyHash]
forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
transTxBodyReqSignerHashes TxBody AlonzoEra
txBody
        , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = TxWits AlonzoEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
transTxWitsDatums (Tx AlonzoEra
AlonzoTx AlonzoEra
ltiTx AlonzoTx AlonzoEra
-> Getting
     (TxWits AlonzoEra) (AlonzoTx AlonzoEra) (TxWits AlonzoEra)
-> TxWits AlonzoEra
forall s a. s -> Getting a s a -> a
^. (TxWits AlonzoEra -> Const (TxWits AlonzoEra) (TxWits AlonzoEra))
-> Tx AlonzoEra -> Const (TxWits AlonzoEra) (Tx AlonzoEra)
Getting (TxWits AlonzoEra) (AlonzoTx AlonzoEra) (TxWits AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx AlonzoEra) (TxWits AlonzoEra)
witsTxL)
        , txInfoId :: TxId
PV1.txInfoId = TxBody AlonzoEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
transTxBodyId TxBody AlonzoEra
txBody
        }
    where
      txBody :: TxBody AlonzoEra
txBody = Tx AlonzoEra
AlonzoTx AlonzoEra
ltiTx AlonzoTx AlonzoEra
-> Getting
     (TxBody AlonzoEra) (AlonzoTx AlonzoEra) (TxBody AlonzoEra)
-> TxBody AlonzoEra
forall s a. s -> Getting a s a -> a
^. (TxBody AlonzoEra -> Const (TxBody AlonzoEra) (TxBody AlonzoEra))
-> Tx AlonzoEra -> Const (TxBody AlonzoEra) (Tx AlonzoEra)
Getting (TxBody AlonzoEra) (AlonzoTx AlonzoEra) (TxBody AlonzoEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx AlonzoEra) (TxBody AlonzoEra)
bodyTxL

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

toPlutusV1Args ::
  EraPlutusTxInfo 'PlutusV1 era =>
  proxy 'PlutusV1 ->
  ProtVer ->
  PV1.TxInfo ->
  PlutusPurpose AsIxItem era ->
  Maybe (Data era) ->
  Data era ->
  Either (ContextError era) (PlutusArgs 'PlutusV1)
toPlutusV1Args :: forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV1 era =>
proxy 'PlutusV1
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV1)
toPlutusV1Args proxy 'PlutusV1
proxy ProtVer
pv TxInfo
txInfo PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData 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
-> ProtVer
-> (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
-> ProtVer
-> (PlutusScriptPurpose l -> PlutusScriptContext l)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs l)
toLegacyPlutusArgs proxy 'PlutusV1
proxy ProtVer
pv (TxInfo -> ScriptPurpose -> ScriptContext
PV1.ScriptContext TxInfo
txInfo) PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData

toLegacyPlutusArgs ::
  EraPlutusTxInfo l era =>
  proxy l ->
  ProtVer ->
  (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
-> ProtVer
-> (PlutusScriptPurpose l -> PlutusScriptContext l)
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (LegacyPlutusArgs l)
toLegacyPlutusArgs proxy l
proxy ProtVer
pv PlutusScriptPurpose l -> PlutusScriptContext l
mkScriptContext PlutusPurpose AsIxItem era
scriptPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData = do
  PlutusScriptContext l
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
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (proxy :: Language -> *).
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
toPlutusScriptPurpose proxy l
proxy ProtVer
pv PlutusPurpose AsIxItem era
scriptPurpose
  let redeemer :: Data
redeemer = Data era -> Data
forall era. Data era -> Data
getPlutusData Data era
redeemerData
  LegacyPlutusArgs l
-> Either (ContextError era) (LegacyPlutusArgs l)
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LegacyPlutusArgs l
 -> Either (ContextError era) (LegacyPlutusArgs l))
-> LegacyPlutusArgs l
-> Either (ContextError era) (LegacyPlutusArgs l)
forall a b. (a -> b) -> a -> b
$ case Maybe (Data era)
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 (Either (ContextError AlonzoEra) (PlutusTxInfo 'PlutusV1))

  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

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

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

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

data AlonzoContextError era
  = TranslationLogicMissingInput !TxIn
  | TimeTranslationPastHorizon !Text
  deriving (AlonzoContextError era -> AlonzoContextError era -> Bool
(AlonzoContextError era -> AlonzoContextError era -> Bool)
-> (AlonzoContextError era -> AlonzoContextError era -> Bool)
-> Eq (AlonzoContextError era)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (era :: k).
AlonzoContextError era -> AlonzoContextError era -> Bool
$c== :: forall k (era :: k).
AlonzoContextError era -> AlonzoContextError era -> Bool
== :: AlonzoContextError era -> AlonzoContextError era -> Bool
$c/= :: forall k (era :: k).
AlonzoContextError era -> AlonzoContextError era -> Bool
/= :: AlonzoContextError era -> AlonzoContextError era -> Bool
Eq, Int -> AlonzoContextError era -> ShowS
[AlonzoContextError era] -> ShowS
AlonzoContextError era -> String
(Int -> AlonzoContextError era -> ShowS)
-> (AlonzoContextError era -> String)
-> ([AlonzoContextError era] -> ShowS)
-> Show (AlonzoContextError era)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (era :: k). Int -> AlonzoContextError era -> ShowS
forall k (era :: k). [AlonzoContextError era] -> ShowS
forall k (era :: k). AlonzoContextError era -> String
$cshowsPrec :: forall k (era :: k). Int -> AlonzoContextError era -> ShowS
showsPrec :: Int -> AlonzoContextError era -> ShowS
$cshow :: forall k (era :: k). AlonzoContextError era -> String
show :: AlonzoContextError era -> String
$cshowList :: forall k (era :: k). [AlonzoContextError era] -> ShowS
showList :: [AlonzoContextError era] -> ShowS
Show, (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 k (era :: k) x.
Rep (AlonzoContextError era) x -> AlonzoContextError era
forall k (era :: k) x.
AlonzoContextError era -> Rep (AlonzoContextError era) x
$cfrom :: forall k (era :: k) x.
AlonzoContextError era -> Rep (AlonzoContextError era) x
from :: forall x. AlonzoContextError era -> Rep (AlonzoContextError era) x
$cto :: forall k (era :: k) x.
Rep (AlonzoContextError era) x -> AlonzoContextError era
to :: forall x. Rep (AlonzoContextError era) x -> AlonzoContextError era
Generic)

instance NoThunks (AlonzoContextError era)

instance Era era => NFData (AlonzoContextError era)

instance Era 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
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
    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
forall {k} (era :: k). 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

instance Era 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
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era) Decode 'Open (TxIn -> AlonzoContextError era)
-> Decode ('Closed Any) 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 Any) 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
forall {k} (era :: k). Text -> AlonzoContextError era
TimeTranslationPastHorizon @era) Decode 'Open (Text -> AlonzoContextError era)
-> Decode ('Closed Any) 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 Any) Text
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 (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

transLookupTxOut ::
  forall era a.
  Inject (AlonzoContextError era) a =>
  UTxO era ->
  TxIn ->
  Either a (TxOut era)
transLookupTxOut :: forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn -> Either a (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 -> a -> Either a (TxOut era)
forall a b. a -> Either a b
Left (a -> Either a (TxOut era)) -> a -> Either a (TxOut era)
forall a b. (a -> b) -> a -> b
$ AlonzoContextError era -> a
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> a) -> AlonzoContextError era -> a
forall a b. (a -> b) -> a -> b
$ forall era. TxIn -> AlonzoContextError era
forall {k} (era :: k). TxIn -> AlonzoContextError era
TranslationLogicMissingInput @era TxIn
txIn
    Just TxOut era
txOut -> TxOut era -> Either a (TxOut era)
forall a b. b -> Either a b
Right TxOut era
txOut

-- | Translate a validity interval to POSIX time
transValidityInterval ::
  forall proxy era a.
  Inject (AlonzoContextError era) a =>
  proxy era ->
  ProtVer ->
  EpochInfo (Either Text) ->
  SystemStart ->
  ValidityInterval ->
  Either a PV1.POSIXTimeRange
transValidityInterval :: forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval proxy era
_ ProtVer
protVer EpochInfo (Either Text)
epochInfo SystemStart
systemStart = \case
  ValidityInterval StrictMaybe SlotNo
SNothing StrictMaybe SlotNo
SNothing -> POSIXTimeRange -> Either a POSIXTimeRange
forall a. a -> Either a 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 a POSIXTime -> Either a POSIXTimeRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
i
  ValidityInterval StrictMaybe SlotNo
SNothing (SJust SlotNo
i) -> do
    POSIXTime
t <- SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
i
    POSIXTimeRange -> Either a POSIXTimeRange
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTimeRange -> Either a POSIXTimeRange)
-> POSIXTimeRange -> Either a POSIXTimeRange
forall a b. (a -> b) -> a -> b
$
      if ProtVer -> Bool
HardForks.translateUpperBoundForPlutusScripts ProtVer
protVer
        then
          LowerBound POSIXTime -> UpperBound POSIXTime -> POSIXTimeRange
forall a. LowerBound a -> UpperBound a -> Interval a
PV1.Interval
            (Extended POSIXTime -> Bool -> LowerBound POSIXTime
forall a. Extended a -> Bool -> LowerBound a
PV1.LowerBound Extended POSIXTime
forall a. Extended a
PV1.NegInf Bool
True)
            (POSIXTime -> UpperBound POSIXTime
forall a. a -> UpperBound a
PV1.strictUpperBound POSIXTime
t)
        else POSIXTime -> POSIXTimeRange
forall a. a -> Interval a
PV1.to POSIXTime
t
  ValidityInterval (SJust SlotNo
i) (SJust SlotNo
j) -> do
    POSIXTime
t1 <- SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
i
    POSIXTime
t2 <- SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
j
    POSIXTimeRange -> Either a POSIXTimeRange
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (POSIXTimeRange -> Either a POSIXTimeRange)
-> POSIXTimeRange -> Either a POSIXTimeRange
forall a b. (a -> b) -> a -> b
$
      LowerBound POSIXTime -> UpperBound POSIXTime -> POSIXTimeRange
forall a. LowerBound a -> UpperBound a -> Interval a
PV1.Interval
        (POSIXTime -> LowerBound POSIXTime
forall a. a -> LowerBound a
PV1.lowerBound POSIXTime
t1)
        (POSIXTime -> UpperBound POSIXTime
forall a. a -> UpperBound a
PV1.strictUpperBound POSIXTime
t2)
  where
    transSlotToPOSIXTime :: SlotNo -> Either a POSIXTime
transSlotToPOSIXTime =
      (Text -> a) -> Either Text POSIXTime -> Either a 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 -> a
forall t s. Inject t s => t -> s
inject (AlonzoContextError era -> a)
-> (Text -> AlonzoContextError era) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (era :: k). Text -> AlonzoContextError era
forall {k} (era :: k). Text -> AlonzoContextError era
TimeTranslationPastHorizon @era)
        (Either Text POSIXTime -> Either a POSIXTime)
-> (SlotNo -> Either Text POSIXTime)
-> SlotNo
-> Either a 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
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)
  TxOut -> Maybe TxOut
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxOut -> Maybe TxOut) -> TxOut -> Maybe TxOut
forall a b. (a -> b) -> a -> b
$ Address -> Value -> Maybe DatumHash -> TxOut
PV1.TxOut Address
address (MaryValue -> Value
transValue MaryValue
val) (DataHash -> DatumHash
transDataHash (DataHash -> DatumHash) -> Maybe DataHash -> Maybe DatumHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMaybe DataHash -> Maybe DataHash
forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe DataHash
dataHash)

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

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

transWithdrawals :: Withdrawals -> Map.Map PV1.StakingCredential Integer
transWithdrawals :: Withdrawals -> Map StakingCredential Integer
transWithdrawals (Withdrawals Map RewardAccount Coin
mp) = (Map StakingCredential Integer
 -> RewardAccount -> Coin -> Map StakingCredential Integer)
-> Map StakingCredential Integer
-> Map RewardAccount Coin
-> Map StakingCredential Integer
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Map StakingCredential Integer
-> RewardAccount -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
forall k a. Map k a
Map.empty Map RewardAccount Coin
mp
  where
    accum :: Map StakingCredential Integer
-> RewardAccount -> Coin -> Map StakingCredential Integer
accum Map StakingCredential Integer
ans RewardAccount
rewardAccount (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 (RewardAccount -> Credential
transRewardAccount RewardAccount
rewardAccount)) Integer
n Map StakingCredential Integer
ans

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

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

-- | 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
ma = MultiAsset -> Value -> Value
transMultiAssetInternal MultiAsset
ma Value
forall a. Monoid a => a
mempty

transMultiAssetInternal :: MultiAsset -> PV1.Value -> PV1.Value
transMultiAssetInternal :: MultiAsset -> Value -> Value
transMultiAssetInternal (MultiAsset Map PolicyID (Map AssetName Integer)
m) Value
initAcc = (Value -> PolicyID -> Map AssetName Integer -> Value)
-> Value -> Map PolicyID (Map AssetName Integer) -> Value
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Value -> PolicyID -> Map AssetName Integer -> Value
accum1 Value
initAcc Map PolicyID (Map AssetName Integer)
m
  where
    accum1 :: Value -> PolicyID -> Map AssetName Integer -> Value
accum1 Value
ans PolicyID
sym Map AssetName Integer
mp2 = (Value -> AssetName -> Integer -> Value)
-> Value -> Map AssetName Integer -> Value
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey' Value -> AssetName -> Integer -> Value
accum2 Value
ans Map AssetName Integer
mp2
      where
        accum2 :: Value -> AssetName -> Integer -> Value
accum2 Value
ans2 AssetName
tok Integer
quantity =
          (Integer -> Integer -> Integer) -> Value -> Value -> Value
PV1.unionWith
            Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(+)
            Value
ans2
            (CurrencySymbol -> TokenName -> Integer -> Value
PV1.singleton (PolicyID -> CurrencySymbol
transPolicyID PolicyID
sym) (AssetName -> TokenName
transAssetName AssetName
tok) Integer
quantity)

-- | 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 = MultiAsset -> Value -> Value
transMultiAssetInternal MultiAsset
m (Coin -> Value
transCoinToValue Coin
forall t. Val t => t
zero)

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, ProtVerAtMost era 8) => TxCert era -> PV1.DCert
transTxCert :: forall era.
(ShelleyEraTxCert era, ProtVerAtMost era 8) =>
TxCert era -> DCert
transTxCert TxCert era
txCert =
  case TxCert era -> Maybe DCert
forall era. ShelleyEraTxCert era => TxCert era -> Maybe DCert
transTxCertCommon TxCert era
txCert of
    Just DCert
cert -> DCert
cert
    Maybe DCert
Nothing ->
      case TxCert era
txCert of
        GenesisDelegTxCert {} -> DCert
PV1.DCertGenesis
        MirTxCert {} -> DCert
PV1.DCertMir
        TxCert era
_ -> String -> DCert
forall a. HasCallStack => String -> a
error String
"Impossible: All certificates should have been accounted for"

-- | Just like `transTxCert`, but do not translate certificates that were deprecated in Conway
transTxCertCommon :: ShelleyEraTxCert era => TxCert era -> Maybe PV1.DCert
transTxCertCommon :: forall era. ShelleyEraTxCert era => TxCert era -> Maybe DCert
transTxCertCommon = \case
  RegTxCert StakeCredential
stakeCred ->
    DCert -> Maybe DCert
forall a. a -> Maybe a
Just (DCert -> Maybe DCert) -> DCert -> Maybe DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegRegKey (Credential -> StakingCredential
PV1.StakingHash (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred))
  UnRegTxCert StakeCredential
stakeCred ->
    DCert -> Maybe DCert
forall a. a -> Maybe a
Just (DCert -> Maybe DCert) -> DCert -> Maybe DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegDeRegKey (Credential -> StakingCredential
PV1.StakingHash (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred))
  DelegStakeTxCert StakeCredential
stakeCred KeyHash 'StakePool
keyHash ->
    DCert -> Maybe DCert
forall a. a -> Maybe a
Just (DCert -> Maybe DCert) -> DCert -> Maybe DCert
forall a b. (a -> b) -> a -> b
$ StakingCredential -> PubKeyHash -> DCert
PV1.DCertDelegDelegate (Credential -> StakingCredential
PV1.StakingHash (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred)) (KeyHash 'StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash 'StakePool
keyHash)
  RegPoolTxCert (PoolParams {KeyHash 'StakePool
ppId :: KeyHash 'StakePool
ppId :: PoolParams -> KeyHash 'StakePool
ppId, VRFVerKeyHash 'StakePoolVRF
ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf :: PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf}) ->
    DCert -> Maybe DCert
forall a. a -> Maybe a
Just (DCert -> Maybe DCert) -> DCert -> Maybe 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
ppId)
        (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
ppVrf))))
  RetirePoolTxCert KeyHash 'StakePool
poolId EpochNo
retireEpochNo ->
    DCert -> Maybe DCert
forall a. a -> Maybe a
Just (DCert -> Maybe DCert) -> DCert -> Maybe 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
_ -> Maybe DCert
forall a. Maybe a
Nothing

transPlutusPurpose ::
  (EraPlutusTxInfo l era, PlutusTxCert l ~ PV1.DCert) =>
  proxy l ->
  ProtVer ->
  AlonzoPlutusPurpose AsItem era ->
  Either (ContextError era) PV1.ScriptPurpose
transPlutusPurpose :: forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurpose proxy l
proxy ProtVer
pv = \case
  AlonzoSpending (AsItem 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)
  AlonzoMinting (AsItem 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)
  AlonzoCertifying (AsItem 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
  AlonzoRewarding (AsItem RewardAccount
rewardAccount) ->
    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 (RewardAccount -> Credential
transRewardAccount RewardAccount
rewardAccount))