{-# 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 #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Conway.TxInfo (
  ConwayContextError (..),
  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,
  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.Plutus.Context (
  ConwayEraPlutusTxInfo (toPlutusChangedParameters),
  conwayPParamMap,
  pparamUpdateFromData,
  pparamUpdateToData,
 )
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.Crypto (Crypto)
import Cardano.Ledger.DRep (DRep (..))
import Cardano.Ledger.Keys (KeyRole (..), unVRFVerKeyHash)
import Cardano.Ledger.Mary (MaryValue)
import Cardano.Ledger.Plutus.Data (Data)
import Cardano.Ledger.Plutus.Language (Language (..), PlutusArgs (..))
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 Cardano.Ledger.SafeHash (hashAnnotated)
import qualified Cardano.Ledger.Shelley.HardForks as HF (bootstrapPhase)
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
import Cardano.Ledger.UTxO (UTxO)
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

instance Crypto c => EraPlutusContext (ConwayEra c) where
  type ContextError (ConwayEra c) = ConwayContextError (ConwayEra c)

  mkPlutusWithContext :: PlutusScript (ConwayEra c)
-> ScriptHash (EraCrypto (ConwayEra c))
-> PlutusPurpose AsIxItem (ConwayEra c)
-> LedgerTxInfo (ConwayEra c)
-> (Data (ConwayEra c), ExUnits)
-> CostModel
-> Either
     (ContextError (ConwayEra c))
     (PlutusWithContext (EraCrypto (ConwayEra c)))
mkPlutusWithContext = \case
    ConwayPlutusV1 Plutus 'PlutusV1
p -> forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash (EraCrypto era)
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) (PlutusWithContext (EraCrypto era))
toPlutusWithContext forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plutus 'PlutusV1
p
    ConwayPlutusV2 Plutus 'PlutusV2
p -> forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash (EraCrypto era)
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) (PlutusWithContext (EraCrypto era))
toPlutusWithContext forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Plutus 'PlutusV2
p
    ConwayPlutusV3 Plutus 'PlutusV3
p -> forall (l :: Language) era.
(EraPlutusTxInfo l era, AlonzoEraUTxO era) =>
Either (Plutus l) (PlutusRunnable l)
-> ScriptHash (EraCrypto era)
-> PlutusPurpose AsIxItem era
-> LedgerTxInfo era
-> (Data era, ExUnits)
-> CostModel
-> Either (ContextError era) (PlutusWithContext (EraCrypto era))
toPlutusWithContext forall a b. (a -> b) -> a -> b
$ 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 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
$cto :: forall era x.
Rep (ConwayContextError era) x -> ConwayContextError era
$cfrom :: forall era x.
ConwayContextError era -> Rep (ConwayContextError era) x
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 = forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError

instance Inject (AlonzoContextError era) (ConwayContextError era) where
  inject :: AlonzoContextError era -> ConwayContextError era
inject = forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError Word
8 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To BabbageContextError era
babbageContextError
    CertificateNotSupported TxCert era
txCert ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. TxCert era -> ConwayContextError era
CertificateNotSupported Word
9 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To TxCert era
txCert
    PlutusPurposeNotSupported PlutusPurpose AsItem era
purpose ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported Word
10 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To PlutusPurpose AsItem era
purpose
    CurrentTreasuryFieldNotSupported Coin
scoin ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported Word
11 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
scoin
    VotingProceduresFieldNotSupported VotingProcedures era
votingProcedures ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported Word
12 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VotingProcedures era
votingProcedures
    ProposalProceduresFieldNotSupported OSet (ProposalProcedure era)
proposalProcedures ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported Word
13 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OSet (ProposalProcedure era)
proposalProcedures
    TreasuryDonationFieldNotSupported Coin
coin ->
      forall (w :: Wrapped) t. Encode w t -> Encoding
