Compiles

IntersectMBO · Jun 14, 2024 · fedf8a0 · fedf8a0
1 parent 5202c50
commit fedf8a0
Show file tree

Hide file tree

Showing 6 changed files with 55 additions and 49 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs
@@ -486,7 +486,12 @@ data ScriptExecutionError =
 
        -- | A cost model was missing for a language which was used.
      | ScriptErrorMissingCostModel Plutus.Language
-  deriving Show
+
+     | forall era. ( Plutus.EraPlutusContext (ShelleyLedgerEra era)
+                   , Show (Plutus.ContextError (ShelleyLedgerEra era))
+                   ) => ScriptErrorTranslationError (Plutus.ContextError (ShelleyLedgerEra era))
+
+deriving instance Show ScriptExecutionError
 
 instance Error ScriptExecutionError where
   prettyError = \case
@@ -543,6 +548,10 @@ instance Error ScriptExecutionError where
     ScriptErrorMissingCostModel language ->
       "No cost model was found for language " <> pshow language
 
+    ScriptErrorTranslationError e -> 
+      "Error translating the transaction context: " <> pshow e
+
+
 data TransactionValidityError era  where
     -- | The transaction validity interval is too far into the future.
     --
@@ -563,11 +572,6 @@ data TransactionValidityError era  where
     TransactionValidityIntervalError
       :: Consensus.PastHorizonException -> TransactionValidityError era
 
-    TransactionValidityTranslationError
-      :: Plutus.EraPlutusContext (ShelleyLedgerEra era)
-      => Plutus.ContextError (ShelleyLedgerEra era)
-      -> TransactionValidityError era
-
     TransactionValidityCostModelError
       :: (Map AnyPlutusScriptVersion CostModel) -> String -> TransactionValidityError era
 
@@ -595,8 +599,6 @@ instance Error (TransactionValidityError era) where
 
           | otherwise
           = 0 -- This should be impossible.
-    TransactionValidityTranslationError errmsg ->
-      "Error translating the transaction context: " <> pshow errmsg
 
     TransactionValidityCostModelError cModels err ->
       mconcat
@@ -635,10 +637,9 @@ evaluateTransactionExecutionUnitsShelley :: forall era. ()
 evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtocolParameters pp) utxo tx =
   caseShelleyToMaryOrAlonzoEraOnwards
     (const (Right Map.empty))
-    (\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)
+    (\w -> return . fromLedgerScriptExUnitsMap w 
+             $ alonzoEraOnwardsConstraints w 
+             $ L.evalTxExUnits pp tx (toLedgerUTxO sbe utxo) ledgerEpochInfo systemstart 
     )
     sbe
   where
@@ -684,6 +685,9 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc
           in ScriptErrorMissingScript scriptWitnessedItemIndex
                $ ResolvablePointers sbe $ Map.map extractScriptBytesAndLanguage resolveable
         L.NoCostModelInLedgerState l -> ScriptErrorMissingCostModel l
+        L.ContextError e -> 
+           alonzoEraOnwardsConstraints aOnwards 
+            $ ScriptErrorTranslationError e
 
 
 extractScriptBytesAndLanguage

diff --git a/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs b/cardano-api/internal/Cardano/Api/Governance/Actions/ProposalProcedure.hs
@@ -193,13 +193,13 @@ fromProposalProcedure sbe (Proposal pp) =
 createPreviousGovernanceActionId
   :: EraCrypto (ShelleyLedgerEra era) ~ StandardCrypto
   => TxId
-  -> Word32 -- ^ Governance action transation index
+  -> Word16 -- ^ Governance action transation index
   -> Ledger.GovPurposeId (r :: Ledger.GovActionPurpose) (ShelleyLedgerEra era)
 createPreviousGovernanceActionId  txid index =
    Ledger.GovPurposeId $ createGovernanceActionId txid index
 
 
