[CBR-227] Avoid overflow in updateUTxO

wallet-new/src/Cardano/Wallet/Kernel/DB/Spec.hs

@@ -114,7 +114,8 @@ deriveSafeCopy 1 'base ''Checkpoint
 initCheckpoint :: Core.Utxo -> Checkpoint
 initCheckpoint utxo = Checkpoint {
       _checkpointUtxo        = InDb utxo
-    , _checkpointUtxoBalance = InDb $ Core.utxoBalance utxo
+    , _checkpointUtxoBalance = InDb $ Core.unsafeIntegerToCoin $
+                                        Core.utxoBalance utxo
     , _checkpointPending     = Pending.empty
     , _checkpointForeign     = Pending.empty
     , _checkpointBlockMeta   = emptyBlockMeta

wallet-new/src/Cardano/Wallet/Kernel/DB/Spec/Read.hs

@@ -55,10 +55,11 @@ cpAvailableBalance :: IsCheckpoint c => c -> Core.Coin
 cpAvailableBalance c =
     fromMaybe subCoinErr balance'
   where
-    pendingIns = Pending.txIns (c ^. cpPending)
-    spentUtxo  = Core.utxoRestrictToInputs (c ^. cpUtxo) pendingIns
-    balance'   = Core.subCoin (c ^. cpUtxoBalance) (Core.utxoBalance spentUtxo)
-    subCoinErr = error "cpAvailableBalance: spent more than available?"
+    pendingIns   = Pending.txIns (c ^. cpPending)
+    spentUtxo    = Core.utxoRestrictToInputs (c ^. cpUtxo) pendingIns
+    spentBalance = Core.unsafeIntegerToCoin $ Core.utxoBalance spentUtxo
+    balance'     = Core.subCoin (c ^. cpUtxoBalance) spentBalance
+    subCoinErr   = error "cpAvailableBalance: spent more than available?"
 
 -- | Change outputs
 --
@@ -78,7 +79,8 @@ cpTotalBalance ours c =
     Core.unsafeAddCoin availableBalance changeBalance
   where
     availableBalance = cpAvailableBalance c
-    changeBalance    = Core.utxoBalance (cpChange ours c)
+    changeBalance    = Core.unsafeIntegerToCoin $
+                         Core.utxoBalance (cpChange ours c)
 
 -- | SlotId a transaction got confirmed in
 cpTxSlotId :: IsCheckpoint c => Core.TxId -> c -> Maybe Core.SlotId

wallet-new/src/Cardano/Wallet/Kernel/DB/Spec/Update.hs

@@ -301,9 +301,10 @@ updateUtxo PrefilteredBlock{..} (utxo, balance) =
     utxoUnion = Map.union utxo pfbOutputs
     utxoMin   = utxoUnion `Core.utxoRestrictToInputs` pfbInputs
     utxo'     = utxoUnion `Core.utxoRemoveInputs`     pfbInputs
-    balance'  = fromMaybe (error "updateUtxo: out-of-range impossible") $ do
-                  withNew <- Core.addCoin balance (Core.utxoBalance pfbOutputs)
-                  Core.subCoin withNew (Core.utxoBalance utxoMin)
+    balance'  = Core.unsafeIntegerToCoin $
+                    Core.coinToInteger balance
+                  + Core.utxoBalance pfbOutputs
+                  - Core.utxoBalance utxoMin
 
 -- | Update the pending transactions with the given prefiltered block
 --

wallet-new/src/Cardano/Wallet/Kernel/Transactions.hs

@@ -32,7 +32,7 @@ import           Formatting (bprint, build, sformat, (%))
 import qualified Formatting.Buildable
 
 import           Pos.Chain.Txp (Utxo)
-import           Pos.Core (Address, Coin, unsafeSubCoin)
+import           Pos.Core (Address, Coin, unsafeIntegerToCoin, unsafeSubCoin)
 import qualified Pos.Core as Core
 import           Pos.Core.Txp (Tx (..), TxAux (..), TxId, TxIn (..), TxOut (..),
                      TxOutAux (..))
@@ -342,10 +342,13 @@ estimateFees activeWallet@ActiveWallet{..} spendingPassword options accountId pa
              return $ Right
                     $ sumOfInputs tx originalUtxo `unsafeSubCoin` sumOfOutputs tx
   where
+      -- Unlike a block, a /single transaction/ cannot have inputs that sum to
+      -- more than maxCoinVal
       sumOfInputs :: TxAux -> Utxo -> Coin
       sumOfInputs tx utxo =
           let inputs = Set.fromList $ toList . _txInputs . taTx $ tx
-          in utxoBalance (utxo `utxoRestrictToInputs` inputs)
+          in unsafeIntegerToCoin $
+               utxoBalance (utxo `utxoRestrictToInputs` inputs)
 
       sumOfOutputs :: TxAux -> Coin
       sumOfOutputs tx =

wallet-new/src/Cardano/Wallet/Kernel/Util/Core.hs

@@ -54,19 +54,16 @@ getSomeTimestamp = Core.Timestamp $ fromMicroseconds 12340000
   UTxO
 -------------------------------------------------------------------------------}
 
