{-# 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,
  transScriptPurpose,
  transMap,
  transTxInInfoV1,
  transTxOutV1,
  toPlutusV3Args,
) where

import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Plutus.Context (
  EraPlutusContext (..),
  EraPlutusTxInfo (..),
  LedgerTxInfo (..),
  PlutusTxCert,
  PlutusTxInfo,
  SupportedLanguage (..),
  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 (..))
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)
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.Tx ()
import Cardano.Ledger.Conway.TxCert
import Cardano.Ledger.Conway.UTxO ()
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.DRep (DRep (..))
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 (
  transBoundedRational,
  transCoinToLovelace,
  transCoinToValue,
  transCred,
  transDatum,
  transEpochNo,
  transKeyHash,
  transRewardAccount,
  transSafeHash,
  transScriptHash,
 )
import qualified Cardano.Ledger.Plutus.TxInfo as TxInfo
import Cardano.Ledger.PoolParams
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.State (UTxO)
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
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 qualified Data.Map.Strict as Map
import qualified Data.OSet.Strict as OSet
import qualified Data.Set as Set
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

  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

  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
  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 Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (ConwayContextError Any) -> Encoding)
-> Encode 'Open (ConwayContextError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Coin -> ConwayContextError Any)
-> Word -> Encode 'Open (Coin -> ConwayContextError Any)
forall t. t -> Word -> Encode 'Open t
Sum Coin -> ConwayContextError Any
forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported Word
11 Encode 'Open (Coin -> ConwayContextError Any)
-> Encode ('Closed 'Dense) Coin
-> Encode 'Open (ConwayContextError Any)
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 Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode 'Open (ConwayContextError Any) -> Encoding)
-> Encode 'Open (ConwayContextError Any) -> Encoding
forall a b. (a -> b) -> a -> b
$ (Coin -> ConwayContextError Any)
-> Word -> Encode 'Open (Coin -> ConwayContextError Any)
forall t. t -> Word -> Encode 'Open t
Sum Coin -> ConwayContextError Any
forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported Word
14 Encode 'Open (Coin -> ConwayContextError Any)
-> Encode ('Closed 'Dense) Coin
-> Encode 'Open (ConwayContextError Any)
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

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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) 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 Any) (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 Any) (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 Any) (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 Any) (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 Any) 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 Any) Coin
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]

-- | 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 era
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
  TxOut
plutusTxOut <- TxOutSource -> TxOut era -> Either (ContextError era) TxOut
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 (TxIn -> TxOutSource
TxOutFromInput TxIn
txIn) TxOut era
txOut
  TxInInfo -> Either (ContextError era) TxInInfo
forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (TxIn -> TxOutRef
TxInfo.transTxIn TxIn
txIn) TxOut
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 era
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
  TxOut
plutusTxOut <- TxOutSource -> TxOut era -> Either (ContextError era) TxOut
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 (TxIn -> TxOutSource
TxOutFromInput TxIn
txIn) TxOut era
txOut
  TxInInfo -> Either (ContextError era) TxInInfo
forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV3.TxInInfo (TxIn -> TxOutRef
transTxIn TxIn
txIn) TxOut
plutusTxOut)

guardConwayFeaturesForPlutusV1V2 ::
  forall era.
  ( EraTx era
  , ConwayEraTxBody era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  Tx era ->
  Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 :: forall era.
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx era
tx = do
  let txBody :: TxBody era
txBody = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
      currentTreasuryValue :: StrictMaybe Coin
currentTreasuryValue = TxBody era
txBody TxBody era
-> Getting (StrictMaybe Coin) (TxBody era) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe Coin) (TxBody era) (StrictMaybe Coin)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody era) (StrictMaybe Coin)
currentTreasuryValueTxBodyL
      votingProcedures :: VotingProcedures era
votingProcedures = TxBody era
txBody TxBody era
-> Getting
     (VotingProcedures era) (TxBody era) (VotingProcedures era)
-> VotingProcedures era
forall s a. s -> Getting a s a -> a
^. Getting (VotingProcedures era) (TxBody era) (VotingProcedures era)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
      proposalProcedures :: OSet (ProposalProcedure era)
proposalProcedures = TxBody era
txBody TxBody era
-> Getting
     (OSet (ProposalProcedure era))
     (TxBody era)
     (OSet (ProposalProcedure era))
