{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Dijkstra.TxInfo (
transPlutusPurposeV1V2,
transPlutusPurposeV3,
) where
import Cardano.Crypto.Hash.Class (hashToBytes)
import Cardano.Ledger.Alonzo.Plutus.Context (
EraPlutusContext (..),
EraPlutusTxInfo (..),
LedgerTxInfo (..),
PlutusTxCert,
PlutusTxInfo,
SupportedLanguage (..),
toPlutusWithContext,
)
import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Alonzo
import Cardano.Ledger.Alonzo.Scripts (toAsItem)
import qualified Cardano.Ledger.Babbage.TxInfo as Babbage
import Cardano.Ledger.BaseTypes (Inject (..), ProtVer (..), strictMaybe)
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Scripts (ConwayPlutusPurpose (..))
import Cardano.Ledger.Conway.TxCert (Delegatee (..))
import Cardano.Ledger.Conway.TxInfo (
ConwayContextError (..),
ConwayEraPlutusTxInfo (..),
transTxInInfoV1,
transTxInInfoV3,
)
import qualified Cardano.Ledger.Conway.TxInfo as Conway
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.Era (DijkstraEra)
import Cardano.Ledger.Dijkstra.Scripts (DijkstraPlutusPurpose (..), PlutusScript (..))
import Cardano.Ledger.Dijkstra.TxCert (DijkstraTxCert)
import Cardano.Ledger.Dijkstra.UTxO ()
import Cardano.Ledger.Plutus (
Language (..),
PlutusArgs (..),
SLanguage (..),
TxOutSource (..),
transCoinToLovelace,
transCoinToValue,
transCred,
transDatum,
transEpochNo,
transKeyHash,
)
import Cardano.Ledger.Plutus.Data (Data)
import Cardano.Ledger.Plutus.ToPlutusData (ToPlutusData (..))
import Cardano.Ledger.State (StakePoolParams (..))
import Control.Monad (zipWithM)
import Data.Foldable (Foldable (..))
import qualified Data.Foldable as F
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy (Proxy (..))
import qualified Data.Set as Set
import Lens.Micro ((^.))
import qualified PlutusLedgerApi.V1 as PV1
import qualified PlutusLedgerApi.V2 as PV2
import qualified PlutusLedgerApi.V3 as PV3
instance EraPlutusContext DijkstraEra where
type ContextError DijkstraEra = ConwayContextError DijkstraEra
data TxInfoResult DijkstraEra
= DijkstraTxInfoResult
(Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1))
(Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2))
(Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3))
(Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4))
mkSupportedLanguage :: Language -> Maybe (SupportedLanguage DijkstraEra)
mkSupportedLanguage = \case
Language
PlutusV1 -> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a. a -> Maybe a
Just (SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra))
-> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV1 -> SupportedLanguage DijkstraEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV1
SPlutusV1
Language
PlutusV2 -> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a. a -> Maybe a
Just (SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra))
-> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV2 -> SupportedLanguage DijkstraEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV2
SPlutusV2
Language
PlutusV3 -> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a. a -> Maybe a
Just (SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra))
-> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV3 -> SupportedLanguage DijkstraEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV3
SPlutusV3
Language
PlutusV4 -> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a. a -> Maybe a
Just (SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra))
-> SupportedLanguage DijkstraEra
-> Maybe (SupportedLanguage DijkstraEra)
forall a b. (a -> b) -> a -> b
$ SLanguage 'PlutusV4 -> SupportedLanguage DijkstraEra
forall (l :: Language) era.
EraPlutusTxInfo l era =>
SLanguage l -> SupportedLanguage era
SupportedLanguage SLanguage 'PlutusV4
SPlutusV4
mkTxInfoResult :: LedgerTxInfo DijkstraEra -> TxInfoResult DijkstraEra
mkTxInfoResult LedgerTxInfo DijkstraEra
lti =
Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
-> TxInfoResult DijkstraEra
DijkstraTxInfoResult
(SLanguage 'PlutusV1
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
toPlutusTxInfo SLanguage 'PlutusV1
SPlutusV1 LedgerTxInfo DijkstraEra
lti)
(SLanguage 'PlutusV2
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
toPlutusTxInfo SLanguage 'PlutusV2
SPlutusV2 LedgerTxInfo DijkstraEra
lti)
(SLanguage 'PlutusV3
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
toPlutusTxInfo SLanguage 'PlutusV3
SPlutusV3 LedgerTxInfo DijkstraEra
lti)
(SLanguage 'PlutusV4
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> LedgerTxInfo era -> Either (ContextError era) (PlutusTxInfo l)
forall (proxy :: Language -> *).
proxy 'PlutusV4
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
toPlutusTxInfo SLanguage 'PlutusV4
SPlutusV4 LedgerTxInfo DijkstraEra
lti)
lookupTxInfoResult :: forall (l :: Language).
EraPlutusTxInfo l DijkstraEra =>
SLanguage l
-> TxInfoResult DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo l)
lookupTxInfoResult SLanguage l
SPlutusV1 (DijkstraTxInfoResult Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1 Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
_) = Either (ContextError DijkstraEra) (PlutusTxInfo l)
Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
tirPlutusV1
lookupTxInfoResult SLanguage l
SPlutusV2 (DijkstraTxInfoResult Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2 Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
_) = Either (ContextError DijkstraEra) (PlutusTxInfo l)
Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
tirPlutusV2
lookupTxInfoResult SLanguage l
SPlutusV3 (DijkstraTxInfoResult Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
tirPlutusV3 Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
_) = Either (ContextError DijkstraEra) (PlutusTxInfo l)
Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
tirPlutusV3
lookupTxInfoResult SLanguage l
SPlutusV4 (DijkstraTxInfoResult Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV1)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV2)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV3)
_ Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
tirPlutusV4) = Either (ContextError DijkstraEra) (PlutusTxInfo l)
Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
tirPlutusV4
mkPlutusWithContext :: PlutusScript DijkstraEra
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext
mkPlutusWithContext = \case
DijkstraPlutusV1 Plutus 'PlutusV1
p -> Either (Plutus 'PlutusV1) (PlutusRunnable 'PlutusV1)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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 DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext)
-> Either (Plutus 'PlutusV1) (PlutusRunnable 'PlutusV1)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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
DijkstraPlutusV2 Plutus 'PlutusV2
p -> Either (Plutus 'PlutusV2) (PlutusRunnable 'PlutusV2)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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 DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext)
-> Either (Plutus 'PlutusV2) (PlutusRunnable 'PlutusV2)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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
DijkstraPlutusV3 Plutus 'PlutusV3
p -> Either (Plutus 'PlutusV3) (PlutusRunnable 'PlutusV3)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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 DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext)
-> Either (Plutus 'PlutusV3) (PlutusRunnable 'PlutusV3)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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
DijkstraPlutusV4 Plutus 'PlutusV4
p -> Either (Plutus 'PlutusV4) (PlutusRunnable 'PlutusV4)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) 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 'PlutusV4) (PlutusRunnable 'PlutusV4)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext)
-> Either (Plutus 'PlutusV4) (PlutusRunnable 'PlutusV4)
-> ScriptHash
-> PlutusPurpose AsIxItem DijkstraEra
-> LedgerTxInfo DijkstraEra
-> TxInfoResult DijkstraEra
-> (Data DijkstraEra, ExUnits)
-> CostModel
-> Either (ContextError DijkstraEra) PlutusWithContext
forall a b. (a -> b) -> a -> b
$ Plutus 'PlutusV4
-> Either (Plutus 'PlutusV4) (PlutusRunnable 'PlutusV4)
forall a b. a -> Either a b
Left Plutus 'PlutusV4
p
transPlutusPurposeV1V2 ::
forall l era proxy.
( EraPlutusTxInfo l era
, PlutusTxCert l ~ PV2.DCert
, Inject (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)
, Inject (DijkstraPlutusPurpose AsItem era) (PlutusPurpose AsItem era)
, Inject (ConwayContextError era) (ContextError era)
) =>
proxy l ->
ProtVer ->
DijkstraPlutusPurpose AsItem era ->
Either (ContextError era) PV2.ScriptPurpose
transPlutusPurposeV1V2 :: forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert,
Inject (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject
(DijkstraPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> DijkstraPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv = \case
DijkstraSpending AsItem Word32 TxIn
txIn -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 TxIn -> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending AsItem Word32 TxIn
txIn
DijkstraMinting AsItem Word32 PolicyID
policyId -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 PolicyID -> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting AsItem Word32 PolicyID
policyId
DijkstraCertifying AsItem Word32 (TxCert era)
txCert -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 (TxCert era) -> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying AsItem Word32 (TxCert era)
txCert
DijkstraRewarding AsItem Word32 RewardAccount
rewardAccount -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 RewardAccount -> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding AsItem Word32 RewardAccount
rewardAccount
DijkstraVoting AsItem Word32 Voter
voting -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 Voter -> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting AsItem Word32 Voter
voting
DijkstraProposing AsItem Word32 (ProposalProcedure era)
proposing -> proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(PlutusTxCert l ~ DCert, EraPlutusTxInfo l era,
Inject (ConwayContextError era) (ContextError era),
Inject
(ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era)) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV1V2 proxy l
proxy ProtVer
pv (ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsItem Word32 (ProposalProcedure era)
-> ConwayPlutusPurpose AsItem era
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing AsItem Word32 (ProposalProcedure era)
proposing
DijkstraPlutusPurpose AsItem era
purpose -> ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ScriptPurpose)
-> ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported @era (PlutusPurpose AsItem era -> ConwayContextError era)
-> PlutusPurpose AsItem era -> ConwayContextError era
forall a b. (a -> b) -> a -> b
$ DijkstraPlutusPurpose AsItem era -> PlutusPurpose AsItem era
forall t s. Inject t s => t -> s
inject DijkstraPlutusPurpose AsItem era
purpose
transPlutusPurposeV3 ::
forall era.
( ConwayEraPlutusTxInfo PlutusV3 era
, Inject (ConwayContextError era) (ContextError era)
, Inject (DijkstraPlutusPurpose AsIxItem era) (PlutusPurpose AsIxItem era)
) =>
ProtVer ->
DijkstraPlutusPurpose AsIxItem era ->
Either (ContextError era) PV3.ScriptPurpose
transPlutusPurposeV3 :: forall era.
(ConwayEraPlutusTxInfo 'PlutusV3 era,
Inject (ConwayContextError era) (ContextError era),
Inject
(DijkstraPlutusPurpose AsIxItem era)
(PlutusPurpose AsIxItem era)) =>
ProtVer
-> DijkstraPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3 ProtVer
pv = \case
DijkstraSpending AsIxItem Word32 TxIn
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 TxIn -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 TxIn -> ConwayPlutusPurpose f era
ConwaySpending AsIxItem Word32 TxIn
txIn
DijkstraMinting AsIxItem Word32 PolicyID
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 PolicyID -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 PolicyID -> ConwayPlutusPurpose f era
ConwayMinting AsIxItem Word32 PolicyID
txIn
DijkstraCertifying AsIxItem Word32 (TxCert era)
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 (TxCert era) -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (TxCert era) -> ConwayPlutusPurpose f era
ConwayCertifying AsIxItem Word32 (TxCert era)
txIn
DijkstraRewarding AsIxItem Word32 RewardAccount
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 RewardAccount -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 RewardAccount -> ConwayPlutusPurpose f era
ConwayRewarding AsIxItem Word32 RewardAccount
txIn
DijkstraVoting AsIxItem Word32 Voter
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 Voter -> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 Voter -> ConwayPlutusPurpose f era
ConwayVoting AsIxItem Word32 Voter
txIn
DijkstraProposing AsIxItem Word32 (ProposalProcedure era)
txIn -> forall (l :: Language) era (proxy :: Language -> *).
(ConwayEraPlutusTxInfo l era, PlutusTxCert l ~ TxCert) =>
proxy l
-> ProtVer
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
Conway.transPlutusPurposeV3 @PlutusV3 @era Proxy 'PlutusV3
forall {k} (t :: k). Proxy t
Proxy ProtVer
pv (ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose)
-> ConwayPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ AsIxItem Word32 (ProposalProcedure era)
-> ConwayPlutusPurpose AsIxItem era
forall (f :: * -> * -> *) era.
f Word32 (ProposalProcedure era) -> ConwayPlutusPurpose f era
ConwayProposing AsIxItem Word32 (ProposalProcedure era)
txIn
DijkstraPlutusPurpose AsIxItem era
purpose ->
ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. a -> Either a b
Left (ContextError era -> Either (ContextError era) ScriptPurpose)
-> ContextError era -> Either (ContextError era) ScriptPurpose
forall a b. (a -> b) -> a -> b
$ ConwayContextError era -> ContextError era
forall t s. Inject t s => t -> s
inject (ConwayContextError era -> ContextError era)
-> ConwayContextError era -> ContextError era
forall a b. (a -> b) -> a -> b
$ forall era. PlutusPurpose AsItem era -> ConwayContextError era
PlutusPurposeNotSupported @era (PlutusPurpose AsItem era -> ConwayContextError era)
-> (PlutusPurpose AsIxItem era -> PlutusPurpose AsItem era)
-> PlutusPurpose AsIxItem era
-> ConwayContextError era
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 @era AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem (PlutusPurpose AsIxItem era -> ConwayContextError era)
-> PlutusPurpose AsIxItem era -> ConwayContextError era
forall a b. (a -> b) -> a -> b
$ DijkstraPlutusPurpose AsIxItem era -> PlutusPurpose AsIxItem era
forall t s. Inject t s => t -> s
inject DijkstraPlutusPurpose AsIxItem era
purpose
instance EraPlutusTxInfo 'PlutusV1 DijkstraEra where
toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV1)
toPlutusTxCert proxy 'PlutusV1
_ ProtVer
_ = TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV1)
TxCert DijkstraEra -> Either (ContextError DijkstraEra) 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 DijkstraEra
-> Either
(ContextError DijkstraEra) (PlutusScriptPurpose 'PlutusV1)
toPlutusScriptPurpose proxy 'PlutusV1
proxy ProtVer
pv =
proxy 'PlutusV1
-> ProtVer
-> DijkstraPlutusPurpose AsItem DijkstraEra
-> Either (ContextError DijkstraEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert,
Inject (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject
(DijkstraPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> DijkstraPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy 'PlutusV1
proxy ProtVer
pv (DijkstraPlutusPurpose AsItem DijkstraEra
-> Either (ConwayContextError DijkstraEra) ScriptPurpose)
-> (DijkstraPlutusPurpose AsIxItem DijkstraEra
-> DijkstraPlutusPurpose AsItem DijkstraEra)
-> DijkstraPlutusPurpose AsIxItem DijkstraEra
-> Either (ConwayContextError DijkstraEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
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 DijkstraEra -> PlutusPurpose f DijkstraEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem
toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
ltiUTxO :: UTxO DijkstraEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO, Tx TopTx DijkstraEra
ltiTx :: Tx TopTx DijkstraEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx} = do
Tx TopTx DijkstraEra -> Either (ContextError DijkstraEra) ()
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era,
Inject (ConwayContextError era) (ContextError era)) =>
Tx l era -> Either (ContextError era) ()
Conway.guardConwayFeaturesForPlutusV1V2 Tx TopTx DijkstraEra
ltiTx
timeRange <- Tx TopTx DijkstraEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError DijkstraEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Conway.transValidityInterval Tx TopTx DijkstraEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel).
Lens' (TxBody l DijkstraEra) ValidityInterval
vldtTxBodyL)
inputs <- mapM (Conway.transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
mapM_ (Conway.transTxInInfoV1 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
outputs <-
zipWithM
(Conway.transTxOutV1 . TxOutFromOutput)
[minBound ..]
(F.toList (txBody ^. outputsTxBodyL))
txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
pure
PV1.TxInfo
{ PV1.txInfoInputs = inputs
, PV1.txInfoOutputs = outputs
, PV1.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
, PV1.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
, PV1.txInfoDCert = txCerts
, PV1.txInfoWdrl = Alonzo.transTxBodyWithdrawals txBody
, PV1.txInfoValidRange = timeRange
, PV1.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
, PV1.txInfoData = Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
, PV1.txInfoId = Alonzo.transTxBodyId txBody
}
where
txBody :: TxBody TopTx DijkstraEra
txBody = Tx TopTx DijkstraEra
ltiTx Tx TopTx DijkstraEra
-> Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
-> TxBody TopTx DijkstraEra
forall s a. s -> Getting a s a -> a
^. Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
bodyTxL
toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV1)
toPlutusArgs = proxy 'PlutusV1
-> ProtVer
-> PlutusTxInfo 'PlutusV1
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV1)
proxy 'PlutusV1
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV1)
forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV1 era =>
proxy 'PlutusV1
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV1)
Alonzo.toPlutusV1Args
toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV1
-> UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV1)
toPlutusTxInInfo proxy 'PlutusV1
_ = UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV1)
UTxO DijkstraEra
-> TxIn -> Either (ContextError DijkstraEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV1
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))
DelegTxCert StakeCredential
stakeCred (DelegStake KeyHash StakePool
keyHash) ->
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 -> PubKeyHash -> DCert
PV1.DCertDelegDelegate (Credential -> StakingCredential
PV1.StakingHash (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred)) (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
keyHash)
RegPoolTxCert (StakePoolParams {KeyHash StakePool
sppId :: KeyHash StakePool
sppId :: StakePoolParams -> KeyHash StakePool
sppId, VRFVerKeyHash StakePoolVRF
sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf :: StakePoolParams -> VRFVerKeyHash StakePoolVRF
sppVrf}) ->
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
$
PubKeyHash -> PubKeyHash -> DCert
PV1.DCertPoolRegister
(KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
sppId)
(BuiltinByteString -> PubKeyHash
PV1.PubKeyHash (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV1.toBuiltin (Hash HASH KeyRoleVRF -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (VRFVerKeyHash StakePoolVRF -> Hash HASH KeyRoleVRF
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash VRFVerKeyHash StakePoolVRF
sppVrf))))
RetirePoolTxCert KeyHash StakePool
poolId EpochNo
retireEpochNo ->
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
$ PubKeyHash -> Integer -> DCert
PV1.DCertPoolRetire (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId) (EpochNo -> Integer
transEpochNo EpochNo
retireEpochNo)
TxCert era
txCert -> 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 'PlutusV2 DijkstraEra where
toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV2)
toPlutusTxCert proxy 'PlutusV2
_ ProtVer
_ = TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV2)
TxCert DijkstraEra -> Either (ContextError DijkstraEra) 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 DijkstraEra
-> Either
(ContextError DijkstraEra) (PlutusScriptPurpose 'PlutusV2)
toPlutusScriptPurpose proxy 'PlutusV2
proxy ProtVer
pv = proxy 'PlutusV2
-> ProtVer
-> DijkstraPlutusPurpose AsItem DijkstraEra
-> Either (ContextError DijkstraEra) ScriptPurpose
forall (l :: Language) era (proxy :: Language -> *).
(EraPlutusTxInfo l era, PlutusTxCert l ~ DCert,
Inject (ConwayPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject
(DijkstraPlutusPurpose AsItem era) (PlutusPurpose AsItem era),
Inject (ConwayContextError era) (ContextError era)) =>
proxy l
-> ProtVer
-> DijkstraPlutusPurpose AsItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV1V2 proxy 'PlutusV2
proxy ProtVer
pv (DijkstraPlutusPurpose AsItem DijkstraEra
-> Either (ConwayContextError DijkstraEra) ScriptPurpose)
-> (DijkstraPlutusPurpose AsIxItem DijkstraEra
-> DijkstraPlutusPurpose AsItem DijkstraEra)
-> DijkstraPlutusPurpose AsIxItem DijkstraEra
-> Either (ConwayContextError DijkstraEra) ScriptPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall ix it. AsIxItem ix it -> AsItem ix it)
-> PlutusPurpose AsIxItem DijkstraEra
-> PlutusPurpose AsItem DijkstraEra
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 DijkstraEra -> PlutusPurpose f DijkstraEra
hoistPlutusPurpose AsIxItem ix it -> AsItem ix it
forall ix it. AsIxItem ix it -> AsItem ix it
toAsItem
toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO DijkstraEra
ltiUTxO, Tx TopTx DijkstraEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx DijkstraEra
ltiTx} = do
Tx TopTx DijkstraEra -> Either (ContextError DijkstraEra) ()
forall era (l :: TxLevel).
(EraTx era, ConwayEraTxBody era,
Inject (ConwayContextError era) (ContextError era)) =>
Tx l era -> Either (ContextError era) ()
Conway.guardConwayFeaturesForPlutusV1V2 Tx TopTx DijkstraEra
ltiTx
timeRange <-
Tx TopTx DijkstraEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError DijkstraEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Conway.transValidityInterval Tx TopTx DijkstraEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel).
Lens' (TxBody l DijkstraEra) ValidityInterval
vldtTxBodyL)
inputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. inputsTxBodyL))
refInputs <- mapM (Babbage.transTxInInfoV2 ltiUTxO) (Set.toList (txBody ^. referenceInputsTxBodyL))
outputs <-
zipWithM
(Babbage.transTxOutV2 . TxOutFromOutput)
[minBound ..]
(F.toList (txBody ^. outputsTxBodyL))
txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer ltiTx
pure
PV2.TxInfo
{ PV2.txInfoInputs = inputs
, PV2.txInfoOutputs = outputs
, PV2.txInfoReferenceInputs = refInputs
, PV2.txInfoFee = transCoinToValue (txBody ^. feeTxBodyL)
, PV2.txInfoMint = Alonzo.transMintValue (txBody ^. mintTxBodyL)
, PV2.txInfoDCert = txCerts
, PV2.txInfoWdrl = PV2.unsafeFromList $ Alonzo.transTxBodyWithdrawals txBody
, PV2.txInfoValidRange = timeRange
, PV2.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
, PV2.txInfoRedeemers = plutusRedeemers
, PV2.txInfoData = PV2.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
, PV2.txInfoId = Alonzo.transTxBodyId txBody
}
where
txBody :: TxBody TopTx DijkstraEra
txBody = Tx TopTx DijkstraEra
ltiTx Tx TopTx DijkstraEra
-> Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
-> TxBody TopTx DijkstraEra
forall s a. s -> Getting a s a -> a
^. Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
bodyTxL
toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV2)
toPlutusArgs = proxy 'PlutusV2
-> ProtVer
-> PlutusTxInfo 'PlutusV2
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV2)
proxy 'PlutusV2
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV2)
forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV2 era =>
proxy 'PlutusV2
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV2)
Babbage.toPlutusV2Args
toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV2
-> UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV2)
toPlutusTxInInfo proxy 'PlutusV2
_ = UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV2)
UTxO DijkstraEra
-> TxIn -> Either (ContextError DijkstraEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
Babbage.transTxInInfoV2
instance EraPlutusTxInfo 'PlutusV3 DijkstraEra where
toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV3)
toPlutusTxCert proxy 'PlutusV3
_ ProtVer
_ = TxCert -> Either (ConwayContextError DijkstraEra) TxCert
forall a. a -> Either (ConwayContextError DijkstraEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxCert -> Either (ConwayContextError DijkstraEra) TxCert)
-> (DijkstraTxCert DijkstraEra -> TxCert)
-> DijkstraTxCert DijkstraEra
-> Either (ConwayContextError DijkstraEra) TxCert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert DijkstraEra -> TxCert
DijkstraTxCert DijkstraEra -> TxCert
forall era.
(ConwayEraTxCert era, TxCert era ~ DijkstraTxCert era) =>
TxCert era -> TxCert
transTxCert
toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> PlutusPurpose AsIxItem DijkstraEra
-> Either
(ContextError DijkstraEra) (PlutusScriptPurpose 'PlutusV3)
toPlutusScriptPurpose proxy 'PlutusV3
_ = ProtVer
-> PlutusPurpose AsIxItem DijkstraEra
-> Either
(ContextError DijkstraEra) (PlutusScriptPurpose 'PlutusV3)
ProtVer
-> DijkstraPlutusPurpose AsIxItem DijkstraEra
-> Either (ContextError DijkstraEra) ScriptPurpose
forall era.
(ConwayEraPlutusTxInfo 'PlutusV3 era,
Inject (ConwayContextError era) (ContextError era),
Inject
(DijkstraPlutusPurpose AsIxItem era)
(PlutusPurpose AsIxItem era)) =>
ProtVer
-> DijkstraPlutusPurpose AsIxItem era
-> Either (ContextError era) ScriptPurpose
transPlutusPurposeV3
toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (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 DijkstraEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO DijkstraEra
ltiUTxO, Tx TopTx DijkstraEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx DijkstraEra
ltiTx} = do
timeRange <-
Tx TopTx DijkstraEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError DijkstraEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Conway.transValidityInterval Tx TopTx DijkstraEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel).
Lens' (TxBody l DijkstraEra) ValidityInterval
vldtTxBodyL)
let
txInputs = TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l DijkstraEra) (Set TxIn)
inputsTxBodyL
refInputs = TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l DijkstraEra) (Set TxIn)
referenceInputsTxBodyL
inputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
refInputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
let
commonInputs = Set TxIn
txInputs Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set TxIn
refInputs
case toList commonInputs of
(TxIn
x : [TxIn]
xs) -> ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ()
forall a b. a -> Either a b
Left (ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ())
-> ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ()
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> ConwayContextError DijkstraEra
forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs (NonEmpty TxIn -> ConwayContextError DijkstraEra)
-> NonEmpty TxIn -> ConwayContextError DijkstraEra
forall a b. (a -> b) -> a -> b
$ TxIn
x TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| [TxIn]
xs
[TxIn]
_ -> () -> Either (ConwayContextError DijkstraEra) ()
forall a b. b -> Either a b
Right ()
outputs <-
zipWithM
(Babbage.transTxOutV2 . TxOutFromOutput)
[minBound ..]
(F.toList (txBody ^. outputsTxBodyL))
txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer ltiTx
pure
PV3.TxInfo
{ PV3.txInfoInputs = inputsInfo
, PV3.txInfoOutputs = outputs
, PV3.txInfoReferenceInputs = refInputsInfo
, PV3.txInfoFee = transCoinToLovelace (txBody ^. feeTxBodyL)
, PV3.txInfoMint = Conway.transMintValue (txBody ^. mintTxBodyL)
, PV3.txInfoTxCerts = txCerts
, PV3.txInfoWdrl = Conway.transTxBodyWithdrawals txBody
, PV3.txInfoValidRange = timeRange
, PV3.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
, PV3.txInfoRedeemers = plutusRedeemers
, PV3.txInfoData = PV3.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
, PV3.txInfoId = Conway.transTxBodyId txBody
, PV3.txInfoVotes = Conway.transVotingProcedures (txBody ^. votingProceduresTxBodyL)
, PV3.txInfoProposalProcedures =
map (Conway.transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
, PV3.txInfoCurrentTreasuryAmount =
strictMaybe Nothing (Just . transCoinToLovelace) $ txBody ^. currentTreasuryValueTxBodyL
, PV3.txInfoTreasuryDonation =
case txBody ^. treasuryDonationTxBodyL of
Coin Integer
0 -> Maybe Lovelace
forall a. Maybe a
Nothing
Coin
coin -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace) -> Lovelace -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
transCoinToLovelace Coin
coin
}
where
txBody :: TxBody TopTx DijkstraEra
txBody = Tx TopTx DijkstraEra
ltiTx Tx TopTx DijkstraEra
-> Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
-> TxBody TopTx DijkstraEra
forall s a. s -> Getting a s a -> a
^. Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
bodyTxL
toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> ProtVer
-> PlutusTxInfo 'PlutusV3
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV3)
toPlutusArgs = proxy 'PlutusV3
-> ProtVer
-> PlutusTxInfo 'PlutusV3
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV3)
proxy 'PlutusV3
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (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)
Conway.toPlutusV3Args
toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV3
-> UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV3)
toPlutusTxInInfo proxy 'PlutusV3
_ = UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV3)
UTxO DijkstraEra
-> TxIn -> Either (ContextError DijkstraEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV3
transTxCert ::
(ConwayEraTxCert era, TxCert era ~ DijkstraTxCert era) => TxCert era -> PV3.TxCert
transTxCert :: forall era.
(ConwayEraTxCert era, TxCert era ~ DijkstraTxCert era) =>
TxCert era -> TxCert
transTxCert = \case
RegPoolTxCert StakePoolParams {KeyHash StakePool
sppId :: StakePoolParams -> KeyHash StakePool
sppId :: KeyHash StakePool
sppId, VRFVerKeyHash StakePoolVRF
sppVrf :: StakePoolParams -> VRFVerKeyHash StakePoolVRF
sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf} ->
PubKeyHash -> PubKeyHash -> TxCert
PV3.TxCertPoolRegister
(KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
sppId)
(BuiltinByteString -> PubKeyHash
PV3.PubKeyHash (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
PV3.toBuiltin (Hash HASH KeyRoleVRF -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (VRFVerKeyHash StakePoolVRF -> Hash HASH KeyRoleVRF
forall (r :: KeyRoleVRF). VRFVerKeyHash r -> Hash HASH KeyRoleVRF
unVRFVerKeyHash VRFVerKeyHash StakePoolVRF
sppVrf))))
RetirePoolTxCert KeyHash StakePool
poolId EpochNo
retireEpochNo ->
PubKeyHash -> Integer -> TxCert
PV3.TxCertPoolRetire (KeyHash StakePool -> PubKeyHash
forall (d :: KeyRole). KeyHash d -> PubKeyHash
transKeyHash KeyHash StakePool
poolId) (EpochNo -> Integer
transEpochNo EpochNo
retireEpochNo)
RegDepositTxCert StakeCredential
stakeCred Coin
deposit ->
Credential -> Maybe Lovelace -> TxCert
PV3.TxCertRegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) (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
deposit)
UnRegDepositTxCert StakeCredential
stakeCred Coin
refund ->
Credential -> Maybe Lovelace -> TxCert
PV3.TxCertUnRegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) (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
refund)
DelegTxCert StakeCredential
stakeCred Delegatee
delegatee ->
Credential -> Delegatee -> TxCert
PV3.TxCertDelegStaking (StakeCredential -> Credential
forall (kr :: KeyRole). Credential kr -> Credential
transCred StakeCredential
stakeCred) (Delegatee -> Delegatee
Conway.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
Conway.transDelegatee Delegatee
delegatee)
(Coin -> Lovelace
transCoinToLovelace Coin
deposit)
AuthCommitteeHotKeyTxCert Credential ColdCommitteeRole
coldCred Credential HotCommitteeRole
hotCred ->
ColdCommitteeCredential -> HotCommitteeCredential -> TxCert
PV3.TxCertAuthHotCommittee
(Credential ColdCommitteeRole -> ColdCommitteeCredential
Conway.transColdCommitteeCred Credential ColdCommitteeRole
coldCred)
(Credential HotCommitteeRole -> HotCommitteeCredential
Conway.transHotCommitteeCred Credential HotCommitteeRole
hotCred)
ResignCommitteeColdTxCert Credential ColdCommitteeRole
coldCred StrictMaybe Anchor
_anchor ->
ColdCommitteeCredential -> TxCert
PV3.TxCertResignColdCommittee (Credential ColdCommitteeRole -> ColdCommitteeCredential
Conway.transColdCommitteeCred Credential ColdCommitteeRole
coldCred)
RegDRepTxCert Credential DRepRole
drepCred Coin
deposit StrictMaybe Anchor
_anchor ->
DRepCredential -> Lovelace -> TxCert
PV3.TxCertRegDRep (Credential DRepRole -> DRepCredential
Conway.transDRepCred Credential DRepRole
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
deposit)
UnRegDRepTxCert Credential DRepRole
drepCred Coin
refund ->
DRepCredential -> Lovelace -> TxCert
PV3.TxCertUnRegDRep (Credential DRepRole -> DRepCredential
Conway.transDRepCred Credential DRepRole
drepCred) (Coin -> Lovelace
transCoinToLovelace Coin
refund)
UpdateDRepTxCert Credential DRepRole
drepCred StrictMaybe Anchor
_anchor ->
DRepCredential -> TxCert
PV3.TxCertUpdateDRep (Credential DRepRole -> DRepCredential
Conway.transDRepCred Credential DRepRole
drepCred)
TxCert era
_ -> [Char] -> TxCert
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible: All TxCerts should have been accounted for"
instance ConwayEraPlutusTxInfo 'PlutusV3 DijkstraEra where
toPlutusChangedParameters :: forall (proxy :: Language -> *).
proxy 'PlutusV3 -> PParamsUpdate DijkstraEra -> ChangedParameters
toPlutusChangedParameters proxy 'PlutusV3
_ PParamsUpdate DijkstraEra
x = BuiltinData -> ChangedParameters
PV3.ChangedParameters (Data -> BuiltinData
PV3.dataToBuiltinData (PParamsUpdate DijkstraEra -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData PParamsUpdate DijkstraEra
x))
instance ConwayEraPlutusTxInfo 'PlutusV4 DijkstraEra where
toPlutusChangedParameters :: forall (proxy :: Language -> *).
proxy 'PlutusV4 -> PParamsUpdate DijkstraEra -> ChangedParameters
toPlutusChangedParameters proxy 'PlutusV4
_ PParamsUpdate DijkstraEra
x = BuiltinData -> ChangedParameters
PV3.ChangedParameters (Data -> BuiltinData
PV3.dataToBuiltinData (PParamsUpdate DijkstraEra -> Data
forall x. ToPlutusData x => x -> Data
toPlutusData PParamsUpdate DijkstraEra
x))
instance EraPlutusTxInfo 'PlutusV4 DijkstraEra where
toPlutusTxCert :: forall (proxy :: Language -> *).
proxy 'PlutusV4
-> ProtVer
-> TxCert DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxCert 'PlutusV4)
toPlutusTxCert proxy 'PlutusV4
_ ProtVer
_ = TxCert -> Either (ConwayContextError DijkstraEra) TxCert
forall a. a -> Either (ConwayContextError DijkstraEra) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxCert -> Either (ConwayContextError DijkstraEra) TxCert)
-> (DijkstraTxCert DijkstraEra -> TxCert)
-> DijkstraTxCert DijkstraEra
-> Either (ConwayContextError DijkstraEra) TxCert
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxCert DijkstraEra -> TxCert
DijkstraTxCert DijkstraEra -> TxCert
forall era.
(ConwayEraTxCert era, TxCert era ~ DijkstraTxCert era) =>
TxCert era -> TxCert
transTxCert
toPlutusScriptPurpose :: forall (proxy :: Language -> *).
proxy 'PlutusV4
-> ProtVer
-> PlutusPurpose AsIxItem DijkstraEra
-> Either
(ContextError DijkstraEra) (PlutusScriptPurpose 'PlutusV4)
toPlutusScriptPurpose proxy 'PlutusV4
_ = [Char]
-> ProtVer
-> DijkstraPlutusPurpose AsIxItem DijkstraEra
-> Either (ConwayContextError DijkstraEra) ScriptPurpose
forall a. HasCallStack => [Char] -> a
error [Char]
"stub: PlutusV4 not yet implemented"
toPlutusTxInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV4
-> LedgerTxInfo DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusTxInfo 'PlutusV4)
toPlutusTxInfo proxy 'PlutusV4
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 DijkstraEra
ltiUTxO :: forall era. LedgerTxInfo era -> UTxO era
ltiUTxO :: UTxO DijkstraEra
ltiUTxO, Tx TopTx DijkstraEra
ltiTx :: forall era. LedgerTxInfo era -> Tx TopTx era
ltiTx :: Tx TopTx DijkstraEra
ltiTx} = do
timeRange <-
Tx TopTx DijkstraEra
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either (ConwayContextError DijkstraEra) POSIXTimeRange
forall (proxy :: * -> *) era a.
Inject (AlonzoContextError era) a =>
proxy era
-> EpochInfo (Either Text)
-> SystemStart
-> ValidityInterval
-> Either a POSIXTimeRange
Conway.transValidityInterval Tx TopTx DijkstraEra
ltiTx EpochInfo (Either Text)
ltiEpochInfo SystemStart
ltiSystemStart (TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
-> ValidityInterval
forall s a. s -> Getting a s a -> a
^. Getting
ValidityInterval (TxBody TopTx DijkstraEra) ValidityInterval
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel).
Lens' (TxBody l DijkstraEra) ValidityInterval
vldtTxBodyL)
let
txInputs = TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l DijkstraEra) (Set TxIn)
inputsTxBodyL
refInputs = TxBody TopTx DijkstraEra
txBody TxBody TopTx DijkstraEra
-> Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
-> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody TopTx DijkstraEra) (Set TxIn)
forall era (l :: TxLevel).
BabbageEraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l DijkstraEra) (Set TxIn)
referenceInputsTxBodyL
inputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList txInputs)
refInputsInfo <- mapM (Conway.transTxInInfoV3 ltiUTxO) (Set.toList refInputs)
let
commonInputs = Set TxIn
txInputs Set TxIn -> Set TxIn -> Set TxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set TxIn
refInputs
case toList commonInputs of
(TxIn
x : [TxIn]
xs) -> ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ()
forall a b. a -> Either a b
Left (ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ())
-> ConwayContextError DijkstraEra
-> Either (ConwayContextError DijkstraEra) ()
forall a b. (a -> b) -> a -> b
$ NonEmpty TxIn -> ConwayContextError DijkstraEra
forall era. NonEmpty TxIn -> ConwayContextError era
ReferenceInputsNotDisjointFromInputs (NonEmpty TxIn -> ConwayContextError DijkstraEra)
-> NonEmpty TxIn -> ConwayContextError DijkstraEra
forall a b. (a -> b) -> a -> b
$ TxIn
x TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| [TxIn]
xs
[TxIn]
_ -> () -> Either (ConwayContextError DijkstraEra) ()
forall a b. b -> Either a b
Right ()
outputs <-
zipWithM
(Babbage.transTxOutV2 . TxOutFromOutput)
[minBound ..]
(F.toList (txBody ^. outputsTxBodyL))
txCerts <- Alonzo.transTxBodyCerts proxy ltiProtVer txBody
plutusRedeemers <- Babbage.transTxRedeemers proxy ltiProtVer ltiTx
pure
PV3.TxInfo
{ PV3.txInfoInputs = inputsInfo
, PV3.txInfoOutputs = outputs
, PV3.txInfoReferenceInputs = refInputsInfo
, PV3.txInfoFee = transCoinToLovelace (txBody ^. feeTxBodyL)
, PV3.txInfoMint = Conway.transMintValue (txBody ^. mintTxBodyL)
, PV3.txInfoTxCerts = txCerts
, PV3.txInfoWdrl = Conway.transTxBodyWithdrawals txBody
, PV3.txInfoValidRange = timeRange
, PV3.txInfoSignatories = Alonzo.transTxBodyReqSignerHashes txBody
, PV3.txInfoRedeemers = plutusRedeemers
, PV3.txInfoData = PV3.unsafeFromList $ Alonzo.transTxWitsDatums (ltiTx ^. witsTxL)
, PV3.txInfoId = Conway.transTxBodyId txBody
, PV3.txInfoVotes = Conway.transVotingProcedures (txBody ^. votingProceduresTxBodyL)
, PV3.txInfoProposalProcedures =
map (Conway.transProposal proxy) $ toList (txBody ^. proposalProceduresTxBodyL)
, PV3.txInfoCurrentTreasuryAmount =
strictMaybe Nothing (Just . transCoinToLovelace) $ txBody ^. currentTreasuryValueTxBodyL
, PV3.txInfoTreasuryDonation =
case txBody ^. treasuryDonationTxBodyL of
Coin Integer
0 -> Maybe Lovelace
forall a. Maybe a
Nothing
Coin
coin -> Lovelace -> Maybe Lovelace
forall a. a -> Maybe a
Just (Lovelace -> Maybe Lovelace) -> Lovelace -> Maybe Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Lovelace
transCoinToLovelace Coin
coin
}
where
txBody :: TxBody TopTx DijkstraEra
txBody = Tx TopTx DijkstraEra
ltiTx Tx TopTx DijkstraEra
-> Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
-> TxBody TopTx DijkstraEra
forall s a. s -> Getting a s a -> a
^. Getting
(TxBody TopTx DijkstraEra)
(Tx TopTx DijkstraEra)
(TxBody TopTx DijkstraEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel).
Lens' (Tx l DijkstraEra) (TxBody l DijkstraEra)
bodyTxL
toPlutusArgs :: forall (proxy :: Language -> *).
proxy 'PlutusV4
-> ProtVer
-> PlutusTxInfo 'PlutusV4
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV4)
toPlutusArgs = proxy 'PlutusV4
-> ProtVer
-> PlutusTxInfo 'PlutusV4
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV4)
proxy 'PlutusV4
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem DijkstraEra
-> Maybe (Data DijkstraEra)
-> Data DijkstraEra
-> Either (ContextError DijkstraEra) (PlutusArgs 'PlutusV4)
forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV4 era =>
proxy 'PlutusV4
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV4)
toPlutusV4Args
toPlutusTxInInfo :: forall (proxy :: Language -> *).
proxy 'PlutusV4
-> UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV4)
toPlutusTxInInfo proxy 'PlutusV4
_ = UTxO DijkstraEra
-> TxIn
-> Either
(ContextError DijkstraEra) (PlutusTxInInfo DijkstraEra 'PlutusV4)
UTxO DijkstraEra
-> TxIn -> Either (ContextError DijkstraEra) TxInInfo
forall era.
(Inject (BabbageContextError era) (ContextError era),
Value era ~ MaryValue, BabbageEraTxOut era) =>
UTxO era -> TxIn -> Either (ContextError era) TxInInfo
transTxInInfoV3
toPlutusV4Args ::
EraPlutusTxInfo 'PlutusV4 era =>
proxy 'PlutusV4 ->
ProtVer ->
PV3.TxInfo ->
PlutusPurpose AsIxItem era ->
Maybe (Data era) ->
Data era ->
Either (ContextError era) (PlutusArgs 'PlutusV4)
toPlutusV4Args :: forall era (proxy :: Language -> *).
EraPlutusTxInfo 'PlutusV4 era =>
proxy 'PlutusV4
-> ProtVer
-> TxInfo
-> PlutusPurpose AsIxItem era
-> Maybe (Data era)
-> Data era
-> Either (ContextError era) (PlutusArgs 'PlutusV4)
toPlutusV4Args proxy 'PlutusV4
proxy ProtVer
pv TxInfo
txInfo PlutusPurpose AsIxItem era
plutusPurpose Maybe (Data era)
maybeSpendingData Data era
redeemerData = do
scriptPurpose <- proxy 'PlutusV4
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose 'PlutusV4)
forall (l :: Language) era (proxy :: Language -> *).
EraPlutusTxInfo l era =>
proxy l
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose l)
forall (proxy :: Language -> *).
proxy 'PlutusV4
-> ProtVer
-> PlutusPurpose AsIxItem era
-> Either (ContextError era) (PlutusScriptPurpose 'PlutusV4)
toPlutusScriptPurpose proxy 'PlutusV4
proxy ProtVer
pv PlutusPurpose AsIxItem era
plutusPurpose
let scriptInfo =
ScriptPurpose -> Maybe Datum -> ScriptInfo
Conway.scriptPurposeToScriptInfo ScriptPurpose
scriptPurpose (Data era -> Datum
forall era. Data era -> Datum
transDatum (Data era -> Datum) -> Maybe (Data era) -> Maybe Datum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Data era)
maybeSpendingData)
pure $
PlutusV4Args $
PV3.ScriptContext
{ PV3.scriptContextTxInfo = txInfo
, PV3.scriptContextRedeemer = Babbage.transRedeemer redeemerData
, PV3.scriptContextScriptInfo = scriptInfo
}