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

module Cardano.Ledger.Conway.TxInfo (
  ConwayContextError (..),
  ConwayEraPlutusTxInfo (..),
  transTxBodyWithdrawals,
  transTxCert,
  transDRepCred,
  transColdCommitteeCred,
  transHotCommitteeCred,
  transDelegatee,
  transDRep,
  transMap,
  transTxInInfoV1,
  transTxOutV1,
  transMintValue,
  transTxBodyId,
  transValidityInterval,
  transVotingProcedures,
  transProposal,
  toPlutusV3Args,
  transTxCertV1V2,
  transPlutusPurposeV1V2,
  transPlutusPurposeV3,
  guardConwayFeaturesForPlutusV1V2,
  transTxInInfoV3,
  scriptPurposeToScriptInfo,
  checkReferenceInputsNotDisjointFromInputs,
) where

import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusTxCert,
  PlutusTxInfoResult (..),
  SupportedLanguage (..),
  lookupTxInfoResultImpossible,
  toPlutusWithContext,
 )
import Cardano.Ledger.Alonzo.Plutus.TxInfo (AlonzoContextError (..), TxOutSource (..))
import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo
import Cardano.Ledger.Alonzo.Scripts (AlonzoPlutusPurpose (..), toAsItem)
import Cardano.Ledger.Babbage.TxInfo (BabbageContextError (..), transTxOutV2)
import qualified Cardano.Ledger.Babbage.TxInfo as Babbage
import Cardano.Ledger.BaseTypes (
  Inject (..),
  ProtVer (..),
  StrictMaybe (..),
  getVersion32,
  isSJust,
  kindObject,
  strictMaybe,
  txIxToInt,
 )
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), natVersion)
import Cardano.Ledger.Binary.Coders (
  Decode (..),
  Encode (..),
  decode,
  encode,
  (!>),
  (<!),
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.Era (ConwayEra, hardforkConwayBootstrapPhase)
import Cardano.Ledger.Conway.Governance (
  Constitution (..),
  GovAction (..),
  GovActionId (..),
  GovPurposeId (..),
  ProposalProcedure (..),
  Vote (..),
  Voter (..),
  VotingProcedure (..),
  VotingProcedures (..),
  unGovActionIx,
 )
import Cardano.Ledger.Conway.Scripts (PlutusScript (..))
import Cardano.Ledger.Conway.State
import Cardano.Ledger.Conway.Tx ()
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Conway.UTxO ()
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Mary (MaryValue)
import Cardano.Ledger.Mary.Value (MultiAsset)
import Cardano.Ledger.Plutus.Data (Data)
import Cardano.Ledger.Plutus.Language (Language (..), PlutusArgs (..), SLanguage (..))
import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
import Cardano.Ledger.Plutus.TxInfo (
  slotToPOSIXTime,
  transAccountAddress,
  transBoundedRational,
  transCoinToLovelace,
  transCoinToValue,
  transCred,
  transDatum,
  transEpochNo,
  transKeyHash,
  transSafeHash,
  transScriptHash,
 )
import qualified Cardano.Ledger.Plutus.TxInfo as TxInfo
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Slotting.EpochInfo (EpochInfo)
import Cardano.Slotting.Time (SystemStart)
import Control.Arrow (ArrowChoice (..))
import Control.DeepSeq (NFData)
import Control.Monad (unless, when, zipWithM)
import Data.Aeson (ToJSON (..), (.=))
import Data.Foldable as F (Foldable (..))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import qualified Data.Set as Set
import Data.Text (Text)
import GHC.Generics hiding (to)
import Lens.Micro ((^.))
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
import qualified PlutusLedgerApi.V3.MintValue as PV3

instance EraPlutusContext ConwayEra where
  type ContextError ConwayEra = ConwayContextError ConwayEra

  data TxInfoResult ConwayEra
    = ConwayTxInfoResult -- Fields must be kept lazy
        (PlutusTxInfoResult 'PlutusV1 ConwayEra)
        (PlutusTxInfoResult 'PlutusV2 ConwayEra)
        (PlutusTxInfoResult 'PlutusV3 ConwayEra)

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

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

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

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

data ConwayContextError era
  = BabbageContextError (BabbageContextError era)
  | CertificateNotSupported (TxCert era)
  | PlutusPurposeNotSupported (PlutusPurpose AsItem era)
  | CurrentTreasuryFieldNotSupported Coin
  | VotingProceduresFieldNotSupported (VotingProcedures era)
  | ProposalProceduresFieldNotSupported (OSet.OSet (ProposalProcedure era))
  | TreasuryDonationFieldNotSupported Coin
  | ReferenceInputsNotDisjointFromInputs (NonEmpty TxIn)
  deriving ((forall x.
 ConwayContextError era -> Rep (ConwayContextError era) x)
-> (forall x.
    Rep (ConwayContextError era) x -> ConwayContextError era)
-> Generic (ConwayContextError era)
forall x. Rep (ConwayContextError era) x -> ConwayContextError era
forall x. ConwayContextError era -> Rep (ConwayContextError era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ConwayContextError era) x -> ConwayContextError era
forall era x.
ConwayContextError era -> Rep (ConwayContextError era) x
$cfrom :: forall era x.
ConwayContextError era -> Rep (ConwayContextError era) x
from :: forall x. ConwayContextError era -> Rep (ConwayContextError era) x
$cto :: forall era x.
Rep (ConwayContextError era) x -> ConwayContextError era
to :: forall x. Rep (ConwayContextError era) x -> ConwayContextError era
Generic)

deriving instance
  ( Eq (BabbageContextError era)
  , Eq (TxCert era)
  , Eq (PlutusPurpose AsItem era)
  , Eq (PlutusPurpose AsIx era)
  , EraPParams era
  ) =>
  Eq (ConwayContextError era)

deriving instance
  ( Show (BabbageContextError era)
  , Show (TxCert era)
  , Show (PlutusPurpose AsItem era)
  , Show (PlutusPurpose AsIx era)
  , EraPParams era
  ) =>
  Show (ConwayContextError era)

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

instance Inject (AlonzoContextError era) (ConwayContextError era) where
  inject :: AlonzoContextError era -> ConwayContextError era
inject = BabbageContextError era -> ConwayContextError era
forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError (BabbageContextError era -> ConwayContextError era)
-> (AlonzoContextError era -> BabbageContextError era)
-> AlonzoContextError era
-> ConwayContextError era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AlonzoContextError era -> BabbageContextError era
forall t s. Inject t s => t -> s
inject

instance
  ( EraPParams era
  , NFData (TxCert era)
  , NFData (PlutusPurpose AsIx era)
  , NFData (PlutusPurpose AsItem era)
  ) =>
  NFData (ConwayContextError era)

instance
  ( EraPParams era
  , EncCBOR (TxCert era)
  , EncCBOR (PlutusPurpose AsIx era)
  , EncCBOR (PlutusPurpose AsItem era)
  ) =>
  EncCBOR (ConwayContextError era)
  where
  encCBOR :: ConwayContextError era -> Encoding
encCBOR = \case
    -- We start at tag 8, just in case to avoid clashes with previous eras.
    BabbageContextError BabbageContextError era
babbageContextError ->
      Encode Open (ConwayContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError era) -> Encoding)
-> Encode Open (ConwayContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (BabbageContextError era -> ConwayContextError era)
-> Word
-> Encode Open (BabbageContextError era -> ConwayContextError era)
forall t. t -> Word -> Encode Open t
Sum BabbageContextError era -> ConwayContextError era
forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError Word
8 Encode Open (BabbageContextError era -> ConwayContextError era)
-> Encode (Closed Dense) (BabbageContextError era)
-> Encode Open (ConwayContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> BabbageContextError era
-> Encode (Closed Dense) (BabbageContextError era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To BabbageContextError era
babbageContextError
    CertificateNotSupported TxCert era
txCert ->
      Encode Open (ConwayContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError era) -> Encoding)
-> Encode Open (ConwayContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (TxCert era -> ConwayContextError era)
-> Word -> Encode Open (TxCert era -> ConwayContextError era)
forall t. t -> Word -> Encode Open t
Sum TxCert era -> ConwayContextError era
forall era. TxCert era -> ConwayContextError era
CertificateNotSupported Word
9 Encode Open (TxCert era -> ConwayContextError era)
-> Encode (Closed Dense) (TxCert era)
-> Encode Open (ConwayContextError 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 (ConwayContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError era) -> Encoding)
-> Encode Open (ConwayContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (PlutusPurpose AsItem era -> ConwayContextError era)
-> Word
-> Encode Open (PlutusPurpose AsItem era -> ConwayContextError era)
forall t. t -> Word -> Encode Open t
Sum PlutusPurpose AsItem era -> ConwayContextError era
forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported Word
10 Encode Open (PlutusPurpose AsItem era -> ConwayContextError era)
-> Encode (Closed Dense) (PlutusPurpose AsItem era)
-> Encode Open (ConwayContextError 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
    CurrentTreasuryFieldNotSupported Coin
scoin ->
      Encode Open (ConwayContextError (ZonkAny 8)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError (ZonkAny 8)) -> Encoding)
-> Encode Open (ConwayContextError (ZonkAny 8)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Coin -> ConwayContextError (ZonkAny 8))
-> Word -> Encode Open (Coin -> ConwayContextError (ZonkAny 8))
forall t. t -> Word -> Encode Open t
Sum Coin -> ConwayContextError (ZonkAny 8)
forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported Word
11 Encode Open (Coin -> ConwayContextError (ZonkAny 8))
-> Encode (Closed Dense) Coin
-> Encode Open (ConwayContextError (ZonkAny 8))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Coin -> Encode (Closed Dense) Coin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Coin
scoin
    VotingProceduresFieldNotSupported VotingProcedures era
votingProcedures ->
      Encode Open (ConwayContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError era) -> Encoding)
-> Encode Open (ConwayContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (VotingProcedures era -> ConwayContextError era)
-> Word
-> Encode Open (VotingProcedures era -> ConwayContextError era)
forall t. t -> Word -> Encode Open t
Sum VotingProcedures era -> ConwayContextError era
forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported Word
12 Encode Open (VotingProcedures era -> ConwayContextError era)
-> Encode (Closed Dense) (VotingProcedures era)
-> Encode Open (ConwayContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> VotingProcedures era
-> Encode (Closed Dense) (VotingProcedures era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To VotingProcedures era
votingProcedures
    ProposalProceduresFieldNotSupported OSet (ProposalProcedure era)
proposalProcedures ->
      Encode Open (ConwayContextError era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError era) -> Encoding)
-> Encode Open (ConwayContextError era) -> Encoding
forall a b. (a -> b) -> a -> b
$ (OSet (ProposalProcedure era) -> ConwayContextError era)
-> Word
-> Encode
     Open (OSet (ProposalProcedure era) -> ConwayContextError era)
forall t. t -> Word -> Encode Open t
Sum OSet (ProposalProcedure era) -> ConwayContextError era
forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported Word
13 Encode
  Open (OSet (ProposalProcedure era) -> ConwayContextError era)
-> Encode (Closed Dense) (OSet (ProposalProcedure era))
-> Encode Open (ConwayContextError era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> OSet (ProposalProcedure era)
-> Encode (Closed Dense) (OSet (ProposalProcedure era))
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To OSet (ProposalProcedure era)
proposalProcedures
    TreasuryDonationFieldNotSupported Coin
coin ->
      Encode Open (ConwayContextError (ZonkAny 9)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError (ZonkAny 9)) -> Encoding)
-> Encode Open (ConwayContextError (ZonkAny 9)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Coin -> ConwayContextError (ZonkAny 9))
-> Word -> Encode Open (Coin -> ConwayContextError (ZonkAny 9))
forall t. t -> Word -> Encode Open t
Sum Coin -> ConwayContextError (ZonkAny 9)
forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported Word
14 Encode Open (Coin -> ConwayContextError (ZonkAny 9))
-> Encode (Closed Dense) Coin
-> Encode Open (ConwayContextError (ZonkAny 9))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> Coin -> Encode (Closed Dense) Coin
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To Coin
coin
    ReferenceInputsNotDisjointFromInputs NonEmpty TxIn
common ->
      Encode Open (ConwayContextError (ZonkAny 10)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode Open (ConwayContextError (ZonkAny 10)) -> Encoding)
-> Encode Open (ConwayContextError (ZonkAny 10)) -> Encoding
forall a b. (a -> b) -> a -> b
$ (NonEmpty TxIn -> ConwayContextError (ZonkAny 10))
-> Word
-> Encode Open (NonEmpty TxIn -> ConwayContextError (ZonkAny 10))
forall t. t -> Word -> Encode Open t
Sum NonEmpty TxIn -> ConwayContextError (ZonkAny 10)
forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs Word
15 Encode Open (NonEmpty TxIn -> ConwayContextError (ZonkAny 10))
-> Encode (Closed Dense) (NonEmpty TxIn)
-> Encode Open (ConwayContextError (ZonkAny 10))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> NonEmpty TxIn -> Encode (Closed Dense) (NonEmpty TxIn)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To NonEmpty TxIn
common

instance
  ( EraPParams era
  , DecCBOR (TxCert era)
  , DecCBOR (PlutusPurpose AsIx era)
  , DecCBOR (PlutusPurpose AsItem era)
  ) =>
  DecCBOR (ConwayContextError era)
  where
  decCBOR :: forall s. Decoder s (ConwayContextError era)
decCBOR = Decode (Closed Dense) (ConwayContextError era)
-> Decoder s (ConwayContextError era)
forall t (w :: Wrapped) s. Typeable t => Decode w t -> Decoder s t
decode (Decode (Closed Dense) (ConwayContextError era)
 -> Decoder s (ConwayContextError era))
-> Decode (Closed Dense) (ConwayContextError era)
-> Decoder s (ConwayContextError era)
forall a b. (a -> b) -> a -> b
$ Text
-> (Word -> Decode Open (ConwayContextError era))
-> Decode (Closed Dense) (ConwayContextError era)
forall t.
Text -> (Word -> Decode Open t) -> Decode (Closed Dense) t
Summands Text
"ContextError" ((Word -> Decode Open (ConwayContextError era))
 -> Decode (Closed Dense) (ConwayContextError era))
-> (Word -> Decode Open (ConwayContextError era))
-> Decode (Closed Dense) (ConwayContextError era)
forall a b. (a -> b) -> a -> b
$ \case
    Word
8 -> (BabbageContextError era -> ConwayContextError era)
-> Decode Open (BabbageContextError era -> ConwayContextError era)
forall t. t -> Decode Open t
SumD BabbageContextError era -> ConwayContextError era
forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError Decode Open (BabbageContextError era -> ConwayContextError era)
-> Decode (Closed (ZonkAny 0)) (BabbageContextError era)
-> Decode Open (ConwayContextError 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)) (BabbageContextError era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> (TxCert era -> ConwayContextError era)
-> Decode Open (TxCert era -> ConwayContextError era)
forall t. t -> Decode Open t
SumD TxCert era -> ConwayContextError era
forall era. TxCert era -> ConwayContextError era
CertificateNotSupported Decode Open (TxCert era -> ConwayContextError era)
-> Decode (Closed (ZonkAny 1)) (TxCert era)
-> Decode Open (ConwayContextError 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)) (TxCert era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> (PlutusPurpose AsItem era -> ConwayContextError era)
-> Decode Open (PlutusPurpose AsItem era -> ConwayContextError era)
forall t. t -> Decode Open t
SumD PlutusPurpose AsItem era -> ConwayContextError era
forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported Decode Open (PlutusPurpose AsItem era -> ConwayContextError era)
-> Decode (Closed (ZonkAny 2)) (PlutusPurpose AsItem era)
-> Decode Open (ConwayContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 2)) (PlutusPurpose AsItem era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
11 -> (Coin -> ConwayContextError era)
-> Decode Open (Coin -> ConwayContextError era)
forall t. t -> Decode Open t
SumD Coin -> ConwayContextError era
forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported Decode Open (Coin -> ConwayContextError era)
-> Decode (Closed (ZonkAny 3)) Coin
-> Decode Open (ConwayContextError 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)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
12 -> (VotingProcedures era -> ConwayContextError era)
-> Decode Open (VotingProcedures era -> ConwayContextError era)
forall t. t -> Decode Open t
SumD VotingProcedures era -> ConwayContextError era
forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported Decode Open (VotingProcedures era -> ConwayContextError era)
-> Decode (Closed (ZonkAny 4)) (VotingProcedures era)
-> Decode Open (ConwayContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 4)) (VotingProcedures era)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
13 -> (OSet (ProposalProcedure era) -> ConwayContextError era)
-> Decode
     Open (OSet (ProposalProcedure era) -> ConwayContextError era)
forall t. t -> Decode Open t
SumD OSet (ProposalProcedure era) -> ConwayContextError era
forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported Decode
  Open (OSet (ProposalProcedure era) -> ConwayContextError era)
-> Decode (Closed (ZonkAny 5)) (OSet (ProposalProcedure era))
-> Decode Open (ConwayContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 5)) (OSet (ProposalProcedure era))
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
14 -> (Coin -> ConwayContextError era)
-> Decode Open (Coin -> ConwayContextError era)
forall t. t -> Decode Open t
SumD Coin -> ConwayContextError era
forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported Decode Open (Coin -> ConwayContextError era)
-> Decode (Closed (ZonkAny 6)) Coin
-> Decode Open (ConwayContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 6)) Coin
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
15 -> (NonEmpty TxIn -> ConwayContextError era)
-> Decode Open (NonEmpty TxIn -> ConwayContextError era)
forall t. t -> Decode Open t
SumD NonEmpty TxIn -> ConwayContextError era
forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs Decode Open (NonEmpty TxIn -> ConwayContextError era)
-> Decode (Closed (ZonkAny 7)) (NonEmpty TxIn)
-> Decode Open (ConwayContextError era)
forall a (w1 :: Wrapped) t (w :: Density).
Typeable a =>
Decode w1 (a -> t) -> Decode (Closed w) a -> Decode w1 t
<! Decode (Closed (ZonkAny 7)) (NonEmpty TxIn)
forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> Word -> Decode Open (ConwayContextError era)
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
n

instance
  ( ToJSON (TxCert era)
  , ToJSON (PlutusPurpose AsIx era)
  , ToJSON (PlutusPurpose AsItem era)
  , EraPParams era
  ) =>
  ToJSON (ConwayContextError era)
  where
  toJSON :: ConwayContextError era -> Value
toJSON = \case
    BabbageContextError BabbageContextError era
err -> BabbageContextError era -> Value
forall a. ToJSON a => a -> Value
toJSON BabbageContextError era
err
    CertificateNotSupported TxCert era
txCert ->
      Text -> [Pair] -> Value
kindObject 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
kindObject 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]
    CurrentTreasuryFieldNotSupported Coin
scoin ->
      Text -> [Pair] -> Value
kindObject
        Text
"CurrentTreasuryFieldNotSupported"
        [Key
"current_treasury_value" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
scoin]
    VotingProceduresFieldNotSupported VotingProcedures era
votingProcedures ->
      Text -> [Pair] -> Value
kindObject
        Text
"VotingProceduresFieldNotSupported"
        [Key
"voting_procedures" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= VotingProcedures era -> Value
forall a. ToJSON a => a -> Value
toJSON VotingProcedures era
votingProcedures]
    ProposalProceduresFieldNotSupported OSet (ProposalProcedure era)
proposalProcedures ->
      Text -> [Pair] -> Value
kindObject
        Text
"ProposalProceduresFieldNotSupported"
        [Key
"proposal_procedures" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= OSet (ProposalProcedure era) -> Value
forall a. ToJSON a => a -> Value
toJSON OSet (ProposalProcedure era)
proposalProcedures]
    TreasuryDonationFieldNotSupported Coin
coin ->
      Text -> [Pair] -> Value
kindObject
        Text
"TreasuryDonationFieldNotSupported"
        [Key
"treasury_donation" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Coin -> Value
forall a. ToJSON a => a -> Value
toJSON Coin
coin]
    ReferenceInputsNotDisjointFromInputs NonEmpty TxIn
common ->
      Text -> [Pair] -> Value
kindObject
        Text
"ReferenceInputsNotDisjointFromInputs"
        [Key
"common" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= NonEmpty TxIn -> Value
forall a. ToJSON a => a -> Value
toJSON NonEmpty TxIn
common]

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

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

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

guardConwayFeaturesForPlutusV1V2 ::
  forall era l.
  ( EraTx era
  , ConwayEraTxBody era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  Tx l era ->
  Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 :: forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx l era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx l era
tx = do
  let txBody :: TxBody l era
txBody = Tx l era
tx Tx l era
-> Getting (TxBody l era) (Tx l era) (TxBody l era) -> TxBody l era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody l era) (Tx l era) (TxBody l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL
      currentTreasuryValue :: StrictMaybe Coin
currentTreasuryValue = TxBody l era
txBody TxBody l era
-> Getting (StrictMaybe Coin) (TxBody l era) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe Coin) (TxBody l era) (StrictMaybe Coin)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Coin)
forall (l :: TxLevel). Lens' (TxBody l era) (StrictMaybe Coin)
currentTreasuryValueTxBodyL
      votingProcedures :: VotingProcedures era
votingProcedures = TxBody l era
txBody TxBody l era
-> Getting
     (VotingProcedures era) (TxBody l era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures era) (TxBody l era) (VotingProcedures era)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel). Lens' (TxBody l era) (VotingProcedures era)
votingProceduresTxBodyL
      proposalProcedures :: OSet (ProposalProcedure era)
proposalProcedures = TxBody l era
txBody TxBody l era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody l era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody l era)
  (OSet (ProposalProcedure era))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
      treasuryDonation :: Coin
treasuryDonation = TxBody l era
txBody TxBody l era -> Getting Coin (TxBody l era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody l era) Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) Coin
forall (l :: TxLevel). Lens' (TxBody l era) Coin
treasuryDonationTxBodyL
  Bool