-> OSet (ProposalProcedure era)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure era))
  (TxBody era)
  (OSet (ProposalProcedure era))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
      treasuryDonation :: Coin
treasuryDonation = TxBody era
txBody TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody 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 ::
  ( ConwayEraTxCert era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  TxCert era ->
  Either (ContextError era) PV1.DCert
transTxCertV1V2 :: forall era.
(ConwayEraTxCert era,
 Inject (ConwayContextError era) (ContextError era)) =>
TxCert era -> Either (ContextError era) DCert
transTxCertV1V2 = \case
  RegDepositTxCert StakeCredential
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 (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred))
  UnRegDepositTxCert StakeCredential
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 (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
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.
(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,
 PlutusPurpose AsItem era ~ ConwayPlutusPurpose AsItem era,
 EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError 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 ConwayEra
ltiTx :: Tx ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx} = do
    Tx ConwayEra -> Either (ContextError ConwayEra) ()
forall era.
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx ConwayEra
ltiTx
    POSIXTimeRange
timeRange <-
      AlonzoTx ConwayEra
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx ConwayEra
AlonzoTx ConwayEra
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody ConwayEra) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL))
    (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
referenceInputsTxBodyL))
    [TxOut]
outputs <-
      (TxIx
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> [TxIx]
-> [TxOut ConwayEra]
-> Either (ConwayContextError ConwayEra) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (TxOutSource
-> TxOut ConwayEra -> Either (ContextError ConwayEra) TxOut
TxOutSource
-> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 (TxOutSource
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> (TxIx -> TxOutSource)
-> TxIx
-> TxOut ConwayEra
-> Either (ConwayContextError ConwayEra) TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIx -> TxOutSource
TxOutFromOutput)
        [TxIx
forall a. Bounded a => a
minBound ..]
        (StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (StrictSeq (TxOut ConwayEra))
     (TxBody ConwayEra)
     (StrictSeq (TxOut ConwayEra))
-> StrictSeq (TxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut ConwayEra))
  (TxBody ConwayEra)
  (StrictSeq (TxOut ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL))
    [DCert]
txCerts <- proxy 'PlutusV1
-> ProtVer
-> TxBody ConwayEra
-> Either (ContextError ConwayEra) [PlutusTxCert 'PlutusV1]
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
Alonzo.transTxBodyCerts proxy 'PlutusV1
proxy ProtVer
ltiProtVer TxBody ConwayEra
txBody
    TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a. a -> Either (ConwayContextError ConwayEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PV1.TxInfo
        { txInfoInputs :: [TxInInfo]
PV1.txInfoInputs = [TxInInfo]
inputs
        , txInfoOutputs :: [TxOut]
PV1.txInfoOutputs = [TxOut]
outputs
        , txInfoFee :: Value
PV1.txInfoFee = Coin -> Value
transCoinToValue (TxBody ConwayEra
txBody TxBody ConwayEra -> Getting Coin (TxBody ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV1.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting MultiAsset (TxBody ConwayEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody ConwayEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody ConwayEra) MultiAsset
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = TxBody ConwayEra -> [(StakingCredential, Integer)]
forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody ConwayEra
txBody
        , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = TxBody ConwayEra -> [PubKeyHash]
forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody ConwayEra
txBody
        , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxWits ConwayEra -> Const (TxWits ConwayEra) (TxWits ConwayEra))
-> Tx ConwayEra -> Const (TxWits ConwayEra) (Tx ConwayEra)
Getting (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL)
        , txInfoId :: TxId
PV1.txInfoId = TxBody ConwayEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
Alonzo.transTxBodyId TxBody ConwayEra
txBody
        }
    where
      txBody :: TxBody ConwayEra
txBody = Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
-> TxBody ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxBody ConwayEra -> Const (TxBody ConwayEra) (TxBody ConwayEra))
-> Tx ConwayEra -> Const (TxBody ConwayEra) (Tx ConwayEra)
Getting (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody 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

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.
(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,
 PlutusPurpose AsItem era ~ ConwayPlutusPurpose AsItem era,
 EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError 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 ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx :: Tx ConwayEra
ltiTx} = do
    Tx ConwayEra -> Either (ContextError ConwayEra) ()
forall era.
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx ConwayEra
ltiTx
    POSIXTimeRange
timeRange <-
      AlonzoTx ConwayEra
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx ConwayEra
AlonzoTx ConwayEra
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody ConwayEra) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL))
    [TxInInfo]
refInputs <- (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
referenceInputsTxBodyL))
    [TxOut]
outputs <-
      (TxIx
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> [TxIx]
-> [TxOut ConwayEra]
-> Either (ConwayContextError ConwayEra) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (TxOutSource
-> TxOut ConwayEra -> Either (ContextError ConwayEra) TxOut
TxOutSource
-> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
Babbage.transTxOutV2 (TxOutSource
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> (TxIx -> TxOutSource)
-> TxIx
-> TxOut ConwayEra
-> Either (ConwayContextError ConwayEra) TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIx -> TxOutSource
TxOutFromOutput)
        [TxIx
forall a. Bounded a => a
minBound ..]
        (StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (StrictSeq (TxOut ConwayEra))
     (TxBody ConwayEra)
     (StrictSeq (TxOut ConwayEra))
-> StrictSeq (TxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut ConwayEra))
  (TxBody ConwayEra)
  (StrictSeq (TxOut ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL))
    [DCert]
txCerts <- proxy 'PlutusV2
-> ProtVer
-> TxBody ConwayEra
-> Either (ContextError ConwayEra) [PlutusTxCert 'PlutusV2]
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
Alonzo.transTxBodyCerts proxy 'PlutusV2
proxy ProtVer
ltiProtVer TxBody ConwayEra
txBody
    Map ScriptPurpose Redeemer
plutusRedeemers <- proxy 'PlutusV2
-> ProtVer
-> Tx ConwayEra
-> Either
     (ContextError ConwayEra)
     (Map (PlutusScriptPurpose 'PlutusV2) Redeemer)
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, AlonzoEraTxBody era, EraTx era,
 AlonzoEraTxWits era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> Tx era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
Babbage.transTxRedeemers proxy 'PlutusV2
proxy ProtVer
ltiProtVer Tx ConwayEra
ltiTx
    TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a. a -> Either (ConwayContextError ConwayEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PV2.TxInfo
        { txInfoInputs :: [TxInInfo]
PV2.txInfoInputs = [TxInInfo]
inputs
        , txInfoOutputs :: [TxOut]
PV2.txInfoOutputs = [TxOut]
outputs
        , txInfoReferenceInputs :: [TxInInfo]
PV2.txInfoReferenceInputs = [TxInInfo]
refInputs
        , txInfoFee :: Value
PV2.txInfoFee = Coin -> Value
transCoinToValue (TxBody ConwayEra
txBody TxBody ConwayEra -> Getting Coin (TxBody ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV2.txInfoMint = MultiAsset -> Value
Alonzo.transMintValue (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting MultiAsset (TxBody ConwayEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody ConwayEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody ConwayEra) MultiAsset
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV2.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: Map StakingCredential Integer
PV2.txInfoWdrl = [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(StakingCredential, Integer)] -> Map StakingCredential Integer)
-> [(StakingCredential, Integer)] -> Map StakingCredential Integer
forall a b. (a -> b) -> a -> b
$ TxBody ConwayEra -> [(StakingCredential, Integer)]
forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody ConwayEra
txBody
        , txInfoValidRange :: POSIXTimeRange
PV2.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV2.txInfoSignatories = TxBody ConwayEra -> [PubKeyHash]
forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody ConwayEra
txBody
        , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV2.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
        , txInfoData :: Map DatumHash Datum
PV2.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV2.unsafeFromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxWits ConwayEra -> Const (TxWits ConwayEra) (TxWits ConwayEra))
-> Tx ConwayEra -> Const (TxWits ConwayEra) (Tx ConwayEra)
Getting (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL)
        , txInfoId :: TxId
PV2.txInfoId = TxBody ConwayEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
Alonzo.transTxBodyId TxBody ConwayEra
txBody
        }
    where
      txBody :: TxBody ConwayEra
txBody = Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
-> TxBody ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxBody ConwayEra -> Const (TxBody ConwayEra) (TxBody ConwayEra))
-> Tx ConwayEra -> Const (TxBody ConwayEra) (Tx ConwayEra)
Getting (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody 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

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. ConwayEraTxCert 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
transScriptPurpose

  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 ConwayEra
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx :: Tx ConwayEra
ltiTx} = do
    POSIXTimeRange
timeRange <-
      AlonzoTx ConwayEra
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError ConwayEra) POSIXTimeRange
forall {k} (proxy :: k -> *) (era :: k) a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx ConwayEra
AlonzoTx ConwayEra
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting ValidityInterval (TxBody ConwayEra) ValidityInterval
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody ConwayEra) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
inputsTxBodyL))
    [TxInInfo]
refInputs <- (TxIn -> Either (ConwayContextError ConwayEra) TxInInfo)
-> [TxIn] -> Either (ConwayContextError ConwayEra) [TxInInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (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 UTxO ConwayEra
ltiUTxO) (Set TxIn -> [TxIn]
forall a. Set a -> [a]
Set.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody ConwayEra) (Set TxIn)
forall era. BabbageEraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ConwayEra) (Set TxIn)
referenceInputsTxBodyL))
    [TxOut]
outputs <-
      (TxIx
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> [TxIx]
-> [TxOut ConwayEra]
-> Either (ConwayContextError ConwayEra) [TxOut]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (TxOutSource
-> TxOut ConwayEra -> Either (ContextError ConwayEra) TxOut
TxOutSource
-> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut
forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue, BabbageEraTxOut era) =>
TxOutSource -> TxOut era -> Either (ContextError era) TxOut
Babbage.transTxOutV2 (TxOutSource
 -> TxOut ConwayEra -> Either (ConwayContextError ConwayEra) TxOut)
-> (TxIx -> TxOutSource)
-> TxIx
-> TxOut ConwayEra
-> Either (ConwayContextError ConwayEra) TxOut
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxIx -> TxOutSource
TxOutFromOutput)
        [TxIx
forall a. Bounded a => a
minBound ..]
        (StrictSeq (TxOut ConwayEra) -> [TxOut ConwayEra]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (StrictSeq (TxOut ConwayEra))
     (TxBody ConwayEra)
     (StrictSeq (TxOut ConwayEra))
-> StrictSeq (TxOut ConwayEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut ConwayEra))
  (TxBody ConwayEra)
  (StrictSeq (TxOut ConwayEra))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ConwayEra) (StrictSeq (TxOut ConwayEra))
