Fork subtract functions into safe and unsafe variants.

This change explicitly forks the various `subtract` functions into safe and
unsafe variants for the following types:

- `TokenQuantity`
- `TokenMap`
- `TokenBundle`

The safe variants all adhere to the following pattern:

```
-- Returns 'Nothing' if the pre-condition is violated.
subtract :: T -> T -> Maybe T
```

The unsafe variants all adhere to the following pattern:

```
-- Throws a run-time exception if the pre-condition is violated.
unsafeSubtract :: T -> T -> T
```

lib/core/src/Cardano/Wallet/Primitive/Types/TokenBundle.hs

@@ -56,10 +56,13 @@ module Cardano.Wallet.Primitive.Types.TokenBundle
     -- * Queries
     , getAssets
 
+    -- * Unsafe operations
+    , unsafeSubtract
+
     ) where
 
 import Prelude hiding
-    ( negate, null, subtract )
+    ( subtract )
 
 import Algebra.PartialOrd
     ( PartialOrd (..) )
@@ -73,8 +76,12 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity
     ( TokenQuantity (..) )
 import Control.DeepSeq
     ( NFData )
+import Control.Monad
+    ( guard )
 import Data.Bifunctor
     ( first )
+import Data.Functor
+    ( ($>) )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Set
@@ -249,11 +256,13 @@ add :: TokenBundle -> TokenBundle -> TokenBundle
 add (TokenBundle (Coin c1) m1) (TokenBundle (Coin c2) m2) =
     TokenBundle (Coin $ c1 + c2) (TokenMap.add m1 m2)
 
--- | Subtracts one token bundle from another.
+-- | Subtracts the second token bundle from the first.
+--
+-- Returns 'Nothing' if the second bundle is not less than or equal to the first
+-- bundle when compared with the `leq` function.
 --
-subtract :: TokenBundle -> TokenBundle -> TokenBundle
-subtract (TokenBundle (Coin c1) m1) (TokenBundle (Coin c2) m2) =
-    TokenBundle (Coin $ c1 - c2) (TokenMap.subtract m1 m2)
+subtract :: TokenBundle -> TokenBundle -> Maybe TokenBundle
+subtract a b = guard (b `leq` a) $> unsafeSubtract a b
 
 --------------------------------------------------------------------------------
 -- Quantities
@@ -317,3 +326,18 @@ hasPolicy = TokenMap.hasPolicy . tokens
 
 getAssets :: TokenBundle -> Set AssetId
 getAssets = TokenMap.getAssets . tokens
+
+--------------------------------------------------------------------------------
+-- Unsafe operations
+--------------------------------------------------------------------------------
+
+-- | Subtracts the second token bundle from the first.
+--
+-- Pre-condition: the second bundle is less than or equal to the first bundle
+-- when compared with the `leq` function.
+--
+-- Throws a run-time exception if the pre-condition is violated.
+--
+unsafeSubtract :: TokenBundle -> TokenBundle -> TokenBundle
+unsafeSubtract (TokenBundle (Coin c1) m1) (TokenBundle (Coin c2) m2) =
+    TokenBundle (Coin $ c1 - c2) (TokenMap.unsafeSubtract m1 m2)

lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap.hs

@@ -74,10 +74,13 @@ module Cardano.Wallet.Primitive.Types.TokenMap
     -- * Queries
     , getAssets
 
+    -- * Unsafe operations
+    , unsafeSubtract
+
     ) where
 
 import Prelude hiding
-    ( negate, null, subtract )
+    ( subtract )
 
 import Algebra.PartialOrd
     ( PartialOrd (..) )
@@ -88,13 +91,15 @@ import Cardano.Wallet.Primitive.Types.TokenQuantity
 import Control.DeepSeq
     ( NFData )
 import Control.Monad