-> Either (ContextError era) () -> Either (ContextError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Voter (Map GovActionId (VotingProcedure era)) -> Bool
forall a. Map Voter a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Map Voter (Map GovActionId (VotingProcedure era)) -> Bool)
-> Map Voter (Map GovActionId (VotingProcedure era)) -> Bool
forall a b. (a -> b) -> a -> b
$ VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures VotingProcedures era
votingProcedures) (Either (ContextError era) () -> Either (ContextError era) ())
-> Either (ContextError era) () -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
    ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
      ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$
        forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported @era VotingProcedures era
votingProcedures
  Bool
-> Either (ContextError era) () -> Either (ContextError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (OSet (ProposalProcedure era) -> Bool
forall a. OSet a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null OSet (ProposalProcedure era)
proposalProcedures) (Either (ContextError era) () -> Either (ContextError era) ())
-> Either (ContextError era) () -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
    ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
      ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$
        forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported @era OSet (ProposalProcedure era)
proposalProcedures
  Bool
-> Either (ContextError era) () -> Either (ContextError era) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Coin
treasuryDonation Coin -> Coin -> Bool
forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0) (Either (ContextError era) () -> Either (ContextError era) ())
-> Either (ContextError era) () -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
    ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$
      ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$
        forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported @era Coin
treasuryDonation
  case StrictMaybe Coin
