{-# 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,
) where

import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusTxCert,
  PlutusTxInfo,
  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 (..),
  getVersion64,
  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 (ConwayPlutusPurpose (..), 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,
  transBoundedRational,
  transCoinToLovelace,
  transCoinToValue,
  transCred,
  transDatum,
  transEpochNo,
  transKeyHash,
  transRewardAccount,
  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 NoThunks.Class (NoThunks)
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
        (Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1))
        (Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2))
        (Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3))

  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 =
    Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
-> TxInfoResult ConwayEra
ConwayTxInfoResult
      (SLanguage 'PlutusV1
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1 LedgerTxInfo ConwayEra
lti)
      (SLanguage 'PlutusV2
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo SLanguage 'PlutusV2
SPlutusV2 LedgerTxInfo ConwayEra
lti)
      (SLanguage 'PlutusV3
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV3
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
toPlutusTxInfo SLanguage 'PlutusV3
SPlutusV3 LedgerTxInfo ConwayEra
lti)

  lookupTxInfoResult :: forall (l :: Language).
EraPlutusTxInfo l ConwayEra =>
SLanguage l
-> TxInfoResult ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo l)
lookupTxInfoResult SLanguage l
SPlutusV1 (ConwayTxInfoResult Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1 Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
_ Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
_) = Either (ContextError ConwayEra) (PlutusTxInfo l)
Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1
  lookupTxInfoResult SLanguage l
SPlutusV2 (ConwayTxInfoResult Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2 Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
_) = Either (ContextError ConwayEra) (PlutusTxInfo l)
Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2
  lookupTxInfoResult SLanguage l
SPlutusV3 (ConwayTxInfoResult Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
_ Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
tirPlutusV3) = Either (ContextError ConwayEra) (PlutusTxInfo l)
Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
tirPlutusV3
  lookupTxInfoResult SLanguage l