-    ( mapM, when, (<=<) )
+    ( guard, mapM, when, (<=<) )
 import Data.Aeson
     ( FromJSON (..), ToJSON (..), camelTo2, genericParseJSON, genericToJSON )
 import Data.Aeson.Types
     ( Options (..), Parser )
 import Data.Bifunctor
     ( first )
+import Data.Functor
+    ( ($>) )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
 import Data.Map.Strict
@@ -438,13 +443,13 @@ add a b = F.foldl' acc a $ toFlatList b
     acc c (asset, quantity) =
         adjustQuantity c asset (`TokenQuantity.add` quantity)
 
--- | Subtracts one token map from another.
+-- | Subtracts the second token map from the first.
 --
-subtract :: TokenMap -> TokenMap -> TokenMap
-subtract a b = F.foldl' acc a $ toFlatList b
-  where
-    acc c (asset, quantity) =
-        adjustQuantity c asset (`TokenQuantity.subtract` quantity)
+-- Returns 'Nothing' if the second map is not less than or equal to the first
+-- map when compared with the `leq` function.
+--
+subtract :: TokenMap -> TokenMap -> Maybe TokenMap
+subtract a b = guard (b `leq` a) $> unsafeSubtract a b
 
 --------------------------------------------------------------------------------
 -- Tests
@@ -550,6 +555,23 @@ hasPolicy b policy = isJust $ Map.lookup policy $ unTokenMap b
 getAssets :: TokenMap -> Set AssetId
 getAssets = Set.fromList . fmap fst . toFlatList
 
+--------------------------------------------------------------------------------
+-- Unsafe operations
+--------------------------------------------------------------------------------
+
+-- | Subtracts the second token map from the first.
+--
+-- Pre-condition: the second map is less than or equal to the first map when
+-- compared with the `leq` function.
+--
+-- Throws a run-time exception if the pre-condition is violated.
+--
+unsafeSubtract :: TokenMap -> TokenMap -> TokenMap
+unsafeSubtract a b = F.foldl' acc a $ toFlatList b
+  where
+    acc c (asset, quantity) =
+        adjustQuantity c asset (`TokenQuantity.unsafeSubtract` quantity)
+
 --------------------------------------------------------------------------------
 -- Internal functions
 --------------------------------------------------------------------------------

lib/core/src/Cardano/Wallet/Primitive/Types/TokenQuantity.hs

@@ -20,15 +20,22 @@ module Cardano.Wallet.Primitive.Types.TokenQuantity
     , isNonZero
     , isZero
 
+      -- * Unsafe operations
+    , unsafeSubtract
+
     ) where
 
 import Prelude hiding
     ( pred, subtract, succ )
 
 import Control.DeepSeq
     ( NFData (..) )
+import Control.Monad
+    ( guard )
 import Data.Aeson
     ( FromJSON (..), ToJSON (..) )
+import Data.Functor
+    ( ($>) )
 import Data.Text.Class
     ( FromText (..), ToText (..) )
 import Fmt
@@ -100,8 +107,12 @@ zero = TokenQuantity 0
 add :: TokenQuantity -> TokenQuantity -> TokenQuantity
 add (TokenQuantity x) (TokenQuantity y) = TokenQuantity $ x + y
 
-subtract :: TokenQuantity -> TokenQuantity -> TokenQuantity
-subtract (TokenQuantity x) (TokenQuantity y) = TokenQuantity $ x - y
+-- | Subtracts the second token quantity from the first.
+--
+-- Returns 'Nothing' if the first quantity is less than the second quantity.
+--
+subtract :: TokenQuantity -> TokenQuantity -> Maybe TokenQuantity
+subtract x y = guard (x >= y) $> unsafeSubtract x y
 
 pred :: TokenQuantity -> TokenQuantity
 pred (TokenQuantity q) = TokenQuantity $ Prelude.pred q
@@ -118,3 +129,16 @@ isNonZero = (/= zero)
 
 isZero :: TokenQuantity -> Bool
 isZero = (== zero)