currentTreasuryValue of
    StrictMaybe Coin
SNothing -> () -> Either (ContextError era) ()
forall a b. b -> Either a b
Right ()
    SJust Coin
treasury ->
      ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> ContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported @era Coin
treasury

transTxCertV1V2 ::
  ( ShelleyEraTxCert era
  , ConwayEraTxCert era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  TxCert era ->
  Either (ContextError era) PV1.DCert
transTxCertV1V2 :: forall era.
(ShelleyEraTxCert era, ConwayEraTxCert era,
 Inject (ConwayContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertV1V2 = \case
  RegDepositTxCert Credential Staking
stakeCred Coin
_deposit ->
    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))
  UnRegDepositTxCert Credential Staking
stakeCred Coin
_refund ->
    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))
  TxCert era
txCert
    | Just DCert
dCert <- TxCert era -> Maybe DCert
forall era. ShelleyEraTxCert era => TxCert era -> Maybe DCert
Alonzo.transTxCertCommon TxCert era
txCert -> DCert -> Either (ContextError era) DCert
forall a b. b -> Either a b
Right DCert
dCert
    | Bool
otherwise -> 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
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ TxCert era -> ConwayContextError era
forall era. TxCert era -> ConwayContextError era
CertificateNotSupported TxCert era
txCert

instance EraPlutusTxInfo 'PlutusV1 ConwayEra where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> TxCert ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxCert 'PlutusV1)
toPlutusTxCert proxy 'PlutusV1
_ ProtVer
_ = TxCert ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxCert 'PlutusV1)
TxCert ConwayEra -> Either (ContextError ConwayEra) DCert
forall era.
(ShelleyEraTxCert era, ConwayEraTxCert era,
 Inject (ConwayContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertV1V2

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose = proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV1)
proxy 'PlutusV1
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo ConwayEra -> PlutusTxInfoResult 'PlutusV1 ConwayEra
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 ConwayEra
ltiUTxO :: UTxO ConwayEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx level ConwayEra
ltiTx :: Tx level ConwayEra
ltiTx :: ()
ltiTx} =
    Either
  (ContextError ConwayEra)
  (PlutusPurpose AsPurpose ConwayEra
   -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 ConwayEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError ConwayEra)
   (PlutusPurpose AsPurpose ConwayEra
    -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
 -> PlutusTxInfoResult 'PlutusV1 ConwayEra)
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
-> PlutusTxInfoResult 'PlutusV1 ConwayEra
forall a b. (a -> b) -> a -> b
$ Tx level ConwayEra
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly Tx level ConwayEra
ltiTx ((Tx TopTx ConwayEra
  -> Either
       (ContextError ConwayEra)
       (PlutusPurpose AsPurpose ConwayEra
        -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)))
 -> Either
      (ContextError ConwayEra)
      (PlutusPurpose AsPurpose ConwayEra
       -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)))
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx ConwayEra
tx -> do
      let txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxBody TopTx ConwayEra)
     (Tx TopTx ConwayEra)
     (TxBody TopTx ConwayEra)
-> TxBody TopTx ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx ConwayEra)
  (Tx TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL
      Tx TopTx ConwayEra -> Either (ContextError ConwayEra) ()
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx l era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx TopTx ConwayEra
tx
      timeRange <-
        Tx TopTx ConwayEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval Tx TopTx ConwayEra
tx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) ValidityInterval
vldtTxBodyL)
      inputs <- mapM (transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
      mapM_ (transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
      outputs <-
        zipWithM
          (transTxOutV1 . TxOutFromOutput)
          [minBound ..]
          (F.toList (txBody ^. outputsTxBodyL))
      txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
      -- It is important for memoization for `txInfo` to be a let binding
      let
        txInfo =
          PV1.TxInfo
            { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [TxInInfo]
inputs
            , txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = [TxOut]
outputs
            , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting Coin (TxBody TopTx ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ConwayEra) Coin
feeTxBodyL)
            , txInfoMint :: Value
PV1.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) MultiAsset
mintTxBodyL)
            , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
            , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = TxBody TopTx ConwayEra -> [(StakingCredential, Integer)]
forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody TopTx ConwayEra
txBody
            , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
            , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = TxBody TopTx ConwayEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody TopTx ConwayEra
txBody
            , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxWits ConwayEra)
witsTxL)
            , txInfoId :: TxId
PV1.txInfoId = TxBody TopTx ConwayEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
Alonzo.transTxBodyId TxBody TopTx ConwayEra
txBody
            }
      Right $ \ConwayPlutusPurpose AsPurpose ConwayEra
_ -> TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

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

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

