Remove old version of addValueToOutputs.

lib/core/src/Cardano/Wallet/Primitive/Migration.hs

@@ -36,7 +36,12 @@ import Cardano.Wallet.Primitive.Types.Coin
 import Cardano.Wallet.Primitive.Types.TokenBundle
     ( TokenBundle (..) )
 import Cardano.Wallet.Primitive.Types.Tx
-    ( TxConstraints (..), TxIn, TxOut, txOutputHasValidSize, txOutputIsValid )
+    ( TxConstraints (..)
+    , TxIn
+    , TxOut
+    , txOutputHasValidSize
+    , txOutputHasValidTokenQuantities
+    )
 import Cardano.Wallet.Primitive.Types.UTxO
     ( UTxO (..) )
 import Control.Monad
@@ -346,54 +351,16 @@ uncategorizeUTxOEntries utxo = mconcat
 --------------------------------------------------------------------------------
 -- Adding value to outputs
 --------------------------------------------------------------------------------
-{-
-addValueToOutputs
-    :: TxSize s
-    => TxConstraints s
-    -> TokenBundle
-    -- ^ Value to add
-    -> [TokenBundle]
-    -- ^ Existing set of outputs
-    -> NonEmpty TokenBundle
-    -- ^ Set of outputs with the value added
-addValueToOutputs constraints valueUnchecked outputs
-    | output : remainder <- outputs, value :| [] <- checkedValues =
-        -- Just one value to add: try to merge this to the output at the start:
-        case safeMergeOutputValue value output of
-            Nothing -> value :| outputs
-            Just mergedValue -> mergedValue :| remainder
-    | output : remainder <- outputs =
-        -- Multiple values to add: put these at the end:
-        (output :| remainder) <> checkedValues
-    | [output] <- outputs =
-        output `NE.cons` checkedValues
-    | otherwise =
-        checkedValues
-
-  where
-    checkedValues :: NonEmpty TokenBundle
-    checkedValues = splitOutputIfLimitsExceeded constraints valueUnchecked
-
-    safeMergeOutputValue :: TokenBundle -> TokenBundle -> Maybe TokenBundle
-    safeMergeOutputValue a b
-        | txOutputIsValid constraints valueWithMaxAda =
-            Just value
-        | otherwise =
-            Nothing
-      where
-        value = a <> b
-        valueWithMaxAda = TokenBundle.setCoin value maxBound
--}
 
 addValueToOutputs
     :: TxSize s
     => TxConstraints s
     -> [TokenBundle]
-    -- ^ Existing set of outputs
+    -- ^ Outputs
     -> TokenBundle
     -- ^ Value to add
     -> NonEmpty TokenBundle
-    -- ^ Set of outputs with the value added
+    -- ^ Outputs with the value added
 addValueToOutputs constraints outputs =
     NE.fromList
         . F.foldl' (flip addToOutputs) outputs
@@ -414,11 +381,14 @@ addValueToOutputs constraints outputs =
 
     safeMergeOutputValue :: TokenBundle -> TokenBundle -> Maybe TokenBundle
     safeMergeOutputValue a b
-        | txOutputIsValid constraints valueWithMaxAda =
+        | isSafe =
             Just value
         | otherwise =
             Nothing
       where
+        isSafe = (&&)
+            (txOutputHasValidSize constraints valueWithMaxAda)
+            (txOutputHasValidTokenQuantities constraints value)
         value = a <> b
         valueWithMaxAda = TokenBundle.setCoin value maxBound
 
@@ -435,14 +405,6 @@ splitOutputIfLimitsExceeded constraints =
     splitOutputIfSizeExceedsLimit constraints >=>
     splitOutputIfTokenQuantityExceedsLimit constraints
 
-splitOutputIfTokenQuantityExceedsLimit
-    :: TxConstraints s
-    -> TokenBundle
-    -> NonEmpty TokenBundle
-splitOutputIfTokenQuantityExceedsLimit
-    = flip TokenBundle.equipartitionQuantitiesWithUpperBound
-    . txOutputMaximumTokenQuantity
-
 splitOutputIfSizeExceedsLimit
     :: TxSize s
     => TxConstraints s
@@ -459,6 +421,14 @@ splitOutputIfSizeExceedsLimit constraints bundle
     bundleWithMaxAda = TokenBundle.setCoin bundle maxBound
     splitInHalf = flip TokenBundle.equipartitionAssets (() :| [()])
 
+splitOutputIfTokenQuantityExceedsLimit
+    :: TxConstraints s
+    -> TokenBundle
+    -> NonEmpty TokenBundle
+splitOutputIfTokenQuantityExceedsLimit
+    = flip TokenBundle.equipartitionQuantitiesWithUpperBound
+    . txOutputMaximumTokenQuantity
+
 --------------------------------------------------------------------------------
 -- Miscellaneous types and functions
 --------------------------------------------------------------------------------

lib/core/test/unit/Cardano/Wallet/Primitive/MigrationSpec.hs

@@ -27,6 +27,7 @@ import Cardano.Wallet.Primitive.Migration.Selection
 import Cardano.Wallet.Primitive.Migration.SelectionSpec
     ( MockInputId
     , MockTxConstraints (..)
+    , conjoinMap
     , counterexampleMap
     , genCoinRange
     , genMockInput
@@ -85,7 +86,7 @@ import qualified Data.List.NonEmpty as NE
 spec :: Spec
 spec = describe "Cardano.Wallet.Primitive.MigrationSpec" $
 
-    modifyMaxSuccess (const 100) $ do
+    modifyMaxSuccess (const 1000) $ do
 
     parallel $ describe "Creating migration plans" $ do
 
@@ -265,10 +266,13 @@ genMockAddValueToOutputsArguments = do
 
 prop_addValueToOutputs :: Blind MockAddValueToOutputsArguments -> Property
 prop_addValueToOutputs mockArgs =
-    conjoin
-        [ F.fold result == F.fold mockOutputs
-        , all (txOutputHasValidSizeIfAdaMaximized constraints) result
-        , all (txOutputHasValidTokenQuantities constraints) result
+    conjoinMap
+        [ ( "Value is preserved"
+          , F.fold result == F.fold mockOutputs )
+        , ( "All outputs have valid sizes (if ada maximized)"
+          , all (txOutputHasValidSizeIfAdaMaximized constraints) result )
+        , ( "All outputs have valid token quantities"
+          , all (txOutputHasValidTokenQuantities constraints) result )
         ]
   where
     Blind MockAddValueToOutputsArguments
@@ -279,7 +283,7 @@ prop_addValueToOutputs mockArgs =
     result :: NonEmpty TokenBundle
     result = F.foldl'
         (addValueToOutputs constraints . NE.toList)
-        [NE.head mockOutputs]
+        (addValueToOutputs constraints [] (NE.head mockOutputs))
         (NE.tail mockOutputs)
 
 txOutputHasValidSizeIfAdaMaximized