Merge #292

292: Fix Change Calculation (#286) r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

#286 

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- [x] I have extended our test to capture the issue highlighted in the bug
- [x] I have looked at the test failing
- [x] I have fixed the calculation of the change which was... weirdly way off the specification..

# Comments

<!-- Additional comments or screenshots to attach if any -->

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <[email protected]>

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

@@ -75,8 +75,6 @@ import Control.Monad
     ( foldM, forM )
 import Control.Monad.Trans.State.Strict
     ( State, evalState, runState, state )
-import Data.Foldable
-    ( fold )
 import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Generics.Labels
@@ -329,10 +327,8 @@ changeUTxO
     -> Set Tx
     -> s
     -> UTxO
-changeUTxO proxy pending = evalState $ do
-    ourUtxo <- mapM (state . utxoOurs proxy) (Set.toList pending)
-    let ins = txIns pending
-    return $ fold ourUtxo `restrictedBy` ins
+changeUTxO proxy pending = evalState $
+    mconcat <$> mapM (state . utxoOurs proxy) (Set.toList pending)
 
 -- | Construct our _next_ UTxO (possible empty) from a transaction by selecting
 -- outputs that are ours. It is important for the transaction outputs to be

lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -52,6 +53,7 @@ module Test.Integration.Framework.DSL
     , json
     , tearDown
     , fixtureWallet
+    , oneMillionAda
 
     -- * CLI
     , cardanoWalletCLI
@@ -382,14 +384,14 @@ walletId =
     _set :: HasType (ApiT WalletId) s => (s, Text) -> s
     _set (s, v) = set typed (ApiT $ WalletId (unsafeCreateDigest v)) s
 
-amount :: HasType (Quantity "lovelace" Natural) s => Lens' s Int
+amount :: HasType (Quantity "lovelace" Natural) s => Lens' s Natural
 amount =
     lens _get _set
   where
-    _get :: HasType (Quantity "lovelace" Natural) s => s -> Int
-    _get = fromIntegral . fromQuantity @"lovelace" @Natural . view typed
-    _set :: HasType (Quantity "lovelace" Natural) s => (s, Int) -> s
-    _set (s, v) = set typed (Quantity @"lovelace" @Natural $ fromIntegral v) s
+    _get :: HasType (Quantity "lovelace" Natural) s => s -> Natural
+    _get = fromQuantity @"lovelace" @Natural . view typed
+    _set :: HasType (Quantity "lovelace" Natural) s => (s, Natural) -> s
+    _set (s, v) = set typed (Quantity @"lovelace" @Natural v) s
 
 direction :: HasType (ApiT Direction) s => Lens' s Direction
 direction =
@@ -430,7 +432,7 @@ fixtureWallet ctx@(Context _ _ _ faucet) = do
         Left _ -> fail "fixtureWallet: waited too long for initial transaction"
         Right a -> return a
   where
-    oneSecond = 1*1000*1000
+    oneSecond = 1_000_000
     sixtySeconds = 60*oneSecond
     checkBalance :: Text -> IO ApiWallet
     checkBalance wid = do
@@ -439,6 +441,12 @@ fixtureWallet ctx@(Context _ _ _ faucet) = do
             then return (getFromResponse id r)
             else threadDelay oneSecond *> checkBalance wid
 
+-- | One million ADA, in Lovelace, just like this.
+oneMillionAda :: Natural
+oneMillionAda = ada (1_000_000)
+  where
+    ada = (*) (1_000_000)
+
 fromQuantity :: Quantity (u :: Symbol) a -> a
 fromQuantity (Quantity a) = a
 

lib/http-bridge/test/integration/Test/Integration/Scenario/Transactions.hs

@@ -32,6 +32,7 @@ import Test.Integration.Framework.DSL
     , expectSuccess
     , fixtureWallet
     , json
+    , oneMillionAda
     , request
     , status
     , unsafeRequest
@@ -55,35 +56,46 @@ spec = do
         (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx
         (_, addrs) <-
             unsafeRequest @[ApiAddress] ctx ("GET", getAddresses wb) Empty
+        let amt = 1
         let destination = (addrs !! 1) ^. #id
         let payload = Json [json|{
                 "payments": [{
                     "address": #{destination},
                     "amount": {
-                        "quantity": 1,
+                        "quantity": #{amt},
                         "unit": "lovelace"
                     }
                 }],
                 "passphrase": "cardano-wallet"
             }|]
+        let fee = 168653
 
         r <- request @ApiTransaction ctx ("POST", postTx wa) Default payload
         verify r
             [ expectSuccess
             , expectResponseCode HTTP.status202
-            , expectFieldEqual amount 168654
+            , expectFieldEqual amount (fee + amt)
             , expectFieldEqual direction Outgoing
             , expectFieldEqual status Pending
             ]
 
-        r' <- request @ApiWallet ctx ("GET", getWallet wb) Default payload
-        verify r'
+        ra <- request @ApiWallet ctx ("GET", getWallet wa) Default payload
+        verify ra
+            [ expectSuccess
+            , expectFieldEqual balanceTotal (oneMillionAda - fee - amt)
+            , expectFieldEqual balanceAvailable 0
+            ]
+
+        rb <- request @ApiWallet ctx ("GET", getWallet wb) Default payload
+        verify rb
             [ expectSuccess
-            , expectEventually ctx balanceAvailable (oneMillionAda + 1)
+            , expectEventually ctx balanceAvailable (oneMillionAda + amt)
+            ]
+
+        verify ra
+            [ expectEventually ctx balanceAvailable (oneMillionAda - fee - amt)
             ]
   where
-    oneMillionAda =
-        1 * 1000 * 1000 * 1000 * 1000
     getAddresses (w :: ApiWallet) =
         "v2/wallets/" <> w ^. walletId <> "/addresses"
     postTx (w :: ApiWallet) =