instance EraPlutusTxInfo 'PlutusV2 ConwayEra where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> TxCert ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxCert 'PlutusV2)
toPlutusTxCert proxy 'PlutusV2
_ ProtVer
_ = TxCert ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxCert 'PlutusV2)
TxCert ConwayEra -> Either (ContextError ConwayEra) DCert
forall era.
(ShelleyEraTxCert era, ConwayEraTxCert era,
 Inject (ConwayContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertV1V2

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose = proxy 'PlutusV2
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV2)
proxy 'PlutusV2
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo ConwayEra -> PlutusTxInfoResult 'PlutusV2 ConwayEra
toPlutusTxInfo proxy 'PlutusV2
proxy LedgerTxInfo {ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart, UTxO ConwayEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO ConwayEra
ltiUTxO, Tx level ConwayEra
ltiTx :: ()
ltiTx :: Tx level ConwayEra
ltiTx} =
    Either
  (ContextError ConwayEra)
  (PlutusPurpose AsPurpose ConwayEra
   -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
-> PlutusTxInfoResult 'PlutusV2 ConwayEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError ConwayEra)
   (PlutusPurpose AsPurpose ConwayEra
    -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
 -> PlutusTxInfoResult 'PlutusV2 ConwayEra)
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
-> PlutusTxInfoResult 'PlutusV2 ConwayEra
forall a b. (a -> b) -> a -> b
$ Tx level ConwayEra
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly Tx level ConwayEra
ltiTx ((Tx TopTx ConwayEra
  -> Either
       (ContextError ConwayEra)
       (PlutusPurpose AsPurpose ConwayEra
        -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)))
 -> Either
      (ContextError ConwayEra)
      (PlutusPurpose AsPurpose ConwayEra
       -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)))
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx ConwayEra
tx -> do
      let txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxBody TopTx ConwayEra)
     (Tx TopTx ConwayEra)
     (TxBody TopTx ConwayEra)
-> TxBody TopTx ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx ConwayEra)
  (Tx TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL
      Tx TopTx ConwayEra -> Either (ContextError ConwayEra) ()
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx l era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx TopTx ConwayEra
tx
      timeRange <-
        Tx TopTx ConwayEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval Tx TopTx ConwayEra
tx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) ValidityInterval
vldtTxBodyL)
      inputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
      refInputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
      outputs <-
        zipWithM
          (Babbage.transTxOutV2 . TxOutFromOutput)
          [minBound ..]
          (F.toList (txBody ^. outputsTxBodyL))
      txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
      plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer tx
      -- It is important for memoization for `txInfo` to be a let binding
      let
        txInfo =
          PV2.TxInfo
            { txInfoInputs :: [TxInInfo]
PV2.txInfoInputs = [TxInInfo]
inputs
            , txInfoOutputs :: [TxOut]
PV2.txInfoOutputs = [TxOut]
outputs
            , txInfoReferenceInputs :: [TxInInfo]
PV2.txInfoReferenceInputs = [TxInInfo]
refInputs
            , txInfoFee :: Value
PV2.txInfoFee = Coin -> Value
transCoinToValue (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting Coin (TxBody TopTx ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ConwayEra) Coin
feeTxBodyL)
            , txInfoMint :: Value
PV2.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) MultiAsset
mintTxBodyL)
            , txInfoDCert :: [DCert]
PV2.txInfoDCert = [DCert]
txCerts
            , txInfoWdrl :: Map StakingCredential Integer
PV2.txInfoWdrl = [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(StakingCredential, Integer)] -> Map StakingCredential Integer)
-> [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall a b. (a -> b) -> a -> b
$ TxBody TopTx ConwayEra -> [(StakingCredential, Integer)]
forall era (t :: TxLevel).
EraTxBody era =>
TxBody t era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody TopTx ConwayEra
txBody
            , txInfoValidRange :: POSIXTimeRange
PV2.txInfoValidRange = POSIXTimeRange
timeRange
            , txInfoSignatories :: [PubKeyHash]
PV2.txInfoSignatories = TxBody TopTx ConwayEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody TopTx ConwayEra
txBody
            , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV2.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
            , txInfoData :: Map DatumHash Datum
PV2.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxWits ConwayEra)
witsTxL)
            , txInfoId :: TxId
PV2.txInfoId = TxBody TopTx ConwayEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
Alonzo.transTxBodyId TxBody TopTx ConwayEra
txBody
            }
      Right $ \ConwayPlutusPurpose AsPurpose ConwayEra
_ -> TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

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

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

instance EraPlutusTxInfo 'PlutusV3 ConwayEra where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> TxCert ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxCert 'PlutusV3)
toPlutusTxCert proxy 'PlutusV3
_ ProtVer
pv = TxCert -> Either (ConwayContextError ConwayEra) TxCert
forall a. a -> Either (ConwayContextError ConwayEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxCert -> Either (ConwayContextError ConwayEra) TxCert)
-> (ConwayTxCert ConwayEra -> TxCert)
-> ConwayTxCert ConwayEra
-> Either (ConwayContextError ConwayEra) TxCert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtVer -> TxCert ConwayEra -> TxCert
forall era.
(ShelleyEraTxCert era, ConwayEraTxCert era,
 TxCert era ~ ConwayTxCert era) =>
ProtVer -> TxCert era -> TxCert
transTxCert ProtVer
pv

  toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV3)
toPlutusScriptPurpose = proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) (PlutusScriptPurpose 'PlutusV3)
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo 'PlutusV3 era,
 Inject (ConwayContextError era) (ContextError era)) =>
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> LedgerTxInfo ConwayEra -> PlutusTxInfoResult 'PlutusV3 ConwayEra
toPlutusTxInfo proxy 'PlutusV3
proxy LedgerTxInfo {ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart, UTxO ConwayEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO ConwayEra
ltiUTxO, Tx level ConwayEra
ltiTx :: ()
ltiTx :: Tx level ConwayEra
ltiTx} =
    Either
  (ContextError ConwayEra)
  (PlutusPurpose AsPurpose ConwayEra
   -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))
-> PlutusTxInfoResult 'PlutusV3 ConwayEra
forall (l :: Language) era.
Either
  (ContextError era)
  (PlutusPurpose AsPurpose era
   -> Either (ContextError era) (PlutusTxInfo l))
-> PlutusTxInfoResult l era
PlutusTxInfoResult (Either
   (ContextError ConwayEra)
   (PlutusPurpose AsPurpose ConwayEra
    -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))
 -> PlutusTxInfoResult 'PlutusV3 ConwayEra)
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))
-> PlutusTxInfoResult 'PlutusV3 ConwayEra
forall a b. (a -> b) -> a -> b
$ Tx level ConwayEra
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))
forall (t :: TxLevel -> * -> *) era (l :: TxLevel) a.
(HasEraTxLevel t era, STxLevel l era ~ STxTopLevel l era) =>
t l era -> (t TopTx era -> a) -> a
withTopTxLevelOnly Tx level ConwayEra
ltiTx ((Tx TopTx ConwayEra
  -> Either
       (ContextError ConwayEra)
       (PlutusPurpose AsPurpose ConwayEra
        -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)))
 -> Either
      (ContextError ConwayEra)
      (PlutusPurpose AsPurpose ConwayEra
       -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)))
-> (Tx TopTx ConwayEra
    -> Either
         (ContextError ConwayEra)
         (PlutusPurpose AsPurpose ConwayEra
          -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)))
-> Either
     (ContextError ConwayEra)
     (PlutusPurpose AsPurpose ConwayEra
      -> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))
forall a b. (a -> b) -> a -> b
$ \Tx TopTx ConwayEra
tx -> do
      let
        txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxBody TopTx ConwayEra)
     (Tx TopTx ConwayEra)
     (TxBody TopTx ConwayEra)
-> TxBody TopTx ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (TxBody TopTx ConwayEra)
  (Tx TopTx ConwayEra)
  (TxBody TopTx ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxBody l ConwayEra)
bodyTxL
        txInputs :: Set TxIn
txInputs = TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting (Set TxIn) (TxBody TopTx ConwayEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx ConwayEra) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
inputsTxBodyL
        refInputs :: Set TxIn
refInputs = TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting (Set TxIn) (TxBody TopTx ConwayEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx ConwayEra) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) (Set TxIn)
referenceInputsTxBodyL
      timeRange <-
        Tx TopTx ConwayEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval Tx TopTx ConwayEra
tx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody TopTx ConwayEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) ValidityInterval
vldtTxBodyL)
      inputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
      refInputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
      when (pvMajor ltiProtVer >= natVersion @11) $ checkReferenceInputsNotDisjointFromInputs txBody
      outputs <-
        zipWithM
          (Babbage.transTxOutV2 . TxOutFromOutput)
          [minBound ..]
          (F.toList (txBody ^. outputsTxBodyL))
      txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
      plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer tx
      -- It is important for memoization for `txInfo` to be a let binding
      let txInfo =
            PV3.TxInfo
              { txInfoInputs :: [TxInInfo]
PV3.txInfoInputs = [TxInInfo]
inputsInfo
              , txInfoOutputs :: [TxOut]
PV3.txInfoOutputs = [TxOut]
outputs
              , txInfoReferenceInputs :: [TxInInfo]
PV3.txInfoReferenceInputs = [TxInInfo]
refInputsInfo
              , txInfoFee :: Lovelace
PV3.txInfoFee = Coin -> Lovelace
transCoinToLovelace (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting Coin (TxBody TopTx ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody TopTx era) Coin
Lens' (TxBody TopTx ConwayEra) Coin
feeTxBodyL)
              , txInfoMint :: MintValue
PV3.txInfoMint = MultiAsset -> MintValue
transMintValue (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
-> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody TopTx ConwayEra) MultiAsset
forall era (l :: TxLevel).
MaryEraTxBody era =>
Lens' (TxBody l era) MultiAsset
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) MultiAsset
mintTxBodyL)
              , txInfoTxCerts :: [TxCert]