outputsTxBodyL))
    [TxCert]
txCerts <- proxy 'PlutusV3
-> ProtVer
-> TxBody ConwayEra
-> Either (ContextError ConwayEra) [PlutusTxCert 'PlutusV3]
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, EraTxBody era) =>
proxy l
-> ProtVer
-> TxBody era
-> Either (ContextError era) [PlutusTxCert l]
Alonzo.transTxBodyCerts proxy 'PlutusV3
proxy ProtVer
ltiProtVer TxBody ConwayEra
txBody
    Map ScriptPurpose Redeemer
plutusRedeemers <- proxy 'PlutusV3
-> ProtVer
-> Tx ConwayEra
-> Either
     (ContextError ConwayEra)
     (Map (PlutusScriptPurpose 'PlutusV3) Redeemer)
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, AlonzoEraTxBody era, EraTx era,
 AlonzoEraTxWits era,
 Inject (BabbageContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> Tx era
-> Either (ContextError era) (Map (PlutusScriptPurpose l) Redeemer)
Babbage.transTxRedeemers proxy 'PlutusV3
proxy ProtVer
ltiProtVer Tx ConwayEra
ltiTx
    TxInfo -> Either (ConwayContextError ConwayEra) TxInfo
forall a. a -> Either (ConwayContextError ConwayEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      PV3.TxInfo
        { txInfoInputs :: [TxInInfo]
PV3.txInfoInputs = [TxInInfo]
inputs
        , txInfoOutputs :: [TxOut]
PV3.txInfoOutputs = [TxOut]
outputs
        , txInfoReferenceInputs :: [TxInInfo]
PV3.txInfoReferenceInputs = [TxInInfo]
refInputs
        , txInfoFee :: Lovelace
PV3.txInfoFee = Coin -> Lovelace
transCoinToLovelace (TxBody ConwayEra
txBody TxBody ConwayEra -> Getting Coin (TxBody ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody ConwayEra) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
feeTxBodyL)
        , txInfoMint :: MintValue
PV3.txInfoMint = MultiAsset -> MintValue
transMintValue (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting MultiAsset (TxBody ConwayEra) MultiAsset -> MultiAsset
forall s a. s -> Getting a s a -> a
^. Getting MultiAsset (TxBody ConwayEra) MultiAsset
forall era. MaryEraTxBody era => Lens' (TxBody era) MultiAsset
Lens' (TxBody ConwayEra) MultiAsset
mintTxBodyL)
        , txInfoTxCerts :: [TxCert]
PV3.txInfoTxCerts = [TxCert]
txCerts
        , txInfoWdrl :: Map Credential Lovelace
PV3.txInfoWdrl = TxBody ConwayEra -> Map Credential Lovelace
forall era. EraTxBody era => TxBody era -> Map Credential Lovelace
transTxBodyWithdrawals TxBody ConwayEra
txBody
        , txInfoValidRange :: POSIXTimeRange
PV3.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV3.txInfoSignatories = TxBody ConwayEra -> [PubKeyHash]
forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody ConwayEra
txBody
        , txInfoRedeemers :: Map ScriptPurpose Redeemer
PV3.txInfoRedeemers = Map ScriptPurpose Redeemer
plutusRedeemers
        , txInfoData :: Map DatumHash Datum
PV3.txInfoData = [(DatumHash, Datum)] -> Map DatumHash Datum
forall k v. [(k, v)] -> Map k v
PV3.unsafeFromList ([(DatumHash, Datum)] -> Map DatumHash Datum)
-> [(DatumHash, Datum)] -> Map DatumHash Datum
forall a b. (a -> b) -> a -> b
$ TxWits ConwayEra -> [(DatumHash, Datum)]
forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
-> TxWits ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxWits ConwayEra -> Const (TxWits ConwayEra) (TxWits ConwayEra))
-> Tx ConwayEra -> Const (TxWits ConwayEra) (Tx ConwayEra)
Getting (TxWits ConwayEra) (AlonzoTx ConwayEra) (TxWits ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ConwayEra) (TxWits ConwayEra)
witsTxL)
        , txInfoId :: TxId
PV3.txInfoId = TxBody ConwayEra -> TxId
forall era. EraTxBody era => TxBody era -> TxId
transTxBodyId TxBody ConwayEra
txBody
        , txInfoVotes :: Map Voter (Map GovernanceActionId Vote)
PV3.txInfoVotes = VotingProcedures ConwayEra
-> Map Voter (Map GovernanceActionId Vote)
forall era.
VotingProcedures era -> Map Voter (Map GovernanceActionId Vote)
transVotingProcedures (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (VotingProcedures ConwayEra)
     (TxBody ConwayEra)
     (VotingProcedures ConwayEra)
-> VotingProcedures ConwayEra
forall s a. s -> Getting a s a -> a
^. Getting
  (VotingProcedures ConwayEra)
  (TxBody ConwayEra)
  (VotingProcedures ConwayEra)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
Lens' (TxBody ConwayEra) (VotingProcedures ConwayEra)
votingProceduresTxBodyL)
        , txInfoProposalProcedures :: [ProposalProcedure]
PV3.txInfoProposalProcedures =
            (ProposalProcedure ConwayEra -> ProposalProcedure)
-> [ProposalProcedure ConwayEra] -> [ProposalProcedure]
forall a b. (a -> b) -> [a] -> [b]
map (proxy 'PlutusV3 -> ProposalProcedure ConwayEra -> ProposalProcedure
forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy 'PlutusV3
proxy) ([ProposalProcedure ConwayEra] -> [ProposalProcedure])
-> [ProposalProcedure ConwayEra] -> [ProposalProcedure]
forall a b. (a -> b) -> a -> b
$ OSet (ProposalProcedure ConwayEra) -> [ProposalProcedure ConwayEra]
forall a. OSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting
     (OSet (ProposalProcedure ConwayEra))
     (TxBody ConwayEra)
     (OSet (ProposalProcedure ConwayEra))
-> OSet (ProposalProcedure ConwayEra)
forall s a. s -> Getting a s a -> a
^. Getting
  (OSet (ProposalProcedure ConwayEra))
  (TxBody ConwayEra)
  (OSet (ProposalProcedure ConwayEra))
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
Lens' (TxBody ConwayEra) (OSet (ProposalProcedure ConwayEra))
proposalProceduresTxBodyL)
        , txInfoCurrentTreasuryAmount :: Maybe Lovelace
PV3.txInfoCurrentTreasuryAmount =
            Maybe Lovelace
-> (Coin -> Maybe Lovelace) -> StrictMaybe Coin -> Maybe Lovelace
forall a b. a -> (b -> a) -> StrictMaybe b -> a
strictMaybe Maybe Lovelace
forall a. Maybe a
Nothing (Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace)
-> (Coin -> Lovelace) -> Coin -> Maybe Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coin -> Lovelace
transCoinToLovelace) (StrictMaybe Coin -> Maybe Lovelace)
-> StrictMaybe Coin -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ TxBody ConwayEra
txBody TxBody ConwayEra
-> Getting (StrictMaybe Coin) (TxBody ConwayEra) (StrictMaybe Coin)
-> StrictMaybe Coin
forall s a. s -> Getting a s a -> a
^. Getting (StrictMaybe Coin) (TxBody ConwayEra) (StrictMaybe Coin)
forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
Lens' (TxBody ConwayEra) (StrictMaybe Coin)
currentTreasuryValueTxBodyL
        , txInfoTreasuryDonation :: Maybe Lovelace
PV3.txInfoTreasuryDonation =
            case TxBody ConwayEra
txBody TxBody ConwayEra -> Getting Coin (TxBody ConwayEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody ConwayEra) Coin
forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody ConwayEra) Coin
treasuryDonationTxBodyL of
              Coin Integer