encode forall a b. (a -> b) -> a -> b
$ forall t. t -> Word -> Encode 'Open t
Sum forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported Word
14 forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> 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 = forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode forall a b. (a -> b) -> a -> b
$ forall t.
Text -> (Word -> Decode 'Open t) -> Decode ('Closed 'Dense) t
Summands Text
"ContextError" forall a b. (a -> b) -> a -> b
$ \case
    Word
8 -> forall t. t -> Decode 'Open t
SumD forall era. BabbageContextError era -> ConwayContextError era
BabbageContextError forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
9 -> forall t. t -> Decode 'Open t
SumD forall era. TxCert era -> ConwayContextError era
CertificateNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
10 -> forall t. t -> Decode 'Open t
SumD forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
11 -> forall t. t -> Decode 'Open t
SumD forall era. Coin -> ConwayContextError era
CurrentTreasuryFieldNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
12 -> forall t. t -> Decode 'Open t
SumD forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
13 -> forall t. t -> Decode 'Open t
SumD forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
14 -> forall t. t -> Decode 'Open t
SumD forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! forall t (w :: Wrapped). DecCBOR t => Decode w t
From
    Word
n -> 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 -> forall a. ToJSON a => a -> Value
toJSON BabbageContextError era
err
    CertificateNotSupported TxCert era
txCert ->
      Text -> [Pair] -> Value
kindObject Text
"CertificateNotSupported" [Key
"certificate" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON TxCert era
txCert]
    PlutusPurposeNotSupported PlutusPurpose AsItem era
purpose ->
      Text -> [Pair] -> Value
kindObject Text
"PlutusPurposeNotSupported" [Key
"purpose" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON PlutusPurpose AsItem era
purpose]
    CurrentTreasuryFieldNotSupported Coin
scoin ->
      Text -> [Pair] -> Value
kindObject
        Text
"CurrentTreasuryFieldNotSupported"
        [Key
"current_treasury_value" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON Coin
scoin]
    VotingProceduresFieldNotSupported VotingProcedures era
votingProcedures ->
      Text -> [Pair] -> Value
kindObject
        Text
"VotingProceduresFieldNotSupported"
        [Key
"voting_procedures" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON VotingProcedures era
votingProcedures]
    ProposalProceduresFieldNotSupported OSet (ProposalProcedure era)
proposalProcedures ->
      Text -> [Pair] -> Value
kindObject
        Text
"ProposalProceduresFieldNotSupported"
        [Key
"proposal_procedures" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON OSet (ProposalProcedure era)
proposalProcedures]
    TreasuryDonationFieldNotSupported Coin
coin ->
      Text -> [Pair] -> Value
kindObject
        Text
"TreasuryDonationFieldNotSupported"
        [Key
"treasury_donation" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= 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 (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  TxOutSource (EraCrypto era) ->
  TxOut era ->
  Either (ContextError era) PV1.TxOut
transTxOutV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 TxOutSource (EraCrypto era)
txOutSource TxOut era
txOut = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. StrictMaybe a -> Bool
isSJust (TxOut era
txOut forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxOut era =>
Lens' (TxOut era) (StrictMaybe (Data era))
dataTxOutL)) forall a b. (a -> b) -> a -> b
$ do
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
InlineDatumsNotSupported @era TxOutSource (EraCrypto era)
txOutSource
  case forall era c.
(Value era ~ MaryValue c, AlonzoEraTxOut era) =>
TxOut era -> Maybe TxOut
Alonzo.transTxOut TxOut era
txOut of
    Maybe TxOut
Nothing -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxOutSource (EraCrypto era) -> BabbageContextError era
ByronTxOutInContext @era TxOutSource (EraCrypto era)
txOutSource
    Just TxOut
plutusTxOut -> 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 (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn (EraCrypto era) ->
  Either (ContextError era) PV1.TxInInfo
transTxInInfoV1 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO era
utxo TxIn (EraCrypto era)
txIn = do
  TxOut era
txOut <- forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) forall a b. (a -> b) -> a -> b
$ forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn (EraCrypto era) -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn (EraCrypto era)
txIn
  TxOut
plutusTxOut <- forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 (forall c. TxIn c -> TxOutSource c
TxOutFromInput TxIn (EraCrypto era)
txIn) TxOut era
txOut
  forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV1.TxInInfo (forall c. TxIn c -> TxOutRef
TxInfo.transTxIn TxIn (EraCrypto era)
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 (EraCrypto era)
  , BabbageEraTxOut era
  ) =>
  UTxO era ->
  TxIn (EraCrypto era) ->
  Either (ContextError era) PV3.TxInInfo
transTxInInfoV3 :: forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV3 UTxO era
utxo TxIn (EraCrypto era)
txIn = do
  TxOut era
txOut <- forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (forall t s. Inject t s => t -> s
inject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoContextError era -> BabbageContextError era
AlonzoContextError @era) forall a b. (a -> b) -> a -> b
$ forall era a.
Inject (AlonzoContextError era) a =>
UTxO era -> TxIn (EraCrypto era) -> Either a (TxOut era)
Alonzo.transLookupTxOut UTxO era
utxo TxIn (EraCrypto era)
txIn
  TxOut
plutusTxOut <- forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV2 (forall c. TxIn c -> TxOutSource c
TxOutFromInput TxIn (EraCrypto era)
txIn) TxOut era
txOut
  forall a b. b -> Either a b
Right (TxOutRef -> TxOut -> TxInInfo
PV3.TxInInfo (forall c. TxIn c -> TxOutRef
transTxIn TxIn (EraCrypto era)
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 forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL
      currentTreasuryValue :: StrictMaybe Coin
currentTreasuryValue = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (StrictMaybe Coin)
currentTreasuryValueTxBodyL
      votingProcedures :: VotingProcedures era
votingProcedures = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (VotingProcedures era)
votingProceduresTxBodyL
      proposalProcedures :: OSet (ProposalProcedure era)
proposalProcedures = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraTxBody era =>
Lens' (TxBody era) (OSet (ProposalProcedure era))
proposalProceduresTxBodyL
      treasuryDonation :: Coin
treasuryDonation = TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraTxBody era => Lens' (TxBody era) Coin
treasuryDonationTxBodyL
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall era.
VotingProcedures era
-> Map
     (Voter (EraCrypto era))
     (Map (GovActionId (EraCrypto era)) (VotingProcedure era))
unVotingProcedures VotingProcedures era
votingProcedures) forall a b. (a -> b) -> a -> b
$
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
      forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$
        forall era. VotingProcedures era -> ConwayContextError era
VotingProceduresFieldNotSupported @era VotingProcedures era
votingProcedures
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null OSet (ProposalProcedure era)
proposalProcedures) forall a b. (a -> b) -> a -> b
$
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
      forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$
        forall era. OSet (ProposalProcedure era) -> ConwayContextError era
ProposalProceduresFieldNotSupported @era OSet (ProposalProcedure era)
proposalProcedures
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Coin
treasuryDonation forall a. Eq a => a -> a -> Bool
== Integer -> Coin
Coin Integer
0) forall a b. (a -> b) -> a -> b
$
    forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$
      forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$
        forall era. Coin -> ConwayContextError era
TreasuryDonationFieldNotSupported @era Coin
treasuryDonation
  case StrictMaybe Coin
currentTreasuryValue of
    StrictMaybe Coin
SNothing -> forall a b. b -> Either a b
Right ()
    SJust Coin
treasury ->
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject 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 (EraCrypto era)
stakeCred Coin
_deposit ->
    forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegRegKey (Credential -> StakingCredential
PV1.StakingHash (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred))
  UnRegDepositTxCert StakeCredential (EraCrypto era)
stakeCred Coin
_refund ->
    forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ StakingCredential -> DCert
PV1.DCertDelegDeRegKey (Credential -> StakingCredential
PV1.StakingHash (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred))
  TxCert era
txCert
    | Just DCert
dCert <- forall era. ShelleyEraTxCert era => TxCert era -> Maybe DCert
Alonzo.transTxCertCommon TxCert era
txCert -> forall a b. b -> Either a b
Right DCert
dCert
    | Bool
otherwise -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. TxCert era -> ConwayContextError era
CertificateNotSupported TxCert era
txCert

instance Crypto c => EraPlutusTxInfo 'PlutusV1 (ConwayEra c) where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> TxCert (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusTxCert 'PlutusV1)
toPlutusTxCert proxy 'PlutusV1
_ ProtVer
_ = 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 c)
-> Either
     (ContextError (ConwayEra c)) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy ProtVer
