diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 437bb156e..5cb7a7d18 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -45,6 +45,7 @@ library if impl(ghc < 9.6) ghc-options: -Wno-redundant-constraints + hs-source-dirs: src exposed-modules: Cardano.CLI.Byron.Commands @@ -172,10 +173,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 fe5a1fd73..629c70d67 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 398c6816a..93cc93f88 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 3ff7db7e9..5b40eb169 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 c4c93b9e8..192e4ed0f 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 22673eabd..2a2d9abf0 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 492ae1a74..61a32be9b 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 000000000..24effd990 --- /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 000000000..909c6032c --- /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 1e9c5d124..4f47c4ad9 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) ->