0 -> Maybe Lovelace
forall a. Maybe a
Nothing
              Coin
coin -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace) -> Lovelace -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
transCoinToLovelace Coin
coin
        }
    where
      txBody :: TxBody ConwayEra
txBody = Tx ConwayEra
AlonzoTx ConwayEra
ltiTx AlonzoTx ConwayEra
-> Getting
     (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
-> TxBody ConwayEra
forall s a. s -> Getting a s a -> a
^. (TxBody ConwayEra -> Const (TxBody ConwayEra) (TxBody ConwayEra))
-> Tx ConwayEra -> Const (TxBody ConwayEra) (Tx ConwayEra)
Getting (TxBody ConwayEra) (AlonzoTx ConwayEra) (TxBody ConwayEra)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx ConwayEra) (TxBody 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

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 era -> PV3.TxId
transTxBodyId :: forall era. EraTxBody era => TxBody era -> TxId
transTxBodyId TxBody era
txBody = BuiltinByteString -> TxId
PV3.TxId (SafeHash EraIndependentTxBody -> BuiltinByteString
forall i. SafeHash i -> BuiltinByteString
transSafeHash (TxBody era -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody era
txBody))

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 era -> PV3.Map PV3.Credential PV3.Lovelace
transTxBodyWithdrawals :: forall era. EraTxBody era => TxBody era -> Map Credential Lovelace
transTxBodyWithdrawals TxBody 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 era
txBody TxBody era
-> Getting Withdrawals (TxBody era) Withdrawals -> Withdrawals
forall s a. s -> Getting a s a -> a
^. Getting Withdrawals (TxBody era) Withdrawals
forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL)

