fix numero dos

cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs

@@ -650,12 +650,15 @@ genTxMintValue =
   inEonForEra
     (pure TxMintNone)
     $ \w -> do
-      values <- Gen.list (Range.constant 1 10) (genValueForMinting w)
-      witnessedValues <- forM values $ \v ->
-        (v,) . pure <$> genScriptWitnessForMint (maryEraOnwardsToShelleyBasedEra w)
+      policies <- Gen.list (Range.constant 1 10) genPolicyId
+      assets <- forM policies $ \policy ->
+        (,) policy <$>
+          ((,,) <$> genAssetName 
+                <*> genPositiveQuantity 
+                <*> fmap (fmap pure) genScriptWitnessForMint (maryEraOnwardsToShelleyBasedEra w))
       Gen.choice
         [ pure TxMintNone
-        , pure $ TxMintValue w witnessedValues
+        , pure $ TxMintValue w (fromList assets)
         ]
 
 genTxBodyContent :: ShelleyBasedEra era -> Gen (TxBodyContent BuildTx era)

cardano-api/internal/Cardano/Api/Fees.hs

@@ -8,6 +8,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 -- | Fee calculation
@@ -1353,10 +1354,8 @@ calculateChangeValue
   :: ShelleyBasedEra era -> Value -> TxBodyContent build era -> Value
 calculateChangeValue sbe incoming txbodycontent =
   let outgoing = calculateCreatedUTOValue sbe txbodycontent
-      mintedValues = case txMintValue txbodycontent of
-        TxMintNone -> mempty
-        TxMintValue _ vs -> fst <$> vs
-   in mconcat $ [incoming] <> mintedValues <> [negateValue outgoing]
+      mintedValues = txMintValueToValue $ txMintValue txbodycontent
+   in mconcat [incoming, mintedValues, 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
@@ -1628,39 +1627,20 @@ substituteExecutionUnits
       -> Either (TxBodyErrorAutoBalance era) (TxMintValue BuildTx era)
     mapScriptWitnessesMinting TxMintNone = Right TxMintNone
     mapScriptWitnessesMinting (TxMintValue w valueWitnesses) = do
-      let valuesWithPoliciesWithWitnesses = fromList
-            [ (policyId, (value, witness))
-            | let ValueNestedRep bundle = valueToNestedRep value
-            , ValueNestedBundle policyId _ <- bundle
-            , (value, witness) <- valueWitnesses
-            ]
-          -- all policies sorted with correct indices
-          allPolicies = zip [0..] $ Map.keys valuesWithPoliciesWithWitnesses
-      forM valueWitnesses $ \(value, witness) -> 
-        -- TODO
-
-      -- TxMintValue supported value $ BuildTxWith $ fromList
-      let mappedScriptWitnesses
-            :: [(PolicyId, Either (TxBodyErrorAutoBalance era) (ScriptWitness WitCtxMint era))]
+      let ixedPolicies = zip [0 ..] $ toList valueWitnesses
           mappedScriptWitnesses =
-            [ (policyid, eWitness)
-            | -- 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 eWitness = substituteExecUnits (ScriptWitnessIndexMint ix) witness
+            [ (policyId, (assetName',quantity,) <$> substitutedWitness)
+            | (ix, (policyId, (assetName', quantity, BuildTxWith witness))) <- ixedPolicies
+            , let substitutedWitness = BuildTxWith <$> substituteExecUnits (ScriptWitnessIndexMint ix) witness
             ]
-      -- let mappedScriptWitnesses =
-      --       [(value, eWitness) | let eWitness substituteExecUnits witness
-      final <- traverseScriptWitnesses mappedScriptWitnesses
-      Right . TxMintValue w value . BuildTxWith $
-        fromList final
+      final <- fromList <$> 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

cardano-api/internal/Cardano/Api/Tx/Body.hs

@@ -113,6 +113,7 @@ module Cardano.Api.Tx.Body
   , TxCertificates (..)
   , TxUpdateProposal (..)
   , TxMintValue (..)
+  , txMintValueToValue
   , TxVotingProcedures (..)
   , mkTxVotingProcedures
   , TxProposalProcedures (..)
@@ -215,7 +216,6 @@ import           Cardano.Api.ProtocolParameters
 import qualified Cardano.Api.ReexposeLedger as Ledger
 import           Cardano.Api.Script
 import           Cardano.Api.ScriptData
-import           Cardano.Api.ScriptData ()
 import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseJSON
 import           Cardano.Api.SerialiseRaw
@@ -1275,16 +1275,27 @@ data TxMintValue build era where
   TxMintNone :: TxMintValue build era
   TxMintValue
     :: MaryEraOnwards era
-    -- This seems ill-defined:
-    -- Value here should not contain coins, they are ignored down the line
-    -- this basically means it should be a policyId -> witness map
-    -> [(Value, BuildTxWith build (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', (assetName', quantity, _)) <- toList policiesWithAssets
+    ]
+
 -- ----------------------------------------------------------------------------
 -- Votes within transactions (era-dependent)
 --
@@ -1588,7 +1599,7 @@ data TxBodyError
   | TxBodyOutputNegative !Quantity !TxOutInAnyEra
   | TxBodyOutputOverflow !Quantity !TxOutInAnyEra
   | TxBodyMetadataError ![(Word64, TxMetadataRangeError)]
-  | TxBodyMintAdaError
+  | TxBodyMintAdaError -- TODO remove - case nonexistent
   | TxBodyInIxOverflow !TxIn
   | TxBodyMissingProtocolParams
   | TxBodyProtocolParamsConversionError !ProtocolParametersConversionError
@@ -1858,11 +1869,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 _ vs -> forM_ vs $ \(v, _) -> guard (selectLovelace v == 0) ?! TxBodyMintAdaError
+validateMintValue _txMintValue = pure ()
 
 inputIndexDoesNotExceedMax :: [(TxIn, a)] -> Either TxBodyError ()
 inputIndexDoesNotExceedMax txIns =
@@ -2318,11 +2327,19 @@ fromLedgerTxMintValue
   :: ShelleyBasedEra era
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxMintValue ViewTx era
-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 TxMintValue w [(fromMaryValue mint, ViewTx)]
+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 $
+          fromList
+            [ (policyId', (assetName', quantity, ViewTx))
+            | -- only non-ada can be here
+            (AssetId policyId' assetName', quantity) <- toList assetMap
+            ]
 
 -- TxMintValue w undefined
 --   case sbe of
@@ -2451,13 +2468,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 _ vs ->
-      mconcat $ flip map vs $ \(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)

cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs

@@ -83,9 +83,7 @@ prop_make_transaction_body_autobalance_return_correct_fee_for_multi_asset = H.pr
   let txMint =
         TxMintValue
           meo
-          undefined
-  -- [(AssetId policyId' "eeee", 1)]
-  -- (BuildTxWith [(policyId', plutusWitness)])
+          [(policyId', ("eeee", 1, BuildTxWith plutusWitness))]
 
   -- tx body content without an asset in TxOut
   let content =
@@ -168,9 +166,7 @@ prop_make_transaction_body_autobalance_multi_asset_collateral = H.propertyOnce $
   let txMint =
         TxMintValue
           meo
-          undefined
-  -- [(AssetId policyId' "eeee", 1)]
-  -- (BuildTxWith [(policyId', plutusWitness)])
+          [(policyId', ("eeee", 1, BuildTxWith plutusWitness))]
 
   let content =
         defaultTxBodyContent sbe