pv = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

  toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo proxy 'PlutusV1
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 c)
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO (ConwayEra c)
ltiUTxO, Tx (ConwayEra c)
ltiTx :: forall era. LedgerTxInfo era -> Tx era
ltiTx :: Tx (ConwayEra c)
ltiTx} = do
    forall era.
(EraTx era, ConwayEraTxBody era,
 Inject (ConwayContextError era) (ContextError era)) =>
Tx era -> Either (ContextError era) ()
guardConwayFeaturesForPlutusV1V2 Tx (ConwayEra c)
ltiTx
    POSIXTimeRange
timeRange <-
      forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> ProtVer
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Alonzo.transValidityInterval Tx (ConwayEra c)
ltiTx ProtVer
ltiProtVer EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody (ConwayEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
vldtTxBodyL)
    [TxInInfo]
inputs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO (ConwayEra c)
ltiUTxO) (forall a. Set a -> [a]
Set.toList (TxBody (ConwayEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
inputsTxBodyL))
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
UTxO era
-> TxIn (EraCrypto era) -> Either (ContextError era) TxInInfo
transTxInInfoV1 UTxO (ConwayEra c)
ltiUTxO) (forall a. Set a -> [a]
Set.toList (TxBody (ConwayEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraTxBody era =>
Lens' (TxBody era) (Set (TxIn (EraCrypto era)))
referenceInputsTxBodyL))
    [TxOut]
outputs <-
      forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM
        (forall era.
(Inject (BabbageContextError era) (ContextError era),
 Value era ~ MaryValue (EraCrypto era), BabbageEraTxOut era) =>
TxOutSource (EraCrypto era)
-> TxOut era -> Either (ContextError era) TxOut
transTxOutV1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TxIx -> TxOutSource c
TxOutFromOutput)
        [forall a. Bounded a => a
minBound ..]
        (forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (TxBody (ConwayEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL))
    [DCert]
txCerts <- 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 c)
txBody
    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 c)