-createGovernanceActionId :: TxId -> Word32 -> Gov.GovActionId StandardCrypto
+createGovernanceActionId :: TxId -> Word16 -> Gov.GovActionId StandardCrypto
 createGovernanceActionId txid index =
    Ledger.GovActionId
      { Ledger.gaidTxId = toShelleyTxId txid

diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs
@@ -136,6 +136,7 @@ import qualified Cardano.Ledger.Conway.Scripts as Conway
 import           Cardano.Ledger.Core (Era (EraCrypto))
 import qualified Cardano.Ledger.Core as Ledger
 import qualified Cardano.Ledger.Keys as Shelley
+import qualified Cardano.Ledger.Allegra.Scripts as Allegra
 import qualified Cardano.Ledger.Plutus.Language as Plutus
 import qualified Cardano.Ledger.Shelley.Scripts as Shelley
 import           Cardano.Slotting.Slot (SlotNo)
@@ -1193,64 +1194,66 @@ data MultiSigError = MultiSigErrorTimelockNotsupported deriving Show
 
 -- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
 --
-toShelleyMultiSig :: forall era.
-                     (Era era, EraCrypto era ~ StandardCrypto)
-                  => SimpleScript
-                  -> Either MultiSigError (Shelley.MultiSig era)
+toShelleyMultiSig 
+  :: SimpleScript
+  -> Either MultiSigError (Shelley.MultiSig (ShelleyLedgerEra ShelleyEra))
 toShelleyMultiSig = go
   where
-    go :: SimpleScript -> Either MultiSigError (Shelley.MultiSig era)
+    go :: SimpleScript -> Either MultiSigError (Shelley.MultiSig (ShelleyLedgerEra ShelleyEra))
     go (RequireSignature (PaymentKeyHash kh)) =
       return $ Shelley.RequireSignature (Shelley.asWitness kh)
-    go (RequireAllOf s) = mapM go s <&> Shelley.RequireAllOf
-    go (RequireAnyOf s) = mapM go s <&> Shelley.RequireAnyOf
-    go (RequireMOf m s) = mapM go s <&> Shelley.RequireMOf m
+    go (RequireAllOf s) = mapM go s <&> Shelley.RequireAllOf . Seq.fromList
+    go (RequireAnyOf s) = mapM go s <&> Shelley.RequireAnyOf . Seq.fromList
+    go (RequireMOf m s) = mapM go s <&> Shelley.RequireMOf m . Seq.fromList
     go _ = Left MultiSigErrorTimelockNotsupported
 
 -- | Conversion for the 'Shelley.MultiSig' language used by the Shelley era.
 --
-fromShelleyMultiSig :: (Era era, EraCrypto era ~ StandardCrypto)
-                    => Shelley.MultiSig era -> SimpleScript
+-- TODO: Remove me
+fromShelleyMultiSig :: Shelley.MultiSig (ShelleyLedgerEra ShelleyEra) -> SimpleScript
 fromShelleyMultiSig = go
   where
     go (Shelley.RequireSignature kh)
                                 = RequireSignature
                                     (PaymentKeyHash (Shelley.coerceKeyRole kh))
-    go (Shelley.RequireAllOf s) = RequireAllOf (map go s)
-    go (Shelley.RequireAnyOf s) = RequireAnyOf (map go s)
-    go (Shelley.RequireMOf m s) = RequireMOf m (map go s)
+    go (Shelley.RequireAllOf s) = RequireAllOf (map go $ toList s)
+    go (Shelley.RequireAnyOf s) = RequireAnyOf (map go $ toList s)
+    go (Shelley.RequireMOf m s) = RequireMOf m (map go $ toList s)
+    go _ = error ""
 
 -- | Conversion for the 'Timelock.Timelock' language that is shared between the
 -- Allegra and Mary eras.
 --
 toAllegraTimelock :: forall era.
-                     (Era era, EraCrypto era ~ StandardCrypto)
-                  => SimpleScript -> Timelock.Timelock era
+                     ( Allegra.AllegraEraScript era
+                     , EraCrypto era ~ StandardCrypto
+                     , Ledger.NativeScript era ~ Allegra.Timelock era
+                     )
+                  => SimpleScript -> Ledger.NativeScript era 
 toAllegraTimelock = go
   where
     go :: SimpleScript -> Timelock.Timelock era
     go (RequireSignature (PaymentKeyHash kh))
-                        = Timelock.RequireSignature (Shelley.asWitness kh)
-    go (RequireAllOf s) = Timelock.RequireAllOf (Seq.fromList (map go s))
-    go (RequireAnyOf s) = Timelock.RequireAnyOf (Seq.fromList (map go s))
-    go (RequireMOf m s) = Timelock.RequireMOf m (Seq.fromList (map go s))
-    go (RequireTimeBefore t) = Timelock.RequireTimeExpire t
-    go (RequireTimeAfter  t) = Timelock.RequireTimeStart  t
+                        = Shelley.RequireSignature (Shelley.asWitness kh)
+    go (RequireAllOf s) = Shelley.RequireAllOf (Seq.fromList (map go s))
+    go (RequireAnyOf s) = Shelley.RequireAnyOf (Seq.fromList (map go s))
+    go (RequireMOf m s) = Shelley.RequireMOf m (Seq.fromList (map go s))
+    go (RequireTimeBefore t) = Allegra.RequireTimeExpire t
+    go (RequireTimeAfter  t) = Allegra.RequireTimeStart  t
 
 -- | Conversion for the 'Timelock.Timelock' language that is shared between the
 -- Allegra and Mary eras.
 --
-fromAllegraTimelock :: (Era era, EraCrypto era ~ StandardCrypto)
-                    => Timelock.Timelock era -> SimpleScript
+fromAllegraTimelock :: (Allegra.AllegraEraScript era, EraCrypto era ~ StandardCrypto)
+                    => Ledger.NativeScript era -> SimpleScript
 fromAllegraTimelock = go
   where
-    go (Timelock.RequireSignature kh) = RequireSignature
-                                          (PaymentKeyHash (Shelley.coerceKeyRole kh))
-    go (Timelock.RequireTimeExpire t) = RequireTimeBefore t
-    go (Timelock.RequireTimeStart  t) = RequireTimeAfter t
-    go (Timelock.RequireAllOf      s) = RequireAllOf (map go (toList s))
-    go (Timelock.RequireAnyOf      s) = RequireAnyOf (map go (toList s))
-    go (Timelock.RequireMOf      i s) = RequireMOf i (map go (toList s))
+    go (Shelley.RequireSignature kh) = RequireSignature (PaymentKeyHash (Shelley.coerceKeyRole kh))
+    go (Allegra.RequireTimeExpire t) = RequireTimeBefore t
+    go (Allegra.RequireTimeStart  t) = RequireTimeAfter t
+    go (Shelley.RequireAllOf      s) = RequireAllOf (map go (toList s))
+    go (Shelley.RequireAnyOf      s) = RequireAnyOf (map go (toList s))
+    go (Shelley.RequireMOf      i s) = RequireMOf i (map go (toList s))
 
 
 -- ----------------------------------------------------------------------------

diff --git a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs
@@ -245,6 +245,7 @@ test_ScriptExecutionError =
     , ("ScriptErrorRedeemerPointsToUnknownScriptHash", ScriptErrorRedeemerPointsToUnknownScriptHash (ScriptWitnessIndexTxIn 0))
     , ("ScriptErrorMissingScript", ScriptErrorMissingScript (ScriptWitnessIndexMint 0) (ResolvablePointers ShelleyBasedEraBabbage Map.empty)) -- TODO CIP-1694 make work in all eras
     , ("ScriptErrorMissingCostModel", ScriptErrorMissingCostModel Plutus.PlutusV2)
+    , ("ScriptErrorTranslationError", ScriptErrorTranslationError testPastHorizonValue)
     ]
 
 test_StakePoolMetadataValidationError :: TestTree
