Update createTxMintValue and propagate the removal of Maybe PolicyId

from PReferenceScript and SReferenceScript constructors Co-authored-by: Mateusz Gałażyn <mateusz.galazyn@gmail.com>
IntersectMBO · Nov 21, 2024 · 9c89fc0 · 9c89fc0
1 parent bfee1ce
commit 9c89fc0
Show file tree

Hide file tree

Showing 4 changed files with 22 additions and 13 deletions.
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/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) ->