From d09f60b790dd831e61442c81c6e1634ca9311108 Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Thu, 21 Nov 2024 11:01:52 -0400 Subject: [PATCH] WIP --- cabal.project | 5 -- cardano-cli/cardano-cli.cabal | 7 ++- .../Cardano/CLI/EraBased/Options/Common.hs | 18 +----- .../Cardano/CLI/EraBased/Run/Transaction.hs | 25 ++++++--- .../Cardano/CLI/EraBased/Script/Mint/Read.hs | 4 +- .../Cardano/CLI/EraBased/Script/Mint/Types.hs | 4 +- cardano-cli/src/Cardano/CLI/Read.hs | 56 ++----------------- cardano-cli/src/Cardano/CLI/Types/Common.hs | 3 - .../Types/Errors/PlutusScriptDecodeError.hs | 32 +++++++++++ .../CLI/Types/Errors/ScriptDataError.hs | 36 ++++++++++++ cardano-cli/src/Cardano/CLI/Types/Output.hs | 2 +- 11 files changed, 103 insertions(+), 89 deletions(-) create mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs create mode 100644 cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs diff --git a/cabal.project b/cabal.project index 8f6d938eea..818b0da028 100644 --- a/cabal.project +++ b/cabal.project @@ -58,8 +58,3 @@ write-ghc-environment-files: always -- Do NOT add more source-repository-package stanzas here unless they are strictly -- temporary! Please read the section in CONTRIBUTING about updating dependencies. -- https://github.com/IntersectMBO/cardano-api/compare/master...jordan/is-plutus-language needed for contraint propagation -source-repository-package - type: git - location: https://github.com/IntersectMBO/cardano-api.git - tag: ce28333ef641e77087f185a100ad0cb9ed555f45 - subdir: cardano-api \ No newline at end of file diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 437bb156e7..016ca82595 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -23,6 +23,7 @@ common project-config default-extensions: OverloadedStrings build-depends: base >=4.14 && <4.21 ghc-options: + -Wno-deprecations -Wall -Wcompat -Wincomplete-record-updates @@ -44,7 +45,9 @@ library , maybe-unix if impl(ghc < 9.6) - ghc-options: -Wno-redundant-constraints + ghc-options: + -Wno-redundant-constraints + -Wno-deprecations hs-source-dirs: src exposed-modules: Cardano.CLI.Byron.Commands @@ -172,10 +175,12 @@ library Cardano.CLI.Types.Errors.KeyCmdError Cardano.CLI.Types.Errors.NodeCmdError Cardano.CLI.Types.Errors.NodeEraMismatchError + Cardano.CLI.Types.Errors.PlutusScriptDecodeError Cardano.CLI.Types.Errors.ProtocolParamsError Cardano.CLI.Types.Errors.QueryCmdError Cardano.CLI.Types.Errors.QueryCmdLocalStateQueryError Cardano.CLI.Types.Errors.RegistrationError + Cardano.CLI.Types.Errors.ScriptDataError Cardano.CLI.Types.Errors.ScriptDecodeError Cardano.CLI.Types.Errors.StakeAddressCmdError Cardano.CLI.Types.Errors.StakeAddressDelegationError diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs index fe5a1fd738..629c70d67b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Common.hs @@ -1539,7 +1539,6 @@ pPlutusStakeReferenceScriptWitnessFilesVotingProposing prefix autoBalanceExecUni AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing pPlutusStakeReferenceScriptWitnessFiles :: String @@ -1556,7 +1555,6 @@ pPlutusStakeReferenceScriptWitnessFiles prefix autoBalanceExecUnits = AutoBalance -> pure (ExecutionUnits 0 0) ManualBalance -> pExecutionUnits $ prefix ++ "reference-tx-in" ) - <*> pure Nothing pPlutusScriptLanguage :: String -> Parser AnyPlutusScriptVersion pPlutusScriptLanguage prefix = plutusP prefix PlutusScriptV2 "v2" <|> plutusP prefix PlutusScriptV3 "v3" @@ -1947,14 +1945,14 @@ pTxIn sbe balance = -> ScriptWitnessFiles WitCtxTxIn createSimpleReferenceScriptWitnessFiles refTxIn = let simpleLang = AnyScriptLanguage SimpleScriptLanguage - in SimpleReferenceScriptWitnessFiles refTxIn simpleLang Nothing + in SimpleReferenceScriptWitnessFiles refTxIn simpleLang pPlutusReferenceScriptWitness :: ShelleyBasedEra era -> BalanceTxExecUnits -> Parser (ScriptWitnessFiles WitCtxTxIn) pPlutusReferenceScriptWitness sbe' autoBalanceExecUnits = caseShelleyToBabbageOrConwayEraOnwards ( const $ - createPlutusReferenceScriptWitnessFiles + PlutusReferenceScriptWitnessFiles <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" <*> pScriptDatumOrFile "spending-reference-tx-in" WitCtxTxIn @@ -1965,7 +1963,7 @@ pTxIn sbe balance = ) ) ( const $ - createPlutusReferenceScriptWitnessFiles + PlutusReferenceScriptWitnessFiles <$> pReferenceTxIn "spending-" "plutus" <*> pPlutusScriptLanguage "spending-" <*> pScriptDatumOrFileCip69 "spending-reference-tx-in" WitCtxTxIn @@ -1976,16 +1974,6 @@ pTxIn sbe balance = ) ) sbe' - where - createPlutusReferenceScriptWitnessFiles - :: TxIn - -> AnyPlutusScriptVersion - -> ScriptDatumOrFile WitCtxTxIn - -> ScriptRedeemerOrFile - -> ExecutionUnits - -> ScriptWitnessFiles WitCtxTxIn - createPlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits = - PlutusReferenceScriptWitnessFiles refIn sLang sDatum sRedeemer execUnits Nothing pEmbeddedPlutusScriptWitness :: Parser (ScriptWitnessFiles WitCtxTxIn) pEmbeddedPlutusScriptWitness = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs index 398c6816a7..93cc93f889 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Transaction.hs @@ -77,7 +77,7 @@ import Data.Function ((&)) import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as Text @@ -1248,9 +1248,9 @@ getAllReferenceInputs :: ScriptWitness witctx era -> Maybe TxIn getReferenceInput sWit = case sWit of - PlutusScriptWitness _ _ (PReferenceScript refIn _) _ _ _ -> Just refIn + PlutusScriptWitness _ _ (PReferenceScript refIn) _ _ _ -> Just refIn PlutusScriptWitness _ _ PScript{} _ _ _ -> Nothing - SimpleScriptWitness _ (SReferenceScript refIn _) -> Just refIn + SimpleScriptWitness _ (SReferenceScript refIn) -> Just refIn SimpleScriptWitness _ SScript{} -> Nothing toAddressInAnyEra @@ -1403,19 +1403,26 @@ createTxMintValue era (val, scriptWitnesses) = caseShelleyToAllegraOrMaryEraOnwards (const (txFeatureMismatchPure (toCardanoEra era) TxFeatureMintValue)) ( \w -> do - -- The set of policy ids for which we need witnesses: - let witnessesNeededSet :: Set PolicyId - witnessesNeededSet = - fromList [pid | (AssetId pid _, _) <- toList val] + let policiesWithAssets :: [(PolicyId, AssetName, Quantity)] + policiesWithAssets = [(pid, assetName, quantity) | (AssetId pid assetName, quantity) <- toList val] + -- The set of policy ids for which we need witnesses: + witnessesNeededSet :: Set PolicyId + witnessesNeededSet = fromList [pid | (pid, _, _) <- policiesWithAssets] let witnessesProvidedMap :: Map PolicyId (ScriptWitness WitCtxMint era) witnessesProvidedMap = fromList $ [(polid, sWit) | MintScriptWitnessWithPolicyId polid sWit <- scriptWitnesses] witnessesProvidedSet = Map.keysSet witnessesProvidedMap - + policiesWithWitnesses = + Map.fromListWith + (<>) + [ (pid, [(assetName, quantity, BuildTxWith witness)]) + | (pid, assetName, quantity) <- policiesWithAssets + , witness <- maybeToList $ Map.lookup pid witnessesProvidedMap + ] -- Check not too many, nor too few: validateAllWitnessesProvided witnessesNeededSet witnessesProvidedSet validateNoUnnecessaryWitnesses witnessesNeededSet witnessesProvidedSet - return (TxMintValue w val (BuildTxWith witnessesProvidedMap)) + pure $ TxMintValue w policiesWithWitnesses ) era where diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs index 3ff7db7e95..5b40eb1690 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Read.hs @@ -66,7 +66,7 @@ readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn MintScriptWitnessWithPolicyId polId $ SimpleScriptWitness (sbeToSimpleScriptLangInEra sbe) - (SReferenceScript refTxIn $ Just $ unPolicyId polId) + (SReferenceScript refTxIn) readMintScriptWitness sbe ( OnDiskPlutusRefScript @@ -74,7 +74,7 @@ readMintScriptWitness ) = do case anyPlutusScriptVersion of AnyPlutusScriptVersion lang -> do - let pScript = PReferenceScript refTxIn $ Just $ unPolicyId polId + let pScript = PReferenceScript refTxIn redeemer <- -- TODO: Implement a new error type to capture this. FileError is not representative of cases -- where we do not have access to the script. diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs index c4c93b9e8f..192e4ed0f3 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Script/Mint/Types.hs @@ -18,8 +18,10 @@ where import Cardano.Api -import Cardano.CLI.Read import Cardano.CLI.Types.Common (ScriptDataOrFile) +import Cardano.CLI.Types.Errors.PlutusScriptDecodeError +import Cardano.CLI.Types.Errors.ScriptDataError +import Cardano.CLI.Types.Errors.ScriptDecodeError -- We always need the policy id when constructing a transaction that mints. -- In the case of reference scripts, the user currently must provide the policy id (script hash) diff --git a/cardano-cli/src/Cardano/CLI/Read.hs b/cardano-cli/src/Cardano/CLI/Read.hs index 22673eabd3..2a2d9abf07 100644 --- a/cardano-cli/src/Cardano/CLI/Read.hs +++ b/cardano-cli/src/Cardano/CLI/Read.hs @@ -112,6 +112,8 @@ import Cardano.Api.Shelley as Api import qualified Cardano.Binary as CBOR import Cardano.CLI.Types.Common import Cardano.CLI.Types.Errors.DelegationError +import Cardano.CLI.Types.Errors.PlutusScriptDecodeError +import Cardano.CLI.Types.Errors.ScriptDataError import Cardano.CLI.Types.Errors.ScriptDecodeError import Cardano.CLI.Types.Errors.StakeCredentialError import Cardano.CLI.Types.Governance @@ -357,7 +359,6 @@ readScriptWitness datumOrFile redeemerOrFile execUnits - mPid ) = do caseShelleyToAlonzoOrBabbageEraOnwards ( const $ @@ -379,7 +380,7 @@ readScriptWitness PlutusScriptWitness sLangInEra version - (PReferenceScript refTxIn (unPolicyId <$> mPid)) + (PReferenceScript refTxIn) datum redeemer execUnits @@ -395,7 +396,6 @@ readScriptWitness ( SimpleReferenceScriptWitnessFiles refTxIn anyScrLang@(AnyScriptLanguage anyScriptLanguage) - mPid ) = do caseShelleyToAlonzoOrBabbageEraOnwards ( const $ @@ -409,7 +409,7 @@ readScriptWitness case languageOfScriptLanguageInEra sLangInEra of SimpleScriptLanguage -> return . SimpleScriptWitness sLangInEra $ - SReferenceScript refTxIn (unPolicyId <$> mPid) + SReferenceScript refTxIn PlutusScriptLanguage{} -> error "readScriptWitness: Should not be possible to specify a plutus script" Nothing -> @@ -433,30 +433,6 @@ validateScriptSupportedInEra era script@(ScriptInAnyLang lang _) = (anyCardanoEra $ toCardanoEra era) Just script' -> pure script' -data ScriptDataError - = ScriptDataErrorFile (FileError ()) - | ScriptDataErrorJsonParse !FilePath !String - | ScriptDataErrorConversion !FilePath !ScriptDataJsonError - | ScriptDataErrorValidation !FilePath !ScriptDataRangeError - | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError - | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError - deriving Show - -renderScriptDataError :: ScriptDataError -> Doc ann -renderScriptDataError = \case - ScriptDataErrorFile err -> - prettyError err - ScriptDataErrorJsonParse fp jsonErr -> - "Invalid JSON format in file: " <> pshow fp <> "\nJSON parse error: " <> pretty jsonErr - ScriptDataErrorConversion fp sDataJsonErr -> - "Error reading metadata at: " <> pshow fp <> "\n" <> prettyError sDataJsonErr - ScriptDataErrorValidation fp sDataRangeErr -> - "Error validating script data at: " <> pshow fp <> ":\n" <> prettyError sDataRangeErr - ScriptDataErrorMetadataDecode fp decoderErr -> - "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr - ScriptDataErrorJsonBytes e -> - prettyError e - readScriptDatumOrFile :: ScriptDatumOrFile witctx -> ExceptT ScriptDataError IO (ScriptDatum witctx) @@ -630,30 +606,6 @@ readFilePlutusScript plutusScriptFp = do hoistEither $ deserialisePlutusScript bs -data PlutusScriptDecodeError - = PlutusScriptDecodeErrorUnknownVersion !Text - | PlutusScriptJsonDecodeError !JsonDecodeError - | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError - | PlutusScriptDecodeErrorVersionMismatch - !Text - -- ^ Script version - !AnyPlutusScriptVersion - -- ^ Attempted to decode with version - -instance Error PlutusScriptDecodeError where - prettyError = \case - PlutusScriptDecodeErrorUnknownVersion version -> - "Unknown Plutus script version: " <> pretty version - PlutusScriptJsonDecodeError err -> - prettyError err - PlutusScriptDecodeTextEnvelopeError err -> - prettyError err - PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> - "Version mismatch in code: script version that was read" - <> pretty version - <> " but tried to decode script version: " - <> pshow v - deserialisePlutusScript :: BS.ByteString -> Either PlutusScriptDecodeError AnyPlutusScript diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 492ae1a746..61a32be9bf 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -421,14 +421,11 @@ data ScriptWitnessFiles witctx where -> ScriptDatumOrFile witctx -> ScriptRedeemerOrFile -> ExecutionUnits - -> Maybe PolicyId -- ^ For minting reference scripts -> ScriptWitnessFiles witctx SimpleReferenceScriptWitnessFiles :: TxIn -> AnyScriptLanguage - -> Maybe PolicyId - -- ^ For minting reference scripts -> ScriptWitnessFiles witctx deriving instance Show (ScriptWitnessFiles witctx) diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs new file mode 100644 index 0000000000..24effd990a --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/PlutusScriptDecodeError.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.PlutusScriptDecodeError + ( PlutusScriptDecodeError(..) + ) where + +import Cardano.Api +import Data.Text (Text) + +data PlutusScriptDecodeError + = PlutusScriptDecodeErrorUnknownVersion !Text + | PlutusScriptJsonDecodeError !JsonDecodeError + | PlutusScriptDecodeTextEnvelopeError !TextEnvelopeError + | PlutusScriptDecodeErrorVersionMismatch + !Text + -- ^ Script version + !AnyPlutusScriptVersion + -- ^ Attempted to decode with version + +instance Error PlutusScriptDecodeError where + prettyError = \case + PlutusScriptDecodeErrorUnknownVersion version -> + "Unknown Plutus script version: " <> pretty version + PlutusScriptJsonDecodeError err -> + prettyError err + PlutusScriptDecodeTextEnvelopeError err -> + prettyError err + PlutusScriptDecodeErrorVersionMismatch version (AnyPlutusScriptVersion v) -> + "Version mismatch in code: script version that was read" + <> pretty version + <> " but tried to decode script version: " + <> pshow v \ No newline at end of file diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs new file mode 100644 index 0000000000..909c6032cd --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE LambdaCase #-} + +module Cardano.CLI.Types.Errors.ScriptDataError + ( ScriptDataError(..) + , renderScriptDataError + ) where + + + +import Cardano.Api +import qualified Cardano.Binary as CBOR + + +data ScriptDataError + = ScriptDataErrorFile (FileError ()) + | ScriptDataErrorJsonParse !FilePath !String + | ScriptDataErrorConversion !FilePath !ScriptDataJsonError + | ScriptDataErrorValidation !FilePath !ScriptDataRangeError + | ScriptDataErrorMetadataDecode !FilePath !CBOR.DecoderError + | ScriptDataErrorJsonBytes !ScriptDataJsonBytesError + deriving Show + +renderScriptDataError :: ScriptDataError -> Doc ann +renderScriptDataError = \case + ScriptDataErrorFile err -> + prettyError err + ScriptDataErrorJsonParse fp jsonErr -> + "Invalid JSON format in file: " <> pshow fp <> "\nJSON parse error: " <> pretty jsonErr + ScriptDataErrorConversion fp sDataJsonErr -> + "Error reading metadata at: " <> pshow fp <> "\n" <> prettyError sDataJsonErr + ScriptDataErrorValidation fp sDataRangeErr -> + "Error validating script data at: " <> pshow fp <> ":\n" <> prettyError sDataRangeErr + ScriptDataErrorMetadataDecode fp decoderErr -> + "Error decoding CBOR metadata at: " <> pshow fp <> " Error: " <> pshow decoderErr + ScriptDataErrorJsonBytes e -> + prettyError e \ No newline at end of file diff --git a/cardano-cli/src/Cardano/CLI/Types/Output.hs b/cardano-cli/src/Cardano/CLI/Types/Output.hs index 1e9c5d1240..4f47c4ad95 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Output.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Output.hs @@ -383,7 +383,7 @@ renderScriptCosts (UTxO utxo) eUnitPrices scriptMapping executionCostMapping = Left err -> Left (PlutusScriptCostErrExecError sWitInd (Just scriptHash) err) : accum -- TODO: Create a new sum type to encapsulate the fact that we can also -- have a txin and render the txin in the case of reference scripts. - Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn _) _ _ _)) -> + Just (AnyScriptWitness (PlutusScriptWitness _ _ (PReferenceScript refTxIn) _ _ _)) -> case Map.lookup refTxIn utxo of Nothing -> Left (PlutusScriptCostErrRefInputNotInUTxO refTxIn) : accum Just (TxOut _ _ _ refScript) ->