-- | 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 :: ConwayEraTxCert era => ProtVer -> TxCert era -> PV3.TxCert
transTxCert :: forall era. ConwayEraTxCert era => ProtVer -> TxCert era -> TxCert
transTxCert ProtVer
pv = \case
  RegPoolTxCert PoolParams {KeyHash 'StakePool
ppId :: KeyHash 'StakePool
ppId :: PoolParams -> KeyHash 'StakePool
ppId, VRFVerKeyHash 'StakePoolVRF
ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf :: PoolParams -> VRFVerKeyHash 'StakePoolVRF
ppVrf} ->
    PubKeyHash -> PubKeyHash -> TxCert
PV3.TxCertPoolRegister
      (KeyHash 'StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash 'StakePool
ppId)
      (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
ppVrf))))
  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 StakeCredential
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) Maybe Lovelace
forall a. Maybe a
Nothing
  UnRegTxCert StakeCredential
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) Maybe Lovelace
forall a. Maybe a
Nothing
  RegDepositTxCert StakeCredential
stakeCred Coin
deposit ->
    let transDeposit :: Maybe Lovelace
transDeposit
          | ProtVer -> Bool
HF.bootstrapPhase 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 (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) Maybe Lovelace
transDeposit
  UnRegDepositTxCert StakeCredential
