Simplify implementation of evaluateTransactionExecutionUnitsShelley

IntersectMBO · Sep 28, 2023 · cac64ae · cac64ae
1 parent c41feae
commit cac64ae
Show file tree

Hide file tree

Showing 4 changed files with 41 additions and 66 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs
@@ -26,10 +26,17 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.Tx as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.TxWits as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -75,10 +82,15 @@ type AlonzoEraOnwardsConstraints era =
   , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
 

diff --git a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs
@@ -26,10 +26,15 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Core as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -71,10 +76,15 @@ type BabbageEraOnwardsConstraints era =
   , L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
 

diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs
@@ -26,12 +26,17 @@ import           Cardano.Binary
 import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Crypto.VRF as C
+import qualified Cardano.Ledger.Alonzo.Language as L
+import qualified Cardano.Ledger.Alonzo.Scripts as L
+import qualified Cardano.Ledger.Alonzo.TxInfo as L
+import qualified Cardano.Ledger.Alonzo.UTxO as L
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.BaseTypes as L
 import qualified Cardano.Ledger.Conway.Core as L
 import qualified Cardano.Ledger.Conway.Governance as L
 import qualified Cardano.Ledger.Conway.TxCert as L
 import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.UTxO as L
 import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
 import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
 import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
@@ -74,10 +79,15 @@ type ConwayEraOnwardsConstraints era =
   , L.Era (ShelleyLedgerEra era)
   , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
   , L.EraGov (ShelleyLedgerEra era)
+  , L.EraPlutusContext 'L.PlutusV1 (ShelleyLedgerEra era)
   , L.EraPParams (ShelleyLedgerEra era)
   , L.EraTx (ShelleyLedgerEra era)
   , L.EraTxBody (ShelleyLedgerEra era)
+  , L.EraUTxO (ShelleyLedgerEra era)
+  , L.ExtendedUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
+  , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
+  , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxBody (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)
   , L.TxCert (ShelleyLedgerEra era) ~ L.ConwayTxCert (ShelleyLedgerEra era)

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -72,7 +72,6 @@ import qualified Cardano.Ledger.Alonzo.TxInfo as Alonzo
 import qualified Cardano.Ledger.Alonzo.TxWits as Alonzo
 import qualified Cardano.Ledger.Api as L
 import qualified Cardano.Ledger.Coin as Ledger
-import qualified Cardano.Ledger.Conway as Conway
 import           Cardano.Ledger.Credential as Ledger (Credential)
 import qualified Cardano.Ledger.Crypto as Ledger
 import qualified Cardano.Ledger.Keys as Ledger
@@ -499,74 +498,18 @@ evaluateTransactionExecutionUnitsShelley :: forall era. ()
   -> L.Tx (ShelleyLedgerEra era)
   -> Either TransactionValidityError
             (Map ScriptWitnessIndex (Either ScriptExecutionError ExecutionUnits))
-evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx' =
-        case sbe of
-          ShelleyBasedEraShelley  -> evalPreAlonzo
-          ShelleyBasedEraAllegra  -> evalPreAlonzo
-          ShelleyBasedEraMary     -> evalPreAlonzo
-          ShelleyBasedEraAlonzo   -> evalAlonzo sbe tx'
-          ShelleyBasedEraBabbage  -> evalBabbage sbe tx'
-          ShelleyBasedEraConway   -> evalConway sbe tx'
+evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx =
+  caseShelleyToMaryOrAlonzoEraOnwards
+    (const (Right Map.empty))
+    (\_ ->
+      case L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of
+        Left err    -> Left (TransactionValidityTranslationError err)
+        Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
+    )
+    sbe
   where
     LedgerEpochInfo ledgerEpochInfo = epochInfo
 
-    -- | Pre-Alonzo eras do not support languages with execution unit accounting.
-    evalPreAlonzo :: Either TransactionValidityError
-                            (Map ScriptWitnessIndex
-                                  (Either ScriptExecutionError ExecutionUnits))
-    evalPreAlonzo = Right Map.empty
-
-
-    evalAlonzo :: ShelleyLedgerEra era ~ L.Alonzo
-               => ShelleyBasedEra era
-               -> Ledger.Tx L.Alonzo
-               -> Either TransactionValidityError
-                         (Map ScriptWitnessIndex
-                              (Either ScriptExecutionError ExecutionUnits))
-    evalAlonzo sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
-    evalBabbage :: ShelleyLedgerEra era ~ L.Babbage
-                => ShelleyBasedEra era
-                -> Ledger.Tx L.Babbage
-                -> Either TransactionValidityError
-                          (Map ScriptWitnessIndex
-                               (Either ScriptExecutionError ExecutionUnits))
-    evalBabbage sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err    -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
-    evalConway :: forall ledgerera.
-                  ShelleyLedgerEra era ~ ledgerera
-               => ledgerera ~ Conway.ConwayEra Ledger.StandardCrypto
-               => ShelleyBasedEra era
-               -> Ledger.Tx ledgerera
-               -> Either TransactionValidityError
-                         (Map ScriptWitnessIndex
-                              (Either ScriptExecutionError ExecutionUnits))
-    evalConway sbe' tx = do
-      case L.evalTxExUnits
-             pp
-             tx
-             (toLedgerUTxO sbe' utxo)
-             ledgerEpochInfo
-             systemstart
-        of Left err    -> Left (TransactionValidityTranslationError err)
-           Right exmap -> Right (fromLedgerScriptExUnitsMap exmap)
-
     fromLedgerScriptExUnitsMap
       :: Map Alonzo.RdmrPtr (Either (L.TransactionScriptFailure (ShelleyLedgerEra era))
                                     Alonzo.ExUnits)