Address review comments

IntersectMBO · Feb 5, 2024 · 9aae71c · 9aae71c
1 parent e739675
commit 9aae71c
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 34 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs
@@ -90,6 +90,7 @@ type AlonzoEraOnwardsConstraints era =
   , L.EraUTxO (ShelleyLedgerEra era)
   , L.HashAnnotated (L.TxBody (ShelleyLedgerEra era)) L.EraIndependentTxBody L.StandardCrypto
   , L.MaryEraTxBody (ShelleyLedgerEra era)
+  , Plutus.EraPlutusContext (ShelleyLedgerEra era)
   , L.Script (ShelleyLedgerEra era) ~ L.AlonzoScript (ShelleyLedgerEra era)
   , L.ScriptsNeeded (ShelleyLedgerEra era) ~ L.AlonzoScriptsNeeded (ShelleyLedgerEra era)
   , L.ShelleyEraTxCert (ShelleyLedgerEra era)

diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -294,7 +294,9 @@ deriving instance Show ResolvablePointers
 -- The first three of these are about failures before we even get to execute
 -- the script, and two are the result of execution.
 --
--- TODO: This will eventually need to be parameterized on the era
+-- TODO: We should replace ScriptWitnessIndex with ledger's
+-- PlutusPurpose AsIndex ledgerera. This would necessitate the
+-- parameterization of ScriptExecutionError.
 data ScriptExecutionError =
 
        -- | The script depends on a 'TxIn' that has not been provided in the
@@ -491,8 +493,8 @@ evaluateTransactionExecutionUnitsShelley :: forall era. ()
 evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx =
   caseShelleyToMaryOrAlonzoEraOnwards
     (const (Right Map.empty))
-    (\w -> case alonzoEraOnwardsPlutusConstraints w $ L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of
-             Left err    -> Left $ alonzoEraOnwardsPlutusConstraints w
+    (\w -> case alonzoEraOnwardsConstraints w $ L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart of
+             Left err    -> Left $ alonzoEraOnwardsConstraints w
                                  $ TransactionValidityTranslationError err
              Right exmap -> Right (fromLedgerScriptExUnitsMap w exmap)
     )

diff --git a/cardano-api/internal/Cardano/Api/ProtocolParameters.hs b/cardano-api/internal/Cardano/Api/ProtocolParameters.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -18,7 +19,6 @@
 {-# LANGUAGE TypeOperators #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
-{-# LANGUAGE InstanceSigs #-}
 
 {- HLINT ignore "Redundant ==" -}
 {- HLINT ignore "Use mapM" -}

diff --git a/cardano-api/internal/Cardano/Api/Tx/Sign.hs b/cardano-api/internal/Cardano/Api/Tx/Sign.hs
@@ -324,36 +324,18 @@ data TxBody era where
 instance Eq (TxBody era) where
     (==) (ShelleyTxBody sbe txbodyA txscriptsA redeemersA txmetadataA scriptValidityA)
          (ShelleyTxBody _   txbodyB txscriptsB redeemersB txmetadataB scriptValidityB) =
-         case sbe of
-           ShelleyBasedEraShelley -> txbodyA     == txbodyB
-                                  && txscriptsA  == txscriptsB
-                                  && txmetadataA == txmetadataB
-
-           ShelleyBasedEraAllegra -> txbodyA     == txbodyB
-                                  && txscriptsA  == txscriptsB
-                                  && txmetadataA == txmetadataB
-
-           ShelleyBasedEraMary    -> txbodyA     == txbodyB
-                                  && txscriptsA  == txscriptsB
-                                  && txmetadataA == txmetadataB
-
-           ShelleyBasedEraAlonzo  -> txbodyA         == txbodyB
-                                  && txscriptsA      == txscriptsB
-                                  && redeemersA      == redeemersB
-                                  && txmetadataA     == txmetadataB
-                                  && scriptValidityA == scriptValidityB
-
-           ShelleyBasedEraBabbage -> txbodyA         == txbodyB
-                                  && txscriptsA      == txscriptsB
-                                  && redeemersA      == redeemersB
-                                  && txmetadataA     == txmetadataB
-                                  && scriptValidityA == scriptValidityB
-
-           ShelleyBasedEraConway  -> txbodyA         == txbodyB
-                                  && txscriptsA      == txscriptsB
-                                  && redeemersA      == redeemersB
-                                  && txmetadataA     == txmetadataB
-                                  && scriptValidityA == scriptValidityB
+         caseShelleyToMaryOrAlonzoEraOnwards
+           (const $ txbodyA     == txbodyB
+                 && txscriptsA  == txscriptsB
+                 && txmetadataA == txmetadataB
+           )
+           (const $ txbodyA         == txbodyB
+                 && txscriptsA      == txscriptsB
+                 && redeemersA      == redeemersB
+                 && txmetadataA     == txmetadataB
+                 && scriptValidityA == scriptValidityB
+           ) sbe
+
 
 -- The GADT in the ShelleyTxBody case requires a custom instance
 instance Show (TxBody era) where