txBody forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Coin
feeTxBodyL)
        , txInfoMint :: Value
PV1.txInfoMint = forall c. MultiAsset c -> Value
Alonzo.transMintValue (TxBody (ConwayEra c)
txBody forall s a. s -> Getting a s a -> a
^. forall era.
MaryEraTxBody era =>
Lens' (TxBody era) (MultiAsset (EraCrypto era))
mintTxBodyL)
        , txInfoDCert :: [DCert]
PV1.txInfoDCert = [DCert]
txCerts
        , txInfoWdrl :: [(StakingCredential, Integer)]
PV1.txInfoWdrl = forall era.
EraTxBody era =>
TxBody era -> [(StakingCredential, Integer)]
Alonzo.transTxBodyWithdrawals TxBody (ConwayEra c)
txBody
        , txInfoValidRange :: POSIXTimeRange
PV1.txInfoValidRange = POSIXTimeRange
timeRange
        , txInfoSignatories :: [PubKeyHash]
PV1.txInfoSignatories = forall era. AlonzoEraTxBody era => TxBody era -> [PubKeyHash]
Alonzo.transTxBodyReqSignerHashes TxBody (ConwayEra c)
txBody
        , txInfoData :: [(DatumHash, Datum)]
PV1.txInfoData = forall era.
AlonzoEraTxWits era =>
TxWits era -> [(DatumHash, Datum)]
Alonzo.transTxWitsDatums (Tx (ConwayEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxWits era)
witsTxL)
        , txInfoId :: TxId
PV1.txInfoId = forall era. EraTxBody era => TxBody era -> TxId
Alonzo.transTxBodyId TxBody (ConwayEra c)
txBody
        }
    where
      txBody :: TxBody (ConwayEra c)
txBody = Tx (ConwayEra c)
ltiTx forall s a. s -> Getting a s a -> a
^. forall era. EraTx era => Lens' (Tx era) (TxBody era)
bodyTxL

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem (ConwayEra c)
-> Maybe (Data (ConwayEra c))
-> Data (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusArgs 'PlutusV1)
toPlutusArgs = 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 Crypto c => EraPlutusTxInfo 'PlutusV2 (ConwayEra c) where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> TxCert (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusTxCert 'PlutusV2)
toPlutusTxCert proxy 'PlutusV2
_ ProtVer
_ = 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 c)
-> Either
     (ContextError (ConwayEra c)) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose proxy 'PlutusV2