PV3.txInfoTxCerts = [TxCert]
txCerts
              , txInfoWdrl :: Map Credential Lovelace
PV3.txInfoWdrl = TxBody TopTx ConwayEra -> Map Credential Lovelace
forall era (l :: TxLevel).
EraTxBody era =>
TxBody l era -> Map Credential Lovelace
transTxBodyWithdrawals TxBody TopTx ConwayEra
txBody
              , txInfoValidRange :: POSIXTimeRange
PV3.txInfoValidRange = POSIXTimeRange
timeRange
              , txInfoSignatories :: [PubKeyHash]
PV3.txInfoSignatories = TxBody TopTx ConwayEra -> [PubKeyHash]
forall era (t :: TxLevel).
AlonzoEraTxBody era =>
TxBody t era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody TopTx ConwayEra
txBody
              , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV3.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
              , txInfoData :: Map DatumHash Datum
PV3.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV3.unsafeFromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx TopTx ConwayEra
tx Tx TopTx ConwayEra
-> Getting
     (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting (TxWits ConwayEra) (Tx TopTx ConwayEra) (TxWits ConwayEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ConwayEra) (TxWits ConwayEra)
witsTxL)
              , txInfoId :: TxId
PV3.txInfoId = TxBody TopTx ConwayEra -> TxId
forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
transTxBodyId TxBody TopTx ConwayEra
txBody
              , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
PV3.txInfoVotes = VotingProcedures ConwayEra
-> Map Voter (Map GovernanceActionId Vote)
forall era.
VotingProcedures era -> Map Voter (Map GovernanceActionId Vote)
transVotingProcedures (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     (VotingProcedures ConwayEra)
     (TxBody TopTx ConwayEra)
     (VotingProcedures ConwayEra)
-> VotingProcedures ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures ConwayEra)
  (TxBody TopTx ConwayEra)
  (VotingProcedures ConwayEra)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (VotingProcedures era)
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (VotingProcedures ConwayEra)
votingProceduresTxBodyL)
              , txInfoProposalProcedures :: [ProposalProcedure]
PV3.txInfoProposalProcedures =
                  (ProposalProcedure ConwayEra -> ProposalProcedure)
-> [ProposalProcedure ConwayEra] -> [ProposalProcedure]
forall a b. (a -> b) -> [a] -> [b]
map (proxy 'PlutusV3 -> ProposalProcedure ConwayEra -> ProposalProcedure
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy 'PlutusV3
proxy) ([ProposalProcedure ConwayEra] -> [ProposalProcedure])
-> [ProposalProcedure ConwayEra] -> [ProposalProcedure]
forall a b. (a -> b) -> a -> b
$ OSet (ProposalProcedure ConwayEra) -> [ProposalProcedure ConwayEra]
forall a. OSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     (OSet (ProposalProcedure ConwayEra))
     (TxBody TopTx ConwayEra)
     (OSet (ProposalProcedure ConwayEra))
-> OSet (ProposalProcedure ConwayEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure ConwayEra))
  (TxBody TopTx ConwayEra)
  (OSet (ProposalProcedure ConwayEra))
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (OSet (ProposalProcedure era))
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (OSet (ProposalProcedure ConwayEra))
proposalProceduresTxBodyL)
              , txInfoCurrentTreasuryAmount :: Maybe Lovelace
PV3.txInfoCurrentTreasuryAmount =
                  Maybe Lovelace
-> (Coin -> Maybe Lovelace) -> StrictMaybe Coin -> Maybe Lovelace
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Maybe Lovelace
forall a. Maybe a
Nothing (Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace)
-> (Coin -> Lovelace) -> Coin -> Maybe Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Lovelace
transCoinToLovelace) (StrictMaybe Coin -> Maybe Lovelace)
-> StrictMaybe Coin -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting
     (StrictMaybe Coin) (TxBody TopTx ConwayEra) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictMaybe Coin) (TxBody TopTx ConwayEra) (StrictMaybe Coin)
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) (StrictMaybe Coin)
forall (l :: TxLevel).
Lens' (TxBody l ConwayEra) (StrictMaybe Coin)
currentTreasuryValueTxBodyL
              , txInfoTreasuryDonation :: Maybe Lovelace
PV3.txInfoTreasuryDonation =
                  case TxBody TopTx ConwayEra
txBody TxBody TopTx ConwayEra
-> Getting Coin (TxBody TopTx ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody TopTx ConwayEra) Coin
forall era (l :: TxLevel).
ConwayEraTxBody era =>
Lens' (TxBody l era) Coin
forall (l :: TxLevel). Lens' (TxBody l ConwayEra) Coin
treasuryDonationTxBodyL of
                    Coin Integer
0 -> Maybe Lovelace
forall a. Maybe a
Nothing
                    Coin
coin -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace) -> Lovelace -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
transCoinToLovelace Coin
coin
              }
      Right $ \ConwayPlutusPurpose AsPurpose ConwayEra
_ -> TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a b. b -> Either a b
Right TxInfo
txInfo

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

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

transTxId :: TxId -> PV3.TxId
transTxId :: TxId -> TxId
transTxId TxId
txId = BuiltinByteString -> TxId
PV3.TxId (SafeHash EraIndependentTxBody -> BuiltinByteString
forall i. SafeHash i -> BuiltinByteString
transSafeHash (TxId -> SafeHash EraIndependentTxBody
unTxId TxId
txId))

transTxBodyId :: EraTxBody era => TxBody l era -> PV3.TxId
transTxBodyId :: forall era (l :: TxLevel). EraTxBody era => TxBody l era -> TxId
transTxBodyId TxBody l era
txBody = BuiltinByteString -> TxId
PV3.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))

transTxIn :: TxIn -> PV3.TxOutRef
transTxIn :: TxIn -> TxOutRef
transTxIn (TxIn TxId
txid TxIx
txIx) = TxId -> Integer -> TxOutRef
PV3.TxOutRef (TxId -> TxId
transTxId TxId
txid) (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (TxIx -> Int
txIxToInt TxIx
txIx))

transMintValue :: MultiAsset -> PV3.MintValue
transMintValue :: MultiAsset -> MintValue
transMintValue = Map CurrencySymbol (Map TokenName Integer) -> MintValue
PV3.UnsafeMintValue (Map CurrencySymbol (Map TokenName Integer) -> MintValue)
-> (MultiAsset -> Map CurrencySymbol (Map TokenName Integer))
-> MultiAsset
-> MintValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Map CurrencySymbol (Map TokenName Integer)
PV1.getValue (Value -> Map CurrencySymbol (Map TokenName Integer))
-> (MultiAsset -> Value)
-> MultiAsset
-> Map CurrencySymbol (Map TokenName Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiAsset -> Value
Alonzo.transMultiAsset

-- | Translate all `Withdrawal`s from within a `TxBody`
transTxBodyWithdrawals :: EraTxBody era => TxBody l era -> PV3.Map PV3.Credential PV3.Lovelace
transTxBodyWithdrawals :: forall era (l :: TxLevel).
EraTxBody era =>
TxBody l era -> Map Credential Lovelace
transTxBodyWithdrawals TxBody l era
txBody =
  (AccountAddress -> Credential)
-> (Coin -> Lovelace)
-> Map AccountAddress Coin
-> Map Credential Lovelace
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap AccountAddress -> Credential
transAccountAddress Coin -> Lovelace
transCoinToLovelace (Withdrawals -> Map AccountAddress Coin
unWithdrawals (Withdrawals -> Map AccountAddress Coin)
-> Withdrawals -> Map AccountAddress Coin
forall a b. (a -> b) -> a -> b
$ TxBody l era
txBody TxBody l era
-> Getting Withdrawals (TxBody l era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody l era) Withdrawals
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) Withdrawals
forall (l :: TxLevel). Lens' (TxBody l era) Withdrawals
withdrawalsTxBodyL)

-- | In protocol version 9, a bug in `RegTxCert` and `UnRegTxCert` pattern definitions was causing
-- the deposit in `RegDepositTxCert` and `UnRegDepositTxCert` to be omitted.  We need to keep this
-- behavior for version 9, so, now that the bug in the patterns has been fixed, we are explicitly
-- omitting the deposit in these cases. It has been confirmed that this buggy behavior for protocol
-- version 9 has been exercised on Mainnet, therefore this conditional translation can never be
-- removed for Conway era (#4863)
transTxCert ::
  (ShelleyEraTxCert era, ConwayEraTxCert era, TxCert era ~ ConwayTxCert era) =>
  ProtVer -> TxCert era -> PV3.TxCert
transTxCert :: forall era.
(ShelleyEraTxCert era, ConwayEraTxCert era,
 TxCert era ~ ConwayTxCert era) =>
ProtVer -> TxCert era -> TxCert
transTxCert ProtVer
pv = \case
  RegPoolTxCert StakePoolParams {KeyHash StakePool
sppId :: KeyHash StakePool
sppId :: StakePoolParams -> KeyHash StakePool
sppId, VRFVerKeyHash StakePoolVRF
sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf :: StakePoolParams -> VRFVerKeyHash StakePoolVRF
sppVrf} ->
    PubKeyHash -> PubKeyHash -> TxCert
PV3.TxCertPoolRegister
      (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
sppId)
      (BuiltinByteString -> PubKeyHash
PV3.PubKeyHash (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV3.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 ->
    PubKeyHash -> Integer -> TxCert
PV3.TxCertPoolRetire (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId) (EpochNo -> Integer
transEpochNo EpochNo
retireEpochNo)
  RegTxCert Credential Staking
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) Maybe Lovelace
forall a. Maybe a
Nothing
  UnRegTxCert Credential Staking
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) Maybe Lovelace
forall a. Maybe a
Nothing
  RegDepositTxCert Credential Staking
stakeCred Coin
deposit ->
    let transDeposit :: Maybe Lovelace
transDeposit
          | ProtVer -> Bool
hardforkConwayBootstrapPhase ProtVer
pv = Maybe Lovelace
forall a. Maybe a
Nothing
          | Bool
otherwise = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
     in Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) Maybe Lovelace