+
+--------------------------------------------------------------------------------
+-- Unsafe operations
+--------------------------------------------------------------------------------
+
+-- | Subtracts the second token quantity from the first.
+--
+-- Pre-condition: the first quantity is not less than the second quantity.
+--
+-- Throws a run-time exception if the pre-condition is violated.
+--
+unsafeSubtract :: TokenQuantity -> TokenQuantity -> TokenQuantity
+unsafeSubtract (TokenQuantity x) (TokenQuantity y) = TokenQuantity $ x - y

lib/core/src/Cardano/Wallet/Primitive/Types/UTxOIndex/Internal.hs

@@ -240,7 +240,10 @@ delete i u = case Map.lookup i (utxo u) of
     Nothing -> u
     Just o -> UTxOIndex
         { index = F.foldl' deleteEntry (index u) (txOutAssets o)
-        , balance = balance u `TokenBundle.subtract` view #tokens o
+          -- This operation is safe, since we have already determined that the
+          -- entry is a member of the index, and therefore the balance must be
+          -- greater than or equal to the value of this output:
+        , balance = balance u `TokenBundle.unsafeSubtract` view #tokens o
         , utxo = Map.delete i $ utxo u
         }
   where

lib/core/test/unit/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs

@@ -223,10 +223,10 @@ prop_add_invariant :: TokenMap -> TokenMap -> Property
 prop_add_invariant b1 b2 = property $ invariantHolds $ TokenMap.add b1 b2
 
 prop_subtract_invariant :: TokenMap -> TokenMap -> Property
-prop_subtract_invariant m1 m2 =
-    -- We must take care to not produce negative quantities:
-    m2 `leq` m1 ==>
-        property $ invariantHolds $ TokenMap.subtract m1 m2
+prop_subtract_invariant m1 m2 = property $
+    m2 `leq` m1 ==> invariantHolds result
+  where
+    Just result = TokenMap.subtract m1 m2
 
 prop_setQuantity_invariant
     :: TokenMap -> AssetId -> TokenQuantity -> Property
@@ -318,14 +318,13 @@ prop_add_associative b1 b2 b3 = (===)
 prop_add_subtract_associative
     :: TokenMap -> TokenMap -> TokenMap -> Property
 prop_add_subtract_associative m1 m2 m3 =
-    -- We must take care to not produce negative quantities:
     m3 `leq` m2 ==> (===)
         ((m1 `TokenMap.add` m2) `TokenMap.subtract` m3)
-        (m1 `TokenMap.add` (m2 `TokenMap.subtract` m3))
+        (fmap (m1 `TokenMap.add`) (m2 `TokenMap.subtract` m3))
 
 prop_subtract_null :: TokenMap -> Property
 prop_subtract_null m =
-    m `TokenMap.subtract` m === TokenMap.empty
+    m `TokenMap.subtract` m === Just TokenMap.empty
 
 --------------------------------------------------------------------------------
 -- Quantity properties

lib/core/test/unit/Cardano/Wallet/Primitive/Types/UTxOIndexSpec.hs

@@ -219,7 +219,7 @@ prop_delete_balance i u =
         Nothing ->
             UTxOIndex.balance u
         Just o ->
-            UTxOIndex.balance u `TokenBundle.subtract` view #tokens o
+            UTxOIndex.balance u `TokenBundle.unsafeSubtract` view #tokens o
 
 prop_delete_lookup :: TxIn -> UTxOIndex -> Property
 prop_delete_lookup i u =
@@ -250,7 +250,7 @@ prop_insert_balance i o u =
         Nothing ->
             UTxOIndex.balance u
         Just o' ->
-            UTxOIndex.balance u `TokenBundle.subtract` view #tokens o'
+            UTxOIndex.balance u `TokenBundle.unsafeSubtract` view #tokens o'
 
 prop_insert_delete :: TxIn -> TxOut -> UTxOIndex -> Property
 prop_insert_delete i o u =