proxy ProtVer
pv = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era (g :: * -> * -> *) (f :: * -> * -> *).
AlonzoEraScript era =>
(forall ix it. g ix it -> f ix it)
-> PlutusPurpose g era -> PlutusPurpose f era
hoistPlutusPurpose forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem

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

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem (ConwayEra c)
-> Maybe (Data (ConwayEra c))
-> Data (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusArgs 'PlutusV2)
toPlutusArgs = 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 Crypto c => EraPlutusTxInfo 'PlutusV3 (ConwayEra c) where
  toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> TxCert (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusTxCert 'PlutusV3)
toPlutusTxCert proxy 'PlutusV3
_ ProtVer
pv = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraTxCert era => ProtVer -> TxCert era -> TxCert
transTxCert ProtVer
pv

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

  toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> PlutusTxInfo 'PlutusV3
-> PlutusPurpose AsIxItem (ConwayEra c)
-> Maybe (Data (ConwayEra c))
-> Data (ConwayEra c)
-> Either (ContextError (ConwayEra c)) (PlutusArgs 'PlutusV3)
toPlutusArgs = 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 c -> PV3.TxId
transTxId :: forall c. TxId c -> TxId
transTxId TxId c
txId = BuiltinByteString -> TxId
PV3.TxId (forall c i. SafeHash c i -> BuiltinByteString
transSafeHash (forall c. TxId c -> SafeHash c EraIndependentTxBody
unTxId TxId c
txId))

transTxBodyId :: EraTxBody era => TxBody era -> PV3.TxId
transTxBodyId :: forall era. EraTxBody era => TxBody era -> TxId
transTxBodyId TxBody era
txBody = BuiltinByteString -> TxId
PV3.TxId (forall c i. SafeHash c i -> BuiltinByteString
transSafeHash (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody era
txBody))

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

-- | 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 =
  forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap forall c. RewardAccount c -> Credential
transRewardAccount Coin -> Lovelace
transCoinToLovelace (forall c. Withdrawals c -> Map (RewardAccount c) Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ TxBody era
txBody forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (Withdrawals (EraCrypto era))
withdrawalsTxBodyL)

-- | In 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.
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 (EraCrypto era)
ppId :: forall c. PoolParams c -> KeyHash 'StakePool c
ppId :: KeyHash 'StakePool (EraCrypto era)
ppId, VRFVerKeyHash 'StakePoolVRF (EraCrypto era)
ppVrf :: forall c. PoolParams c -> VRFVerKeyHash 'StakePoolVRF c
ppVrf :: VRFVerKeyHash 'StakePoolVRF (EraCrypto era)
ppVrf} ->
    PubKeyHash -> PubKeyHash -> TxCert
PV3.TxCertPoolRegister
      (forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash KeyHash 'StakePool (EraCrypto era)
ppId)
      (BuiltinByteString -> PubKeyHash
PV3.PubKeyHash (forall a. HasToBuiltin a => a -> ToBuiltin a
PV3.toBuiltin (forall h a. Hash h a -> ByteString
hashToBytes (forall (r :: KeyRoleVRF) c.
VRFVerKeyHash r c -> Hash (HASH c) KeyRoleVRF
unVRFVerKeyHash VRFVerKeyHash 'StakePoolVRF (EraCrypto era)
ppVrf))))
  RetirePoolTxCert KeyHash 'StakePool (EraCrypto era)
poolId EpochNo
retireEpochNo ->
    PubKeyHash -> Integer -> TxCert
PV3.TxCertPoolRetire (forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash KeyHash 'StakePool (EraCrypto era)
poolId) (EpochNo -> Integer
transEpochNo EpochNo
retireEpochNo)
  RegTxCert StakeCredential (EraCrypto era)
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) forall a. Maybe a
Nothing
  UnRegTxCert StakeCredential (EraCrypto era)
stakeCred ->
    Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) forall a. Maybe a
Nothing
  RegDepositTxCert StakeCredential (EraCrypto era)
stakeCred Coin
deposit ->
    let transDeposit :: Maybe Lovelace
transDeposit
          | ProtVer -> Bool
HF.bootstrapPhase ProtVer
pv = forall a. Maybe a
Nothing
          | Bool
otherwise = forall a. a -> Maybe a
Just (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
     in Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) Maybe Lovelace
transDeposit
  UnRegDepositTxCert StakeCredential (EraCrypto era)
stakeCred Coin
refund ->
    let transRefund :: Maybe Lovelace
transRefund
          | ProtVer -> Bool
HF.bootstrapPhase ProtVer
pv = forall a. Maybe a
Nothing
          | Bool
otherwise = forall a. a -> Maybe a
Just (Coin -> Lovelace
transCoinToLovelace Coin
refund)
     in Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) Maybe Lovelace
transRefund
  DelegTxCert StakeCredential (EraCrypto era)
stakeCred Delegatee (EraCrypto era)
delegatee ->
    Credential -> Delegatee -> TxCert
PV3.TxCertDelegStaking (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) (forall c. Delegatee c -> Delegatee
transDelegatee Delegatee (EraCrypto era)
delegatee)
  RegDepositDelegTxCert StakeCredential (EraCrypto era)
stakeCred Delegatee (EraCrypto era)
delegatee Coin
deposit ->
    Credential -> Delegatee -> Lovelace -> TxCert