stakeCred Coin
refund ->
    let transRefund :: Maybe Lovelace
transRefund
          | ProtVer -> Bool
HF.bootstrapPhase 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 (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) Maybe Lovelace
transRefund
  DelegTxCert StakeCredential
stakeCred Delegatee
delegatee ->
    Credential -> Delegatee -> TxCert
PV3.TxCertDelegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) (Delegatee -> Delegatee
transDelegatee Delegatee
delegatee)
  RegDepositDelegTxCert StakeCredential
stakeCred Delegatee
delegatee Coin
deposit ->
    Credential -> Delegatee -> Lovelace -> TxCert
PV3.TxCertRegDeleg (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
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)

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.
transScriptPurpose ::
  (ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ PV3.TxCert) =>
  proxy l ->
  ProtVer ->
  ConwayPlutusPurpose AsIxItem era ->
  Either (ContextError era) PV3.ScriptPurpose
transScriptPurpose :: forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transScriptPurpose 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 era)
pGovActionId PParamsUpdate era
ppu StrictMaybe ScriptHash
govPolicy ->
    Maybe GovernanceActionId
-> ChangedParameters -> Maybe ScriptHash -> GovernanceAction
PV3.ParameterChange
      (StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
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 era)
pGovActionId ProtVer
protVer ->
    Maybe GovernanceActionId -> ProtocolVersion -> GovernanceAction
