fix numero dos

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

@@ -650,12 +650,17 @@ 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 3) genPolicyId
+      assets <- forM policies $ \policy ->
+        (,) policy <$>
+          Gen.list
+            (Range.constant 1 3)
+            ((,,) <$> 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]
+      mintedValue = txMintValueToValue $ txMintValue txbodycontent
+   in mconcat [incoming, mintedValue, 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
@@ -1627,40 +1626,20 @@ substituteExecutionUnits
       :: TxMintValue BuildTx era
       -> 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
+    mapScriptWitnessesMinting txMintValue'@(TxMintValue w _) = do
+      let mappedScriptWitnesses =
+            [ (policyId, pure . (assetName',quantity,) <$> substitutedWitness)
+            | (ix, policyId, assetName', quantity, BuildTxWith witness) <- txMintValueToIndexed txMintValue'
+            , let substitutedWitness = BuildTxWith <$> substituteExecUnits ix witness
             ]
-          -- 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))]
-          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
-            ]
-      -- let mappedScriptWitnesses =
-      --       [(value, eWitness) | let eWitness substituteExecUnits witness
-      final <- traverseScriptWitnesses mappedScriptWitnesses
-      Right . TxMintValue w value . BuildTxWith $
-        fromList final
+      final <- Map.fromListWith (<>) <$> 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/Script.hs

@@ -54,6 +54,7 @@ module Cardano.Api.Script
   , WitCtxMint
   , WitCtxStake
   , WitCtx (..)
+  , WitCtxMaybe (..)
   , ScriptWitness (..)
   , Witness (..)
   , KeyWitnessInCtx (..)
@@ -165,7 +166,7 @@ import           Data.String (IsString)
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
-import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
+import           Data.Type.Equality (TestEquality (..), type (==), (:~:) (Refl))
 import           Data.Typeable (Typeable)
 import           Data.Vector (Vector)
 import           GHC.Exts (IsList (..))
@@ -676,6 +677,17 @@ data WitCtx witctx where
   WitCtxMint :: WitCtx WitCtxMint
   WitCtxStake :: WitCtx WitCtxStake
 
+-- TODO: not needed anymore - remove
+
+-- | A typed version of a 'Maybe'. Allows to store value of type @a@ when @purpose ~ witctx@, otherwise it is empty.
+data WitCtxMaybe purpose witctx a where
+  WitCtxJust :: WitCtx purpose -> a -> WitCtxMaybe purpose purpose a
+  WitCtxNothing :: (purpose == witctx) ~ False => WitCtxMaybe purpose witctx a
+
+instance Show a => Show (WitCtxMaybe p w a) where
+  show (WitCtxJust _ a) = "WitCtxJust " <> show a
+  show WitCtxNothing = "WitCtxNothing"
+
 -- | Scripts can now exist in the UTxO at a transaction output. We can
 -- reference these scripts via specification of a reference transaction input
 -- in order to witness spending inputs, withdrawals, certificates

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

@@ -113,6 +113,8 @@ module Cardano.Api.Tx.Body
   , TxCertificates (..)
   , TxUpdateProposal (..)
   , TxMintValue (..)
+  , txMintValueToValue
+  , txMintValueToIndexed
   , TxVotingProcedures (..)
   , mkTxVotingProcedures
   , TxProposalProcedures (..)
@@ -215,7 +217,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 +1276,46 @@ 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', assets) <- toList policiesWithAssets
+    , (assetName', quantity, _) <- assets
+    ]
+
+-- | Index the assets with witnesses in the order of policy ids.
+txMintValueToIndexed
+  :: TxMintValue build era
+  -> [ ( ScriptWitnessIndex
+       , PolicyId
+       , AssetName
+       , Quantity
+       , BuildTxWith build (ScriptWitness WitCtxMint era)
+       )
+     ]
+txMintValueToIndexed TxMintNone = []
+txMintValueToIndexed (TxMintValue _ policiesWithAssets) =
+  [ (ScriptWitnessIndexMint ix, policyId', assetName', quantity, witness)
+  | (ix, (policyId', assets)) <- zip [0 ..] $ toList policiesWithAssets
+  , (assetName', quantity, witness) <- assets
+  ]
+
 -- ----------------------------------------------------------------------------
 -- Votes within transactions (era-dependent)
 --
@@ -1588,7 +1619,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 +1889,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,26 +2347,20 @@ 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)]
-
--- TxMintValue w undefined
---   case sbe of
---     ShelleyBasedEraShelley -> TxMintNone
---     ShelleyBasedEraAllegra -> TxMintNone
---     ShelleyBasedEraMary -> toMintValue body MaryEraOnwardsMary
---     ShelleyBasedEraAlonzo -> toMintValue body MaryEraOnwardsAlonzo
---     ShelleyBasedEraBabbage -> toMintValue body MaryEraOnwardsBabbage
---     ShelleyBasedEraConway -> toMintValue body MaryEraOnwardsConway
---  where
---   toMintValue txBody maInEra
---     | L.isZero mint = TxMintNone
---     | otherwise = TxMintValue maInEra (fromMaryValue mint) ViewTx
---    where
---     mint = MaryValue (Ledger.Coin 0) (txBody ^. L.mintTxBodyL)
+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 $
+          Map.fromListWith
+            (<>)
+            [ (policyId', [(assetName', quantity, ViewTx)])
+            | -- only non-ada can be here
+            (AssetId policyId' assetName', quantity) <- toList assetMap
+            ]
 
 makeByronTransactionBody
   :: ()
@@ -2451,13 +2474,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)
@@ -3371,14 +3390,10 @@ collectTxBodyScriptWitnesses
       :: TxMintValue BuildTx era
       -> [(ScriptWitnessIndex, AnyScriptWitness era)]
     scriptWitnessesMinting TxMintNone = []
-    scriptWitnessesMinting (TxMintValue _ _vw) = undefined
-    -- FIXME
-    -- [ (ScriptWitnessIndexMint ix, AnyScriptWitness witness)
-    -- \| -- 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)
-    -- ]
+    scriptWitnessesMinting txMintValue' =
+      [ (ix, AnyScriptWitness witness)
+      | (ix, _, _, _, BuildTxWith witness) <- txMintValueToIndexed txMintValue'
+      ]
 
     scriptWitnessesVoting
       :: TxVotingProcedures BuildTx era

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

@@ -323,6 +323,7 @@ calcMinimumDeposit v =
 -- ----------------------------------------------------------------------------
 -- An alternative nested representation
 --
+-- TODO remove ? - it is now unused
 
 -- | An alternative nested representation for 'Value' that groups assets that
 -- share a 'PolicyId'.

cardano-api/src/Cardano/Api.hs

@@ -364,6 +364,8 @@ module Cardano.Api
   , TxCertificates (..)
   , TxUpdateProposal (..)
   , TxMintValue (..)
+  , txMintValueToValue
+  , txMintValueToIndexed
   , TxVotingProcedures (..)
   , mkTxVotingProcedures
   , TxProposalProcedures (..)
@@ -527,6 +529,7 @@ module Cardano.Api
   , WitCtxMint
   , WitCtxStake
   , WitCtx (..)
+  , WitCtxMaybe (..)
   , ScriptWitness (..)
   , Witness (..)
   , KeyWitnessInCtx (..)

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