From da8485b0cbb8841f788a0b59c0c06f4beae9ab43 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 15 Nov 2024 18:55:27 +0100 Subject: [PATCH 01/11] Remove accidental leak of experimental API --- .../Cardano/Api/Convenience/Construction.hs | 13 +- cardano-api/internal/Cardano/Api/Fees.hs | 148 +++++++----------- .../internal/Cardano/Api/Tx/Compatible.hs | 2 +- 3 files changed, 64 insertions(+), 99 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs index 786a81b9e9..081f66eb0b 100644 --- a/cardano-api/internal/Cardano/Api/Convenience/Construction.hs +++ b/cardano-api/internal/Cardano/Api/Convenience/Construction.hs @@ -17,8 +17,6 @@ where import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Eon.ShelleyBasedEra -import Cardano.Api.Experimental.Eras -import Cardano.Api.Experimental.Tx import Cardano.Api.Fees import Cardano.Api.ProtocolParameters import Cardano.Api.Query @@ -31,7 +29,6 @@ import qualified Cardano.Ledger.Coin as L import qualified Cardano.Ledger.Credential as L import qualified Cardano.Ledger.Keys as L -import Data.Bifunctor import qualified Data.List as List import qualified Data.Map.Strict as Map import Data.Set (Set) @@ -75,9 +72,7 @@ constructBalancedTx stakeDelegDeposits drepDelegDeposits shelleyWitSigningKeys = do - availableEra <- first TxBodyErrorDeprecatedEra $ sbeToEra sbe - - BalancedTxBody _ unsignedTx _txBalanceOutput _fee <- + BalancedTxBody _ txbody _txBalanceOutput _fee <- makeTransactionBodyAutoBalance sbe systemStart @@ -91,10 +86,8 @@ constructBalancedTx changeAddr mOverrideWits - let alternateKeyWits = map (makeKeyWitness availableEra unsignedTx) shelleyWitSigningKeys - signedTx = signTx availableEra [] alternateKeyWits unsignedTx - - return $ ShelleyTx sbe $ obtainCommonConstraints availableEra signedTx + let keyWits = map (makeShelleyKeyWitness sbe txbody) shelleyWitSigningKeys + return $ makeSignedTransaction keyWits txbody data TxInsExistError = TxInsDoNotExist [TxIn] diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 1e6d69ad8d..25ecf80f79 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -8,7 +8,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE UndecidableInstances #-} -- | Fee calculation module Cardano.Api.Fees @@ -58,9 +57,6 @@ import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Case import Cardano.Api.Eras.Core import Cardano.Api.Error -import Cardano.Api.Experimental.Eras (obtainCommonConstraints, sbeToEra) -import qualified Cardano.Api.Experimental.Eras as Exp -import Cardano.Api.Experimental.Tx import Cardano.Api.Feature import qualified Cardano.Api.Ledger.Lens as A import Cardano.Api.Pretty @@ -381,7 +377,7 @@ estimateBalancedTxBody return ( BalancedTxBody finalTxBodyContent - (convertTxBodyToUnsignedTx sbe txbody3) + txbody3 (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee ) @@ -806,26 +802,24 @@ evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits u TxOutValueShelleyBased sbe $ L.evalBalanceTxBody pp - (lookupDelegDeposit stakeDelegDeposits) - (lookupDRepDeposit drepDelegDeposits) - (isRegPool poolids) + lookupDelegDeposit + lookupDRepDeposit + isRegPool (toLedgerUTxO sbe utxo) txbody + where + isRegPool :: Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool + isRegPool kh = StakePoolKeyHash kh `Set.member` poolids -isRegPool :: Set PoolId -> Ledger.KeyHash Ledger.StakePool Ledger.StandardCrypto -> Bool -isRegPool poolids kh = StakePoolKeyHash kh `Set.member` poolids - -lookupDelegDeposit - :: Map StakeCredential L.Coin -> Ledger.Credential 'Ledger.Staking L.StandardCrypto -> Maybe L.Coin -lookupDelegDeposit stakeDelegDeposits stakeCred = - Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits + lookupDelegDeposit + :: Ledger.Credential 'Ledger.Staking L.StandardCrypto -> Maybe L.Coin + lookupDelegDeposit stakeCred = + Map.lookup (fromShelleyStakeCredential stakeCred) stakeDelegDeposits -lookupDRepDeposit - :: Map (Ledger.Credential Ledger.DRepRole Ledger.StandardCrypto) L.Coin - -> Ledger.Credential 'Ledger.DRepRole L.StandardCrypto - -> Maybe L.Coin -lookupDRepDeposit drepDelegDeposits drepCred = - Map.lookup drepCred drepDelegDeposits + lookupDRepDeposit + :: Ledger.Credential 'Ledger.DRepRole L.StandardCrypto -> Maybe L.Coin + lookupDRepDeposit drepCred = + Map.lookup drepCred drepDelegDeposits -- ---------------------------------------------------------------------------- -- Automated transaction building @@ -872,7 +866,6 @@ data TxBodyErrorAutoBalance era | TxBodyErrorScriptWitnessIndexMissingFromExecUnitsMap ScriptWitnessIndex (Map ScriptWitnessIndex ExecutionUnits) - | TxBodyErrorDeprecatedEra (Exp.DeprecatedEra era) deriving Show instance Error (TxBodyErrorAutoBalance era) where @@ -926,8 +919,6 @@ instance Error (TxBodyErrorAutoBalance era) where [ "ScriptWitnessIndex (redeemer pointer): " <> pshow sIndex <> " is missing from the execution " , "units (redeemer pointer) map: " <> pshow eUnitsMap ] - TxBodyErrorDeprecatedEra deprecatedEra -> - "The era " <> pretty deprecatedEra <> " is deprecated and no longer supported." handleExUnitsErrors :: ScriptValidity @@ -946,18 +937,15 @@ handleExUnitsErrors ScriptInvalid failuresMap exUnitsMap | null failuresMap = Left TxBodyScriptBadScriptValidity | otherwise = Right $ Map.map (\_ -> ExecutionUnits 0 0) failuresMap <> exUnitsMap -data BalancedTxBody era where - BalancedTxBody - :: (TxBodyContent BuildTx era) - -> (UnsignedTx era) - -> (TxOut CtxTx era) - -- ^ Transaction balance (change output) - -> L.Coin - -- ^ Estimated transaction fee - -> BalancedTxBody era - -deriving instance - (Exp.IsEra era, IsShelleyBasedEra era) => Show (BalancedTxBody era) +data BalancedTxBody era + = BalancedTxBody + (TxBodyContent BuildTx era) + (TxBody era) + (TxOut CtxTx era) + -- ^ Transaction balance (change output) + L.Coin + -- ^ Estimated transaction fee + deriving Show newtype RequiredShelleyKeyWitnesses = RequiredShelleyKeyWitnesses {unRequiredShelleyKeyWitnesses :: Int} @@ -1053,8 +1041,6 @@ makeTransactionBodyAutoBalance changeaddr mnkeys = shelleyBasedEraConstraints sbe $ do - availableEra <- first TxBodyErrorDeprecatedEra $ sbeToEra sbe - -- Our strategy is to: -- 1. evaluate all the scripts to get the exec units, update with ex units -- 2. figure out the overall min fees @@ -1066,23 +1052,22 @@ makeTransactionBodyAutoBalance monoidForEraInEon (toCardanoEra sbe) $ \w -> toLedgerValue w $ calculateChangeValue sbe totalValueAtSpendableUTxO txbodycontent - UnsignedTx unsignedTx0 <- + txbody0 <- first TxBodyError - $ makeUnsignedTx - availableEra - $ obtainCommonConstraints availableEra + $ createTransactionBody + sbe $ txbodycontent & modTxOuts (<> [TxOut changeaddr (TxOutValueShelleyBased sbe change) TxOutDatumNone ReferenceScriptNone]) exUnitsMapWithLogs <- - first TxBodyErrorValidityInterval - $ evaluateTransactionExecutionUnitsShelley - sbe + first TxBodyErrorValidityInterval $ + evaluateTransactionExecutionUnits + era systemstart history lpp utxo - $ obtainCommonConstraints availableEra unsignedTx0 + txbody0 let exUnitsMap = Map.map (fmap snd) exUnitsMapWithLogs @@ -1108,7 +1093,6 @@ makeTransactionBodyAutoBalance -- we can use the true values for that. let maxLovelaceChange = L.Coin (2 ^ (64 :: Integer)) - 1 let maxLovelaceFee = L.Coin (2 ^ (32 :: Integer) - 1) - let changeWithMaxLovelace = change & A.adaAssetL sbe .~ maxLovelaceChange let changeTxOut = forShelleyBasedEraInEon @@ -1117,19 +1101,18 @@ makeTransactionBodyAutoBalance (\w -> maryEraOnwardsConstraints w $ TxOutValueShelleyBased sbe changeWithMaxLovelace) let (dummyCollRet, dummyTotColl) = maybeDummyTotalCollAndCollReturnOutput sbe txbodycontent changeaddr - UnsignedTx txbody1 <- - first TxBodyError - $ makeUnsignedTx -- TODO: impossible to fail now - availableEra - $ obtainCommonConstraints availableEra - $ txbodycontent1 - { txFee = TxFeeExplicit sbe maxLovelaceFee - , txOuts = - txOuts txbodycontent - <> [TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone] - , txReturnCollateral = dummyCollRet - , txTotalCollateral = dummyTotColl - } + txbody1 <- + first TxBodyError $ -- TODO: impossible to fail now + createTransactionBody + sbe + txbodycontent1 + { txFee = TxFeeExplicit sbe maxLovelaceFee + , txOuts = + txOuts txbodycontent + <> [TxOut changeaddr changeTxOut TxOutDatumNone ReferenceScriptNone] + , txReturnCollateral = dummyCollRet + , txTotalCollateral = dummyTotColl + } -- NB: This has the potential to over estimate the fees because estimateTransactionKeyWitnessCount -- makes the conservative assumption that all inputs are from distinct -- addresses. @@ -1137,9 +1120,7 @@ makeTransactionBodyAutoBalance fromMaybe (estimateTransactionKeyWitnessCount txbodycontent1) mnkeys - fee = - obtainCommonConstraints availableEra $ - L.calcMinFeeTx (toLedgerUTxO sbe utxo) pp txbody1 (fromIntegral nkeys) + fee = calculateMinTxFee sbe pp utxo txbody1 nkeys (retColl, reqCol) = caseShelleyToAlonzoOrBabbageEraOnwards (const (TxReturnCollateralNone, TxTotalCollateralNone)) @@ -1167,27 +1148,16 @@ makeTransactionBodyAutoBalance -- does not matter, instead it's just the values of the fee and outputs. -- Here we do not want to start with any change output, since that's what -- we need to calculate. - UnsignedTx txbody2 <- - first TxBodyError - $ makeUnsignedTx -- TODO: impossible to fail now - availableEra - $ obtainCommonConstraints availableEra - $ txbodycontent1 - { txFee = TxFeeExplicit sbe fee - , txReturnCollateral = retColl - , txTotalCollateral = reqCol - } - let balance = - TxOutValueShelleyBased sbe $ - obtainCommonConstraints availableEra $ - L.evalBalanceTxBody - pp - (lookupDelegDeposit stakeDelegDeposits) - (lookupDRepDeposit drepDelegDeposits) - (isRegPool poolids) - (toLedgerUTxO sbe utxo) - (txbody2 ^. L.bodyTxL) - + txbody2 <- + first TxBodyError $ -- TODO: impossible to fail now + createTransactionBody + sbe + txbodycontent1 + { txFee = TxFeeExplicit sbe fee + , txReturnCollateral = retColl + , txTotalCollateral = reqCol + } + let balance = evaluateTransactionBalance sbe pp poolids stakeDelegDeposits drepDelegDeposits utxo txbody2 forM_ (txOuts txbodycontent1) $ \txout -> checkMinUTxOValue sbe txout pp -- check if the balance is positive or negative @@ -1196,7 +1166,6 @@ makeTransactionBodyAutoBalance -- TODO: we could add the extra fee for the CBOR encoding of the change, -- now that we know the magnitude of the change: i.e. 1-8 bytes extra. - -- The txbody with the final fee and change output. This should work -- provided that the fee and change are less than 2^32-1, and so will -- fit within the encoding size we picked above when calculating the fee. @@ -1216,8 +1185,7 @@ makeTransactionBodyAutoBalance first TxBodyError $ -- TODO: impossible to fail now. We need to implement a function -- that simply creates a transaction body because we have already -- validated the transaction body earlier within makeTransactionBodyAutoBalance - makeUnsignedTx availableEra $ - obtainCommonConstraints availableEra finalTxBodyContent + createTransactionBody sbe finalTxBodyContent return ( BalancedTxBody finalTxBodyContent @@ -1225,6 +1193,9 @@ makeTransactionBodyAutoBalance (TxOut changeaddr balance TxOutDatumNone ReferenceScriptNone) fee ) + where + era :: CardanoEra era + era = toCardanoEra sbe -- | In the event of spending the exact amount of lovelace in -- the specified input(s), this function excludes the change @@ -1276,7 +1247,8 @@ onlyAda = null . toList . filterValue isNotAda calculateIncomingUTxOValue :: Monoid (Ledger.Value (ShelleyLedgerEra era)) - => [TxOut ctx era] -> Ledger.Value (ShelleyLedgerEra era) + => [TxOut ctx era] + -> Ledger.Value (ShelleyLedgerEra era) calculateIncomingUTxOValue providedUtxoOuts = mconcat [v | (TxOut _ (TxOutValueShelleyBased _ v) _ _) <- providedUtxoOuts] diff --git a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs index e22ba70b4b..da05768d01 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs @@ -16,7 +16,7 @@ where import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToBabbageEra -import Cardano.Api.Experimental.Eras +import Cardano.Api.Eras import Cardano.Api.ProtocolParameters import Cardano.Api.Script import Cardano.Api.Tx.Body From b72fc8db2a82ff62837a07b886e9213aab68b71f Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 28 Oct 2024 10:59:39 +0100 Subject: [PATCH 02/11] Remove `Show (Some a)` and `Eq (Some a)`. Add `Show (Some Era)` and `Eq (Some Era)`. --- .../internal/Cardano/Api/Experimental/Eras.hs | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs index 2b2e40cd0a..c2517e2eeb 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs @@ -66,8 +66,8 @@ type family LedgerEra era = (r :: Type) | r -> era where LedgerEra BabbageEra = Ledger.Babbage LedgerEra ConwayEra = Ledger.Conway --- | An existential type for singleton types. Use to hold any era e.g. @Some Era@. One can then bring the --- era witness back into scope for example using this pattern: +-- | An existential wrapper for types of kind @k -> Types@. Use it to hold any era e.g. @Some Era@. One can +-- then bring the era witness back into scope for example using this pattern: -- @ -- anyEra = Some ConwayEra -- -- then later in the code @@ -81,15 +81,6 @@ data Some (f :: k -> Type) where => f a -> Some f --- | Assumes that @f@ is a singleton -instance Show (Some f) where - showsPrec _ (Some v) = showsTypeRep (typeOf v) - --- | Assumes that @f@ is a singleton -instance TestEquality f => Eq (Some f) where - Some era1 == Some era2 = - isJust $ testEquality era1 era2 - -- | Represents the eras in Cardano's blockchain. -- This type represents eras currently on mainnet and new eras which are -- in development. @@ -119,6 +110,12 @@ instance TestEquality Era where instance ToJSON (Era era) where toJSON = eraToStringLike +instance Show (Some Era) where + showsPrec _ (Some era) = shows era + +instance Eq (Some Era) where + Some era1 == Some era2 = isJust $ testEquality era1 era2 + instance Bounded (Some Era) where minBound = Some BabbageEra maxBound = Some ConwayEra From b2486000aea52af3cae11e328f3a4167424d872d Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Fri, 1 Nov 2024 14:54:17 -0400 Subject: [PATCH 03/11] Update ScriptErrorEvaluationFailed with DebugPlutusFailure --- cardano-api/cardano-api.cabal | 6 +- cardano-api/internal/Cardano/Api/Fees.hs | 17 ++-- cardano-api/internal/Cardano/Api/Plutus.hs | 82 +++++++++++++++++++ .../Test/Golden/ErrorsSpec.hs | 70 ++++++++++++++-- .../ScriptErrorEvaluationFailed.txt | 65 +++++++++++++-- 5 files changed, 217 insertions(+), 23 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Plutus.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 0ae0eb0331..6bff1535b3 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -123,6 +123,7 @@ library internal Cardano.Api.NetworkId Cardano.Api.OperationalCertificate Cardano.Api.Orphans + Cardano.Api.Plutus Cardano.Api.Pretty Cardano.Api.Protocol Cardano.Api.ProtocolParameters @@ -161,6 +162,7 @@ library internal attoparsec, base16-bytestring >=1.0, base58-bytestring, + base64-bytestring, bech32 >=1.1.0, bytestring, cardano-binary, @@ -380,6 +382,7 @@ test-suite cardano-api-golden type: exitcode-stdio-1.0 build-depends: aeson, + base64-bytestring, bech32 >=1.1.0, bytestring, cardano-api, @@ -391,6 +394,7 @@ test-suite cardano-api-golden cardano-ledger-alonzo, cardano-ledger-api ^>=1.9, cardano-ledger-babbage >=1.9, + cardano-ledger-binary, cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley, cardano-ledger-shelley-test >=1.2.0.1, @@ -403,7 +407,7 @@ test-suite cardano-api-golden microlens, parsec, plutus-core ^>=1.36, - plutus-ledger-api ^>=1.36, + plutus-ledger-api, tasty, tasty-hedgehog, text, diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 25ecf80f79..f026efde5c 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -59,6 +59,7 @@ import Cardano.Api.Eras.Core import Cardano.Api.Error import Cardano.Api.Feature import qualified Cardano.Api.Ledger.Lens as A +import Cardano.Api.Plutus import Cardano.Api.Pretty import Cardano.Api.ProtocolParameters import Cardano.Api.Query @@ -80,7 +81,6 @@ import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Plutus.Language as Plutus import qualified Cardano.Ledger.Val as L import qualified Ouroboros.Consensus.HardFork.History as Consensus -import qualified PlutusLedgerApi.V1 as Plutus import Control.Monad import Data.Bifunctor (bimap, first, second) @@ -95,7 +95,6 @@ import Data.Ratio import Data.Set (Set) import qualified Data.Set as Set import Data.Text (Text) -import qualified Data.Text as Text import GHC.Exts (IsList (..)) import Lens.Micro ((.~), (^.)) @@ -536,7 +535,7 @@ data ScriptExecutionError -- (which is not possible for 'evaluateTransactionExecutionUnits' since -- the whole point of it is to discover how many execution units are -- needed). - ScriptErrorEvaluationFailed Plutus.EvaluationError [Text.Text] + ScriptErrorEvaluationFailed DebugPlutusFailure | -- | The execution units overflowed a 64bit word. Congratulations if -- you encounter this error. With the current style of cost model this -- would need a script to run for over 7 months, which is somewhat more @@ -577,11 +576,8 @@ instance Error ScriptExecutionError where [ "The Plutus script witness has the wrong datum (according to the UTxO). " , "The expected datum value has hash " <> pshow dh ] - ScriptErrorEvaluationFailed evalErr logs -> - mconcat - [ "The Plutus script evaluation failed: " <> pretty evalErr - , "\nScript debugging logs: " <> mconcat (map (\t -> pretty $ t `Text.append` "\n") logs) - ] + ScriptErrorEvaluationFailed plutusDebugFailure -> + pretty $ renderDebugPlutusFailure plutusDebugFailure ScriptErrorExecutionUnitsOverflow -> mconcat [ "The execution units required by this Plutus script overflows a 64bit " @@ -736,9 +732,8 @@ evaluateTransactionExecutionUnitsShelley sbe systemstart epochInfo (LedgerProtoc where txin' = fromShelleyTxIn txin L.MissingDatum dh -> ScriptErrorWrongDatum (ScriptDataHash dh) - L.ValidationFailure _ evalErr logs _ -> - -- TODO: Include additional information from ValidationFailure - ScriptErrorEvaluationFailed evalErr logs + L.ValidationFailure execUnits evalErr logs scriptWithContext -> + ScriptErrorEvaluationFailed $ DebugPlutusFailure evalErr scriptWithContext execUnits logs L.IncompatibleBudget _ -> ScriptErrorExecutionUnitsOverflow L.RedeemerPointsToUnknownScriptHash rdmrPtr -> ScriptErrorRedeemerPointsToUnknownScriptHash $ toScriptIndex aOnwards rdmrPtr diff --git a/cardano-api/internal/Cardano/Api/Plutus.hs b/cardano-api/internal/Cardano/Api/Plutus.hs new file mode 100644 index 0000000000..6ca64ecbc0 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Plutus.hs @@ -0,0 +1,82 @@ +-- | This module provides an error to conveniently render plutus related failures. +module Cardano.Api.Plutus + ( DebugPlutusFailure (..) + , renderDebugPlutusFailure + ) +where + +import Cardano.Api.Pretty + +import qualified Cardano.Ledger.Api as L +import Cardano.Ledger.Binary.Encoding (serialize') +import Cardano.Ledger.Binary.Plain (serializeAsHexText) +import qualified Cardano.Ledger.Plutus.Evaluate as Plutus +import qualified Cardano.Ledger.Plutus.ExUnits as Plutus +import qualified Cardano.Ledger.Plutus.Language as Plutus +import qualified PlutusLedgerApi.V1 as Plutus + +import qualified Data.ByteString.Base64 as B64 +import Data.ByteString.Short as BSS +import Data.Text (Text) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Prettyprinter + +-- | A structured representation of Plutus script validation failures, +-- providing detailed information about the failed execution for debugging purposes. +-- This type contains the same information as the data constructor +-- 'Cardano.Ledger.Alonzo.Plutus.Evaluate.TransactionScriptFailure.ValidationFailure' +-- but with named fields and fixed crypto parameters for easier debugging and +-- error reporting. +data DebugPlutusFailure + = DebugPlutusFailure + { dpfEvaluationError :: Plutus.EvaluationError + , dpfScriptWithContext :: Plutus.PlutusWithContext L.StandardCrypto + , dpfExecutionUnits :: Plutus.ExUnits + , dpfExecutionLogs :: [Text] + } + deriving (Eq, Show) + +renderDebugPlutusFailure :: DebugPlutusFailure -> Text +renderDebugPlutusFailure dpf = + let pwc = dpfScriptWithContext dpf + lang = case pwc of + Plutus.PlutusWithContext{Plutus.pwcScript = script} -> + either Plutus.plutusLanguage Plutus.plutusLanguage script + + scriptArgs = case pwc of + Plutus.PlutusWithContext{Plutus.pwcArgs = args} -> + line <> indent 3 (pretty args) + protocolVersion = Plutus.pwcProtocolVersion pwc + scriptArgsBase64 = case pwc of + Plutus.PlutusWithContext{Plutus.pwcArgs = args} -> + Text.decodeUtf8 $ B64.encode $ serialize' protocolVersion args + evalError = dpfEvaluationError dpf + binaryScript = case pwc of + Plutus.PlutusWithContext{Plutus.pwcScript = scr} -> + let Plutus.Plutus bytes = either id Plutus.plutusFromRunnable scr + in Text.decodeUtf8 . B64.encode . BSS.fromShort $ Plutus.unPlutusBinary bytes + in Text.unlines + [ "Script hash: " <> serializeAsHexText (Plutus.pwcScriptHash pwc) + , "Script language: " <> Text.pack (show lang) + , "Protocol version: " <> Text.pack (show protocolVersion) + , "Script arguments: " <> docToText scriptArgs + , "Script evaluation error: " <> docToText (pretty evalError) + , "Script execution logs: " <> Text.unlines (dpfExecutionLogs dpf) + , "Script base64 encoded arguments: " <> scriptArgsBase64 + , "Script base64 encoded bytes: " <> binaryScript + ] + +{- +-- Should be used on `dpfExecutionLogs dpf`. Disabled until next plutus release. +See: https://github.com/IntersectMBO/cardano-api/pull/672#issuecomment-2455909946 + +PlutusTx.ErrorCodes.plutusPreludeErrorCodes + +lookupPlutusErrorCode :: Text -> Text +lookupPlutusErrorCode code = + let codeString = PlutusTx.stringToBuiltinString $ Text.unpack code + in case Map.lookup codeString plutusPreludeErrorCodes of + Just err -> Text.pack err + Nothing -> "Unknown error code: " <> code +-} 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 19cc093595..b86611c8bb 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} -{- HLINT ignore "Redundant do" -} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Golden.ErrorsSpec @@ -30,15 +31,21 @@ module Test.Golden.ErrorsSpec where import Cardano.Api +import Cardano.Api.Plutus import Cardano.Api.Shelley import Cardano.Binary as CBOR import qualified Cardano.Crypto.Seed as Crypto import qualified Cardano.Ledger.Alonzo.Plutus.TxInfo as Ledger import qualified Cardano.Ledger.Api.Era as Ledger +import qualified Cardano.Ledger.Binary.Decoding as Binary +import Cardano.Ledger.Binary.Version import qualified Cardano.Ledger.Coin as L import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Cardano.Ledger.Plutus.Language as Plutus +import qualified Cardano.Ledger.Plutus.CostModels as Plutus +import Cardano.Ledger.Plutus.Evaluate +import Cardano.Ledger.Plutus.ExUnits +import qualified Cardano.Ledger.Plutus.Language as Language import qualified PlutusCore.Evaluation.Machine.CostModelInterface as Plutus import qualified PlutusLedgerApi.Common as Plutus hiding (PlutusV2) @@ -46,12 +53,15 @@ import qualified Codec.Binary.Bech32 as Bech32 import Control.Error.Util (hush) import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) +import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy as LBS import Data.Data import qualified Data.Map as Map -import Data.Maybe (fromJust) +import Data.Maybe import qualified Data.Set as Set import Data.Text (Text) +import qualified Data.Text.Encoding as Text +import Data.Word import GHC.Exts (IsList (..)) import GHC.Stack (HasCallStack) @@ -272,7 +282,12 @@ test_ScriptExecutionError = , ("ScriptErrorWrongDatum", ScriptErrorWrongDatum hashScriptData1) , ( "ScriptErrorEvaluationFailed" - , ScriptErrorEvaluationFailed Plutus.CostModelParameterMismatch (replicate 5 text) + , ScriptErrorEvaluationFailed $ + DebugPlutusFailure + Plutus.CostModelParameterMismatch + examplePlutusWithContext + (ExUnits 1 1) + ["Example logs"] ) , ("ScriptErrorExecutionUnitsOverflow", ScriptErrorExecutionUnitsOverflow) , @@ -289,10 +304,55 @@ test_ScriptExecutionError = (ScriptWitnessIndexMint 0) (ResolvablePointers ShelleyBasedEraBabbage Map.empty) -- TODO CIP-1694 make work in all eras ) - , ("ScriptErrorMissingCostModel", ScriptErrorMissingCostModel Plutus.PlutusV2) + , ("ScriptErrorMissingCostModel", ScriptErrorMissingCostModel Language.PlutusV2) , ("ScriptErrorTranslationError", ScriptErrorTranslationError testPastHorizonValue) ] +examplePlutusWithContext :: PlutusWithContext StandardCrypto +examplePlutusWithContext = + PlutusWithContext + { pwcProtocolVersion = defaultVersion + , pwcScript = Left examplePlutusScript + , pwcScriptHash = Language.hashPlutusScript examplePlutusScript + , pwcArgs = examplePlutusScriptArgs + , pwcExUnits = ExUnits 1 1 + , pwcCostModel = defaultCostModel + } + +defaultCostModel :: Plutus.CostModel +defaultCostModel = + fromJust + $ Plutus.costModelFromMap + Language.PlutusV3 + $ fromList + $ map (,0) (Plutus.costModelParamNames Language.PlutusV3) + +defaultVersion :: Version +defaultVersion = fromJust $ mkVersion @Word64 9 + +-- Try decoding to api's PlutusScript first then convert to ledger types +examplePlutusScript :: Language.Plutus Language.PlutusV3 +examplePlutusScript = + let cborBytes = Text.encodeUtf8 hexPlutusScriptBytes + in case deserialiseFromRawBytes (AsPlutusScript AsPlutusScriptV3) cborBytes of + Left e -> error $ "examplePlutusScript: Failed to decode Plutus script: " <> show e + Right (PlutusScriptSerialised script) -> Language.Plutus $ Language.PlutusBinary script + +examplePlutusScriptArgs :: Language.PlutusArgs Language.PlutusV3 +examplePlutusScriptArgs = + let cborBytes = B64.decodeLenient $ Text.encodeUtf8 base64PlutusScriptArgsBytes + in case Binary.decodeFull' defaultVersion cborBytes of + Left _ -> error "examplePlutusScriptArgs: Failed to decode Plutus script args" + Right args -> args + +base64PlutusScriptArgsBytes :: Text +base64PlutusScriptArgsBytes = + "2Hmf2Hmfn9h5n9h5n1ggp4nVTEZsdm+0vF4Jy816CkYJdWfk/2BiCVVip0BLnL8A/9h5n9h5n9h6n1gcxhv6HBOFJLafN4vGlQQyLzkonOVU1UnbTR4rUP/YeoD/oUChQBoATEtA2HqfWCADFwoudZe3t+PYTAU5HROaYrFX54eG2MCC8p3PTBETFP/YeoD///+An9h5n9h5n9h5n1gcxbyvlPIHUatyym5imViDpytwsNh06mjqCXkOk//YeoD/okChQBoAHoSAWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQoUpNaWxsYXJDb2luBdh5gNh6gP/YeZ/YeZ/YeZ9YHMW8r5TyB1GrcspuYplYg6crcLDYdOpo6gl5DpP/2HqA/6FAoUAaAA9CQNh6n1gg7hVazpxAKSB0y2r/jJzN0nPIFkj/EUnvNrzqbruKPiX/2HqA/9h5n9h5n9h5n1gcKSM+X/Qw3SW5FG9fON4SNYYd6scERBygsGr5Ev/YeoD/oUChQBsAAA2kdfg7QNh5gNh6gP//AKFYHMYb+hwThSS2nzeLxpUEMi85KJzlVNVJ200eK1ChSk1pbGxhckNvaW4Fn9h5n9h6n1gcxhv6HBOFJLafN4vGlQQyLzkonOVU1UnbTR4rUP/YeZ8aAAYagP///6DYeZ/YeZ/YeYDYeoD/2Hmf2HuA2HqA//+Ao9h6n9h5n1ggp4nVTEZsdm+0vF4Jy816CkYJdWfk/2BiCVVip0BLnL8A//8A2HmfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/wDYfJ8A2Hmf2HqfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/9h5nxoABhqA////AKJYIAMXCi51l7e349hMBTkdE5pisVfnh4bYwILync9MERMUAFgg7hVazpxAKSB0y2r/jJzN0nPIFkj/EUnvNrzqbruKPiUBWCDYftkmm+fgwSsSsBQx2QwFWHhnvtoPcpBPuBHJ7A+Z0KCA2HqA2HqA/wDYfJ8A2Hmf2HqfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/9h5nxoABhqA/////w==" + +hexPlutusScriptBytes :: Text +hexPlutusScriptBytes = + "590e73590e7001000032323322332233223232323232323232323232323225335533535353232325335333573466e1d200000201301213232323232333222123330010040030023232325335333573466e1d200000201b01a1323232323232323232323232323232323333333333332333233233222222222222222212333333333333333300101101000f00e00d00c00b00a00900800700600500400300230013574202860026ae8404cc0948c8c8c94cd4ccd5cd19b87480000080c40c04cc8848cc00400c008c074d5d080098029aba135744002260589201035054310035573c0046aae74004dd5000998128009aba101123232325335333573466e1d200000203002f13232333322221233330010050040030023232325335333573466e1d2000002035034133221233001003002302e357420026605e4646464a66a666ae68cdc3a4000004072070264244600400660646ae8400454cd4ccd5cd19b87480080080e40e04c8ccc888488ccc00401401000cdd69aba1002375a6ae84004dd69aba1357440026ae880044c0d12401035054310035573c0046aae74004dd50009aba135744002260609201035054310035573c0046aae74004dd51aba1003300735742004646464a66a666ae68cdc3a400000406a068224440062a66a666ae68cdc3a400400406a068264244460020086eb8d5d08008a99a999ab9a3370e900200101a81a099091118010021aba1001130304901035054310035573c0046aae74004dd51aba10013302c75c6ae84d5d10009aba200135744002260569201035054310035573c0046aae74004dd50009bad3574201e60026ae84038c008c009d69981180a9aba100c33302702475a6ae8402cc8c8c94cd4ccd5cd19b87480000080b80b44cc8848cc00400c008c8c8c94cd4ccd5cd19b87480000080c40c04cc8848cc00400c008cc09dd69aba10013026357426ae880044c0b1241035054310035573c0046aae74004dd51aba10013232325335333573466e1d20000020310301332212330010030023302775a6ae84004c098d5d09aba20011302c491035054310035573c0046aae74004dd51aba13574400226052921035054310035573c0046aae74004dd51aba100a3302375c6ae84024ccc09c8c8c8c94cd4ccd5cd19b87480000080bc0b84c84888888c01401cdd71aba100115335333573466e1d200200202f02e13212222223002007301b357420022a66a666ae68cdc3a400800405e05c2642444444600600e60506ae8400454cd4ccd5cd19b87480180080bc0b84cc884888888cc01802001cdd69aba10013019357426ae8800454cd4ccd5cd19b87480200080bc0b84c84888888c00401cc068d5d08008a99a999ab9a3370e9005001017817099910911111198020040039bad3574200260306ae84d5d1000898152481035054310035573c0046aae74004dd500080f9aba10083300201f3574200e6eb8d5d080319981380b198138111191919299a999ab9a3370e9000001017817089110010a99a999ab9a3370e9001001017817089110008a99a999ab9a3370e900200101781708911001898152481035054310035573c0046aae74004dd50009aba1005330230143574200860026ae8400cc004d5d09aba2003302475a604aeb8d5d10009aba2001357440026ae88004d5d10009aba2001357440026ae88004d5d10009aba2001357440026ae88004d5d10009aba200113016491035054310035573c0046aae74004dd51aba10063574200a646464a66a666ae68cdc3a40000040360342642444444600a00e6eb8d5d08008a99a999ab9a3370e900100100d80d0999109111111980100400398039aba10013301500f357426ae8800454cd4ccd5cd19b874801000806c0684c84888888c00c01cc050d5d08008a99a999ab9a3370e900300100d80d099910911111198030040039bad35742002600a6ae84d5d10008a99a999ab9a3370e900400100d80d0990911111180080398031aba100115335333573466e1d200a00201b01a13322122222233004008007375a6ae84004c010d5d09aba2001130164901035054310035573c0046aae74004dd51aba13574400a4646464a66a666ae68cdc3a4000004036034264666444246660020080060046eb4d5d0801180a9aba10013232325335333573466e1d200000201f01e1323332221222222233300300a0090083301a017357420046ae84004cc069d71aba1357440026ae8800454cd4ccd5cd19b874800800807c0784cc8848888888cc01c024020cc064058d5d0800991919299a999ab9a3370e90000010110108999109198008018011bad357420026eb4d5d09aba20011301d491035054310035573c0046aae74004dd51aba1357440022a66a666ae68cdc3a400800403e03c266442444444466004012010666036030eb4d5d08009980cbae357426ae8800454cd4ccd5cd19b874801800807c0784c848888888c010020cc064058d5d08008a99a999ab9a3370e900400100f80f09919199991110911111119998008058050048041980d80c1aba10033301901a3574200466603a034eb4d5d08009a991919299a999ab9a3370e90000010120118998149bad357420026eb4d5d09aba20011301f4901035054310035573c0046aae74004dd51aba135744002446602a0040026ae88004d5d10008a99a999ab9a3370e900500100f80f0999109111111198028048041980c80b1aba10013232325335333573466e1d200000202202113301c75c6ae840044c075241035054310035573c0046aae74004dd51aba1357440022a66a666ae68cdc3a401800403e03c22444444400c26034921035054310035573c0046aae74004dd51aba1357440026ae880044c059241035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100d00c899910911111111111980280680618099aba10013301475a6ae84d5d10008a99a999ab9a3370e900100100d00c899910911111111111980100680618099aba10013301475a6ae84d5d10008a9919a999ab9a3370e900200180d80d0999109111111111119805006806180a1aba10023001357426ae8800854cd4ccd5cd19b874801800c06c0684c8ccc888488888888888ccc018038034030c054d5d080198011aba1001375a6ae84d5d10009aba200215335333573466e1d200800301b01a133221222222222223300700d00c3014357420046eb4d5d09aba200215335333573466e1d200a00301b01a132122222222222300100c3014357420042a66a666ae68cdc3a4018006036034266442444444444446600601a01860286ae84008dd69aba1357440042a66a666ae68cdc3a401c006036034266442444444444446601201a0186eb8d5d08011bae357426ae8800854cd4ccd5cd19b874804000c06c0684cc88488888888888cc020034030dd71aba1002375a6ae84d5d10010a99a999ab9a3370e900900180d80d0999109111111111119805806806180a1aba10023014357426ae8800854cd4ccd5cd19b874805000c06c0684c8488888888888c010030c050d5d08010980b2481035054310023232325335333573466e1d200000201e01d13212223003004375c6ae8400454c8cd4ccd5cd19b874800800c07c0784c84888c004010c004d5d08010a99a999ab9a3370e900200180f80f099910911198010028021bae3574200460026ae84d5d10010980d2481035054310023232325335333573466e1d200000202202113212223003004301b357420022a66a666ae68cdc3a4004004044042224440042a66a666ae68cdc3a4008004044042224440022603a921035054310035573c0046aae74004dd50009aab9e00235573a0026ea8004d55cf0011aab9d00137540024646464a66a666ae68cdc3a40000040320302642444600600860246ae8400454cd4ccd5cd19b87480080080640604c84888c008010c048d5d08008a99a999ab9a3370e900200100c80c099091118008021bae3574200226028921035054310035573c0046aae74004dd50009191919299a999ab9a3370e900000100c00b8999109198008018011bae357420026eb4d5d09aba200113013491035054310035573c0046aae74004dd50009aba20011300e491035054310035573c0046aae74004dd50009110019111111111111111180f0031080888078a4c26016921035054350030142225335333573466e1d20000010110101300c491035054330015335333573466e20005200001101013300333702900000119b81480000044c8cc8848cc00400c008cdc200180099b840020013300400200130132225335333573466e1d200000101000f10021330030013370c00400240024646464a66a666ae68cdc3a400000401e01c201c2a66a666ae68cdc3a400400401e01c201e260149201035054310035573c0046aae74004dd500091191919299a999ab9a3370e9000001007807089110010a99a999ab9a3370e90010010078070990911180180218029aba100115335333573466e1d200400200f00e112220011300a4901035054310035573c0046aae74004dd50009191919299a999ab9a3370e90000010068060999109198008018011bae357420026eb4d5d09aba200113008491035054310035573c0046aae74004dd5000919118011bac001300f2233335573e002401c466a01a60086ae84008c00cd5d10010041191919299a999ab9a3370e900000100580509909118010019bae357420022a66a666ae68cdc3a400400401601426424460020066eb8d5d0800898032481035054310035573c0046aae74004dd500091191919299a999ab9a3370e90010010058050a8070a99a999ab9a3370e90000010058050980798029aba1001130064901035054310035573c0046aae74004dd5000919319ab9c00100322322300237560026018446666aae7c004802c8c8cd402ccc03cc018d55ce80098029aab9e0013004357440066ae8400801448004c020894cd40045401c884d4008894cd4ccd5cd19b8f4881210104312775add93ed57c301fab7501f74beb3dbc3a70a659ef36bcea6ebb8a3e25000020080071300c001130060031220021220011220021221223300100400321223002003112200122123300100300223230010012300223300200200101" + test_StakePoolMetadataValidationError :: TestTree test_StakePoolMetadataValidationError = testAllErrorMessages @StakePoolMetadataValidationError diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorEvaluationFailed.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorEvaluationFailed.txt index 660b0bb374..1ab8477c1c 100644 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorEvaluationFailed.txt +++ b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Fees.ScriptExecutionError/ScriptErrorEvaluationFailed.txt @@ -1,6 +1,59 @@ -The Plutus script evaluation failed: Cost model parameters were not as we expected -Script debugging logs: - - - - +Script hash: 581c6df41fc4a246b092be25af52ef47626f1d33d244c98d3885250f42ce +Script language: PlutusV3 +Protocol version: Version 9 +Script arguments: + ScriptInfo: CertifyingScript 0 (TxCertRegStaking (ScriptCredential c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50) (Just 400000)) + TxInfo: + TxId: d87ed9269be7e0c12b12b01431d90c05587867beda0f72904fb811c9ec0f99d0 + Inputs: [ a789d54c466c766fb4bc5e09cbcd7a0a46097567e4ff6062095562a7404b9cbf!0 -> - Value {getValue = Map {unMap = [(,Map {unMap = [("",5000000)]})]}} addressed to + ScriptCredential: c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50 (no staking credential) + with datum + datum hash: 03170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c111314 + with referenceScript + ] + Reference inputs: [] + Outputs: [ - Value {getValue = Map {unMap = [(,Map {unMap = [("",2000000)]}),(c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50,Map {unMap = [("MillarCoin",5)]})]}} addressed to + PubKeyCredential: c5bcaf94f20751ab72ca6e62995883a72b70b0d874ea68ea09790e93 (no staking credential) + with datum + no datum + with referenceScript + + , - Value {getValue = Map {unMap = [(,Map {unMap = [("",1000000)]})]}} addressed to + PubKeyCredential: c5bcaf94f20751ab72ca6e62995883a72b70b0d874ea68ea09790e93 (no staking credential) + with datum + datum hash: ee155ace9c40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e25 + with referenceScript + + , - Value {getValue = Map {unMap = [(,Map {unMap = [("",15000005000000)]})]}} addressed to + PubKeyCredential: 29233e5ff430dd25b9146f5f38de1235861deac704441ca0b06af912 (no staking credential) + with datum + no datum + with referenceScript + ] + Fee: 0 + Value minted: Value {getValue = Map {unMap = [(c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50,Map {unMap = [("MillarCoin",5)]})]}} + TxCerts: [ TxCertRegStaking (ScriptCredential c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50) (Just 400000) ] + Wdrl: [] + Valid range: (-∞ , +∞) + Signatories: [] + Redeemers: [ ( Spending (TxOutRef {txOutRefId = a789d54c466c766fb4bc5e09cbcd7a0a46097567e4ff6062095562a7404b9cbf, txOutRefIdx = 0}) + , 0 ) + , ( Minting c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50 + , 0 ) + , ( Certifying 0 (TxCertRegStaking (ScriptCredential c61bfa1c138524b69f378bc69504322f39289ce554d549db4d1e2b50) (Just 400000)) + , 0 ) ] + Datums: [ ( 03170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c111314 + , 0 ) + , ( ee155ace9c40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e25 + , 1 ) ] + Votes: [] + Proposal Procedures: [] + Current Treasury Amount: + Treasury Donation: + Redeemer: + 0 +Script evaluation error: Cost model parameters were not as we expected +Script execution logs: Example logs + +Script base64 encoded arguments: 2Hmf2Hmfn9h5n9h5n1ggp4nVTEZsdm+0vF4Jy816CkYJdWfk/2BiCVVip0BLnL8A/9h5n9h5n9h6n1gcxhv6HBOFJLafN4vGlQQyLzkonOVU1UnbTR4rUP/YeoD/oUChQBoATEtA2HqfWCADFwoudZe3t+PYTAU5HROaYrFX54eG2MCC8p3PTBETFP/YeoD///+An9h5n9h5n9h5n1gcxbyvlPIHUatyym5imViDpytwsNh06mjqCXkOk//YeoD/okChQBoAHoSAWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQoUpNaWxsYXJDb2luBdh5gNh6gP/YeZ/YeZ/YeZ9YHMW8r5TyB1GrcspuYplYg6crcLDYdOpo6gl5DpP/2HqA/6FAoUAaAA9CQNh6n1gg7hVazpxAKSB0y2r/jJzN0nPIFkj/EUnvNrzqbruKPiX/2HqA/9h5n9h5n9h5n1gcKSM+X/Qw3SW5FG9fON4SNYYd6scERBygsGr5Ev/YeoD/oUChQBsAAA2kdfg7QNh5gNh6gP//AKFYHMYb+hwThSS2nzeLxpUEMi85KJzlVNVJ200eK1ChSk1pbGxhckNvaW4Fn9h5n9h6n1gcxhv6HBOFJLafN4vGlQQyLzkonOVU1UnbTR4rUP/YeZ8aAAYagP///6DYeZ/YeZ/YeYDYeoD/2Hmf2HuA2HqA//+Ao9h6n9h5n1ggp4nVTEZsdm+0vF4Jy816CkYJdWfk/2BiCVVip0BLnL8A//8A2HmfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/wDYfJ8A2Hmf2HqfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/9h5nxoABhqA////AKJYIAMXCi51l7e349hMBTkdE5pisVfnh4bYwILync9MERMUAFgg7hVazpxAKSB0y2r/jJzN0nPIFkj/EUnvNrzqbruKPiUBWCDYftkmm+fgwSsSsBQx2QwFWHhnvtoPcpBPuBHJ7A+Z0KCA2HqA2HqA/wDYfJ8A2Hmf2HqfWBzGG/ocE4Uktp83i8aVBDIvOSic5VTVSdtNHitQ/9h5nxoABhqA/////w== +Script base64 encoded bytes: NTkwZTczNTkwZTcwMDEwMDAwMzIzMjMzMjIzMzIyMzMyMjMyMzIzMjMyMzIzMjMyMzIzMjMyMzIzMjMyMjUzMzU1MzM1MzUzNTMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDEzMDEyMTMyMzIzMjMyMzIzMzMyMjIxMjMzMzAwMTAwNDAwMzAwMjMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDFiMDFhMTMyMzIzMjMyMzIzMjMyMzIzMjMyMzIzMjMyMzIzMjMyMzMzMzMzMzMzMzMzMjMzMzIzMzIzMzIyMjIyMjIyMjIyMjIyMjIxMjMzMzMzMzMzMzMzMzMzMzMwMDEwMTEwMTAwMGYwMGUwMGQwMGMwMGIwMGEwMDkwMDgwMDcwMDYwMDUwMDQwMDMwMDIzMDAxMzU3NDIwMjg2MDAyNmFlODQwNGNjMDk0OGM4YzhjOTRjZDRjY2Q1Y2QxOWI4NzQ4MDAwMDA4MGM0MGMwNGNjODg0OGNjMDA0MDBjMDA4YzA3NGQ1ZDA4MDA5ODAyOWFiYTEzNTc0NDAwMjI2MDU4OTIwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUwMDA5OTgxMjgwMDlhYmExMDExMjMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDMwMDJmMTMyMzIzMzMzMjIyMjEyMzMzMzAwMTAwNTAwNDAwMzAwMjMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDM1MDM0MTMzMjIxMjMzMDAxMDAzMDAyMzAyZTM1NzQyMDAyNjYwNWU0NjQ2NDY0YTY2YTY2NmFlNjhjZGMzYTQwMDAwMDQwNzIwNzAyNjQyNDQ2MDA0MDA2NjA2NDZhZTg0MDA0NTRjZDRjY2Q1Y2QxOWI4NzQ4MDA4MDA4MGU0MGUwNGM4Y2NjODg4NDg4Y2NjMDA0MDE0MDEwMDBjZGQ2OWFiYTEwMDIzNzVhNmFlODQwMDRkZDY5YWJhMTM1NzQ0MDAyNmFlODgwMDQ0YzBkMTI0MDEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOWFiYTEzNTc0NDAwMjI2MDYwOTIwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUxYWJhMTAwMzMwMDczNTc0MjAwNDY0NjQ2NGE2NmE2NjZhZTY4Y2RjM2E0MDAwMDA0MDZhMDY4MjI0NDQwMDYyYTY2YTY2NmFlNjhjZGMzYTQwMDQwMDQwNmEwNjgyNjQyNDQ0NjAwMjAwODZlYjhkNWQwODAwOGE5OWE5OTlhYjlhMzM3MGU5MDAyMDAxMDFhODFhMDk5MDkxMTE4MDEwMDIxYWJhMTAwMTEzMDMwNDkwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUxYWJhMTAwMTMzMDJjNzVjNmFlODRkNWQxMDAwOWFiYTIwMDEzNTc0NDAwMjI2MDU2OTIwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUwMDA5YmFkMzU3NDIwMWU2MDAyNmFlODQwMzhjMDA4YzAwOWQ2OTk4MTE4MGE5YWJhMTAwYzMzMzAyNzAyNDc1YTZhZTg0MDJjYzhjOGM5NGNkNGNjZDVjZDE5Yjg3NDgwMDAwMDgwYjgwYjQ0Y2M4ODQ4Y2MwMDQwMGMwMDhjOGM4Yzk0Y2Q0Y2NkNWNkMTliODc0ODAwMDAwODBjNDBjMDRjYzg4NDhjYzAwNDAwYzAwOGNjMDlkZDY5YWJhMTAwMTMwMjYzNTc0MjZhZTg4MDA0NGMwYjEyNDEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MWFiYTEwMDEzMjMyMzI1MzM1MzMzNTczNDY2ZTFkMjAwMDAwMjAzMTAzMDEzMzIyMTIzMzAwMTAwMzAwMjMzMDI3NzVhNmFlODQwMDRjMDk4ZDVkMDlhYmEyMDAxMTMwMmM0OTEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MWFiYTEzNTc0NDAwMjI2MDUyOTIxMDM1MDU0MzEwMDM1NTczYzAwNDZhYWU3NDAwNGRkNTFhYmExMDBhMzMwMjM3NWM2YWU4NDAyNGNjYzA5YzhjOGM4Yzk0Y2Q0Y2NkNWNkMTliODc0ODAwMDAwODBiYzBiODRjODQ4ODg4ODhjMDE0MDFjZGQ3MWFiYTEwMDExNTMzNTMzMzU3MzQ2NmUxZDIwMDIwMDIwMmYwMmUxMzIxMjIyMjIyMzAwMjAwNzMwMWIzNTc0MjAwMjJhNjZhNjY2YWU2OGNkYzNhNDAwODAwNDA1ZTA1YzI2NDI0NDQ0NDQ2MDA2MDBlNjA1MDZhZTg0MDA0NTRjZDRjY2Q1Y2QxOWI4NzQ4MDE4MDA4MGJjMGI4NGNjODg0ODg4ODg4Y2MwMTgwMjAwMWNkZDY5YWJhMTAwMTMwMTkzNTc0MjZhZTg4MDA0NTRjZDRjY2Q1Y2QxOWI4NzQ4MDIwMDA4MGJjMGI4NGM4NDg4ODg4OGMwMDQwMWNjMDY4ZDVkMDgwMDhhOTlhOTk5YWI5YTMzNzBlOTAwNTAwMTAxNzgxNzA5OTkxMDkxMTExMTE5ODAyMDA0MDAzOWJhZDM1NzQyMDAyNjAzMDZhZTg0ZDVkMTAwMDg5ODE1MjQ4MTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUwMDA4MGY5YWJhMTAwODMzMDAyMDFmMzU3NDIwMGU2ZWI4ZDVkMDgwMzE5OTgxMzgwYjE5ODEzODExMTE5MTkxOTI5OWE5OTlhYjlhMzM3MGU5MDAwMDAxMDE3ODE3MDg5MTEwMDEwYTk5YTk5OWFiOWEzMzcwZTkwMDEwMDEwMTc4MTcwODkxMTAwMDhhOTlhOTk5YWI5YTMzNzBlOTAwMjAwMTAxNzgxNzA4OTExMDAxODk4MTUyNDgxMDM1MDU0MzEwMDM1NTczYzAwNDZhYWU3NDAwNGRkNTAwMDlhYmExMDA1MzMwMjMwMTQzNTc0MjAwODYwMDI2YWU4NDAwY2MwMDRkNWQwOWFiYTIwMDMzMDI0NzVhNjA0YWViOGQ1ZDEwMDA5YWJhMjAwMTM1NzQ0MDAyNmFlODgwMDRkNWQxMDAwOWFiYTIwMDEzNTc0NDAwMjZhZTg4MDA0ZDVkMTAwMDlhYmEyMDAxMzU3NDQwMDI2YWU4ODAwNGQ1ZDEwMDA5YWJhMjAwMTEzMDE2NDkxMDM1MDU0MzEwMDM1NTczYzAwNDZhYWU3NDAwNGRkNTFhYmExMDA2MzU3NDIwMGE2NDY0NjRhNjZhNjY2YWU2OGNkYzNhNDAwMDAwNDAzNjAzNDI2NDI0NDQ0NDQ2MDBhMDBlNmViOGQ1ZDA4MDA4YTk5YTk5OWFiOWEzMzcwZTkwMDEwMDEwMGQ4MGQwOTk5MTA5MTExMTExOTgwMTAwNDAwMzk4MDM5YWJhMTAwMTMzMDE1MDBmMzU3NDI2YWU4ODAwNDU0Y2Q0Y2NkNWNkMTliODc0ODAxMDAwODA2YzA2ODRjODQ4ODg4ODhjMDBjMDFjYzA1MGQ1ZDA4MDA4YTk5YTk5OWFiOWEzMzcwZTkwMDMwMDEwMGQ4MGQwOTk5MTA5MTExMTExOTgwMzAwNDAwMzliYWQzNTc0MjAwMjYwMGE2YWU4NGQ1ZDEwMDA4YTk5YTk5OWFiOWEzMzcwZTkwMDQwMDEwMGQ4MGQwOTkwOTExMTExMTgwMDgwMzk4MDMxYWJhMTAwMTE1MzM1MzMzNTczNDY2ZTFkMjAwYTAwMjAxYjAxYTEzMzIyMTIyMjIyMjMzMDA0MDA4MDA3Mzc1YTZhZTg0MDA0YzAxMGQ1ZDA5YWJhMjAwMTEzMDE2NDkwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUxYWJhMTM1NzQ0MDBhNDY0NjQ2NGE2NmE2NjZhZTY4Y2RjM2E0MDAwMDA0MDM2MDM0MjY0NjY2NDQ0MjQ2NjYwMDIwMDgwMDYwMDQ2ZWI0ZDVkMDgwMTE4MGE5YWJhMTAwMTMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDFmMDFlMTMyMzMzMjIyMTIyMjIyMjIzMzMwMDMwMGEwMDkwMDgzMzAxYTAxNzM1NzQyMDA0NmFlODQwMDRjYzA2OWQ3MWFiYTEzNTc0NDAwMjZhZTg4MDA0NTRjZDRjY2Q1Y2QxOWI4NzQ4MDA4MDA4MDdjMDc4NGNjODg0ODg4ODg4OGNjMDFjMDI0MDIwY2MwNjQwNThkNWQwODAwOTkxOTE5Mjk5YTk5OWFiOWEzMzcwZTkwMDAwMDEwMTEwMTA4OTk5MTA5MTk4MDA4MDE4MDExYmFkMzU3NDIwMDI2ZWI0ZDVkMDlhYmEyMDAxMTMwMWQ0OTEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MWFiYTEzNTc0NDAwMjJhNjZhNjY2YWU2OGNkYzNhNDAwODAwNDAzZTAzYzI2NjQ0MjQ0NDQ0NDQ2NjAwNDAxMjAxMDY2NjAzNjAzMGViNGQ1ZDA4MDA5OTgwY2JhZTM1NzQyNmFlODgwMDQ1NGNkNGNjZDVjZDE5Yjg3NDgwMTgwMDgwN2MwNzg0Yzg0ODg4ODg4OGMwMTAwMjBjYzA2NDA1OGQ1ZDA4MDA4YTk5YTk5OWFiOWEzMzcwZTkwMDQwMDEwMGY4MGYwOTkxOTE5OTk5MTExMDkxMTExMTExOTk5ODAwODA1ODA1MDA0ODA0MTk4MGQ4MGMxYWJhMTAwMzMzMDE5MDFhMzU3NDIwMDQ2NjYwM2EwMzRlYjRkNWQwODAwOWE5OTE5MTkyOTlhOTk5YWI5YTMzNzBlOTAwMDAwMTAxMjAxMTg5OTgxNDliYWQzNTc0MjAwMjZlYjRkNWQwOWFiYTIwMDExMzAxZjQ5MDEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MWFiYTEzNTc0NDAwMjQ0NjYwMmEwMDQwMDI2YWU4ODAwNGQ1ZDEwMDA4YTk5YTk5OWFiOWEzMzcwZTkwMDUwMDEwMGY4MGYwOTk5MTA5MTExMTExMTk4MDI4MDQ4MDQxOTgwYzgwYjFhYmExMDAxMzIzMjMyNTMzNTMzMzU3MzQ2NmUxZDIwMDAwMDIwMjIwMjExMzMwMWM3NWM2YWU4NDAwNDRjMDc1MjQxMDM1MDU0MzEwMDM1NTczYzAwNDZhYWU3NDAwNGRkNTFhYmExMzU3NDQwMDIyYTY2YTY2NmFlNjhjZGMzYTQwMTgwMDQwM2UwM2MyMjQ0NDQ0NDQwMGMyNjAzNDkyMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUxYWJhMTM1NzQ0MDAyNmFlODgwMDQ0YzA1OTI0MTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUwMDA5MTkxOTE5Mjk5YTk5OWFiOWEzMzcwZTkwMDAwMDEwMGQwMGM4OTk5MTA5MTExMTExMTExMTE5ODAyODA2ODA2MTgwOTlhYmExMDAxMzMwMTQ3NWE2YWU4NGQ1ZDEwMDA4YTk5YTk5OWFiOWEzMzcwZTkwMDEwMDEwMGQwMGM4OTk5MTA5MTExMTExMTExMTE5ODAxMDA2ODA2MTgwOTlhYmExMDAxMzMwMTQ3NWE2YWU4NGQ1ZDEwMDA4YTk5MTlhOTk5YWI5YTMzNzBlOTAwMjAwMTgwZDgwZDA5OTkxMDkxMTExMTExMTExMTk4MDUwMDY4MDYxODBhMWFiYTEwMDIzMDAxMzU3NDI2YWU4ODAwODU0Y2Q0Y2NkNWNkMTliODc0ODAxODAwYzA2YzA2ODRjOGNjYzg4ODQ4ODg4ODg4ODg4OGNjYzAxODAzODAzNDAzMGMwNTRkNWQwODAxOTgwMTFhYmExMDAxMzc1YTZhZTg0ZDVkMTAwMDlhYmEyMDAyMTUzMzUzMzM1NzM0NjZlMWQyMDA4MDAzMDFiMDFhMTMzMjIxMjIyMjIyMjIyMjIzMzAwNzAwZDAwYzMwMTQzNTc0MjAwNDZlYjRkNWQwOWFiYTIwMDIxNTMzNTMzMzU3MzQ2NmUxZDIwMGEwMDMwMWIwMWExMzIxMjIyMjIyMjIyMjIzMDAxMDBjMzAxNDM1NzQyMDA0MmE2NmE2NjZhZTY4Y2RjM2E0MDE4MDA2MDM2MDM0MjY2NDQyNDQ0NDQ0NDQ0NDQ2NjAwNjAxYTAxODYwMjg2YWU4NDAwOGRkNjlhYmExMzU3NDQwMDQyYTY2YTY2NmFlNjhjZGMzYTQwMWMwMDYwMzYwMzQyNjY0NDI0NDQ0NDQ0NDQ0NDY2MDEyMDFhMDE4NmViOGQ1ZDA4MDExYmFlMzU3NDI2YWU4ODAwODU0Y2Q0Y2NkNWNkMTliODc0ODA0MDAwYzA2YzA2ODRjYzg4NDg4ODg4ODg4ODg4Y2MwMjAwMzQwMzBkZDcxYWJhMTAwMjM3NWE2YWU4NGQ1ZDEwMDEwYTk5YTk5OWFiOWEzMzcwZTkwMDkwMDE4MGQ4MGQwOTk5MTA5MTExMTExMTExMTE5ODA1ODA2ODA2MTgwYTFhYmExMDAyMzAxNDM1NzQyNmFlODgwMDg1NGNkNGNjZDVjZDE5Yjg3NDgwNTAwMGMwNmMwNjg0Yzg0ODg4ODg4ODg4ODhjMDEwMDMwYzA1MGQ1ZDA4MDEwOTgwYjI0ODEwMzUwNTQzMTAwMjMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDFlMDFkMTMyMTIyMjMwMDMwMDQzNzVjNmFlODQwMDQ1NGM4Y2Q0Y2NkNWNkMTliODc0ODAwODAwYzA3YzA3ODRjODQ4ODhjMDA0MDEwYzAwNGQ1ZDA4MDEwYTk5YTk5OWFiOWEzMzcwZTkwMDIwMDE4MGY4MGYwOTk5MTA5MTExOTgwMTAwMjgwMjFiYWUzNTc0MjAwNDYwMDI2YWU4NGQ1ZDEwMDEwOTgwZDI0ODEwMzUwNTQzMTAwMjMyMzIzMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAyMDIyMDIxMTMyMTIyMjMwMDMwMDQzMDFiMzU3NDIwMDIyYTY2YTY2NmFlNjhjZGMzYTQwMDQwMDQwNDQwNDIyMjQ0NDAwNDJhNjZhNjY2YWU2OGNkYzNhNDAwODAwNDA0NDA0MjIyNDQ0MDAyMjYwM2E5MjEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOWFhYjllMDAyMzU1NzNhMDAyNmVhODAwNGQ1NWNmMDAxMWFhYjlkMDAxMzc1NDAwMjQ2NDY0NjRhNjZhNjY2YWU2OGNkYzNhNDAwMDAwNDAzMjAzMDI2NDI0NDQ2MDA2MDA4NjAyNDZhZTg0MDA0NTRjZDRjY2Q1Y2QxOWI4NzQ4MDA4MDA4MDY0MDYwNGM4NDg4OGMwMDgwMTBjMDQ4ZDVkMDgwMDhhOTlhOTk5YWI5YTMzNzBlOTAwMjAwMTAwYzgwYzA5OTA5MTExODAwODAyMWJhZTM1NzQyMDAyMjYwMjg5MjEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTE5MTkxOTI5OWE5OTlhYjlhMzM3MGU5MDAwMDAxMDBjMDBiODk5OTEwOTE5ODAwODAxODAxMWJhZTM1NzQyMDAyNmViNGQ1ZDA5YWJhMjAwMTEzMDEzNDkxMDM1MDU0MzEwMDM1NTczYzAwNDZhYWU3NDAwNGRkNTAwMDlhYmEyMDAxMTMwMGU0OTEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTExMDAxOTExMTExMTExMTExMTExMTE4MGYwMDMxMDgwODg4MDc4YTRjMjYwMTY5MjEwMzUwNTQzNTAwMzAxNDIyMjUzMzUzMzM1NzM0NjZlMWQyMDAwMDAxMDExMDEwMTMwMGM0OTEwMzUwNTQzMzAwMTUzMzUzMzM1NzM0NjZlMjAwMDUyMDAwMDExMDEwMTMzMDAzMzM3MDI5MDAwMDAxMTliODE0ODAwMDAwNDRjOGNjODg0OGNjMDA0MDBjMDA4Y2RjMjAwMTgwMDk5Yjg0MDAyMDAxMzMwMDQwMDIwMDEzMDEzMjIyNTMzNTMzMzU3MzQ2NmUxZDIwMDAwMDEwMTAwMGYxMDAyMTMzMDAzMDAxMzM3MGMwMDQwMDI0MDAyNDY0NjQ2NGE2NmE2NjZhZTY4Y2RjM2E0MDAwMDA0MDFlMDFjMjAxYzJhNjZhNjY2YWU2OGNkYzNhNDAwNDAwNDAxZTAxYzIwMWUyNjAxNDkyMDEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTExOTE5MTkyOTlhOTk5YWI5YTMzNzBlOTAwMDAwMTAwNzgwNzA4OTExMDAxMGE5OWE5OTlhYjlhMzM3MGU5MDAxMDAxMDA3ODA3MDk5MDkxMTE4MDE4MDIxODAyOWFiYTEwMDExNTMzNTMzMzU3MzQ2NmUxZDIwMDQwMDIwMGYwMGUxMTIyMjAwMTEzMDBhNDkwMTAzNTA1NDMxMDAzNTU3M2MwMDQ2YWFlNzQwMDRkZDUwMDA5MTkxOTE5Mjk5YTk5OWFiOWEzMzcwZTkwMDAwMDEwMDY4MDYwOTk5MTA5MTk4MDA4MDE4MDExYmFlMzU3NDIwMDI2ZWI0ZDVkMDlhYmEyMDAxMTMwMDg0OTEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTE5MTE4MDExYmFjMDAxMzAwZjIyMzMzMzU1NzNlMDAyNDAxYzQ2NmEwMWE2MDA4NmFlODQwMDhjMDBjZDVkMTAwMTAwNDExOTE5MTkyOTlhOTk5YWI5YTMzNzBlOTAwMDAwMTAwNTgwNTA5OTA5MTE4MDEwMDE5YmFlMzU3NDIwMDIyYTY2YTY2NmFlNjhjZGMzYTQwMDQwMDQwMTYwMTQyNjQyNDQ2MDAyMDA2NmViOGQ1ZDA4MDA4OTgwMzI0ODEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTExOTE5MTkyOTlhOTk5YWI5YTMzNzBlOTAwMTAwMTAwNTgwNTBhODA3MGE5OWE5OTlhYjlhMzM3MGU5MDAwMDAxMDA1ODA1MDk4MDc5ODAyOWFiYTEwMDExMzAwNjQ5MDEwMzUwNTQzMTAwMzU1NzNjMDA0NmFhZTc0MDA0ZGQ1MDAwOTE5MzE5YWI5YzAwMTAwMzIyMzIyMzAwMjM3NTYwMDI2MDE4NDQ2NjY2YWFlN2MwMDQ4MDJjOGM4Y2Q0MDJjY2MwM2NjMDE4ZDU1Y2U4MDA5ODAyOWFhYjllMDAxMzAwNDM1NzQ0MDA2NmFlODQwMDgwMTQ0ODAwNGMwMjA4OTRjZDQwMDQ1NDAxYzg4NGQ0MDA4ODk0Y2Q0Y2NkNWNkMTliOGY0ODgxMjEwMTA0MzEyNzc1YWRkOTNlZDU3YzMwMWZhYjc1MDFmNzRiZWIzZGJjM2E3MGE2NTllZjM2YmNlYTZlYmI4YTNlMjUwMDAwMjAwODAwNzEzMDBjMDAxMTMwMDYwMDMxMjIwMDIxMjIwMDExMjIwMDIxMjIxMjIzMzAwMTAwNDAwMzIxMjIzMDAyMDAzMTEyMjAwMTIyMTIzMzAwMTAwMzAwMjIzMjMwMDEwMDEyMzAwMjIzMzAwMjAwMjAwMTAx From bd03c7416dc7bb587717112b6f80491121f3a4a3 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Tue, 19 Nov 2024 10:25:15 -0400 Subject: [PATCH 04/11] readFile on windows ghc 8.10.7 was using the system default encoding rather than UTF-8 We fix this by explicitly specifying UTF-8 on reading and writing golden files --- cardano-api/cardano-api.cabal | 2 + .../gen/Test/Hedgehog/Golden/ErrorMessage.hs | 133 +++++++++++++++++- 2 files changed, 130 insertions(+), 5 deletions(-) diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 6bff1535b3..99a03e84d2 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -280,6 +280,7 @@ library gen Test.Hedgehog.Roundtrip.CBOR build-depends: + Diff, QuickCheck, aeson >=1.5.6.0, base16-bytestring, @@ -295,6 +296,7 @@ library gen cardano-ledger-core:{cardano-ledger-core, testlib} >=1.14, cardano-ledger-shelley >=1.13, containers, + directory, filepath, hedgehog >=1.1, hedgehog-extras, diff --git a/cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs b/cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs index afb3d58de9..173b265202 100644 --- a/cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs +++ b/cardano-api/gen/Test/Hedgehog/Golden/ErrorMessage.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Hedgehog.Golden.ErrorMessage where @@ -5,13 +6,27 @@ module Test.Hedgehog.Golden.ErrorMessage where import Cardano.Api (Error (..)) import Cardano.Api.Pretty +import qualified Control.Concurrent.QSem as IO +import Control.Exception (bracket_) +import Control.Monad +import Control.Monad.IO.Class +import Data.Algorithm.Diff (PolyDiff (Both), getGroupedDiff) +import Data.Algorithm.DiffOutput (ppDiff) import Data.Data +import qualified Data.List as List +import qualified Data.Text as Text +import qualified Data.Text.IO as Text import GHC.Stack (HasCallStack, withFrozenCallStack) -import System.FilePath (()) +import qualified GHC.Stack as GHC +import qualified System.Directory as IO +import qualified System.Environment as IO +import System.FilePath (takeDirectory, ()) +import qualified System.IO as IO +import qualified System.IO.Unsafe as IO import Hedgehog -import qualified Hedgehog.Extras.Test.Base as H -import qualified Hedgehog.Extras.Test.Golden as H +import qualified Hedgehog.Extras.Test as H +import qualified Hedgehog.Internal.Property as H import Test.Tasty import Test.Tasty.Hedgehog @@ -97,6 +112,114 @@ testErrorMessage_ goldenFilesLocation moduleName typeName constructorName err = let fqtn = moduleName <> "." <> typeName testProperty constructorName . withTests 1 . property $ do H.note_ "Incorrect error message in golden file" - H.diffVsGoldenFile - (docToString (prettyError err)) + H.note_ "What the value looks like in memory" + let pErr = docToString (prettyError err) + H.note_ $ show pErr + diffVsGoldenFile + pErr (goldenFilesLocation fqtn constructorName <> ".txt") + +-- TODO: Upstream all to hedgehog-extras +diffVsGoldenFile + :: HasCallStack + => (MonadIO m, MonadTest m) + => String + -- ^ Actual content + -> FilePath + -- ^ Reference file + -> m () +diffVsGoldenFile actualContent goldenFile = GHC.withFrozenCallStack $ do + forM_ mGoldenFileLogFile $ \logFile -> + liftIO $ semBracket $ IO.appendFile logFile $ goldenFile <> "\n" + + fileExists <- liftIO $ IO.doesFileExist goldenFile + + if + | recreateGoldenFiles -> writeGoldenFile goldenFile actualContent + | fileExists -> checkAgainstGoldenFile goldenFile actualLines + | createGoldenFiles -> writeGoldenFile goldenFile actualContent + | otherwise -> reportGoldenFileMissing goldenFile + where + actualLines = List.lines actualContent + +writeGoldenFile + :: () + => HasCallStack + => MonadIO m + => MonadTest m + => FilePath + -> String + -> m () +writeGoldenFile goldenFile actualContent = GHC.withFrozenCallStack $ do + H.note_ $ "Creating golden file " <> goldenFile + H.createDirectoryIfMissing_ (takeDirectory goldenFile) + writeFile' goldenFile actualContent + +recreateGoldenFiles :: Bool +recreateGoldenFiles = IO.unsafePerformIO $ do + value <- IO.lookupEnv "RECREATE_GOLDEN_FILES" + return $ value == Just "1" + +createGoldenFiles :: Bool +createGoldenFiles = IO.unsafePerformIO $ do + value <- IO.lookupEnv "CREATE_GOLDEN_FILES" + return $ value == Just "1" + +writeFile' :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m () +writeFile' filePath contents = GHC.withFrozenCallStack $ do + void . H.annotate $ "Writing file: " <> filePath + H.evalIO $ IO.withFile filePath IO.WriteMode $ \handle -> do + IO.hSetEncoding handle IO.utf8 + IO.hPutStr handle contents + +checkAgainstGoldenFile + :: () + => HasCallStack + => MonadIO m + => MonadTest m + => FilePath + -> [String] + -> m () +checkAgainstGoldenFile goldenFile actualLines = GHC.withFrozenCallStack $ do + referenceLines <- liftIO $ IO.withFile goldenFile IO.ReadMode $ \handle -> do + IO.hSetEncoding handle IO.utf8 + List.lines . Text.unpack <$> Text.hGetContents handle + let difference = getGroupedDiff actualLines referenceLines + case difference of + [] -> pure () + [Both{}] -> pure () + _ -> do + H.note_ $ + unlines + [ "Golden test failed against the golden file." + , "To recreate golden file, run with RECREATE_GOLDEN_FILES=1." + ] + H.failMessage GHC.callStack $ ppDiff difference + +sem :: IO.QSem +sem = IO.unsafePerformIO $ IO.newQSem 1 +{-# NOINLINE sem #-} + +semBracket :: IO a -> IO a +semBracket = bracket_ (IO.waitQSem sem) (IO.signalQSem sem) + +mGoldenFileLogFile :: Maybe FilePath +mGoldenFileLogFile = + IO.unsafePerformIO $ + IO.lookupEnv "GOLDEN_FILE_LOG_FILE" + +reportGoldenFileMissing + :: () + => HasCallStack + => MonadIO m + => MonadTest m + => FilePath + -> m () +reportGoldenFileMissing goldenFile = GHC.withFrozenCallStack $ do + H.note_ $ + unlines + [ "Golden file " <> goldenFile <> " does not exist." + , "To create it, run with CREATE_GOLDEN_FILES=1." + , "To recreate it, run with RECREATE_GOLDEN_FILES=1." + ] + H.failure From cfd2778e1a237f537d84ad35e96936b02d31c315 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Mon, 11 Nov 2024 14:52:16 -0400 Subject: [PATCH 05/11] Propagate IsPlutusLanguage constraint --- cardano-api/internal/Cardano/Api/Script.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index dc1d12c9a2..dfe3df1a84 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -228,7 +228,8 @@ instance HasTypeProxy PlutusScriptV3 where -- data ScriptLanguage lang where SimpleScriptLanguage :: ScriptLanguage SimpleScript' - PlutusScriptLanguage :: PlutusScriptVersion lang -> ScriptLanguage lang + PlutusScriptLanguage + :: IsPlutusScriptLanguage lang => PlutusScriptVersion lang -> ScriptLanguage lang deriving instance (Eq (ScriptLanguage lang)) @@ -285,7 +286,8 @@ instance Bounded AnyScriptLanguage where data AnyPlutusScriptVersion where AnyPlutusScriptVersion - :: PlutusScriptVersion lang + :: IsPlutusScriptLanguage lang + => PlutusScriptVersion lang -> AnyPlutusScriptVersion deriving instance (Show AnyPlutusScriptVersion) @@ -407,7 +409,8 @@ data Script lang where :: !SimpleScript -> Script SimpleScript' PlutusScript - :: !(PlutusScriptVersion lang) + :: IsPlutusScriptLanguage lang + => !(PlutusScriptVersion lang) -> !(PlutusScript lang) -> Script lang @@ -721,7 +724,8 @@ data ScriptWitness witctx era where -> SimpleScriptOrReferenceInput SimpleScript' -> ScriptWitness witctx era PlutusScriptWitness - :: ScriptLanguageInEra lang era + :: IsPlutusScriptLanguage lang + => ScriptLanguageInEra lang era -> PlutusScriptVersion lang -> PlutusScriptOrReferenceInput lang -> ScriptDatum witctx From a374fb6ab68d02a5aefa67cac59689fe227ae538 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 25 Oct 2024 11:51:52 +0200 Subject: [PATCH 06/11] Refactor `TxMintValue` to better represent minting state --- cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 42 +++++++-- cardano-api/internal/Cardano/Api/Fees.hs | 42 +++------ cardano-api/internal/Cardano/Api/Script.hs | 17 ++-- cardano-api/internal/Cardano/Api/Tx/Body.hs | 94 ++++++++++++------- cardano-api/internal/Cardano/Api/Value.hs | 3 +- cardano-api/src/Cardano/Api.hs | 3 + .../Cardano/Api/Transaction/Autobalance.hs | 6 +- 7 files changed, 123 insertions(+), 84 deletions(-) diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 4a1f5caaa1..815f42d9cc 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -662,11 +662,18 @@ genTxMintValue :: CardanoEra era -> Gen (TxMintValue BuildTx era) genTxMintValue = inEonForEra (pure TxMintNone) - $ \supported -> + $ \w -> do + policies <- Gen.list (Range.constant 1 3) genPolicyId + assets <- forM policies $ \policy -> + (,) policy <$> + Gen.list + (Range.constant 1 3) + ((,,) <$> genAssetName + <*> genPositiveQuantity + <*> fmap (fmap pure) genScriptWitnessForMint (maryEraOnwardsToShelleyBasedEra w)) Gen.choice [ pure TxMintNone - -- TODO write a generator for the last parameter of 'TxMintValue' constructor - , TxMintValue supported <$> genValueForMinting <*> return (pure mempty) + , pure $ TxMintValue w (fromList assets) ] genTxBodyContent :: ShelleyBasedEra era -> Gen (TxBodyContent BuildTx era) @@ -1196,13 +1203,13 @@ genScriptWitnessForStake sbe = do SimpleScript simpleScript -> do simpleScriptOrReferenceInput <- Gen.choice [ pure $ SScript simpleScript - , SReferenceScript <$> genTxIn <*> Gen.maybe genScriptHash + , SReferenceScript <$> genTxIn ] pure $ Api.SimpleScriptWitness scriptLangInEra simpleScriptOrReferenceInput PlutusScript plutusScriptVersion' plutusScript -> do plutusScriptOrReferenceInput <- Gen.choice [ pure $ PScript plutusScript - , PReferenceScript <$> genTxIn <*> Gen.maybe genScriptHash + , PReferenceScript <$> genTxIn ] scriptRedeemer <- genHashableScriptData PlutusScriptWitness @@ -1213,6 +1220,27 @@ genScriptWitnessForStake sbe = do scriptRedeemer <$> genExecutionUnits - - +genScriptWitnessForMint :: ShelleyBasedEra era -> Gen (Api.ScriptWitness WitCtxMint era) +genScriptWitnessForMint sbe = do + ScriptInEra scriptLangInEra script' <- genScriptInEra sbe + case script' of + SimpleScript simpleScript -> do + simpleScriptOrReferenceInput <- Gen.choice + [ pure $ SScript simpleScript + , SReferenceScript <$> genTxIn + ] + pure $ Api.SimpleScriptWitness scriptLangInEra simpleScriptOrReferenceInput + PlutusScript plutusScriptVersion' plutusScript -> do + plutusScriptOrReferenceInput <- Gen.choice + [ pure $ PScript plutusScript + , PReferenceScript <$> genTxIn + ] + scriptRedeemer <- genHashableScriptData + PlutusScriptWitness + scriptLangInEra + plutusScriptVersion' + plutusScriptOrReferenceInput + NoScriptDatumForMint + scriptRedeemer + <$> genExecutionUnits diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index f026efde5c..3e44dc189c 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -8,6 +8,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TupleSections #-} -- | Fee calculation module Cardano.Api.Fees @@ -1320,10 +1321,8 @@ calculateChangeValue :: ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value calculateChangeValue sbe incoming txbodycontent = let outgoing = calculateCreatedUTOValue sbe txbodycontent - minted = case txMintValue txbodycontent of - TxMintNone -> mempty - TxMintValue _ v _ -> v - in mconcat [incoming, minted, negateValue outgoing] + mintedValue = txMintValueToValue $ txMintValue txbodycontent + in mconcat [incoming, mintedValue, negateValue outgoing] -- | This is used in the balance calculation in the event where -- the user does not supply the UTxO(s) they intend to spend @@ -1593,33 +1592,20 @@ substituteExecutionUnits :: TxMintValue BuildTx era -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era) mapScriptWitnessesMinting TxMintNone = Right TxMintNone - mapScriptWitnessesMinting - ( TxMintValue - supported - value - (BuildTxWith witnesses) - ) = - -- TxMintValue supported value $ BuildTxWith $ fromList - let mappedScriptWitnesses - :: [(PolicyId, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))] - mappedScriptWitnesses = - [ (policyid, witness') - | -- The minting policies are indexed in policy id order in the value - let ValueNestedRep bundle = valueToNestedRep value - , (ix, ValueNestedBundle policyid _) <- zip [0 ..] bundle - , witness <- maybeToList (Map.lookup policyid witnesses) - , let witness' = substituteExecUnits (ScriptWitnessIndexMint ix) witness - ] - in do - final <- traverseScriptWitnesses mappedScriptWitnesses - Right . TxMintValue supported value . BuildTxWith $ - fromList final + mapScriptWitnessesMinting txMintValue'@(TxMintValue w _) = do + let mappedScriptWitnesses = + [ (policyId, pure . (assetName',quantity,) <$> substitutedWitness) + | (ix, policyId, assetName', quantity, BuildTxWith witness) <- txMintValueToIndexed txMintValue' + , let substitutedWitness = BuildTxWith <$> substituteExecUnits ix witness + ] + final <- Map.fromListWith (<>) <$> traverseScriptWitnesses mappedScriptWitnesses + pure $ TxMintValue w final traverseScriptWitnesses - :: [(a, Either (TxBodyErrorAutoBalance era) (ScriptWitness ctx era))] - -> Either (TxBodyErrorAutoBalance era) [(a, ScriptWitness ctx era)] + :: [(a, Either (TxBodyErrorAutoBalance era) b)] + -> Either (TxBodyErrorAutoBalance era) [(a, b)] traverseScriptWitnesses = - traverse (\(item, eScriptWitness) -> eScriptWitness >>= (\sWit -> Right (item, sWit))) + traverse (\(item, eRes) -> eRes >>= (\res -> Right (item, res))) calculateMinimumUTxO :: ShelleyBasedEra era diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index dfe3df1a84..a1de27f666 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -54,6 +54,7 @@ module Cardano.Api.Script , WitCtxMint , WitCtxStake , WitCtx (..) + , WitCtxMaybe (..) , ScriptWitness (..) , Witness (..) , KeyWitnessInCtx (..) @@ -165,7 +166,7 @@ import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) +import Data.Type.Equality (TestEquality (..), type (==), (:~:) (Refl)) import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Exts (IsList (..)) @@ -688,20 +689,18 @@ data PlutusScriptOrReferenceInput lang | -- | Needed to construct the redeemer pointer map -- in the case of minting reference scripts where we don't -- have direct access to the script - PReferenceScript - TxIn - (Maybe ScriptHash) + PReferenceScript TxIn deriving (Eq, Show) data SimpleScriptOrReferenceInput lang = SScript SimpleScript - | SReferenceScript TxIn (Maybe ScriptHash) + | SReferenceScript TxIn deriving (Eq, Show) getScriptWitnessReferenceInput :: ScriptWitness witctx era -> Maybe TxIn -getScriptWitnessReferenceInput (SimpleScriptWitness _ (SReferenceScript txIn _)) = +getScriptWitnessReferenceInput (SimpleScriptWitness _ (SReferenceScript txIn)) = Just txIn -getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PReferenceScript txIn _) _ _ _) = +getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _) = Just txIn getScriptWitnessReferenceInput (SimpleScriptWitness _ (SScript _)) = Nothing getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PScript _) _ _ _) = Nothing @@ -804,9 +803,9 @@ scriptWitnessScript (SimpleScriptWitness SimpleScriptInConway (SScript script)) Just $ ScriptInEra SimpleScriptInConway (SimpleScript script) scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) = Just $ ScriptInEra langInEra (PlutusScript version script) -scriptWitnessScript (SimpleScriptWitness _ (SReferenceScript _ _)) = +scriptWitnessScript (SimpleScriptWitness _ (SReferenceScript _)) = Nothing -scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _ _) _ _ _) = +scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) = Nothing -- ---------------------------------------------------------------------------- diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 4189434b60..1ee6d790dd 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -111,6 +111,8 @@ module Cardano.Api.Tx.Body , TxCertificates (..) , TxUpdateProposal (..) , TxMintValue (..) + , txMintValueToValue + , txMintValueToIndexed , TxVotingProcedures (..) , mkTxVotingProcedures , TxProposalProcedures (..) @@ -1248,16 +1250,46 @@ data TxMintValue build era where TxMintNone :: TxMintValue build era TxMintValue :: MaryEraOnwards era - -> Value - -> BuildTxWith - build - (Map PolicyId (ScriptWitness WitCtxMint era)) + -> Map + PolicyId + [ ( AssetName + , Quantity + , BuildTxWith build (ScriptWitness WitCtxMint era) + ) + ] -> TxMintValue build era deriving instance Eq (TxMintValue build era) deriving instance Show (TxMintValue build era) +-- | Convert 'TxMintValue' to a more handy 'Value'. +txMintValueToValue :: TxMintValue build era -> Value +txMintValueToValue TxMintNone = mempty +txMintValueToValue (TxMintValue _ policiesWithAssets) = + fromList + [ (AssetId policyId' assetName', quantity) + | (policyId', assets) <- toList policiesWithAssets + , (assetName', quantity, _) <- assets + ] + +-- | Index the assets with witnesses in the order of policy ids. +txMintValueToIndexed + :: TxMintValue build era + -> [ ( ScriptWitnessIndex + , PolicyId + , AssetName + , Quantity + , BuildTxWith build (ScriptWitness WitCtxMint era) + ) + ] +txMintValueToIndexed TxMintNone = [] +txMintValueToIndexed (TxMintValue _ policiesWithAssets) = + [ (ScriptWitnessIndexMint ix, policyId', assetName', quantity, witness) + | (ix, (policyId', assets)) <- zip [0 ..] $ toList policiesWithAssets + , (assetName', quantity, witness) <- assets + ] + -- ---------------------------------------------------------------------------- -- Votes within transactions (era-dependent) -- @@ -1555,7 +1587,7 @@ data TxBodyError | TxBodyOutputNegative !Quantity !TxOutInAnyEra | TxBodyOutputOverflow !Quantity !TxOutInAnyEra | TxBodyMetadataError ![(Word64, TxMetadataRangeError)] - | TxBodyMintAdaError + | TxBodyMintAdaError -- TODO remove - case nonexistent | TxBodyInIxOverflow !TxIn | TxBodyMissingProtocolParams | TxBodyProtocolParamsConversionError !ProtocolParametersConversionError @@ -1824,11 +1856,9 @@ validateTxOuts sbe txOuts = do | txout@(TxOut _ v _ _) <- txOuts ] +-- TODO remove validateMintValue :: TxMintValue build era -> Either TxBodyError () -validateMintValue txMintValue = - case txMintValue of - TxMintNone -> return () - TxMintValue _ v _ -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError +validateMintValue _txMintValue = pure () inputIndexDoesNotExceedMax :: [(TxIn, a)] -> Either TxBodyError () inputIndexDoesNotExceedMax txIns = @@ -2285,20 +2315,20 @@ fromLedgerTxMintValue :: ShelleyBasedEra era -> Ledger.TxBody (ShelleyLedgerEra era) -> TxMintValue ViewTx era -fromLedgerTxMintValue sbe body = - case sbe of - ShelleyBasedEraShelley -> TxMintNone - ShelleyBasedEraAllegra -> TxMintNone - ShelleyBasedEraMary -> toMintValue body MaryEraOnwardsMary - ShelleyBasedEraAlonzo -> toMintValue body MaryEraOnwardsAlonzo - ShelleyBasedEraBabbage -> toMintValue body MaryEraOnwardsBabbage - ShelleyBasedEraConway -> toMintValue body MaryEraOnwardsConway - where - toMintValue txBody maInEra - | L.isZero mint = TxMintNone - | otherwise = TxMintValue maInEra (fromMaryValue mint) ViewTx - where - mint = MaryValue (Ledger.Coin 0) (txBody ^. L.mintTxBodyL) +fromLedgerTxMintValue sbe body = forEraInEon (toCardanoEra sbe) TxMintNone $ \w -> + maryEraOnwardsConstraints w $ do + let mint = MaryValue (Ledger.Coin 0) (body ^. L.mintTxBodyL) + if L.isZero mint + then TxMintNone + else do + let assetMap = toList $ fromMaryValue mint + TxMintValue w $ + Map.fromListWith + (<>) + [ (policyId', [(assetName', quantity, ViewTx)]) + | -- only non-ada can be here + (AssetId policyId' assetName', quantity) <- toList assetMap + ] makeByronTransactionBody :: () @@ -2412,12 +2442,9 @@ convTxUpdateProposal sbe = \case TxUpdateProposal _ p -> bimap TxBodyProtocolParamsConversionError pure $ toLedgerUpdate sbe p convMintValue :: TxMintValue build era -> MultiAsset StandardCrypto -convMintValue txMintValue = - case txMintValue of - TxMintNone -> mempty - TxMintValue _ v _ -> - case toMaryValue v of - MaryValue _ ma -> ma +convMintValue txMintValue = do + let L.MaryValue _coin multiAsset = toMaryValue $ txMintValueToValue txMintValue + multiAsset convExtraKeyWitnesses :: TxExtraKeyWitnesses era -> Set (Shelley.KeyHash Shelley.Witness StandardCrypto) @@ -3328,12 +3355,9 @@ collectTxBodyScriptWitnesses :: TxMintValue BuildTx era -> [(ScriptWitnessIndex, AnyScriptWitness era)] scriptWitnessesMinting TxMintNone = [] - scriptWitnessesMinting (TxMintValue _ value (BuildTxWith witnesses)) = - [ (ScriptWitnessIndexMint ix, AnyScriptWitness witness) - | -- The minting policies are indexed in policy id order in the value - let ValueNestedRep bundle = valueToNestedRep value - , (ix, ValueNestedBundle policyid _) <- zip [0 ..] bundle - , witness <- maybeToList (Map.lookup policyid witnesses) + scriptWitnessesMinting txMintValue' = + [ (ix, AnyScriptWitness witness) + | (ix, _, _, _, BuildTxWith witness) <- txMintValueToIndexed txMintValue' ] scriptWitnessesVoting diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index 070b4aba8e..c97133e2bc 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -328,6 +328,7 @@ calcMinimumDeposit v = -- ---------------------------------------------------------------------------- -- An alternative nested representation -- +-- TODO remove ? - it is now unused -- | An alternative nested representation for 'Value' that groups assets that -- share a 'PolicyId'. @@ -358,7 +359,7 @@ valueToNestedRep v = valueFromNestedRep :: ValueNestedRep -> Value valueFromNestedRep (ValueNestedRep bundles) = - valueFromList + fromList [ (aId, q) | bundle <- bundles , (aId, q) <- case bundle of diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index b98b2eb3eb..17891ba79f 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -368,6 +368,8 @@ module Cardano.Api , TxCertificates (..) , TxUpdateProposal (..) , TxMintValue (..) + , txMintValueToValue + , txMintValueToIndexed , TxVotingProcedures (..) , mkTxVotingProcedures , TxProposalProcedures (..) @@ -535,6 +537,7 @@ module Cardano.Api , WitCtxMint , WitCtxStake , WitCtx (..) + , WitCtxMaybe (..) , ScriptWitness (..) , Witness (..) , KeyWitnessInCtx (..) diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 207cec7c25..2a3fc42dec 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -83,8 +83,7 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr let txMint = TxMintValue meo - [(AssetId policyId' "eeee", 1)] - (BuildTxWith [(policyId', plutusWitness)]) + [(policyId', [("eeee", 1, BuildTxWith plutusWitness)])] -- tx body content without an asset in TxOut let content = @@ -167,8 +166,7 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ let txMint = TxMintValue meo - [(AssetId policyId' "eeee", 1)] - (BuildTxWith [(policyId', plutusWitness)]) + [(policyId', [("eeee", 1, BuildTxWith plutusWitness)])] let content = defaultTxBodyContent sbe From e58eb3f1fbc831f6cca69e41c7c1155f475bca33 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Fri, 8 Nov 2024 18:18:28 +0100 Subject: [PATCH 07/11] Add getScriptWitnessScript, getScriptWitnessReferenceInput, getScriptWitnessReferenceInputOrScript functions --- cardano-api/internal/Cardano/Api/Script.hs | 58 ++++++++----------- cardano-api/internal/Cardano/Api/Tx/Body.hs | 27 +++------ cardano-api/src/Cardano/Api.hs | 5 +- .../Test/Golden/ErrorsSpec.hs | 1 - .../TxBodyMintAdaError.txt | 1 - 5 files changed, 34 insertions(+), 58 deletions(-) delete mode 100644 cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index a1de27f666..bbcba91605 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -4,6 +4,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} @@ -47,22 +48,22 @@ module Cardano.Api.Script -- * Reference scripts , ReferenceScript (..) , refScriptToShelleyScript - , getScriptWitnessReferenceInput -- * Use of a script in an era as a witness , WitCtxTxIn , WitCtxMint , WitCtxStake , WitCtx (..) - , WitCtxMaybe (..) , ScriptWitness (..) + , getScriptWitnessReferenceInput + , getScriptWitnessScript + , getScriptWitnessReferenceInputOrScript , Witness (..) , KeyWitnessInCtx (..) , ScriptWitnessInCtx (..) , IsScriptWitnessInCtx (..) , ScriptDatum (..) , ScriptRedeemer - , scriptWitnessScript -- ** Languages supported in each era , ScriptLanguageInEra (..) @@ -686,10 +687,7 @@ data WitCtx witctx where -- or to mint tokens. This datatype encapsulates this concept. data PlutusScriptOrReferenceInput lang = PScript (PlutusScript lang) - | -- | Needed to construct the redeemer pointer map - -- in the case of minting reference scripts where we don't - -- have direct access to the script - PReferenceScript TxIn + | PReferenceScript TxIn deriving (Eq, Show) data SimpleScriptOrReferenceInput lang @@ -697,14 +695,6 @@ data SimpleScriptOrReferenceInput lang | SReferenceScript TxIn deriving (Eq, Show) -getScriptWitnessReferenceInput :: ScriptWitness witctx era -> Maybe TxIn -getScriptWitnessReferenceInput (SimpleScriptWitness _ (SReferenceScript txIn)) = - Just txIn -getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _) = - Just txIn -getScriptWitnessReferenceInput (SimpleScriptWitness _ (SScript _)) = Nothing -getScriptWitnessReferenceInput (PlutusScriptWitness _ _ (PScript _) _ _ _) = Nothing - -- | A /use/ of a script within a transaction body to witness that something is -- being used in an authorised manner. That can be -- @@ -785,28 +775,26 @@ deriving instance Eq (ScriptDatum witctx) deriving instance Show (ScriptDatum witctx) --- We cannot always extract a script from a script witness due to reference scripts. +getScriptWitnessReferenceInput :: ScriptWitness witctx era -> Maybe TxIn +getScriptWitnessReferenceInput = either (const Nothing) Just . getScriptWitnessReferenceInputOrScript + +getScriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era) +getScriptWitnessScript = either Just (const Nothing) . getScriptWitnessReferenceInputOrScript + +-- | We cannot always extract a script from a script witness due to reference scripts. -- Reference scripts exist in the UTxO, so without access to the UTxO we cannot -- retrieve the script. -scriptWitnessScript :: ScriptWitness witctx era -> Maybe (ScriptInEra era) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInShelley (SScript script)) = - Just $ ScriptInEra SimpleScriptInShelley (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInAllegra (SScript script)) = - Just $ ScriptInEra SimpleScriptInAllegra (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInMary (SScript script)) = - Just $ ScriptInEra SimpleScriptInMary (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInAlonzo (SScript script)) = - Just $ ScriptInEra SimpleScriptInAlonzo (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInBabbage (SScript script)) = - Just $ ScriptInEra SimpleScriptInBabbage (SimpleScript script) -scriptWitnessScript (SimpleScriptWitness SimpleScriptInConway (SScript script)) = - Just $ ScriptInEra SimpleScriptInConway (SimpleScript script) -scriptWitnessScript (PlutusScriptWitness langInEra version (PScript script) _ _ _) = - Just $ ScriptInEra langInEra (PlutusScript version script) -scriptWitnessScript (SimpleScriptWitness _ (SReferenceScript _)) = - Nothing -scriptWitnessScript (PlutusScriptWitness _ _ (PReferenceScript _) _ _ _) = - Nothing +-- So in the cases for script reference, the result contains @Right TxIn@. +getScriptWitnessReferenceInputOrScript :: ScriptWitness witctx era -> Either (ScriptInEra era) TxIn +getScriptWitnessReferenceInputOrScript = \case + SimpleScriptWitness (s :: (ScriptLanguageInEra SimpleScript' era)) (SScript script) -> + Left $ ScriptInEra s (SimpleScript script) + PlutusScriptWitness langInEra version (PScript script) _ _ _ -> + Left $ ScriptInEra langInEra (PlutusScript version script) + SimpleScriptWitness _ (SReferenceScript txIn) -> + Right txIn + PlutusScriptWitness _ _ (PReferenceScript txIn) _ _ _ -> + Right txIn -- ---------------------------------------------------------------------------- -- The kind of witness to use, key (signature) or script diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 1ee6d790dd..0332ccf4ee 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -183,7 +183,6 @@ module Cardano.Api.Tx.Body , guardShelleyTxInsOverflow , validateTxOuts , validateMetadata - , validateMintValue , validateTxInsCollateral , validateProtocolParameters ) @@ -1274,6 +1273,7 @@ txMintValueToValue (TxMintValue _ policiesWithAssets) = ] -- | Index the assets with witnesses in the order of policy ids. +-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf txMintValueToIndexed :: TxMintValue build era -> [ ( ScriptWitnessIndex @@ -1587,7 +1587,6 @@ data TxBodyError | TxBodyOutputNegative !Quantity !TxOutInAnyEra | TxBodyOutputOverflow !Quantity !TxOutInAnyEra | TxBodyMetadataError ![(Word64, TxMetadataRangeError)] - | TxBodyMintAdaError -- TODO remove - case nonexistent | TxBodyInIxOverflow !TxIn | TxBodyMissingProtocolParams | TxBodyProtocolParamsConversionError !ProtocolParametersConversionError @@ -1623,8 +1622,6 @@ instance Error TxBodyError where | (k, err) <- errs ] ] - TxBodyMintAdaError -> - "Transaction cannot mint ada, only non-ada assets" TxBodyMissingProtocolParams -> "Transaction uses Plutus scripts but does not provide the protocol " <> "parameters to hash" @@ -1786,13 +1783,11 @@ validateTxBodyContent guardShelleyTxInsOverflow (map fst txIns) validateTxOuts sbe txOuts validateMetadata txMetadata - validateMintValue txMintValue ShelleyBasedEraAlonzo -> do validateTxIns txIns guardShelleyTxInsOverflow (map fst txIns) validateTxOuts sbe txOuts validateMetadata txMetadata - validateMintValue txMintValue validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages ShelleyBasedEraBabbage -> do @@ -1800,14 +1795,12 @@ validateTxBodyContent guardShelleyTxInsOverflow (map fst txIns) validateTxOuts sbe txOuts validateMetadata txMetadata - validateMintValue txMintValue validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages ShelleyBasedEraConway -> do validateTxIns txIns validateTxOuts sbe txOuts validateMetadata txMetadata - validateMintValue txMintValue validateTxInsCollateral txInsCollateral languages validateProtocolParameters txProtocolParams languages @@ -1856,10 +1849,6 @@ validateTxOuts sbe txOuts = do | txout@(TxOut _ v _ _) <- txOuts ] --- TODO remove -validateMintValue :: TxMintValue build era -> Either TxBodyError () -validateMintValue _txMintValue = pure () - inputIndexDoesNotExceedMax :: [(TxIn, a)] -> Either TxBodyError () inputIndexDoesNotExceedMax txIns = for_ txIns $ \(txin@(TxIn _ (TxIx txix)), _) -> @@ -2463,7 +2452,7 @@ convScripts -> [Ledger.Script ledgerera] convScripts scriptWitnesses = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- scriptWitnesses ] @@ -2630,7 +2619,7 @@ makeShelleyTransactionBody scripts_ :: [Ledger.Script StandardShelley] scripts_ = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2675,7 +2664,7 @@ makeShelleyTransactionBody scripts_ :: [Ledger.Script StandardAllegra] scripts_ = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2724,7 +2713,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- collectTxBodyScriptWitnesses sbe txbodycontent ] @@ -2789,7 +2778,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] @@ -2910,7 +2899,7 @@ makeShelleyTransactionBody scripts = List.nub $ catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] @@ -3049,7 +3038,7 @@ makeShelleyTransactionBody scripts :: [Ledger.Script StandardConway] scripts = catMaybes - [ toShelleyScript <$> scriptWitnessScript scriptwitness + [ toShelleyScript <$> getScriptWitnessScript scriptwitness | (_, AnyScriptWitness scriptwitness) <- witnesses ] diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index 17891ba79f..aebcbbf6fb 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -537,15 +537,16 @@ module Cardano.Api , WitCtxMint , WitCtxStake , WitCtx (..) - , WitCtxMaybe (..) , ScriptWitness (..) + , getScriptWitnessScript + , getScriptWitnessReferenceInput + , getScriptWitnessReferenceInputOrScript , Witness (..) , KeyWitnessInCtx (..) , ScriptWitnessInCtx (..) , IsScriptWitnessInCtx (..) , ScriptDatum (..) , ScriptRedeemer - , scriptWitnessScript -- ** Inspecting 'ScriptWitness'es , AnyScriptWitness (..) 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 b86611c8bb..b39ea2151b 100644 --- a/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs +++ b/cardano-api/test/cardano-api-golden/Test/Golden/ErrorsSpec.hs @@ -415,7 +415,6 @@ test_TxBodyError = , ("TxBodyOutputNegative", TxBodyOutputNegative 1 txOutInAnyEra1) , ("TxBodyOutputOverflow", TxBodyOutputOverflow 1 txOutInAnyEra1) , ("TxBodyMetadataError", TxBodyMetadataError [(1, TxMetadataBytesTooLong 2)]) - , ("TxBodyMintAdaError", TxBodyMintAdaError) , ("TxBodyMissingProtocolParams", TxBodyMissingProtocolParams) , ("TxBodyInIxOverflow", TxBodyInIxOverflow txin1) ] diff --git a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt b/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt deleted file mode 100644 index d2e5d85c44..0000000000 --- a/cardano-api/test/cardano-api-golden/files/golden/errors/Cardano.Api.Tx.Body.TxBodyError/TxBodyMintAdaError.txt +++ /dev/null @@ -1 +0,0 @@ -Transaction cannot mint ada, only non-ada assets \ No newline at end of file From 0f5187411b69e902f4665927c24a17cba62c1290 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 19 Nov 2024 23:29:15 +0100 Subject: [PATCH 08/11] Add sbeToSimpleScriptLanguageInEra --- cardano-api/internal/Cardano/Api/Script.hs | 55 +++++++++++---------- cardano-api/internal/Cardano/Api/Tx/Body.hs | 1 - cardano-api/internal/Cardano/Api/Value.hs | 1 - cardano-api/src/Cardano/Api.hs | 1 + 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/cardano-api/internal/Cardano/Api/Script.hs b/cardano-api/internal/Cardano/Api/Script.hs index bbcba91605..ce59e80da5 100644 --- a/cardano-api/internal/Cardano/Api/Script.hs +++ b/cardano-api/internal/Cardano/Api/Script.hs @@ -68,6 +68,7 @@ module Cardano.Api.Script -- ** Languages supported in each era , ScriptLanguageInEra (..) , scriptLanguageSupportedInEra + , sbeToSimpleScriptLanguageInEra , languageOfScriptLanguageInEra , eraOfScriptLanguageInEra @@ -167,7 +168,7 @@ import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.Type.Equality (TestEquality (..), type (==), (:~:) (Refl)) +import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import Data.Typeable (Typeable) import Data.Vector (Vector) import GHC.Exts (IsList (..)) @@ -581,18 +582,8 @@ scriptLanguageSupportedInEra -> Maybe (ScriptLanguageInEra lang era) scriptLanguageSupportedInEra era lang = case (era, lang) of - (ShelleyBasedEraShelley, SimpleScriptLanguage) -> - Just SimpleScriptInShelley - (ShelleyBasedEraAllegra, SimpleScriptLanguage) -> - Just SimpleScriptInAllegra - (ShelleyBasedEraMary, SimpleScriptLanguage) -> - Just SimpleScriptInMary - (ShelleyBasedEraAlonzo, SimpleScriptLanguage) -> - Just SimpleScriptInAlonzo - (ShelleyBasedEraBabbage, SimpleScriptLanguage) -> - Just SimpleScriptInBabbage - (ShelleyBasedEraConway, SimpleScriptLanguage) -> - Just SimpleScriptInConway + (sbe, SimpleScriptLanguage) -> + Just $ sbeToSimpleScriptLanguageInEra sbe (ShelleyBasedEraAlonzo, PlutusScriptLanguage PlutusScriptV1) -> Just PlutusScriptV1InAlonzo (ShelleyBasedEraBabbage, PlutusScriptLanguage PlutusScriptV1) -> @@ -625,23 +616,33 @@ languageOfScriptLanguageInEra langInEra = PlutusScriptV2InConway -> PlutusScriptLanguage PlutusScriptV2 PlutusScriptV3InConway -> PlutusScriptLanguage PlutusScriptV3 +sbeToSimpleScriptLanguageInEra + :: ShelleyBasedEra era + -> ScriptLanguageInEra SimpleScript' era +sbeToSimpleScriptLanguageInEra = \case + ShelleyBasedEraShelley -> SimpleScriptInShelley + ShelleyBasedEraAllegra -> SimpleScriptInAllegra + ShelleyBasedEraMary -> SimpleScriptInMary + ShelleyBasedEraAlonzo -> SimpleScriptInAlonzo + ShelleyBasedEraBabbage -> SimpleScriptInBabbage + ShelleyBasedEraConway -> SimpleScriptInConway + eraOfScriptLanguageInEra :: ScriptLanguageInEra lang era -> ShelleyBasedEra era -eraOfScriptLanguageInEra langInEra = - case langInEra of - SimpleScriptInShelley -> ShelleyBasedEraShelley - SimpleScriptInAllegra -> ShelleyBasedEraAllegra - SimpleScriptInMary -> ShelleyBasedEraMary - SimpleScriptInAlonzo -> ShelleyBasedEraAlonzo - SimpleScriptInBabbage -> ShelleyBasedEraBabbage - SimpleScriptInConway -> ShelleyBasedEraConway - PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo - PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage - PlutusScriptV1InConway -> ShelleyBasedEraConway - PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage - PlutusScriptV2InConway -> ShelleyBasedEraConway - PlutusScriptV3InConway -> ShelleyBasedEraConway +eraOfScriptLanguageInEra = \case + SimpleScriptInShelley -> ShelleyBasedEraShelley + SimpleScriptInAllegra -> ShelleyBasedEraAllegra + SimpleScriptInMary -> ShelleyBasedEraMary + SimpleScriptInAlonzo -> ShelleyBasedEraAlonzo + SimpleScriptInBabbage -> ShelleyBasedEraBabbage + SimpleScriptInConway -> ShelleyBasedEraConway + PlutusScriptV1InAlonzo -> ShelleyBasedEraAlonzo + PlutusScriptV1InBabbage -> ShelleyBasedEraBabbage + PlutusScriptV1InConway -> ShelleyBasedEraConway + PlutusScriptV2InBabbage -> ShelleyBasedEraBabbage + PlutusScriptV2InConway -> ShelleyBasedEraConway + PlutusScriptV3InConway -> ShelleyBasedEraConway -- | Given a target era and a script in some language, check if the language is -- supported in that era, and if so return a 'ScriptInEra'. diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 0332ccf4ee..38d12be3e6 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -1757,7 +1757,6 @@ validateTxBodyContent , txInsCollateral , txOuts , txProtocolParams - , txMintValue , txMetadata } = let witnesses = collectTxBodyScriptWitnesses sbe txBodContent diff --git a/cardano-api/internal/Cardano/Api/Value.hs b/cardano-api/internal/Cardano/Api/Value.hs index c97133e2bc..9fc9f18607 100644 --- a/cardano-api/internal/Cardano/Api/Value.hs +++ b/cardano-api/internal/Cardano/Api/Value.hs @@ -328,7 +328,6 @@ calcMinimumDeposit v = -- ---------------------------------------------------------------------------- -- An alternative nested representation -- --- TODO remove ? - it is now unused -- | An alternative nested representation for 'Value' that groups assets that -- share a 'PolicyId'. diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs index aebcbbf6fb..7438af2ede 100644 --- a/cardano-api/src/Cardano/Api.hs +++ b/cardano-api/src/Cardano/Api.hs @@ -557,6 +557,7 @@ module Cardano.Api -- ** Languages supported in each era , ScriptLanguageInEra (..) , scriptLanguageSupportedInEra + , sbeToSimpleScriptLanguageInEra , languageOfScriptLanguageInEra , eraOfScriptLanguageInEra From e6912ab71dc2aa73082ec1a6fcb0fbb3e46e2828 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Wed, 20 Nov 2024 21:03:39 +0100 Subject: [PATCH 09/11] Release cardano-api-10.3.0.0 --- cardano-api/CHANGELOG.md | 21 +++++++++++++++++++++ cardano-api/cardano-api.cabal | 2 +- 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/cardano-api/CHANGELOG.md b/cardano-api/CHANGELOG.md index 9998029337..f3e36180e7 100644 --- a/cardano-api/CHANGELOG.md +++ b/cardano-api/CHANGELOG.md @@ -1,5 +1,26 @@ # Changelog for cardano-api +## 10.3.0.0 + +- Add `sbeToSimpleScriptLanguageInEra`, `getScriptWitnessScript`, `getScriptWitnessReferenceInput`, `getScriptWitnessReferenceInputOrScript` function + Refactor `TxMintValue` to better represent minting state + Propagate `IsPlutusLanguage` constraint to `ScriptLanguage lang`, `AnyPlutusScriptVersion`, `Script lang` and `ScriptWitness witctx era` types. + Remove `Maybe ScriptHash` from `PReferenceScript` and `SReferenceScript`. + (breaking, refactoring) + [PR 663](https://github.com/IntersectMBO/cardano-api/pull/663) + +- Improve plutus script failure error + (feature) + [PR 683](https://github.com/IntersectMBO/cardano-api/pull/683) + +- Remove experimental code exposure in `Cardano.Api` non-experimental modules + (breaking) + [PR 681](https://github.com/IntersectMBO/cardano-api/pull/681) + +- Deprecate eons conversion functions like `conwayEraOnwardsToBabbageEraOnwards`. Add [`Inject`](https://cardano-ledger.cardano.intersectmbo.org/cardano-ledger-core/Cardano-Ledger-BaseTypes.html#t:Inject) instances for eon conversions. See the PR description for migration aid. + (compatible, refactoring) + [PR 636](https://github.com/IntersectMBO/cardano-api/pull/636) + ## 10.2.0.0 - ValueParser: rename publicly exposed function names to indicate they are parsers diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index 99a03e84d2..a42d3266b1 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -1,6 +1,6 @@ cabal-version: 3.4 name: cardano-api -version: 10.2.0.0 +version: 10.3.0.0 synopsis: The cardano API description: The cardano API. category: From a16541b54333a2cfa34044f03b270ed0d7845d57 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 19:37:40 -0400 Subject: [PATCH 10/11] We introduce the `Convert` type class as an alternative to cardano-ledger's `Inject` typeclass. While `Inject` is more general, `Convert` is specifically designed for transformations between era-indexed types, making the intent clearer at call sites where we're converting between eons. --- cardano-api/cardano-api.cabal | 1 + cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs | 19 ++++---- .../internal/Cardano/Api/Certificate.hs | 5 +- .../Cardano/Api/Eon/AllegraEraOnwards.hs | 13 +++--- .../Cardano/Api/Eon/AlonzoEraOnwards.hs | 13 +++--- .../Cardano/Api/Eon/BabbageEraOnwards.hs | 20 ++++---- .../Cardano/Api/Eon/ByronToAlonzoEra.hs | 5 +- .../internal/Cardano/Api/Eon/Convert.hs | 16 +++++++ .../Cardano/Api/Eon/ConwayEraOnwards.hs | 21 +++++---- .../Cardano/Api/Eon/MaryEraOnwards.hs | 13 +++--- .../Cardano/Api/Eon/ShelleyBasedEra.hs | 5 +- .../Cardano/Api/Eon/ShelleyEraOnly.hs | 13 +++--- .../Cardano/Api/Eon/ShelleyToAllegraEra.hs | 13 +++--- .../Cardano/Api/Eon/ShelleyToAlonzoEra.hs | 11 +++-- .../Cardano/Api/Eon/ShelleyToBabbageEra.hs | 13 +++--- .../Cardano/Api/Eon/ShelleyToMaryEra.hs | 13 +++--- .../internal/Cardano/Api/Experimental/Eras.hs | 29 ++++++------ .../internal/Cardano/Api/Experimental/Tx.hs | 5 +- cardano-api/internal/Cardano/Api/Fees.hs | 5 +- cardano-api/internal/Cardano/Api/Protocol.hs | 3 +- .../internal/Cardano/Api/Query/Expr.hs | 46 ++++++++----------- cardano-api/internal/Cardano/Api/Tx/Body.hs | 17 ++++--- .../internal/Cardano/Api/Tx/Compatible.hs | 6 +-- .../Cardano/Api/Transaction/Autobalance.hs | 21 +++++---- 24 files changed, 179 insertions(+), 147 deletions(-) create mode 100644 cardano-api/internal/Cardano/Api/Eon/Convert.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index a42d3266b1..a2d21fb328 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -71,6 +71,7 @@ library internal Cardano.Api.Eon.AlonzoEraOnwards Cardano.Api.Eon.BabbageEraOnwards Cardano.Api.Eon.ByronToAlonzoEra + Cardano.Api.Eon.Convert Cardano.Api.Eon.ConwayEraOnwards Cardano.Api.Eon.MaryEraOnwards Cardano.Api.Eon.ShelleyBasedEra diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs index 815f42d9cc..f394180906 100644 --- a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs +++ b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs @@ -145,6 +145,7 @@ import qualified Cardano.Binary as CBOR import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Hash.Class as CRYPTO import qualified Cardano.Crypto.Seed as Crypto +import Cardano.Api.Eon.Convert import qualified Cardano.Ledger.Alonzo.Scripts as Alonzo import qualified Cardano.Ledger.BaseTypes as Ledger import qualified Cardano.Ledger.Core as Ledger @@ -391,15 +392,13 @@ genLedgerValue w genAId genQuant = genValueDefault :: MaryEraOnwards era -> Gen (L.Value (ShelleyLedgerEra era)) genValueDefault w = genLedgerValue w genAssetId genSignedNonZeroQuantity -genValueForRole :: forall era. MaryEraOnwards era -> ParserValueRole -> Gen Value +genValueForRole :: MaryEraOnwards era -> ParserValueRole -> Gen Value genValueForRole w = \case RoleMint -> genValueForMinting RoleUTxO -> - fromLedgerValue sbe <$> genValueForTxOut sbe - where - sbe = inject w :: ShelleyBasedEra era + fromLedgerValue (convert w) <$> genValueForTxOut (convert w) -- | Generate a 'Value' suitable for minting, i.e. non-ADA asset ID and a -- positive or negative quantity. @@ -468,7 +467,7 @@ genOperationalCertificateWithCounter = do Gen.either (genSigningKey AsStakePoolKey) (genSigningKey AsGenesisDelegateExtendedKey) kesP <- genKESPeriod c <- Gen.integral $ Range.linear 0 1000 - let stakePoolVer = either getVerificationKey (convert . getVerificationKey) stkPoolOrGenDelExtSign + let stakePoolVer = either getVerificationKey (convert' . getVerificationKey) stkPoolOrGenDelExtSign iCounter = OperationalCertificateIssueCounter c stakePoolVer case issueOperationalCertificate kesVKey stkPoolOrGenDelExtSign kesP iCounter of @@ -477,10 +476,10 @@ genOperationalCertificateWithCounter = do Left err -> error $ docToString $ prettyError err Right pair -> return pair where - convert + convert' :: VerificationKey GenesisDelegateExtendedKey -> VerificationKey StakePoolKey - convert = + convert' = ( castVerificationKey :: VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey @@ -599,7 +598,7 @@ genTxAuxScripts era = TxAuxScripts w <$> Gen.list (Range.linear 0 3) - (genScriptInEra (inject w)) + (genScriptInEra $ convert w) ) genTxWithdrawals :: CardanoEra era -> Gen (TxWithdrawals build era) @@ -1169,7 +1168,7 @@ genProposals w = conwayEraOnwardsConstraints w $ do -- We're doing it for the complete representation of possible values space of TxProposalProcedures. -- Proposal procedures code in cardano-api should handle such invalid values just fine. extraProposals <- Gen.list (Range.constant 0 10) (genProposal w) - let sbe = inject w + let sbe = convert w proposalsWithWitnesses <- forM (extraProposals <> proposalsToBeWitnessed) $ \proposal -> (proposal,) <$> genScriptWitnessForStake sbe @@ -1184,7 +1183,7 @@ genVotingProcedures :: Applicative (BuildTxWith build) -> Gen (Api.TxVotingProcedures build era) genVotingProcedures w = conwayEraOnwardsConstraints w $ do voters <- Gen.list (Range.constant 0 10) Q.arbitrary - let sbe = inject w + let sbe = convert w votersWithWitnesses <- fmap fromList . forM voters $ \voter -> (voter,) <$> genScriptWitnessForStake sbe Api.TxVotingProcedures <$> Q.arbitrary <*> pure (pure votersWithWitnesses) diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs index 4b0a3b8218..b31ab11135 100644 --- a/cardano-api/internal/Cardano/Api/Certificate.hs +++ b/cardano-api/internal/Cardano/Api/Certificate.hs @@ -78,6 +78,7 @@ where import Cardano.Api.Address import Cardano.Api.DRepMetadata +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToBabbageEra @@ -515,10 +516,10 @@ selectStakeCredentialWitness selectStakeCredentialWitness = \case ShelleyRelatedCertificate stbEra shelleyCert -> shelleyToBabbageEraConstraints stbEra $ - getTxCertWitness (inject stbEra) shelleyCert + getTxCertWitness (convert stbEra) shelleyCert ConwayCertificate cEra conwayCert -> conwayEraOnwardsConstraints cEra $ - getTxCertWitness (inject cEra) conwayCert + getTxCertWitness (convert cEra) conwayCert filterUnRegCreds :: Certificate era -> Maybe StakeCredential diff --git a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs index d4864efc33..199e79883f 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AllegraEraOnwards.hs @@ -18,6 +18,7 @@ module Cardano.Api.Eon.AllegraEraOnwards ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -67,11 +68,11 @@ instance ToCardanoEra AllegraEraOnwards where AllegraEraOnwardsBabbage -> BabbageEra AllegraEraOnwardsConway -> ConwayEra -instance Inject (AllegraEraOnwards era) (CardanoEra era) where - inject = toCardanoEra +instance Convert AllegraEraOnwards CardanoEra where + convert = toCardanoEra -instance Inject (AllegraEraOnwards era) (ShelleyBasedEra era) where - inject = \case +instance Convert AllegraEraOnwards ShelleyBasedEra where + convert = \case AllegraEraOnwardsAllegra -> ShelleyBasedEraAllegra AllegraEraOnwardsMary -> ShelleyBasedEraMary AllegraEraOnwardsAlonzo -> ShelleyBasedEraAlonzo @@ -115,9 +116,9 @@ allegraEraOnwardsConstraints = \case AllegraEraOnwardsBabbage -> id AllegraEraOnwardsConway -> id -{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED allegraEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} allegraEraOnwardsToShelleyBasedEra :: AllegraEraOnwards era -> ShelleyBasedEra era -allegraEraOnwardsToShelleyBasedEra = inject +allegraEraOnwardsToShelleyBasedEra = convert class IsShelleyBasedEra era => IsAllegraBasedEra era where allegraBasedEra :: AllegraEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs index b4272aa92d..fe2f864dcd 100644 --- a/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/AlonzoEraOnwards.hs @@ -18,6 +18,7 @@ module Cardano.Api.Eon.AlonzoEraOnwards ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core @@ -71,11 +72,11 @@ instance ToCardanoEra AlonzoEraOnwards where AlonzoEraOnwardsBabbage -> BabbageEra AlonzoEraOnwardsConway -> ConwayEra -instance Inject (AlonzoEraOnwards era) (CardanoEra era) where - inject = toCardanoEra +instance Convert AlonzoEraOnwards CardanoEra where + convert = toCardanoEra -instance Inject (AlonzoEraOnwards era) (ShelleyBasedEra era) where - inject = \case +instance Convert AlonzoEraOnwards ShelleyBasedEra where + convert = \case AlonzoEraOnwardsAlonzo -> ShelleyBasedEraAlonzo AlonzoEraOnwardsBabbage -> ShelleyBasedEraBabbage AlonzoEraOnwardsConway -> ShelleyBasedEraConway @@ -124,9 +125,9 @@ alonzoEraOnwardsConstraints = \case AlonzoEraOnwardsBabbage -> id AlonzoEraOnwardsConway -> id -{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED alonzoEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} alonzoEraOnwardsToShelleyBasedEra :: AlonzoEraOnwards era -> ShelleyBasedEra era -alonzoEraOnwardsToShelleyBasedEra = inject +alonzoEraOnwardsToShelleyBasedEra = convert class IsMaryBasedEra era => IsAlonzoBasedEra era where alonzoBasedEra :: AlonzoEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs index baab37a13f..811d23d0ef 100644 --- a/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/BabbageEraOnwards.hs @@ -7,7 +7,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -21,6 +20,7 @@ module Cardano.Api.Eon.BabbageEraOnwards where import Cardano.Api.Eon.AlonzoEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core @@ -70,14 +70,16 @@ instance ToCardanoEra BabbageEraOnwards where BabbageEraOnwardsBabbage -> BabbageEra BabbageEraOnwardsConway -> ConwayEra -instance Inject (BabbageEraOnwards era) (CardanoEra era) where - inject = toCardanoEra +instance Convert BabbageEraOnwards CardanoEra where + convert = toCardanoEra -instance Inject (BabbageEraOnwards era) (ShelleyBasedEra era) where - inject = inject @(MaryEraOnwards era) . inject +instance Convert BabbageEraOnwards ShelleyBasedEra where + convert = \case + BabbageEraOnwardsBabbage -> ShelleyBasedEraBabbage + BabbageEraOnwardsConway -> ShelleyBasedEraConway -instance Inject (BabbageEraOnwards era) (MaryEraOnwards era) where - inject = \case +instance Convert BabbageEraOnwards MaryEraOnwards where + convert = \case BabbageEraOnwardsBabbage -> MaryEraOnwardsBabbage BabbageEraOnwardsConway -> MaryEraOnwardsConway @@ -124,9 +126,9 @@ babbageEraOnwardsConstraints = \case BabbageEraOnwardsBabbage -> id BabbageEraOnwardsConway -> id -{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED babbageEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} babbageEraOnwardsToShelleyBasedEra :: BabbageEraOnwards era -> ShelleyBasedEra era -babbageEraOnwardsToShelleyBasedEra = inject +babbageEraOnwardsToShelleyBasedEra = convert class IsAlonzoBasedEra era => IsBabbageBasedEra era where babbageBasedEra :: BabbageEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs index 23701d8bd3..adf2a751ed 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ByronToAlonzoEra.hs @@ -15,6 +15,7 @@ module Cardano.Api.Eon.ByronToAlonzoEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eras.Core import Data.Typeable (Typeable) @@ -48,8 +49,8 @@ instance ToCardanoEra ByronToAlonzoEra where ByronToAlonzoEraMary -> MaryEra ByronToAlonzoEraAlonzo -> AlonzoEra -instance Inject (ByronToAlonzoEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ByronToAlonzoEra CardanoEra where + convert = toCardanoEra type ByronToAlonzoEraConstraints era = ( IsCardanoEra era diff --git a/cardano-api/internal/Cardano/Api/Eon/Convert.hs b/cardano-api/internal/Cardano/Api/Eon/Convert.hs new file mode 100644 index 0000000000..8e31e6e91e --- /dev/null +++ b/cardano-api/internal/Cardano/Api/Eon/Convert.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE RankNTypes #-} + +module Cardano.Api.Eon.Convert + ( Convert (..) + ) +where + +import Data.Kind (Type) + +-- | The Convert class is aimed at exposing a single interface that lets us +-- convert between eons. However this is generalizable to any injective +-- relationship between types. +class Convert (f :: a -> Type) (g :: a -> Type) where + convert :: forall era. f era -> g era diff --git a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs index 17923ce828..9298b47b1a 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ConwayEraOnwards.hs @@ -20,6 +20,7 @@ module Cardano.Api.Eon.ConwayEraOnwards where import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -67,15 +68,15 @@ instance ToCardanoEra ConwayEraOnwards where toCardanoEra = \case ConwayEraOnwardsConway -> ConwayEra -instance Inject (ConwayEraOnwards era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ConwayEraOnwards CardanoEra where + convert = toCardanoEra -instance Inject (ConwayEraOnwards era) (ShelleyBasedEra era) where - inject = \case +instance Convert ConwayEraOnwards ShelleyBasedEra where + convert = \case ConwayEraOnwardsConway -> ShelleyBasedEraConway -instance Inject (ConwayEraOnwards era) (BabbageEraOnwards era) where - inject = \case +instance Convert ConwayEraOnwards BabbageEraOnwards where + convert = \case ConwayEraOnwardsConway -> BabbageEraOnwardsConway type ConwayEraOnwardsConstraints era = @@ -125,13 +126,13 @@ conwayEraOnwardsConstraints conwayEraOnwardsConstraints = \case ConwayEraOnwardsConway -> id -{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED conwayEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} conwayEraOnwardsToShelleyBasedEra :: ConwayEraOnwards era -> ShelleyBasedEra era -conwayEraOnwardsToShelleyBasedEra = inject +conwayEraOnwardsToShelleyBasedEra = convert -{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'inject' instead." #-} +{-# DEPRECATED conwayEraOnwardsToBabbageEraOnwards "Use 'convert' instead." #-} conwayEraOnwardsToBabbageEraOnwards :: ConwayEraOnwards era -> BabbageEraOnwards era -conwayEraOnwardsToBabbageEraOnwards = inject +conwayEraOnwardsToBabbageEraOnwards = convert class IsBabbageBasedEra era => IsConwayBasedEra era where conwayBasedEra :: ConwayEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs index a6f4979b34..ab81c0e119 100644 --- a/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs +++ b/cardano-api/internal/Cardano/Api/Eon/MaryEraOnwards.hs @@ -19,6 +19,7 @@ module Cardano.Api.Eon.MaryEraOnwards where import Cardano.Api.Eon.AllegraEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -68,11 +69,11 @@ instance ToCardanoEra MaryEraOnwards where MaryEraOnwardsBabbage -> BabbageEra MaryEraOnwardsConway -> ConwayEra -instance Inject (MaryEraOnwards era) (CardanoEra era) where - inject = toCardanoEra +instance Convert MaryEraOnwards CardanoEra where + convert = toCardanoEra -instance Inject (MaryEraOnwards era) (ShelleyBasedEra era) where - inject = \case +instance Convert MaryEraOnwards ShelleyBasedEra where + convert = \case MaryEraOnwardsMary -> ShelleyBasedEraMary MaryEraOnwardsAlonzo -> ShelleyBasedEraAlonzo MaryEraOnwardsBabbage -> ShelleyBasedEraBabbage @@ -116,9 +117,9 @@ maryEraOnwardsConstraints = \case MaryEraOnwardsBabbage -> id MaryEraOnwardsConway -> id -{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED maryEraOnwardsToShelleyBasedEra "Use 'convert' instead." #-} maryEraOnwardsToShelleyBasedEra :: MaryEraOnwards era -> ShelleyBasedEra era -maryEraOnwardsToShelleyBasedEra = inject +maryEraOnwardsToShelleyBasedEra = convert class IsAllegraBasedEra era => IsMaryBasedEra era where maryBasedEra :: MaryEraOnwards era diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs index fab704c474..2a4b25187b 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyBasedEra.hs @@ -36,6 +36,7 @@ module Cardano.Api.Eon.ShelleyBasedEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eras.Core import Cardano.Api.Modes import Cardano.Api.Orphans () @@ -179,8 +180,8 @@ instance ToCardanoEra ShelleyBasedEra where ShelleyBasedEraBabbage -> BabbageEra ShelleyBasedEraConway -> ConwayEra -instance Inject (ShelleyBasedEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyBasedEra CardanoEra where + convert = toCardanoEra -- | The class of eras that are based on Shelley. This allows uniform handling -- of Shelley-based eras, but also non-uniform by making case distinctions on diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs index fbafc1d902..a0ef0b71a1 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyEraOnly.hs @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyEraOnly ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -60,11 +61,11 @@ instance ToCardanoEra ShelleyEraOnly where toCardanoEra = \case ShelleyEraOnlyShelley -> ShelleyEra -instance Inject (ShelleyEraOnly era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyEraOnly CardanoEra where + convert = toCardanoEra -instance Inject (ShelleyEraOnly era) (ShelleyBasedEra era) where - inject = \case +instance Convert ShelleyEraOnly ShelleyBasedEra where + convert = \case ShelleyEraOnlyShelley -> ShelleyBasedEraShelley type ShelleyEraOnlyConstraints era = @@ -107,6 +108,6 @@ shelleyEraOnlyConstraints shelleyEraOnlyConstraints = \case ShelleyEraOnlyShelley -> id -{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED shelleyEraOnlyToShelleyBasedEra "Use 'convert' instead." #-} shelleyEraOnlyToShelleyBasedEra :: ShelleyEraOnly era -> ShelleyBasedEra era -shelleyEraOnlyToShelleyBasedEra = inject +shelleyEraOnlyToShelleyBasedEra = convert diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs index fefccda7c8..72449078d8 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAllegraEra.hs @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyToAllegraEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -63,11 +64,11 @@ instance ToCardanoEra ShelleyToAllegraEra where ShelleyToAllegraEraShelley -> ShelleyEra ShelleyToAllegraEraAllegra -> AllegraEra -instance Inject (ShelleyToAllegraEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyToAllegraEra CardanoEra where + convert = toCardanoEra -instance Inject (ShelleyToAllegraEra era) (ShelleyBasedEra era) where - inject = \case +instance Convert ShelleyToAllegraEra ShelleyBasedEra where + convert = \case ShelleyToAllegraEraShelley -> ShelleyBasedEraShelley ShelleyToAllegraEraAllegra -> ShelleyBasedEraAllegra @@ -111,6 +112,6 @@ shelleyToAllegraEraConstraints = \case ShelleyToAllegraEraShelley -> id ShelleyToAllegraEraAllegra -> id -{-# DEPRECATED shelleyToAllegraEraToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED shelleyToAllegraEraToShelleyBasedEra "Use 'convert' instead." #-} shelleyToAllegraEraToShelleyBasedEra :: ShelleyToAllegraEra era -> ShelleyBasedEra era -shelleyToAllegraEraToShelleyBasedEra = inject +shelleyToAllegraEraToShelleyBasedEra = convert diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs index 8271355f90..7ac0568cfc 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToAlonzoEra.hs @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyToAlonzoEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -65,11 +66,11 @@ instance ToCardanoEra ShelleyToAlonzoEra where ShelleyToAlonzoEraMary -> MaryEra ShelleyToAlonzoEraAlonzo -> AlonzoEra -instance Inject (ShelleyToAlonzoEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyToAlonzoEra CardanoEra where + convert = toCardanoEra -instance Inject (ShelleyToAlonzoEra era) (ShelleyBasedEra era) where - inject = \case +instance Convert ShelleyToAlonzoEra ShelleyBasedEra where + convert = \case ShelleyToAlonzoEraShelley -> ShelleyBasedEraShelley ShelleyToAlonzoEraAllegra -> ShelleyBasedEraAllegra ShelleyToAlonzoEraMary -> ShelleyBasedEraMary @@ -115,4 +116,4 @@ shelleyToAlonzoEraConstraints = \case ShelleyToAlonzoEraAlonzo -> id shelleyToAlonzoEraToShelleyBasedEra :: ShelleyToAlonzoEra era -> ShelleyBasedEra era -shelleyToAlonzoEraToShelleyBasedEra = inject +shelleyToAlonzoEraToShelleyBasedEra = convert diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs index 43d6fed433..5aead9b370 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToBabbageEra.hs @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyToBabbageEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -67,11 +68,11 @@ instance ToCardanoEra ShelleyToBabbageEra where ShelleyToBabbageEraAlonzo -> AlonzoEra ShelleyToBabbageEraBabbage -> BabbageEra -instance Inject (ShelleyToBabbageEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyToBabbageEra CardanoEra where + convert = toCardanoEra -instance Inject (ShelleyToBabbageEra era) (ShelleyBasedEra era) where - inject = \case +instance Convert ShelleyToBabbageEra ShelleyBasedEra where + convert = \case ShelleyToBabbageEraShelley -> ShelleyBasedEraShelley ShelleyToBabbageEraAllegra -> ShelleyBasedEraAllegra ShelleyToBabbageEraMary -> ShelleyBasedEraMary @@ -117,6 +118,6 @@ shelleyToBabbageEraConstraints = \case ShelleyToBabbageEraAlonzo -> id ShelleyToBabbageEraBabbage -> id -{-# DEPRECATED shelleyToBabbageEraToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED shelleyToBabbageEraToShelleyBasedEra "Use 'convert' instead." #-} shelleyToBabbageEraToShelleyBasedEra :: ShelleyToBabbageEra era -> ShelleyBasedEra era -shelleyToBabbageEraToShelleyBasedEra = inject +shelleyToBabbageEraToShelleyBasedEra = convert diff --git a/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs b/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs index a92cc8c57d..3e1d37e0f9 100644 --- a/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs +++ b/cardano-api/internal/Cardano/Api/Eon/ShelleyToMaryEra.hs @@ -17,6 +17,7 @@ module Cardano.Api.Eon.ShelleyToMaryEra ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core import Cardano.Api.Modes @@ -63,11 +64,11 @@ instance ToCardanoEra ShelleyToMaryEra where ShelleyToMaryEraAllegra -> AllegraEra ShelleyToMaryEraMary -> MaryEra -instance Inject (ShelleyToMaryEra era) (CardanoEra era) where - inject = toCardanoEra +instance Convert ShelleyToMaryEra CardanoEra where + convert = toCardanoEra -instance Inject (ShelleyToMaryEra era) (ShelleyBasedEra era) where - inject = \case +instance Convert ShelleyToMaryEra ShelleyBasedEra where + convert = \case ShelleyToMaryEraShelley -> ShelleyBasedEraShelley ShelleyToMaryEraAllegra -> ShelleyBasedEraAllegra ShelleyToMaryEraMary -> ShelleyBasedEraMary @@ -111,6 +112,6 @@ shelleyToMaryEraConstraints = \case ShelleyToMaryEraAllegra -> id ShelleyToMaryEraMary -> id -{-# DEPRECATED shelleyToMaryEraToShelleyBasedEra "Use 'inject' instead." #-} +{-# DEPRECATED shelleyToMaryEraToShelleyBasedEra "Use 'convert' instead." #-} shelleyToMaryEraToShelleyBasedEra :: ShelleyToMaryEra era -> ShelleyBasedEra era -shelleyToMaryEraToShelleyBasedEra = inject +shelleyToMaryEraToShelleyBasedEra = convert diff --git a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs index c2517e2eeb..c4f9af8678 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Eras.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Eras.hs @@ -33,6 +33,7 @@ module Cardano.Api.Experimental.Eras where import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra) import qualified Cardano.Api.Eras as Api import Cardano.Api.Eras.Core (BabbageEra, ConwayEra, Eon (..)) @@ -184,29 +185,29 @@ eraFromStringLike = \case -- instance IsEra ConwayEra where -- useEra = ConwayEra -- @ -{-# DEPRECATED eraToSbe "Use 'inject' instead." #-} +{-# DEPRECATED eraToSbe "Use 'convert' instead." #-} eraToSbe :: Era era -> ShelleyBasedEra era -eraToSbe = inject +eraToSbe = convert -instance Inject (Era era) (Api.CardanoEra era) where - inject = \case +instance Convert Era Api.CardanoEra where + convert = \case BabbageEra -> Api.BabbageEra ConwayEra -> Api.ConwayEra -instance Inject (Era era) (ShelleyBasedEra era) where - inject = \case +instance Convert Era ShelleyBasedEra where + convert = \case BabbageEra -> ShelleyBasedEraBabbage ConwayEra -> ShelleyBasedEraConway -instance Inject (Era era) (BabbageEraOnwards era) where - inject = \case +instance Convert Era BabbageEraOnwards where + convert = \case BabbageEra -> BabbageEraOnwardsBabbage ConwayEra -> BabbageEraOnwardsConway -instance Inject (BabbageEraOnwards era) (Era era) where - inject = \case +instance Convert BabbageEraOnwards Era where + convert = \case BabbageEraOnwardsBabbage -> BabbageEra BabbageEraOnwardsConway -> ConwayEra @@ -227,13 +228,13 @@ sbeToEra e@ShelleyBasedEraMary = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraAllegra = throwError $ DeprecatedEra e sbeToEra e@ShelleyBasedEraShelley = throwError $ DeprecatedEra e -{-# DEPRECATED babbageEraOnwardsToEra "Use 'inject' instead." #-} +{-# DEPRECATED babbageEraOnwardsToEra "Use 'convert' instead." #-} babbageEraOnwardsToEra :: BabbageEraOnwards era -> Era era -babbageEraOnwardsToEra = inject +babbageEraOnwardsToEra = convert -{-# DEPRECATED eraToBabbageEraOnwards "Use 'inject' instead." #-} +{-# DEPRECATED eraToBabbageEraOnwards "Use 'convert' instead." #-} eraToBabbageEraOnwards :: Era era -> BabbageEraOnwards era -eraToBabbageEraOnwards = inject +eraToBabbageEraOnwards = convert ------------------------------------------------------------------------- diff --git a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs index f7cd681018..9f4dfe972c 100644 --- a/cardano-api/internal/Cardano/Api/Experimental/Tx.hs +++ b/cardano-api/internal/Cardano/Api/Experimental/Tx.hs @@ -20,6 +20,7 @@ module Cardano.Api.Experimental.Tx ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras.Core (ToCardanoEra (toCardanoEra), forEraInEon) import Cardano.Api.Experimental.Eras @@ -63,7 +64,7 @@ makeUnsignedTx -> TxBodyContent BuildTx era -> Either TxBodyError (UnsignedTx era) makeUnsignedTx era bc = obtainCommonConstraints era $ do - let sbe = inject era + let sbe = convert era -- cardano-api types let apiTxOuts = txOuts bc @@ -139,7 +140,7 @@ eraSpecificLedgerTxBody -> TxBodyContent BuildTx era -> Either TxBodyError (Ledger.TxBody (LedgerEra era)) eraSpecificLedgerTxBody BabbageEra ledgerbody bc = do - let sbe = inject BabbageEra + let sbe = convert BabbageEra setUpdateProposal <- convTxUpdateProposal sbe (txUpdateProposal bc) diff --git a/cardano-api/internal/Cardano/Api/Fees.hs b/cardano-api/internal/Cardano/Api/Fees.hs index 3e44dc189c..61a4daf5ba 100644 --- a/cardano-api/internal/Cardano/Api/Fees.hs +++ b/cardano-api/internal/Cardano/Api/Fees.hs @@ -52,6 +52,7 @@ import Cardano.Api.Address import Cardano.Api.Certificate import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -232,7 +233,7 @@ estimateBalancedTxBody totalUTxOValue = do -- Step 1. Substitute those execution units into the tx - let sbe = inject w + let sbe = convert w txbodycontent1 <- maryEraOnwardsConstraints w $ first TxFeeEstimationScriptExecutionError $ @@ -1270,7 +1271,7 @@ calcReturnAndTotalCollateral -> (TxReturnCollateral CtxTx era, TxTotalCollateral era) calcReturnAndTotalCollateral _ _ _ TxInsCollateralNone _ _ _ _ = (TxReturnCollateralNone, TxTotalCollateralNone) calcReturnAndTotalCollateral w fee pp' TxInsCollateral{} txReturnCollateral txTotalCollateral cAddr totalAvailableCollateral = babbageEraOnwardsConstraints w $ do - let sbe = inject w + let sbe = convert w colPerc = pp' ^. Ledger.ppCollateralPercentageL -- We must first figure out how much lovelace we have committed -- as collateral and we must determine if we have enough lovelace at our diff --git a/cardano-api/internal/Cardano/Api/Protocol.hs b/cardano-api/internal/Cardano/Api/Protocol.hs index 72c759892d..e1c67a28a9 100644 --- a/cardano-api/internal/Cardano/Api/Protocol.hs +++ b/cardano-api/internal/Cardano/Api/Protocol.hs @@ -98,7 +98,8 @@ instance (ProtocolParamsShelleyBased StandardCrypto) ProtVer protocolInfo (ProtocolInfoArgsShelley genesis paramsShelleyBased_ paramsShelley_) = - bimap inject (fmap $ map inject) $ protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_ + bimap inject (fmap $ map inject) $ + protocolInfoShelley genesis paramsShelleyBased_ paramsShelley_ instance Consensus.LedgerSupportsProtocol diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs index ca737dd685..74f3cd8d0f 100644 --- a/cardano-api/internal/Cardano/Api/Query/Expr.hs +++ b/cardano-api/internal/Cardano/Api/Query/Expr.hs @@ -42,6 +42,7 @@ import Cardano.Api.Address import Cardano.Api.Block import Cardano.Api.Certificate import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eras @@ -164,7 +165,7 @@ queryPoolDistribution IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolDistribution era))) queryPoolDistribution era mPoolIds = do - let sbe = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolDistribution mPoolIds queryPoolState @@ -179,7 +180,7 @@ queryPoolState IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedPoolState era))) queryPoolState era mPoolIds = do - let sbe = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryPoolState mPoolIds queryProtocolParameters @@ -262,8 +263,7 @@ queryStakeAddresses sbe stakeCredentials networkId = queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeAddresses stakeCredentials networkId queryStakeDelegDeposits - :: forall era block point r - . BabbageEraOnwards era + :: BabbageEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block @@ -275,7 +275,7 @@ queryStakeDelegDeposits queryStakeDelegDeposits era stakeCreds | S.null stakeCreds = pure . pure $ pure mempty | otherwise = do - let sbe :: ShelleyBasedEra era = inject era + let sbe = convert era queryExpr $ QueryInEra . QueryInShelleyBasedEra sbe $ QueryStakeDelegDeposits stakeCreds queryStakeDistribution @@ -332,7 +332,7 @@ queryStakeSnapshot IO (Either UnsupportedNtcVersionError (Either EraMismatch (SerialisedStakeSnapshots era))) queryStakeSnapshot era mPoolIds = do - let sbe = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeSnapshot mPoolIds querySystemStart @@ -366,7 +366,7 @@ queryConstitution IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.Constitution (ShelleyLedgerEra era)))) queryConstitution era = do - let sbe = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryConstitution queryGovState @@ -380,12 +380,11 @@ queryGovState IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.GovState (ShelleyLedgerEra era)))) queryGovState era = do - let sbe = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe QueryGovState queryDRepState - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> Set (L.Credential L.DRepRole L.StandardCrypto) -- ^ An empty credentials set means that states for all DReps will be returned -> LocalStateQueryExpr @@ -399,12 +398,11 @@ queryDRepState (Either EraMismatch (Map (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto))) ) queryDRepState era drepCreds = do - let sbe :: ShelleyBasedEra era = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepState drepCreds queryDRepStakeDistribution - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> Set (L.DRep L.StandardCrypto) -- ^ An empty DRep set means that distributions for all DReps will be returned -> LocalStateQueryExpr @@ -415,12 +413,11 @@ queryDRepStakeDistribution IO (Either UnsupportedNtcVersionError (Either EraMismatch (Map (L.DRep L.StandardCrypto) L.Coin))) queryDRepStakeDistribution era dreps = do - let sbe = inject era :: ShelleyBasedEra era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryDRepStakeDistr dreps querySPOStakeDistribution - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> Set (L.KeyHash 'L.StakePool L.StandardCrypto) -- ^ An empty SPO key hash set means that distributions for all SPOs will be returned -> LocalStateQueryExpr @@ -434,14 +431,13 @@ querySPOStakeDistribution (Either EraMismatch (Map (L.KeyHash 'L.StakePool L.StandardCrypto) L.Coin)) ) querySPOStakeDistribution era spos = do - let sbe = inject era :: ShelleyBasedEra era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QuerySPOStakeDistr spos -- | Returns info about committee members filtered by: cold credentials, hot credentials and statuses. -- If empty sets are passed as filters, then no filtering is done. queryCommitteeMembersState - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> Set (L.Credential L.ColdCommitteeRole L.StandardCrypto) -> Set (L.Credential L.HotCommitteeRole L.StandardCrypto) -> Set L.MemberStatus @@ -453,14 +449,13 @@ queryCommitteeMembersState IO (Either UnsupportedNtcVersionError (Either EraMismatch (L.CommitteeMembersState L.StandardCrypto))) queryCommitteeMembersState era coldCreds hotCreds statuses = do - let sbe = inject era :: ShelleyBasedEra era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe (QueryCommitteeMembersState coldCreds hotCreds statuses) queryStakeVoteDelegatees - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> Set StakeCredential -> LocalStateQueryExpr block @@ -473,12 +468,11 @@ queryStakeVoteDelegatees (Either EraMismatch (Map StakeCredential (L.DRep L.StandardCrypto))) ) queryStakeVoteDelegatees era stakeCredentials = do - let sbe :: ShelleyBasedEra era = inject era + let sbe = convert era queryExpr $ QueryInEra $ QueryInShelleyBasedEra sbe $ QueryStakeVoteDelegatees stakeCredentials queryAccountState - :: forall era block point r - . ConwayEraOnwards era + :: ConwayEraOnwards era -> LocalStateQueryExpr block point @@ -488,5 +482,5 @@ queryAccountState (Either UnsupportedNtcVersionError (Either EraMismatch L.AccountState)) queryAccountState cOnwards = queryExpr $ - QueryInEra . QueryInShelleyBasedEra (inject cOnwards :: ShelleyBasedEra era) $ + QueryInEra . QueryInShelleyBasedEra (convert cOnwards) $ QueryAccountState diff --git a/cardano-api/internal/Cardano/Api/Tx/Body.hs b/cardano-api/internal/Cardano/Api/Tx/Body.hs index 38d12be3e6..753d4c1b5b 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Body.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Body.hs @@ -193,6 +193,7 @@ import Cardano.Api.Certificate import Cardano.Api.Eon.AllegraEraOnwards import Cardano.Api.Eon.AlonzoEraOnwards import Cardano.Api.Eon.BabbageEraOnwards +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.MaryEraOnwards import Cardano.Api.Eon.ShelleyBasedEra @@ -964,17 +965,19 @@ instance IsShelleyBasedEra era => FromJSON (TxOutValue era) where caseShelleyToAllegraOrMaryEraOnwards ( \shelleyToAlleg -> do ll <- o .: "lovelace" + let sbe = convert shelleyToAlleg pure $ - shelleyBasedEraConstraints (inject shelleyToAlleg :: ShelleyBasedEra era) $ - TxOutValueShelleyBased (inject shelleyToAlleg) $ - A.mkAdaValue (inject shelleyToAlleg :: ShelleyBasedEra era) ll + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ + A.mkAdaValue sbe ll ) ( \w -> do let l = toList o + sbe = convert w vals <- mapM decodeAssetId l pure $ - shelleyBasedEraConstraints (inject w :: ShelleyBasedEra era) $ - TxOutValueShelleyBased (inject w) $ + shelleyBasedEraConstraints sbe $ + TxOutValueShelleyBased sbe $ toLedgerValue w $ mconcat vals ) @@ -2081,7 +2084,7 @@ fromAlonzoTxOut w txdatums txOut = (fromAlonzoTxOutDatum w txdatums (txOut ^. L.dataHashTxOutL)) ReferenceScriptNone where - sbe :: ShelleyBasedEra era = inject w + sbe :: ShelleyBasedEra era = convert w fromAlonzoTxOutDatum :: () @@ -2113,7 +2116,7 @@ fromBabbageTxOut w txdatums txout = SJust rScript -> fromShelleyScriptToReferenceScript shelleyBasedEra rScript ) where - sbe :: ShelleyBasedEra era = inject w + sbe :: ShelleyBasedEra era = convert w -- NOTE: This is different to 'fromBabbageTxOutDatum' as it may resolve -- 'DatumHash' values using the datums included in the transaction. diff --git a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs index da05768d01..fceb8c1e5d 100644 --- a/cardano-api/internal/Cardano/Api/Tx/Compatible.hs +++ b/cardano-api/internal/Cardano/Api/Tx/Compatible.hs @@ -13,10 +13,10 @@ module Cardano.Api.Tx.Compatible ) where +import Cardano.Api.Eon.Convert import Cardano.Api.Eon.ConwayEraOnwards import Cardano.Api.Eon.ShelleyBasedEra import Cardano.Api.Eon.ShelleyToBabbageEra -import Cardano.Api.Eras import Cardano.Api.ProtocolParameters import Cardano.Api.Script import Cardano.Api.Tx.Body @@ -67,7 +67,7 @@ createCompatibleSignedTx sbeF ins outs witnesses txFee' anyProtocolUpdate anyVot shelleyBasedEraConstraints sbeF $ do tx <- case anyProtocolUpdate of ProtocolUpdate shelleyToBabbageEra updateProposal -> do - let sbe = inject shelleyToBabbageEra + let sbe = convert shelleyToBabbageEra ledgerPParamsUpdate <- toLedgerUpdate sbe updateProposal @@ -86,7 +86,7 @@ createCompatibleSignedTx sbeF ins outs witnesses txFee' anyProtocolUpdate anyVot return $ ShelleyTx sbe finalTx ProposalProcedures conwayOnwards proposalProcedures -> do - let sbe = inject conwayOnwards + let sbe = convert conwayOnwards proposals = convProposalProcedures proposalProcedures apiScriptWitnesses = scriptWitnessesProposing proposalProcedures ledgerScripts = convScripts apiScriptWitnesses diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs index 2a3fc42dec..4030210669 100644 --- a/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs +++ b/cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs @@ -15,6 +15,7 @@ module Test.Cardano.Api.Transaction.Autobalance where import Cardano.Api +import Cardano.Api.Eon.Convert import Cardano.Api.Fees import qualified Cardano.Api.Ledger as L import qualified Cardano.Api.Ledger.Lens as L @@ -56,9 +57,9 @@ import Test.Tasty.Hedgehog (testProperty) prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset :: Property prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.propertyOnce $ do let ceo = ConwayEraOnwardsConway - beo = inject ceo - meo = inject beo - sbe = inject ceo + beo = convert ceo + meo = convert beo + sbe = convert ceo era = toCardanoEra sbe aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era @@ -140,9 +141,9 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr prop_make_transaction_body_autobalance_multi_asset_collateral :: Property prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ do let ceo = ConwayEraOnwardsConway - beo = inject ceo - sbe = inject beo - meo = inject beo + beo = convert ceo + sbe = convert beo + meo = convert beo era = toCardanoEra sbe aeo <- H.nothingFail $ forEraMaybeEon @AlonzoEraOnwards era @@ -205,8 +206,8 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $ prop_calcReturnAndTotalCollateral :: Property prop_calcReturnAndTotalCollateral = H.withTests 400 . H.property $ do let beo = BabbageEraOnwardsConway - sbe = inject beo - era = inject beo + sbe = convert beo + era = convert beo feeCoin@(L.Coin fee) <- forAll genLovelace totalCollateral <- forAll $ genValueForTxOut sbe let totalCollateralAda = totalCollateral ^. L.adaAssetL sbe @@ -308,7 +309,7 @@ textEnvTypes = mkUtxos :: BabbageEraOnwards era -> L.ScriptHash L.StandardCrypto -> UTxO era mkUtxos beo scriptHash = babbageEraOnwardsConstraints beo $ do - let sbe = inject beo + let sbe = convert beo UTxO [ ( TxIn @@ -356,7 +357,7 @@ mkTxOutput -- ^ there will be an asset in the txout if provided -> [TxOut CtxTx era] mkTxOutput beo address mScriptHash = babbageEraOnwardsConstraints beo $ do - let sbe = inject beo + let sbe = convert beo [ TxOut address ( TxOutValueShelleyBased From 52e250f67d35f45a1fa38c55cfe8a04af4c40ec2 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Tue, 26 Nov 2024 12:16:57 +0100 Subject: [PATCH 11/11] Switch to system dependencies action fork to fix macos build issues --- .github/workflows/haskell.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index a1f90674e1..b761d9db29 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -76,7 +76,8 @@ jobs: cabal-version: ${{ matrix.cabal }} - name: Install system dependencies - uses: input-output-hk/actions/base@latest + # TODO: switch to input-output-hk/actions/base@latest after https://github.com/input-output-hk/actions/pull/29 gets merged + uses: carbolymer/actions/base@latest with: use-sodium-vrf: true # default is true