PV3.HardForkInitiation
      (StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'HardForkPurpose era)
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 era)
pGovActionId -> Maybe GovernanceActionId -> GovernanceAction
PV3.NoConfidence (StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'CommitteePurpose era)
pGovActionId)
  UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
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 era)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'CommitteePurpose era)
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 era)
pGovActionId Constitution era
constitution ->
    Maybe GovernanceActionId -> Constitution -> GovernanceAction
PV3.NewConstitution
      (StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Maybe GovernanceActionId
forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
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 era) -> 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 era)
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 ::
  ( PlutusTxCert l ~ PV2.DCert
  , PlutusPurpose AsItem era ~ ConwayPlutusPurpose AsItem era
  , EraPlutusTxInfo l era
  , Inject (ConwayContextError era) (ContextError era)
  ) =>
  proxy l ->
  ProtVer ->
  ConwayPlutusPurpose AsItem era ->
  Either (ContextError era) PV2.ScriptPurpose
transPlutusPurposeV1V2 :: forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert,
 PlutusPurpose AsItem era ~ ConwayPlutusPurpose AsItem era,
 EraPlutusTxInfo l era,
 Inject (ConwayContextError era) (ContextError 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
$ PlutusPurpose AsItem era -> ConwayContextError era
forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported PlutusPurpose AsItem era
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
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 :: ScriptInfo
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)
  PlutusArgs 'PlutusV3
-> Either (ContextError era) (PlutusArgs 'PlutusV3)
forall a. a -> Either (ContextError era) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlutusArgs 'PlutusV3
 -> Either (ContextError era) (PlutusArgs 'PlutusV3))
-> PlutusArgs 'PlutusV3
-> Either (ContextError era) (PlutusArgs 'PlutusV3)
forall a b. (a -> b) -> a -> b
$
    ScriptContext -> PlutusArgs 'PlutusV3
PlutusV3Args (ScriptContext -> PlutusArgs 'PlutusV3)
-> ScriptContext -> PlutusArgs 'PlutusV3
forall a b. (a -> b) -> a -> b
$
      PV3.ScriptContext
        { scriptContextTxInfo :: TxInfo
PV3.scriptContextTxInfo = TxInfo
txInfo
        , scriptContextRedeemer :: Redeemer
PV3.scriptContextRedeemer = Data era -> Redeemer
forall era. Data era -> Redeemer
Babbage.transRedeemer Data era
redeemerData
        , scriptContextScriptInfo :: ScriptInfo
PV3.scriptContextScriptInfo = ScriptInfo
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))