WIP

IntersectMBO · Nov 21, 2024 · 424ad7b · 424ad7b
1 parent fafcea1
commit 424ad7b
Show file tree

Hide file tree

Showing 10 changed files with 100 additions and 83 deletions.
diff --git 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
@@ -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
@@ -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
@@ -66,15 +66,15 @@ readMintScriptWitness sbe (OnDiskSimpleRefScript (SimpleRefScriptCliArgs refTxIn
     MintScriptWitnessWithPolicyId polId $
       SimpleScriptWitness
         (sbeToSimpleScriptLangInEra sbe)
-        (SReferenceScript refTxIn $ Just $ unPolicyId polId)
+        (SReferenceScript refTxIn)
 readMintScriptWitness
   sbe
   ( OnDiskPlutusRefScript
       (PlutusRefScriptCliArgs refTxIn anyPlutusScriptVersion redeemerFile execUnits polId)
     ) = 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
@@ -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
@@ -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
@@ -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
@@ -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
diff --git a/cardano-cli/src/Cardano/CLI/Types/Errors/ScriptDataError.hs 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
diff --git 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) ->