--- | Computes the balance for this 'Utxo'. We use 'unsafeAddCoin' as
--- as long as the 'maxCoinVal' stays within the 'Word64' 'maxBound', the
--- circulating supply of coins is finite and as such we should never have
--- to sum an 'Utxo' which would exceed the bounds.
--- If it does, this is clearly a bug and we throw an 'ErrorCall' exception
--- (crf. 'unsafeAddCoin' implementation).
-utxoBalance :: Core.Utxo -> Core.Coin
-utxoBalance = foldl' updateFn (Core.mkCoin 0) . Map.elems
+-- | Computes the balance for this UTxO
+--
+-- This returns an 'Integer' rather than a 'Coin' because the outputs of a
+-- block may sum to more than 'maxCoinVal' (if some outputs of the transactions
+-- in the block are used as inputs by other transactions in that block).
+utxoBalance :: Core.Utxo -> Integer
+utxoBalance = foldl' updateFn 0 . Map.elems
   where
-    updateFn :: Core.Coin -> Core.TxOutAux -> Core.Coin
-    updateFn acc txOutAux =
-      fromMaybe (error "utxoBalance: overflow") $
-         Core.addCoin acc (toCoin txOutAux)
+    updateFn :: Integer -> Core.TxOutAux -> Integer
+    updateFn acc txOut = acc + Core.coinToInteger (toCoin txOut)
 
 -- | Restricts the 'Utxo' to only the selected set of inputs.
 utxoRestrictToInputs :: Core.Utxo -> Set Core.TxIn -> Core.Utxo

wallet-new/test/unit/Test/Spec/CoinSelection.hs

@@ -25,7 +25,7 @@ import qualified Text.Tabl as Tabl
 
 import           Pos.Binary.Class (Bi (encode), toLazyByteString)
 import qualified Pos.Chain.Txp as Core
-import           Pos.Core (Coeff (..), TxSizeLinear (..))
+import           Pos.Core (Coeff (..), TxSizeLinear (..), unsafeIntegerToCoin)
 import qualified Pos.Core as Core
 import           Pos.Core.Attributes (mkAttributes)
 import           Pos.Crypto (SecretKey)
@@ -138,7 +138,7 @@ renderUtxoAndPayees utxo outputs =
                                    (sortedPayees $ toList outputs) <> footer
 
       footer :: [Row]
-      footer = ["Total", "Total"] : [[T.pack . show . Core.getCoin . utxoBalance $ utxo
+      footer = ["Total", "Total"] : [[T.pack . show . utxoBalance $ utxo
                                     , T.pack . show . Core.getCoin . paymentAmount $ outputs
                                     ]]
 
@@ -186,9 +186,9 @@ renderTx payees utxo tx =
           in header : (subTable1 `mergeRows` subTable2) <> footer
 
       footer :: [Row]
-      footer = replicate 4 "Total" : [[T.pack . show . Core.getCoin . utxoBalance $ utxo
+      footer = replicate 4 "Total" : [[T.pack . show . utxoBalance $ utxo
                                      , T.pack . show . Core.getCoin . paymentAmount $ payees
-                                     , T.pack . show . Core.getCoin . utxoBalance $ pickedInputs
+                                     , T.pack . show . utxoBalance $ pickedInputs
                                      , T.pack . show . Core.getCoin . paymentAmount $ txOutputs
                                      ]]
 
@@ -324,7 +324,7 @@ feeWasPayed SenderPaysFee originalUtxo originalOutputs tx =
                     T.unpack (renderTx originalOutputs originalUtxo tx) <>
                     "\n\n"
               )
-              (< utxoBalance originalUtxo)
+              (< unsafeIntegerToCoin (utxoBalance originalUtxo))
               (paymentAmount txOutputs)
 feeWasPayed ReceiverPaysFee _ originalOutputs tx =
     let txOutputs = Core._txOutputs . Core.taTx $ tx

wallet-new/test/unit/Test/Spec/CoinSelection/Generators.hs

@@ -21,20 +21,15 @@ import           Universum
 import qualified Data.List
 import qualified Data.Map as Map
 import           Formatting (sformat)
-import           Test.QuickCheck (Gen, arbitrary, choose, suchThat)
-
 import qualified Formatting as F
+import           Test.QuickCheck (Gen, arbitrary, choose, suchThat)
 
 import qualified Pos.Chain.Txp as Core
-import           Pos.Core ()
 import qualified Pos.Core as Core
-import           Pos.Crypto ()
-
-import           Util.Buildable ()
 
-import           Cardano.Wallet.Kernel.CoinSelection ()
 import           Cardano.Wallet.Kernel.Util.Core (paymentAmount, utxoBalance)
 
+-- type class instances
 import           Test.Pos.Core.Arbitrary ()
 
 {-------------------------------------------------------------------------------
@@ -167,7 +162,7 @@ genUtxo o = do
           addr <- arbitraryAddress o
           let txOutAux = Core.TxOutAux (Core.TxOut addr coins)
           return $ Map.singleton txIn txOutAux
-    fromStakeOptions o genValue utxoBalance
+    fromStakeOptions o genValue (Core.unsafeIntegerToCoin . utxoBalance)
 
 -- | Generate some Utxo with @at least@ the supplied amount of money.
 genFiddlyUtxo :: InitialBalance -> Gen Core.Utxo