transDeposit
  UnRegDepositTxCert Credential Staking
stakeCred Coin
refund ->
    let transRefund :: Maybe Lovelace
transRefund
          | ProtVer -> Bool
hardforkConwayBootstrapPhase ProtVer
pv = Maybe Lovelace
forall a. Maybe a
Nothing
          | Bool
otherwise = Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Coin -> Lovelace
transCoinToLovelace Coin
refund)
     in Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) Maybe Lovelace
transRefund
  DelegTxCert Credential Staking
stakeCred Delegatee
delegatee ->
    Credential -> Delegatee -> TxCert
PV3.TxCertDelegStaking (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) (Delegatee -> Delegatee
transDelegatee Delegatee
delegatee)
  RegDepositDelegTxCert Credential Staking
stakeCred Delegatee
delegatee Coin
deposit ->
    Credential -> Delegatee -> Lovelace -> TxCert
PV3.TxCertRegDeleg (Credential Staking -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential Staking
stakeCred) (Delegatee -> Delegatee
transDelegatee Delegatee
delegatee) (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
  AuthCommitteeHotKeyTxCert Credential ColdCommitteeRole
coldCred Credential HotCommitteeRole
hotCred ->
    ColdCommitteeCredential -> HotCommitteeCredential -> TxCert
PV3.TxCertAuthHotCommittee (Credential ColdCommitteeRole -> ColdCommitteeCredential
transColdCommitteeCred Credential ColdCommitteeRole
coldCred) (Credential HotCommitteeRole -> HotCommitteeCredential
transHotCommitteeCred Credential HotCommitteeRole
hotCred)
  ResignCommitteeColdTxCert Credential ColdCommitteeRole
coldCred StrictMaybe Anchor
_anchor ->
    ColdCommitteeCredential -> TxCert
PV3.TxCertResignColdCommittee (Credential ColdCommitteeRole -> ColdCommitteeCredential
transColdCommitteeCred Credential ColdCommitteeRole
coldCred)
  RegDRepTxCert Credential DRepRole
drepCred Coin
deposit StrictMaybe Anchor
_anchor ->
    DRepCredential -> Lovelace -> TxCert
PV3.TxCertRegDRep (Credential DRepRole -> DRepCredential
transDRepCred Credential DRepRole
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
  UnRegDRepTxCert Credential DRepRole
drepCred Coin
refund ->
    DRepCredential -> Lovelace -> TxCert
PV3.TxCertUnRegDRep (Credential DRepRole -> DRepCredential
transDRepCred Credential DRepRole
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
refund)
  UpdateDRepTxCert Credential DRepRole
drepCred StrictMaybe Anchor
_anchor ->
    DRepCredential -> TxCert
PV3.TxCertUpdateDRep (Credential DRepRole -> DRepCredential
transDRepCred Credential DRepRole
drepCred)
  TxCert era
_ -> String -> TxCert
forall a. HasCallStack => String -> a
error String
"Impossible: All TxCerts should have been accounted for"

transDRepCred :: Credential DRepRole -> PV3.DRepCredential
transDRepCred :: Credential DRepRole -> DRepCredential
transDRepCred = Credential -> DRepCredential
PV3.DRepCredential (Credential -> DRepCredential)
-> (Credential DRepRole -> Credential)
-> Credential DRepRole
-> DRepCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential DRepRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred

transColdCommitteeCred :: Credential ColdCommitteeRole -> PV3.ColdCommitteeCredential
transColdCommitteeCred :: Credential ColdCommitteeRole -> ColdCommitteeCredential
transColdCommitteeCred = Credential -> ColdCommitteeCredential
PV3.ColdCommitteeCredential (Credential -> ColdCommitteeCredential)
-> (Credential ColdCommitteeRole -> Credential)
-> Credential ColdCommitteeRole
-> ColdCommitteeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential ColdCommitteeRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred

transHotCommitteeCred :: Credential HotCommitteeRole -> PV3.HotCommitteeCredential
transHotCommitteeCred :: Credential HotCommitteeRole -> HotCommitteeCredential
transHotCommitteeCred = Credential -> HotCommitteeCredential
PV3.HotCommitteeCredential (Credential -> HotCommitteeCredential)
-> (Credential HotCommitteeRole -> Credential)
-> Credential HotCommitteeRole
-> HotCommitteeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential HotCommitteeRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred

transDelegatee :: Delegatee -> PV3.Delegatee
transDelegatee :: Delegatee -> Delegatee
transDelegatee = \case
  DelegStake KeyHash StakePool
poolId -> PubKeyHash -> Delegatee
PV3.DelegStake (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId)
  DelegVote DRep
drep -> DRep -> Delegatee
PV3.DelegVote (DRep -> DRep
transDRep DRep
drep)
  DelegStakeVote KeyHash StakePool
poolId DRep
drep -> PubKeyHash -> DRep -> Delegatee
PV3.DelegStakeVote (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId) (DRep -> DRep
transDRep DRep
drep)

transDRep :: DRep -> PV3.DRep
transDRep :: DRep -> DRep
transDRep = \case
  DRepCredential Credential DRepRole
drepCred -> DRepCredential -> DRep
PV3.DRep (Credential DRepRole -> DRepCredential
transDRepCred Credential DRepRole
drepCred)
  DRep
DRepAlwaysAbstain -> DRep
PV3.DRepAlwaysAbstain
  DRep
DRepAlwaysNoConfidence -> DRep
PV3.DRepAlwaysNoConfidence

-- | In Conway we have `Anchor`s in some certificates and all proposals. However, because
-- we do not translate anchors to plutus context, it is not always possible to deduce
-- which item the script purpose is responsible for, without also including the index for
-- that item. For this reason starting with PlutusV3, besides the item, `PV3.Certifying`
-- and `PV3.Proposing` also have an index. Moreover, other script purposes rely on Ledger
-- `Ord` instances for types that dictate the order, so it might not be a good idea to pass
-- that information to Plutus for those purposes.
transPlutusPurposeV3 ::
  forall era proxy.
  ( ConwayEraPlutusTxInfo 'PlutusV3 era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  proxy 'PlutusV3 ->
  ProtVer ->
  PlutusPurpose AsIxItem era ->
  Either (ContextError era) PV3.ScriptPurpose
transPlutusPurposeV3 :: forall era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo 'PlutusV3 era,
 Inject (ConwayContextError era) (ContextError era)) =>
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3 proxy 'PlutusV3
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
PV3.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
PV3.Minting (PolicyID -> CurrencySymbol
Alonzo.transPolicyID PolicyID
policyId)
  CertifyingPurpose (AsIxItem Word32
ix TxCert era
txCert) ->
    Integer -> TxCert -> ScriptPurpose
PV3.Certifying (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
ix) (TxCert -> ScriptPurpose)
-> Either (ContextError era) TxCert
-> Either (ContextError era) ScriptPurpose
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> proxy 'PlutusV3
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert 'PlutusV3)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert 'PlutusV3)
toPlutusTxCert proxy 'PlutusV3
proxy ProtVer
pv TxCert era
txCert
  RewardingPurpose (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
$ Credential -> ScriptPurpose
PV3.Rewarding (AccountAddress -> Credential
transAccountAddress AccountAddress
accountAddress)
  VotingPurpose (AsIxItem Word32
_ Voter
voter) -> 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
$ Voter -> ScriptPurpose
PV3.Voting (Voter -> Voter
transVoter Voter
voter)
  ProposingPurpose (AsIxItem Word32
ix ProposalProcedure era
proposal) ->
    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
$ Integer -> ProposalProcedure -> ScriptPurpose
PV3.Proposing (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
ix) (proxy 'PlutusV3 -> ProposalProcedure era -> ProposalProcedure
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy 'PlutusV3
proxy ProposalProcedure era
proposal)
  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
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported @era (PlutusPurpose AsItem era -> ConwayContextError era)
-> PlutusPurpose AsItem era -> ConwayContextError 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

transVoter :: Voter -> PV3.Voter
transVoter :: Voter -> Voter
transVoter = \case
  CommitteeVoter Credential HotCommitteeRole
cred -> HotCommitteeCredential -> Voter
PV3.CommitteeVoter (HotCommitteeCredential -> Voter)
-> HotCommitteeCredential -> Voter
forall a b. (a -> b) -> a -> b
$ Credential -> HotCommitteeCredential
PV3.HotCommitteeCredential (Credential -> HotCommitteeCredential)
-> Credential -> HotCommitteeCredential
forall a b. (a -> b) -> a -> b
$ Credential HotCommitteeRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential HotCommitteeRole
cred
  DRepVoter Credential DRepRole
cred -> DRepCredential -> Voter
PV3.DRepVoter (DRepCredential -> Voter) -> DRepCredential -> Voter
forall a b. (a -> b) -> a -> b
$ Credential -> DRepCredential
PV3.DRepCredential (Credential -> DRepCredential) -> Credential -> DRepCredential
forall a b. (a -> b) -> a -> b
$ Credential DRepRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred Credential DRepRole
cred
  StakePoolVoter KeyHash StakePool
keyHash -> PubKeyHash -> Voter
PV3.StakePoolVoter (PubKeyHash -> Voter) -> PubKeyHash -> Voter
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
keyHash

transGovActionId :: GovActionId -> PV3.GovernanceActionId
transGovActionId :: GovActionId -> GovernanceActionId
transGovActionId GovActionId {TxId
gaidTxId :: TxId
gaidTxId :: GovActionId -> TxId
gaidTxId, GovActionIx
gaidGovActionIx :: GovActionIx
gaidGovActionIx :: GovActionId -> GovActionIx
gaidGovActionIx} =
  PV3.GovernanceActionId
    { gaidTxId :: TxId
PV3.gaidTxId = TxId -> TxId
transTxId TxId
gaidTxId
    , gaidGovActionIx :: Integer
PV3.gaidGovActionIx = Word16 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word16 -> Integer) -> Word16 -> Integer
forall a b. (a -> b) -> a -> b
$ GovActionIx -> Word16
unGovActionIx GovActionIx
gaidGovActionIx
    }

transGovAction :: ConwayEraPlutusTxInfo l era => proxy l -> GovAction era -> PV3.GovernanceAction
transGovAction :: forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> GovAction era -> GovernanceAction
transGovAction proxy l
proxy = \case
  ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
pGovActionId PParamsUpdate era
ppu StrictMaybe ScriptHash
govPolicy ->
    Maybe GovernanceActionId
-> ChangedParameters -> Maybe ScriptHash -> GovernanceAction
PV3.ParameterChange
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose}.
StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'PParamUpdatePurpose)
pGovActionId)
      (proxy l -> PParamsUpdate era -> ChangedParameters
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> PParamsUpdate era -> ChangedParameters
forall (proxy :: Language -> *).
proxy l -> PParamsUpdate era -> ChangedParameters
toPlutusChangedParameters proxy l
proxy PParamsUpdate era
ppu)
      (StrictMaybe ScriptHash -> Maybe ScriptHash
transGovPolicy StrictMaybe ScriptHash
govPolicy)
  HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose)