slang TxInfoResult ConwayEra
_ = SLanguage l -> Either (ContextError ConwayEra) (PlutusTxInfo l)
forall (l :: Language) era.
(HasCallStack, EraPlutusTxInfo l era) =>
SLanguage l -> Either (ContextError era) (PlutusTxInfo l)
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
  ( NoThunks (TxCert era)
  , NoThunks (PlutusPurpose AsIx era)
  , NoThunks (PlutusPurpose AsItem era)
  , EraPParams era
  ) =>
  NoThunks (ConwayContextError era)

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
proxy ProtVer
pv = proxy 'PlutusV1
-> ProtVer
-> ConwayPlutusPurpose AsItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era),
 Inject
   (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy 'PlutusV1
proxy ProtVer
pv (ConwayPlutusPurpose AsItem ConwayEra
 -> Either (ConwayContextError ConwayEra) ScriptPurpose)
-> (ConwayPlutusPurpose AsIxItem ConwayEra
    -> ConwayPlutusPurpose AsItem ConwayEra)
-> ConwayPlutusPurpose AsIxItem ConwayEra
-> Either (ConwayContextError ConwayEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem ConwayEra
-> PlutusPurpose AsItem ConwayEra
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 ConwayEra -> PlutusPurpose f ConwayEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo proxy 'PlutusV1
proxy LedgerTxInfo {ProtVer
ltiProtVer :: ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart, UTxO ConwayEra
ltiUTxO :: UTxO ConwayEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx TopTx ConwayEra
ltiTx :: Tx TopTx ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx} = do
    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
ltiTx
    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
ltiTx 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
    pure
      PV1.TxInfo
        { PV1.txInfoInputs = inputs
        , PV1.txInfoOutputs = outputs
        , PV1.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
        , PV1.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
        , PV1.txInfoDCert = txCerts
        , PV1.txInfoWdrl = Alonzo.transTxBodyWithdrawals txBody
        , PV1.txInfoValidRange = timeRange
        , PV1.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
        , PV1.txInfoData = Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
        , PV1.txInfoId = Alonzo.transTxBodyId txBody
        }
    where
      txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
ltiTx 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

  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
proxy ProtVer
pv = proxy 'PlutusV2
-> ProtVer
-> ConwayPlutusPurpose AsItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era),
 Inject
   (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy 'PlutusV2
proxy ProtVer
pv (ConwayPlutusPurpose AsItem ConwayEra
 -> Either (ConwayContextError ConwayEra) ScriptPurpose)
-> (ConwayPlutusPurpose AsIxItem ConwayEra
    -> ConwayPlutusPurpose AsItem ConwayEra)
-> ConwayPlutusPurpose AsIxItem ConwayEra
-> Either (ConwayContextError ConwayEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem ConwayEra
-> PlutusPurpose AsItem ConwayEra
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 ConwayEra -> PlutusPurpose f ConwayEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo proxy 'PlutusV2
proxy LedgerTxInfo {ProtVer
ltiProtVer :: forall era. LedgerTxInfo era -> ProtVer
ltiProtVer :: ProtVer
ltiProtVer, EpochInfo (Either Text)
ltiEpochInfo :: forall era. LedgerTxInfo era -> EpochInfo (Either Text)
ltiEpochInfo :: EpochInfo (Either Text)
ltiEpochInfo, SystemStart
ltiSystemStart :: forall era. LedgerTxInfo era -> SystemStart
ltiSystemStart :: SystemStart
ltiSystemStart, UTxO ConwayEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO ConwayEra
ltiUTxO, Tx TopTx ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx ConwayEra
ltiTx} = do
    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
ltiTx
    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
ltiTx 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 ltiTx
    pure
      PV2.TxInfo
        { PV2.txInfoInputs = inputs
        , PV2.txInfoOutputs = outputs
        , PV2.txInfoReferenceInputs = refInputs
        , PV2.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
        , PV2.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
        , PV2.txInfoDCert = txCerts
        , PV2.txInfoWdrl = PV2.unsafeFromList $ Alonzo.transTxBodyWithdrawals txBody
        , PV2.txInfoValidRange = timeRange
        , PV2.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
        , PV2.txInfoRedeemers = plutusRedeemers
        , PV2.txInfoData = PV2.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
        , PV2.txInfoId = Alonzo.transTxBodyId txBody
        }
    where
      txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
ltiTx 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

  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
-> ConwayPlutusPurpose AsIxItem ConwayEra
-> Either (ContextError ConwayEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> LedgerTxInfo ConwayEra
-> Either (ContextError ConwayEra) (PlutusTxInfo 'PlutusV3)
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 TopTx ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx ConwayEra
ltiTx} = do
    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
ltiTx 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)
    let
      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 = 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
    inputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
    refInputsInfo <- mapM (transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
    let
      commonInputs = Set TxIn
txInputs Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set TxIn
refInputs
    unless (pvMajor ltiProtVer < natVersion @11) $ case toList commonInputs of
      (TxIn
x : [TxIn]
xs) -> ConwayContextError ConwayEra
-> Either (ConwayContextError ConwayEra) ()
forall a b. a -> Either a b
Left (ConwayContextError ConwayEra
 -> Either (ConwayContextError ConwayEra) ())
-> ConwayContextError ConwayEra
-> Either (ConwayContextError ConwayEra) ()
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> ConwayContextError ConwayEra
forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs (NonEmpty TxIn -> ConwayContextError ConwayEra)
-> NonEmpty TxIn -> ConwayContextError ConwayEra
forall a b. (a -> b) -> a -> b
$ TxIn
x TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| [TxIn]
xs
      [TxIn]
_ -> () -> Either (ConwayContextError ConwayEra) ()
forall a b. b -> Either a b
Right ()
    outputs <-
      zipWithM
        (Babbage.transTxOutV2 . TxOutFromOutput)
        [minBound ..]
        (F.toList (txBody ^. outputsTxBodyL))
    txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
    plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer ltiTx
    pure
      PV3.TxInfo
        { PV3.txInfoInputs = inputsInfo
        , PV3.txInfoOutputs = outputs
        , PV3.txInfoReferenceInputs = refInputsInfo
        , PV3.txInfoFee = transCoinToLovelace (txBody ^. feeTxBodyL)
        , PV3.txInfoMint = transMintValue (txBody ^. mintTxBodyL)
        , PV3.txInfoTxCerts = txCerts
        , PV3.txInfoWdrl = transTxBodyWithdrawals txBody
        , PV3.txInfoValidRange = timeRange
        , PV3.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
        , PV3.txInfoRedeemers = plutusRedeemers
        , PV3.txInfoData = PV3.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
        , PV3.txInfoId = transTxBodyId txBody
        , PV3.txInfoVotes = transVotingProcedures (txBody ^. votingProceduresTxBodyL)
        , PV3.txInfoProposalProcedures =
            map (transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
        , PV3.txInfoCurrentTreasuryAmount =
            strictMaybe Nothing (Just . transCoinToLovelace) $ txBody ^. currentTreasuryValueTxBodyL
        , PV3.txInfoTreasuryDonation =
            case txBody ^. 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
        }
    where
      txBody :: TxBody TopTx ConwayEra
txBody = Tx TopTx ConwayEra
ltiTx 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

  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 =
  (RewardAccount -> Credential)
-> (Coin -> Lovelace)
-> Map RewardAccount Coin
-> Map Credential Lovelace
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap RewardAccount -> Credential
transRewardAccount Coin -> Lovelace
transCoinToLovelace (Withdrawals -> Map RewardAccount Coin
unWithdrawals (Withdrawals -> Map RewardAccount Coin)
-> Withdrawals -> Map RewardAccount 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 ::
  ( ConwayEraPlutusTxInfo l era
  , PlutusTxCert l ~ PV3.TxCert
  ) =>
  proxy l ->
  ProtVer ->
  ConwayPlutusPurpose AsIxItem era ->
  Either (ContextError era) PV3.ScriptPurpose
transPlutusPurposeV3 :: forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3 proxy l
proxy ProtVer
pv = \case
  ConwaySpending (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)
  ConwayMinting (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)
  ConwayCertifying (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 l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
forall (proxy :: Language -> *).
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
toPlutusTxCert proxy l
proxy ProtVer
pv TxCert era
txCert
  ConwayRewarding (AsIxItem Word32
_ RewardAccount
rewardAccount) -> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptPurpose -> Either (ContextError era) ScriptPurpose)
-> ScriptPurpose -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ Credential -> ScriptPurpose
PV3.Rewarding (RewardAccount -> Credential
transRewardAccount RewardAccount
rewardAccount)
  ConwayVoting (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)
  ConwayProposing (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 l -> ProposalProcedure era -> ProposalProcedure
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy l
proxy ProposalProcedure era
proposal)

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 RewardAccount Coin
withdrawals StrictMaybe ScriptHash
govPolicy ->
    Map Credential Lovelace -> Maybe ScriptHash -> GovernanceAction
PV3.TreasuryWithdrawals
      ((RewardAccount -> Credential)
-> (Coin -> Lovelace)
-> Map RewardAccount Coin
-> Map Credential Lovelace
forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap RewardAccount -> Credential
transRewardAccount Coin -> Lovelace
transCoinToLovelace Map RewardAccount 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, RewardAccount
pProcReturnAddr :: RewardAccount
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount
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 = RewardAccount -> Credential
transRewardAccount RewardAccount
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)
  , Inject (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)
  ) =>
  proxy l ->
  ProtVer ->
  ConwayPlutusPurpose AsItem era ->
  Either (ContextError era) PV2.ScriptPurpose
transPlutusPurposeV1V2 :: forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError era),
 Inject
   (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv = \case
  ConwaySpending AsItem Word32 TxIn
txIn -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 TxIn -> AlonzoPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> AlonzoPlutusPurpose f era
AlonzoSpending AsItem Word32 TxIn
txIn
  ConwayMinting AsItem Word32 PolicyID
policyId -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 PolicyID -> AlonzoPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> AlonzoPlutusPurpose f era
AlonzoMinting AsItem Word32 PolicyID
policyId
  ConwayCertifying AsItem Word32 (TxCert era)
txCert -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 (TxCert era) -> AlonzoPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying AsItem Word32 (TxCert era)
txCert
  ConwayRewarding AsItem Word32 RewardAccount
rewardAccount -> proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert) =>
proxy l
-> ProtVer
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Alonzo.transPlutusPurpose proxy l
proxy ProtVer
pv (AlonzoPlutusPurpose AsItem era
 -> Either (ContextError era) ScriptPurpose)
-> AlonzoPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 RewardAccount -> AlonzoPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> AlonzoPlutusPurpose f era
AlonzoRewarding AsItem Word32 RewardAccount
rewardAccount
  ConwayPlutusPurpose AsItem 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
$ ConwayPlutusPurpose AsItem era -> PlutusPurpose AsItem era
forall t s. Inject t s => t -> s
inject ConwayPlutusPurpose AsItem era
purpose

transProtVer :: ProtVer -> PV3.ProtocolVersion
transProtVer :: ProtVer -> ProtocolVersion
transProtVer (ProtVer Version
major Natural
minor) =
  Integer -> Integer -> ProtocolVersion
PV3.ProtocolVersion (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Version -> Word64
getVersion64 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
rewardAccount -> Credential -> ScriptInfo
PV3.RewardingScript Credential
rewardAccount
    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
  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