From 5a2cac07c0cfafda016a045f843816f834aeb257 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 14 Jun 2024 18:06:07 +0200 Subject: [PATCH] Replace Cardano.Api.Fees.TransactionValidityError.TransactionValidityTranslationError with Cardano.Api.Fees.ScriptExecutionError.ScriptErrorTranslationError Concretize toShelleyMultiSig and fromShelleyMultiSig to ShelleyEra --- cardano-api/internal/Cardano/Api/Fees.hs | 28 +++++---- .../Governance/Actions/ProposalProcedure.hs | 4 +- cardano-api/internal/Cardano/Api/Script.hs | 62 ++++++++++--------- .../Test/Golden/ErrorsSpec.hs | 4 +- .../golden/LegacyProtocolParameters.json | 4 +- .../ScriptErrorTranslationError.txt | 1 + 6 files changed, 54 insertions(+), 49 deletions(-) create mode 100644 cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 6765081a16..0ed8ffc705 100644 --- 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 index 4ace67d01a..8575878245 100644 --- 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 index f79439484e..9f56613214 100644 --- 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,65 @@ 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 +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 index 9e6048a008..3379fcb6e7 100644 --- 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 index f2dd7a00c8..58bddcfbbb 100644 --- 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/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt new file mode 100644 index 0000000000..12ba2de35b --- /dev/null +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorTranslationError.txt @@ -0,0 +1 @@ +Error translating the transaction context: TimeTranslationPastHorizon "" \ No newline at end of file