pGovActionId ProtVer
protVer ->
    Maybe GovernanceActionId -> ProtocolVersion -> GovernanceAction
PV3.HardForkInitiation
      (StrictMaybe (GovPurposeId 'HardForkPurpose)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose}.
StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'HardForkPurpose)
pGovActionId)
      (ProtVer -> ProtocolVersion
transProtVer ProtVer
protVer)
  TreasuryWithdrawals Map AccountAddress Coin
withdrawals StrictMaybe ScriptHash
govPolicy ->
    Map Credential Lovelace -> Maybe ScriptHash -> GovernanceAction
PV3.TreasuryWithdrawals
      ((AccountAddress -> Credential)
-> (Coin -> Lovelace)
-> Map AccountAddress Coin
-> Map Credential Lovelace
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap AccountAddress -> Credential
transAccountAddress Coin -> Lovelace
transCoinToLovelace Map AccountAddress Coin
withdrawals)
      (StrictMaybe ScriptHash -> Maybe ScriptHash
transGovPolicy StrictMaybe ScriptHash
govPolicy)
  NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose)
pGovActionId -> Maybe GovernanceActionId -> GovernanceAction
PV3.NoConfidence (StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose}.
StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'CommitteePurpose)
pGovActionId)
  UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose)
pGovActionId Set (Credential ColdCommitteeRole)
ccToRemove Map (Credential ColdCommitteeRole) EpochNo
ccToAdd UnitInterval
threshold ->
    Maybe GovernanceActionId
-> [ColdCommitteeCredential]
-> Map ColdCommitteeCredential Integer
-> Rational
-> GovernanceAction
PV3.UpdateCommittee
      (StrictMaybe (GovPurposeId 'CommitteePurpose)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose}.
StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'CommitteePurpose)
pGovActionId)
      ((Credential ColdCommitteeRole -> ColdCommitteeCredential)
-> [Credential ColdCommitteeRole] -> [ColdCommitteeCredential]
forall a b. (a -> b) -> [a] -> [b]
map (Credential -> ColdCommitteeCredential
PV3.ColdCommitteeCredential (Credential -> ColdCommitteeCredential)
-> (Credential ColdCommitteeRole -> Credential)
-> Credential ColdCommitteeRole
-> ColdCommitteeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential ColdCommitteeRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred) ([Credential ColdCommitteeRole] -> [ColdCommitteeCredential])
-> [Credential ColdCommitteeRole] -> [ColdCommitteeCredential]
forall a b. (a -> b) -> a -> b
$ Set (Credential ColdCommitteeRole)
-> [Credential ColdCommitteeRole]
forall a. Set a -> [a]
Set.toList Set (Credential ColdCommitteeRole)
ccToRemove)
      ((Credential ColdCommitteeRole -> ColdCommitteeCredential)
-> (EpochNo -> Integer)
-> Map (Credential ColdCommitteeRole) EpochNo
-> Map ColdCommitteeCredential Integer
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap (Credential -> ColdCommitteeCredential
PV3.ColdCommitteeCredential (Credential -> ColdCommitteeCredential)
-> (Credential ColdCommitteeRole -> Credential)
-> Credential ColdCommitteeRole
-> ColdCommitteeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential ColdCommitteeRole -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred) EpochNo -> Integer
transEpochNo Map (Credential ColdCommitteeRole) EpochNo
ccToAdd)
      (UnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
transBoundedRational UnitInterval
threshold)
  NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose)
pGovActionId Constitution era
constitution ->
    Maybe GovernanceActionId -> Constitution -> GovernanceAction
PV3.NewConstitution
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose}.
StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'ConstitutionPurpose)
pGovActionId)
      (Constitution era -> Constitution
forall {era}. Constitution era -> Constitution
transConstitution Constitution era
constitution)
  GovAction era
InfoAction -> GovernanceAction
PV3.InfoAction
  where
    transGovPolicy :: StrictMaybe ScriptHash -> Maybe ScriptHash
transGovPolicy = \case
      SJust ScriptHash
govPolicy -> ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just (ScriptHash -> ScriptHash
transScriptHash ScriptHash
govPolicy)
      StrictMaybe ScriptHash
SNothing -> Maybe ScriptHash
forall a. Maybe a
Nothing
    transConstitution :: Constitution era -> Constitution
transConstitution (Constitution Anchor
_ StrictMaybe ScriptHash
govPolicy) =
      Maybe ScriptHash -> Constitution
PV3.Constitution (StrictMaybe ScriptHash -> Maybe ScriptHash
transGovPolicy StrictMaybe ScriptHash
govPolicy)
    transPrevGovActionId :: StrictMaybe (GovPurposeId p) -> Maybe GovernanceActionId
transPrevGovActionId = \case
      SJust (GovPurposeId GovActionId
gaId) -> GovernanceActionId -> Maybe GovernanceActionId
forall a. a -> Maybe a
Just (GovActionId -> GovernanceActionId
transGovActionId GovActionId
gaId)
      StrictMaybe (GovPurposeId p)
SNothing -> Maybe GovernanceActionId
forall a. Maybe a
Nothing

transMap :: (t1 -> k) -> (t2 -> v) -> Map.Map t1 t2 -> PV3.Map k v
transMap :: forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap t1 -> k
transKey t2 -> v
transValue =
  [(k, v)] -> Map k v
forall k v. [(k, v)] -> Map k v
PV3.unsafeFromList ([(k, v)] -> Map k v)
-> (Map t1 t2 -> [(k, v)]) -> Map t1 t2 -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((t1, t2) -> (k, v)) -> [(t1, t2)] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (\(t1
k, t2
v) -> (t1 -> k
transKey t1
k, t2 -> v
transValue t2
v)) ([(t1, t2)] -> [(k, v)])
-> (Map t1 t2 -> [(t1, t2)]) -> Map t1 t2 -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map t1 t2 -> [(t1, t2)]
forall k a. Map k a -> [(k, a)]
Map.toList

transVotingProcedures ::
  VotingProcedures era -> PV3.Map PV3.Voter (PV3.Map PV3.GovernanceActionId PV3.Vote)
transVotingProcedures :: forall era.
VotingProcedures era -> Map Voter (Map GovernanceActionId Vote)
transVotingProcedures =
  (Voter -> Voter)
-> (Map GovActionId (VotingProcedure era)
    -> Map GovernanceActionId Vote)
-> Map Voter (Map GovActionId (VotingProcedure era))
-> Map Voter (Map GovernanceActionId Vote)
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap Voter -> Voter
transVoter ((GovActionId -> GovernanceActionId)
-> (VotingProcedure era -> Vote)
-> Map GovActionId (VotingProcedure era)
-> Map GovernanceActionId Vote
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap GovActionId -> GovernanceActionId
transGovActionId (Vote -> Vote
transVote (Vote -> Vote)
-> (VotingProcedure era -> Vote) -> VotingProcedure era -> Vote
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedure era -> Vote
forall era. VotingProcedure era -> Vote
vProcVote)) (Map Voter (Map GovActionId (VotingProcedure era))
 -> Map Voter (Map GovernanceActionId Vote))
-> (VotingProcedures era
    -> Map Voter (Map GovActionId (VotingProcedure era)))