@@ -279,8 +280,7 @@ testPastHorizonValue = Ledger.TimeTranslationPastHorizon text
 test_TransactionValidityError :: TestTree
 test_TransactionValidityError =
   testAllErrorMessages_ "Cardano.Api.Fees" "TransactionValidityError"
-    [ ("TransactionValidityTranslationError", TransactionValidityTranslationError testPastHorizonValue)
-    , ("TransactionValidityCostModelError", TransactionValidityCostModelError
+    [ ("TransactionValidityCostModelError", TransactionValidityCostModelError
         (Map.fromList [(AnyPlutusScriptVersion PlutusScriptV2, costModel)])
         string)
     -- TODO Implement this when we get access to data constructors of PastHorizon or its fields' types' constructors

diff --git a/cardano-api/test/cardano-api-golden/files/golden/LegacyProtocolParameters.json b/cardano-api/test/cardano-api-golden/files/golden/LegacyProtocolParameters.json
@@ -577,9 +577,7 @@
             228,
             229,
             230,
-            231,
-            232,
-            233
+            231
         ]
     },
     "decentralization": 0.52,

diff --git a/...files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt b/...files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt
@@ -0,0 +1 @@
+Error translating the transaction context: TimeTranslationPastHorizon "<text>"
-Original file line number
+Diff line change
@@ Expand Up / @@ -577,9 +577,7 @@ @@
 ,
 ,
 ,
-,
-,
             ]
         },
         "decentralization": 0.52,
@@ Expand Down @@
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1 @@
		Error translating the transaction context: TimeTranslationPastHorizon "<text>"