PV3.TxCertRegDeleg (forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred StakeCredential (EraCrypto era)
stakeCred) (forall c. Delegatee c -> Delegatee
transDelegatee Delegatee (EraCrypto era)
delegatee) (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
  AuthCommitteeHotKeyTxCert Credential 'ColdCommitteeRole (EraCrypto era)
coldCred Credential 'HotCommitteeRole (EraCrypto era)
hotCred ->
    ColdCommitteeCredential -> HotCommitteeCredential -> TxCert
PV3.TxCertAuthHotCommittee (forall c.
Credential 'ColdCommitteeRole c -> ColdCommitteeCredential
transColdCommitteeCred Credential 'ColdCommitteeRole (EraCrypto era)
coldCred) (forall c. Credential 'HotCommitteeRole c -> HotCommitteeCredential
transHotCommitteeCred Credential 'HotCommitteeRole (EraCrypto era)
hotCred)
  ResignCommitteeColdTxCert Credential 'ColdCommitteeRole (EraCrypto era)
coldCred StrictMaybe (Anchor (EraCrypto era))
_anchor ->
    ColdCommitteeCredential -> TxCert
PV3.TxCertResignColdCommittee (forall c.
Credential 'ColdCommitteeRole c -> ColdCommitteeCredential
transColdCommitteeCred Credential 'ColdCommitteeRole (EraCrypto era)
coldCred)
  RegDRepTxCert Credential 'DRepRole (EraCrypto era)
drepCred Coin
deposit StrictMaybe (Anchor (EraCrypto era))
_anchor ->
    DRepCredential -> Lovelace -> TxCert
PV3.TxCertRegDRep (forall c. Credential 'DRepRole c -> DRepCredential
transDRepCred Credential 'DRepRole (EraCrypto era)
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
  UnRegDRepTxCert Credential 'DRepRole (EraCrypto era)
drepCred Coin
refund ->
    DRepCredential -> Lovelace -> TxCert
PV3.TxCertUnRegDRep (forall c. Credential 'DRepRole c -> DRepCredential
transDRepCred Credential 'DRepRole (EraCrypto era)
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
refund)
  UpdateDRepTxCert Credential 'DRepRole (EraCrypto era)
drepCred StrictMaybe (Anchor (EraCrypto era))
_anchor ->
    DRepCredential -> TxCert
PV3.TxCertUpdateDRep (forall c. Credential 'DRepRole c -> DRepCredential
transDRepCred Credential 'DRepRole (EraCrypto era)
drepCred)

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

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

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

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

transDRep :: DRep c -> PV3.DRep
transDRep :: forall c. DRep c -> DRep
transDRep = \case
  DRepCredential Credential 'DRepRole c
drepCred -> DRepCredential -> DRep
PV3.DRep (forall c. Credential 'DRepRole c -> DRepCredential
transDRepCred Credential 'DRepRole c
drepCred)
  DRep c
DRepAlwaysAbstain -> DRep
PV3.DRepAlwaysAbstain
  DRep c
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 (EraCrypto era)
txIn) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ TxOutRef -> ScriptPurpose
PV3.Spending (forall c. TxIn c -> TxOutRef
transTxIn TxIn (EraCrypto era)
txIn)
  ConwayMinting (AsIxItem Word32
_ PolicyID (EraCrypto era)
policyId) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ CurrencySymbol -> ScriptPurpose
PV3.Minting (forall c. PolicyID c -> CurrencySymbol
Alonzo.transPolicyID PolicyID (EraCrypto era)
policyId)
  ConwayCertifying (AsIxItem Word32
ix TxCert era
txCert) ->
    Integer -> TxCert -> ScriptPurpose
PV3.Certifying (forall a. Integral a => a -> Integer
toInteger Word32
ix) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> TxCert era
-> Either (ContextError era) (PlutusTxCert l)
toPlutusTxCert proxy l
proxy ProtVer
pv TxCert era
txCert
  ConwayRewarding (AsIxItem Word32
_ RewardAccount (EraCrypto era)
rewardAccount) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Credential -> ScriptPurpose
PV3.Rewarding (forall c. RewardAccount c -> Credential
transRewardAccount RewardAccount (EraCrypto era)
rewardAccount)
  ConwayVoting (AsIxItem Word32
_ Voter (EraCrypto era)
voter) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Voter -> ScriptPurpose
PV3.Voting (forall c. Voter c -> Voter
transVoter Voter (EraCrypto era)
voter)
  ConwayProposing (AsIxItem Word32
ix ProposalProcedure era
proposal) ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> ProposalProcedure -> ScriptPurpose
PV3.Proposing (forall a. Integral a => a -> Integer
toInteger Word32
ix) (forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> ProposalProcedure era -> ProposalProcedure
transProposal proxy l
proxy ProposalProcedure era
proposal)

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

transGovActionId :: GovActionId c -> PV3.GovernanceActionId
transGovActionId :: forall c. GovActionId c -> GovernanceActionId
transGovActionId GovActionId {TxId c
gaidTxId :: forall c. GovActionId c -> TxId c
gaidTxId :: TxId c
gaidTxId, GovActionIx
gaidGovActionIx :: forall c. GovActionId c -> GovActionIx
gaidGovActionIx :: GovActionIx
gaidGovActionIx} =
  PV3.GovernanceActionId
    { gaidTxId :: TxId
PV3.gaidTxId = forall c. TxId c -> TxId
transTxId TxId c
gaidTxId
    , gaidGovActionIx :: Integer
PV3.gaidGovActionIx = forall a. Integral a => a -> Integer
toInteger 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 (EraCrypto era))
govPolicy ->
    Maybe GovernanceActionId
-> ChangedParameters -> Maybe ScriptHash -> GovernanceAction
PV3.ParameterChange
      (forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
pGovActionId)
      (forall (l :: Language) era (proxy :: Language -> *).
ConwayEraPlutusTxInfo l era =>
proxy l -> PParamsUpdate era -> ChangedParameters
toPlutusChangedParameters proxy l
proxy PParamsUpdate era
ppu)
      (forall {c}. StrictMaybe (ScriptHash c) -> Maybe ScriptHash
transGovPolicy StrictMaybe (ScriptHash (EraCrypto era))
govPolicy)
  HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
pGovActionId ProtVer
protVer ->
    Maybe GovernanceActionId -> ProtocolVersion -> GovernanceAction
PV3.HardForkInitiation
      (forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'HardForkPurpose era)
pGovActionId)
      (ProtVer -> ProtocolVersion
transProtVer ProtVer
protVer)
  TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
withdrawals StrictMaybe (ScriptHash (EraCrypto era))
govPolicy ->
    Map Credential Lovelace -> Maybe ScriptHash -> GovernanceAction
PV3.TreasuryWithdrawals
      (forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap forall c. RewardAccount c -> Credential
transRewardAccount Coin -> Lovelace
transCoinToLovelace Map (RewardAccount (EraCrypto era)) Coin
withdrawals)
      (forall {c}. StrictMaybe (ScriptHash c) -> Maybe ScriptHash
transGovPolicy StrictMaybe (ScriptHash (EraCrypto era))
govPolicy)
  NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
pGovActionId -> Maybe GovernanceActionId -> GovernanceAction
PV3.NoConfidence (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 (EraCrypto era))
ccToRemove Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
ccToAdd UnitInterval
threshold ->
    Maybe GovernanceActionId
-> [ColdCommitteeCredential]
-> Map ColdCommitteeCredential Integer
-> Rational
-> GovernanceAction
PV3.UpdateCommittee
      (forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'CommitteePurpose era)
pGovActionId)
      (forall a b. (a -> b) -> [a] -> [b]
map (Credential -> ColdCommitteeCredential
PV3.ColdCommitteeCredential forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
Set.toList Set (Credential 'ColdCommitteeRole (EraCrypto era))
ccToRemove)
      (forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap (Credential -> ColdCommitteeCredential
PV3.ColdCommitteeCredential forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. Credential kr c -> Credential
transCred) EpochNo -> Integer
transEpochNo Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
ccToAdd)
      (forall r. BoundedRational r => r -> Rational
transBoundedRational UnitInterval
threshold)
  NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
pGovActionId Constitution era
constitution ->
    Maybe GovernanceActionId -> Constitution -> GovernanceAction
PV3.NewConstitution
      (forall {p :: GovActionPurpose} {era}.
StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
pGovActionId)
      (forall {era}. Constitution era -> Constitution
transConstitution Constitution era
constitution)
  GovAction era
InfoAction -> GovernanceAction
PV3.InfoAction
  where
    transGovPolicy :: StrictMaybe (ScriptHash c) -> Maybe ScriptHash
transGovPolicy = \case
      SJust ScriptHash c
govPolicy -> forall a. a -> Maybe a
Just (forall c. ScriptHash c -> ScriptHash
transScriptHash ScriptHash c
govPolicy)
      StrictMaybe (ScriptHash c)
SNothing -> forall a. Maybe a
Nothing
    transConstitution :: Constitution era -> Constitution
transConstitution (Constitution Anchor (EraCrypto era)
_ StrictMaybe (ScriptHash (EraCrypto era))
govPolicy) =
      Maybe ScriptHash -> Constitution
PV3.Constitution (forall {c}. StrictMaybe (ScriptHash c) -> Maybe ScriptHash
transGovPolicy StrictMaybe (ScriptHash (EraCrypto era))
govPolicy)
    transPrevGovActionId :: StrictMaybe (GovPurposeId p era) -> Maybe GovernanceActionId
transPrevGovActionId = \case
      SJust (GovPurposeId GovActionId (EraCrypto era)
gaId) -> forall a. a -> Maybe a
Just (forall c. GovActionId c -> GovernanceActionId
transGovActionId GovActionId (EraCrypto era)
gaId)
      StrictMaybe (GovPurposeId p era)
SNothing -> 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 =
  forall k v. [(k, v)] -> Map k v
PV3.unsafeFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(t1
k, t2
v) -> (t1 -> k
transKey t1
k, t2 -> v
transValue t2
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
  forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap forall c. Voter c -> Voter
transVoter (forall t1 k t2 v. (t1 -> k) -> (t2 -> v) -> Map t1 t2 -> Map k v
transMap forall c. GovActionId c -> GovernanceActionId
transGovActionId (Vote -> Vote
transVote forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. VotingProcedure era -> Vote
vProcVote)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
VotingProcedures era
-> Map
     (Voter (EraCrypto era))
     (Map (GovActionId (EraCrypto era)) (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 :: forall era. ProposalProcedure era -> Coin
pProcDeposit :: Coin
pProcDeposit, RewardAccount (EraCrypto era)
pProcReturnAddr :: forall era. ProposalProcedure era -> RewardAccount (EraCrypto era)
pProcReturnAddr :: RewardAccount (EraCrypto era)
pProcReturnAddr, GovAction era
pProcGovAction :: forall era. ProposalProcedure era -> GovAction era
pProcGovAction :: GovAction era
pProcGovAction} =
  PV3.ProposalProcedure
    { ppDeposit :: Lovelace
PV3.ppDeposit = Coin -> Lovelace
transCoinToLovelace Coin
pProcDeposit
    , ppReturnAddr :: Credential
PV3.ppReturnAddr = forall c. RewardAccount c -> Credential
transRewardAccount RewardAccount (EraCrypto era)
pProcReturnAddr
    , ppGovernanceAction :: GovernanceAction
PV3.ppGovernanceAction = 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 (EraCrypto era))
txIn -> 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) era.
f Word32 (TxIn (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoSpending AsItem Word32 (TxIn (EraCrypto era))
txIn
  ConwayMinting AsItem Word32 (PolicyID (EraCrypto era))
policyId -> 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) era.
f Word32 (PolicyID (EraCrypto era)) -> AlonzoPlutusPurpose f era
AlonzoMinting AsItem Word32 (PolicyID (EraCrypto era))
policyId
  ConwayCertifying AsItem Word32 (TxCert era)
txCert -> 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> AlonzoPlutusPurpose f era
AlonzoCertifying AsItem Word32 (TxCert era)
txCert
  ConwayRewarding AsItem Word32 (RewardAccount (EraCrypto era))
rewardAccount -> 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 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> * -> *) era.
f Word32 (RewardAccount (EraCrypto era))
-> AlonzoPlutusPurpose f era
AlonzoRewarding AsItem Word32 (RewardAccount (EraCrypto era))
rewardAccount
  ConwayPlutusPurpose AsItem era
purpose -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall t s. Inject t s => t -> s
inject forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported ConwayPlutusPurpose AsItem era
purpose

transProtVer :: ProtVer -> PV3.ProtocolVersion
transProtVer :: ProtVer -> ProtocolVersion
transProtVer (ProtVer Version
major Natural
minor) =
  Integer -> Integer -> ProtocolVersion
PV3.ProtocolVersion (forall a. Integral a => a -> Integer
toInteger (Version -> Word64
getVersion64 Version
major)) (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 <- forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
toPlutusScriptPurpose proxy 'PlutusV3
proxy ProtVer
pv PlutusPurpose AsIxItem era
plutusPurpose
  let scriptInfo :: ScriptInfo
scriptInfo =
        ScriptPurpose -> Maybe Datum -> ScriptInfo
scriptPurposeToScriptInfo
          ScriptPurpose
scriptPurpose
          (forall era. Data era -> Datum
transDatum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Data era)
maybeSpendingData)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    ScriptContext -> PlutusArgs 'PlutusV3
PlutusV3Args forall a b. (a -> b) -> a -> b
$
      PV3.ScriptContext
        { scriptContextTxInfo :: TxInfo
PV3.scriptContextTxInfo = TxInfo
txInfo
        , scriptContextRedeemer :: Redeemer
PV3.scriptContextRedeemer = 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

-- ==========================
-- Instances

instance Crypto c => ToPlutusData (PParamsUpdate (ConwayEra c)) where
  toPlutusData :: PParamsUpdate (ConwayEra c) -> Data
toPlutusData = forall era. Map Word (PParam era) -> PParamsUpdate era -> Data
pparamUpdateToData forall era. ConwayEraPParams era => Map Word (PParam era)
conwayPParamMap
  fromPlutusData :: Data -> Maybe (PParamsUpdate (ConwayEra c))
fromPlutusData = forall era.
EraPParams era =>
Map Word (PParam era) -> Data -> Maybe (PParamsUpdate era)
pparamUpdateFromData forall era. ConwayEraPParams era => Map Word (PParam era)
conwayPParamMap

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