-> VotingProcedures era
-> Map Voter (Map GovernanceActionId Vote)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
forall era.
VotingProcedures era
-> Map Voter (Map GovActionId (VotingProcedure era))
unVotingProcedures

transVote :: Vote -> PV3.Vote
transVote :: Vote -> Vote
transVote = \case
  Vote
VoteNo -> Vote
PV3.VoteNo
  Vote
VoteYes -> Vote
PV3.VoteYes
  Vote
Abstain -> Vote
PV3.Abstain

transProposal ::
  ConwayEraPlutusTxInfo l era =>
  proxy l ->
  ProposalProcedure era ->
  PV3.ProposalProcedure
transProposal :: forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy l
proxy ProposalProcedure {Coin
pProcDeposit :: Coin
pProcDeposit :: forall era. ProposalProcedure era -> Coin
pProcDeposit, AccountAddress
pProcReturnAddr :: AccountAddress
pProcReturnAddr :: forall era. ProposalProcedure era -> AccountAddress
pProcReturnAddr, GovAction era
pProcGovAction :: GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction} =
  PV3.ProposalProcedure
    { ppDeposit :: Lovelace
PV3.ppDeposit = Coin -> Lovelace
transCoinToLovelace Coin
pProcDeposit
    , ppReturnAddr :: Credential
PV3.ppReturnAddr = AccountAddress -> Credential
transAccountAddress AccountAddress
pProcReturnAddr
    , ppGovernanceAction :: GovernanceAction
PV3.ppGovernanceAction = proxy l -> GovAction era -> GovernanceAction
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> GovAction era -> GovernanceAction
transGovAction proxy l
proxy GovAction era
pProcGovAction
    }

transPlutusPurposeV1V2 ::
  forall l era proxy.
  ( PlutusTxCert l ~ PV2.DCert
  , EraPlutusTxInfo l era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  PlutusPurpose AsIxItem era ->
  Either (ContextError era) PV2.ScriptPurpose
transPlutusPurposeV1V2 :: forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv = \case
  SpendingPurpose AsIxItem Word32 TxIn
asIxItem -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsIxItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 TxIn -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending AsIxItem Word32 TxIn
asIxItem
  MintingPurpose AsIxItem Word32 PolicyID
asIxItem -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsIxItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 PolicyID -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting AsIxItem Word32 PolicyID
asIxItem
  CertifyingPurpose AsIxItem Word32 (TxCert era)
asIxItem -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsIxItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 (TxCert era) -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying AsIxItem Word32 (TxCert era)
asIxItem
  RewardingPurpose AsIxItem Word32 AccountAddress
asIxItem -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsIxItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 AccountAddress -> AlonzoPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 AccountAddress -> AlonzoPlutusPurpose f era
AlonzoRewarding AsIxItem Word32 AccountAddress
asIxItem
  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
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported @era (PlutusPurpose AsItem era -> ConwayContextError era)
-> PlutusPurpose AsItem era -> ConwayContextError 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

transProtVer :: ProtVer -> PV3.ProtocolVersion
transProtVer :: ProtVer -> ProtocolVersion
transProtVer (ProtVer Version
major Natural
minor) =
  Integer -> Integer -> ProtocolVersion
PV3.ProtocolVersion (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Version -> Word32
getVersion32 Version
major)) (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
minor)

toPlutusV3Args ::
  EraPlutusTxInfo 'PlutusV3 era =>
  proxy 'PlutusV3 ->
  ProtVer ->
  PV3.TxInfo ->
  PlutusPurpose AsIxItem era ->
  Maybe (Data era) ->
  Data era ->
  Either (ContextError era) (PlutusArgs 'PlutusV3)
toPlutusV3Args :: forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV3 era =>
proxy 'PlutusV3
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV3)
toPlutusV3Args proxy 'PlutusV3
proxy ProtVer
pv TxInfo
txInfo PlutusPurpose AsIxItem era
plutusPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData = do
  scriptPurpose <- proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose 'PlutusV3)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose 'PlutusV3)
toPlutusScriptPurpose proxy 'PlutusV3
proxy ProtVer
pv PlutusPurpose AsIxItem era
plutusPurpose
  let scriptInfo =
        ScriptPurpose -> Maybe Datum -> ScriptInfo
scriptPurposeToScriptInfo
          ScriptPurpose
scriptPurpose
          (Data era -> Datum
forall era. Data era -> Datum
transDatum (Data era -> Datum) -> Maybe (Data era) -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Data era)
maybeSpendingData)
  pure $
    PlutusV3Args $
      PV3.ScriptContext
        { PV3.scriptContextTxInfo = txInfo
        , PV3.scriptContextRedeemer = Babbage.transRedeemer redeemerData
        , PV3.scriptContextScriptInfo = scriptInfo
        }

scriptPurposeToScriptInfo :: PV3.ScriptPurpose -> Maybe PV1.Datum -> PV3.ScriptInfo
scriptPurposeToScriptInfo :: ScriptPurpose -> Maybe Datum -> ScriptInfo
scriptPurposeToScriptInfo ScriptPurpose
sp Maybe Datum
maybeSpendingData =
  case ScriptPurpose
sp of
    PV3.Spending TxOutRef
txIn -> TxOutRef -> Maybe Datum -> ScriptInfo
PV3.SpendingScript TxOutRef
txIn Maybe Datum
maybeSpendingData
    PV3.Minting CurrencySymbol
policyId -> CurrencySymbol -> ScriptInfo
PV3.MintingScript CurrencySymbol
policyId
    PV3.Certifying Integer
ix TxCert
txCert -> Integer -> TxCert -> ScriptInfo
PV3.CertifyingScript Integer
ix TxCert
txCert
    PV3.Rewarding Credential
accountAddress -> Credential -> ScriptInfo
PV3.RewardingScript Credential
accountAddress
    PV3.Voting Voter
voter -> Voter -> ScriptInfo
PV3.VotingScript Voter
voter
    PV3.Proposing Integer
ix ProposalProcedure
proposal -> Integer -> ProposalProcedure -> ScriptInfo
PV3.ProposingScript Integer
ix ProposalProcedure
proposal

-- | A class to compute the changed parameters in the TxInfo
-- given a ToPlutusData instance for PParamsUpdate
class
  (ConwayEraScript era, EraPlutusTxInfo l era) =>
  ConwayEraPlutusTxInfo (l :: Language) era
  where
  toPlutusChangedParameters :: proxy l -> PParamsUpdate era -> PV3.ChangedParameters

instance ConwayEraPlutusTxInfo 'PlutusV3 ConwayEra where
  toPlutusChangedParameters :: forall (proxy :: Language -> *).
proxy 'PlutusV3 -> PParamsUpdate ConwayEra -> ChangedParameters
toPlutusChangedParameters proxy 'PlutusV3
_ PParamsUpdate ConwayEra
x = BuiltinData -> ChangedParameters
PV3.ChangedParameters (Data -> BuiltinData
PV3.dataToBuiltinData (PParamsUpdate ConwayEra -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData PParamsUpdate ConwayEra
x))

-- | Translate a validity interval to POSIX time
transValidityInterval ::
  forall proxy era a.
  Inject (AlonzoContextError era) a =>
  proxy era ->
  EpochInfo (Either Text) ->
  SystemStart ->
  ValidityInterval ->
  Either a PV1.POSIXTimeRange
transValidityInterval :: forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
transValidityInterval proxy era
_ 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
    t <- SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
i
    pure $ PV1.Interval (PV1.LowerBound PV1.NegInf True) (PV1.strictUpperBound t)
  ValidityInterval (SJust SlotNo
i) (SJust SlotNo
j) -> do
    t1 <- SlotNo -> Either a POSIXTime
transSlotToPOSIXTime SlotNo
i
    t2 <- transSlotToPOSIXTime j
    pure $
      PV1.Interval
        (PV1.lowerBound t1)
        (PV1.strictUpperBound 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. 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

checkReferenceInputsNotDisjointFromInputs ::
  forall l era.
  (BabbageEraTxBody era, Inject (ConwayContextError era) (ContextError era)) =>
  TxBody l era ->
  Either (ContextError era) ()
checkReferenceInputsNotDisjointFromInputs :: forall (l :: TxLevel) era.
(BabbageEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
TxBody l era -> Either (ContextError era) ()
checkReferenceInputsNotDisjointFromInputs TxBody l era
txBody =
  case Set TxIn -> [TxIn]
forall a. Set a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Set TxIn
txInputs Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set TxIn
refInputs) of
    (TxIn
x : [TxIn]
xs) -> ContextError era -> Either (ContextError era) ()
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ())
-> (ConwayContextError era -> ContextError era)
-> ConwayContextError era
-> Either (ContextError era) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> Either (ContextError era) ())
-> ConwayContextError era -> Either (ContextError era) ()
forall a b. (a -> b) -> a -> b
$ forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs @era (NonEmpty TxIn -> ConwayContextError era)
-> NonEmpty TxIn -> ConwayContextError era
forall a b. (a -> b) -> a -> b
$ TxIn
x TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| [TxIn]
xs
    [] -> () -> Either (ContextError era) ()
forall a b. b -> Either a b
Right ()
  where
    txInputs :: Set TxIn
txInputs = TxBody l era
txBody TxBody l era
-> Getting (Set TxIn) (TxBody l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody l era) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
inputsTxBodyL
    refInputs :: Set TxIn
refInputs = TxBody l era
txBody TxBody l era
-> Getting (Set TxIn) (TxBody l era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody l era) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
referenceInputsTxBodyL