[CBR-313] Write tests for Servant handlers

adinapoli-iohk · adinapoli-iohk · commit a823d5750a09 · 2018-07-17T09:19:33.000+02:00
diff --git a/src/Cardano/Wallet/API/V1/Handlers/Transactions.hs b/src/Cardano/Wallet/API/V1/Handlers/Transactions.hs
@@ -1,7 +1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeOperators     #-}
 
-module Cardano.Wallet.API.V1.Handlers.Transactions where
+module Cardano.Wallet.API.V1.Handlers.Transactions (
+      handlers
+    , newTransaction
+    , getTransactionsHistory
+    , estimateFees
+    ) where
 
 import           Universum
 
diff --git a/src/Cardano/Wallet/Kernel.hs b/src/Cardano/Wallet/Kernel.hs
@@ -67,9 +67,7 @@ import           Cardano.Wallet.Kernel.Util (getCurrentTimestamp)
 
 import           Cardano.Wallet.Kernel.DB.Read as Getters
 
-import           Pos.Core (TxAux (..))
-
-import           Pos.Core (ProtocolMagic)
+import           Pos.Core (ProtocolMagic, TxAux (..))
 import           Pos.Core.Chrono (OldestFirst)
 import           Pos.Crypto (EncryptedSecretKey, hash)
 import           Pos.Txp (Utxo)
diff --git a/src/Cardano/Wallet/Kernel/Internal.hs b/src/Cardano/Wallet/Kernel/Internal.hs
@@ -15,7 +15,7 @@ module Cardano.Wallet.Kernel.Internal (
   , walletLogMessage
   ) where
 
-import           Universum hiding (State, init)
+import           Universum hiding (State)
 
 import           Control.Lens.TH
 
diff --git a/src/Cardano/Wallet/Kernel/Transactions.hs b/src/Cardano/Wallet/Kernel/Transactions.hs
@@ -142,16 +142,8 @@ newTransaction :: ActiveWallet
 newTransaction ActiveWallet{..} genChangeAddr signAddress options accountId payees = do
     snapshot <- getWalletSnapshot walletPassive
     let toTxOuts = fmap (\(a,c) -> TxOutAux (TxOut a c))
-    -- We generate a new change address outside the 'MonadRandom' monad in which
-    -- coin selection runs, so that we keep our \"external\" model consistent
-    -- by generating it once, before calling coin selection. Specifically, we
-    -- pass this potential change address from the outside.
-    -- One disadvantage of this approach is that in case of failure of the
-    -- coin-selection we might be left with such dangling address, but in the
-    -- future we could easily add a function to delete an address, keeping the
-    -- possible number of orphans at bay.
     let mkTx = mkStdTx walletProtocolMagic signAddress
-    -- | FIXME(adn) This number was computed out of the work Matt Noonan did
+    -- | NOTE(adn) This number was computed out of the work Matt Noonan did
     -- on the size estimation. See [CBR-318].
     let maxInputs = 350
     let availableUtxo = accountAvailableUtxo snapshot accountId
@@ -170,7 +162,6 @@ newTransaction ActiveWallet{..} genChangeAddr signAddress options accountId paye
 -- from a fixed seed obtained from hashing the payees. This guarantees that
 -- when we estimate the fees and later create a transaction, the coin selection
 -- will always yield the same value, making the process externally-predicatable.
-
 newtype PayMonad a = PayMonad {
       buildPayment :: ReaderT (NonEmpty (Address, Coin)) IO a
     } deriving (Functor, Applicative, Monad, MonadIO, MonadReader (NonEmpty (Address, Coin)))
@@ -212,7 +203,7 @@ estimateFees :: ActiveWallet
              -> IO (Either EstimateFeesError Coin)
 estimateFees activeWallet@ActiveWallet{..} genChangeAddr signAddress options accountId payees = do
     snapshot         <- getWalletSnapshot walletPassive
-    let originalUtxo = accountUtxo snapshot accountId
+    let originalUtxo = accountAvailableUtxo snapshot accountId
     res <- newTransaction activeWallet genChangeAddr signAddress options accountId payees
     case res of
          Left e  -> return . Left . EstFeesTxCreationFailed $ e
@@ -271,7 +262,7 @@ mkSigner spendingPassword (Just esk) allWallets addr =
                  _                   ->
                      Left (CoinSelHardErrAddressNotOwned (Proxy @ Cardano) addr)
 
--- | An hopefully-accurate estimate of the Tx fees in Cardano.
+-- | An estimate of the Tx fees in Cardano based on a sensible number of defaults.
 cardanoFee :: Int -> NonEmpty Coin -> Coin
 cardanoFee inputs outputs = Core.mkCoin $
     estimateCardanoFee linearFeePolicy inputs (toList $ fmap Core.getCoin outputs)
diff --git a/src/Cardano/Wallet/WalletLayer/Kernel.hs b/src/Cardano/Wallet/WalletLayer/Kernel.hs
@@ -42,9 +42,8 @@ import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
                      InputGrouping, newOptions)
 import           Cardano.Wallet.Kernel.CoinSelection.Generic
                      (CoinSelHardErr (..))
-import           Pos.Core (decodeTextAddress)
 
-import           Pos.Core (Address, Coin)
+import           Pos.Core (Address, Coin, decodeTextAddress)
 import qualified Pos.Core as Core
 import           Pos.Core.Chrono (OldestFirst (..))
 import           Pos.Crypto (safeDeterministicKeyGen)
@@ -168,13 +167,8 @@ bracketActiveWallet pm walletPassiveLayer passiveWallet walletDiffusion runActiv
         -- | Generates a new transaction @and submit it as pending@.
         , pay = \spendingPassword grouping regulation payment -> do
               liftIO $ limitExecutionTimeTo (60 :: Second) NewPaymentTimeLimitReached $ do
-                  let pw = Kernel.walletPassive activeWallet
-                  snapshot <- liftIO (Kernel.getWalletSnapshot pw)
-                  let keystore = Kernel.walletPassive activeWallet ^. Internal.walletKeystore
                   (genChangeAddr, mkSigner, opts, accountId, payees) <-
-                       liftIO $ setupPayment pw
-                                             (Kernel.hdWallets snapshot)
-                                             keystore
+                       liftIO $ setupPayment (Kernel.walletPassive activeWallet)
                                              spendingPassword
                                              grouping
                                              regulation
@@ -192,13 +186,8 @@ bracketActiveWallet pm walletPassiveLayer passiveWallet walletDiffusion runActiv
         -- | Estimates the fees for a payment.
         , estimateFees = \spendingPassword grouping regulation payment -> do
               liftIO $ limitExecutionTimeTo (60 :: Second) EstimateFeesTimeLimitReached $ do
-                  let pw = Kernel.walletPassive activeWallet
-                  snapshot <- liftIO (Kernel.getWalletSnapshot pw)
-                  let keystore = Kernel.walletPassive activeWallet ^. Internal.walletKeystore
                   (genChangeAddr, mkSigner, opts, accountId, payees) <-
-                      liftIO $ setupPayment pw
-                                            (Kernel.hdWallets snapshot)
-                                            keystore
+                      liftIO $ setupPayment (Kernel.walletPassive activeWallet)
                                             spendingPassword
                                             grouping
                                             regulation
@@ -215,9 +204,9 @@ bracketActiveWallet pm walletPassiveLayer passiveWallet walletDiffusion runActiv
         }
 
 
+-- | Internal function setup to facilitate the creation of the necessary
+-- context to perform either a new payment or the estimation of the fees.
 setupPayment :: Kernel.PassiveWallet
-             -> HD.HdWallets
-             -> Keystore
              -> PassPhrase
              -> InputGrouping
              -> ExpenseRegulation
@@ -228,8 +217,13 @@ setupPayment :: Kernel.PassiveWallet
                    , HD.HdAccountId
                    , NonEmpty (Address, Coin)
                    )
-setupPayment pw wallets keystore spendingPassword grouping regulation payment = do
-    let (WalletId wId) = psWalletId . pmtSource $ payment
+setupPayment pw spendingPassword grouping regulation payment = do
+    snapshot <- liftIO (Kernel.getWalletSnapshot pw)
+
+    let keystore = pw ^. Internal.walletKeystore
+        wallets = Kernel.hdWallets snapshot
+        (WalletId wId) = psWalletId . pmtSource $ payment
+
     hdRootId  <- case Core.decodeTextAddress wId of
                      Left e  -> throwM (InvalidAddressConversionFailed e)
                      Right a -> return (HD.HdRootId . InDb $ a)
diff --git a/src/Cardano/Wallet/WalletLayer/Types.hs b/src/Cardano/Wallet/WalletLayer/Types.hs
@@ -35,7 +35,7 @@ import qualified Formatting.Buildable
 
 import           Cardano.Wallet.API.V1.Types (Account, AccountIndex,
                      AccountUpdate, Address, NewAccount, NewAddress, NewWallet,
-                     Wallet, WalletId, WalletUpdate)
+                     Payment, Wallet, WalletId, WalletUpdate)
 
 import qualified Cardano.Wallet.Kernel.Addresses as Kernel
 import qualified Cardano.Wallet.Kernel.Transactions as Kernel
@@ -44,7 +44,6 @@ import           Cardano.Wallet.WalletLayer.ExecutionTimeLimit
 
 import           Test.QuickCheck (Arbitrary (..), oneof)
 
-import           Cardano.Wallet.API.V1.Types (Payment)
 import           Cardano.Wallet.Kernel.CoinSelection.FromGeneric
                      (ExpenseRegulation, InputGrouping)
 
diff --git a/test/unit/Test/Spec/NewPayment.hs b/test/unit/Test/Spec/NewPayment.hs
@@ -58,6 +58,10 @@ import qualified Cardano.Wallet.WalletLayer as WalletLayer
 
 import           Util.Buildable (ShowThroughBuild (..))
 
+import qualified Cardano.Wallet.API.V1.Handlers.Transactions as Handlers
+import           Control.Monad.Except (runExceptT)
+import           Servant.Server
+
 {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
 
 -- | Do not pollute the test runner output with logs.
@@ -138,44 +142,62 @@ withFixture initialBalance toPay cc = do
             walletSendTx = \_tx -> return False
           }
 
+-- | Generate a fresh change 'Address', throwing an exception if the underlying
+-- operation fails.
 genChangeAddr :: AccountId -> PassiveWallet -> IO Address
 genChangeAddr accountId pw = do
     res <- Kernel.createAddress mempty accountId pw
     case res of
          Right addr -> pure addr
          Left err   -> throwM err
 
+-- | A fake signer which doesn't check for 'Address' ownership.
 fakeSigner :: PassPhrase
            -> Maybe EncryptedSecretKey
            -> Address
            -> Either CoinSelHardErr SafeSigner
 fakeSigner _ Nothing addr    = Left (CoinSelHardErrAddressNotOwned (Proxy @ Cardano) addr)
 fakeSigner _ (Just esk) _    = Right (FakeSigner (encToSecret esk))
 
+-- | A constant fee calculation.
 constantFee :: Int -> NonEmpty Coin -> Coin
 constantFee _ _ = mkCoin 10
 
+-- | Helper function to facilitate payments via the Layer or Servant.
+withPayment :: MonadIO n
+            => InitialBalance
+            -- ^ How big the wallet Utxo must be
+            -> Pay
+            -- ^ How big the payment must be
+            -> (ActiveWalletLayer n -> V1.Payment -> IO ())
+            -- ^ The action to run.
+            -> PropertyM IO ()
+withPayment initialBalance toPay action = do
+    withFixture initialBalance toPay $ \keystore activeLayer Fixture{..} -> do
+        liftIO $ Keystore.insert (WalletIdHdRnd fixtureHdRootId) fixtureESK keystore
+        let (AccountIdHdRnd hdAccountId)  = fixtureAccountId
+        let (HdRootId (InDb rootAddress)) = fixtureHdRootId
+        let sourceWallet = V1.WalletId (sformat build rootAddress)
+        let accountIndex = hdAccountId ^. hdAccountIdIx . to getHdAccountIx
+        let destinations =
+                fmap (\(addr, coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)
+                     ) fixturePayees
+        let newPayment = V1.Payment {
+                         pmtSource           = V1.PaymentSource sourceWallet accountIndex
+                       , pmtDestinations     = destinations
+                       , pmtGroupingPolicy   = Nothing
+                       , pmtSpendingPassword = Nothing
+                       }
+        action activeLayer newPayment
+
 spec :: Spec
 spec = describe "NewPayment" $ do
 
     describe "Generating a new payment (wallet layer)" $ do
 
         prop "pay works (realSigner, SenderPaysFee)" $ withMaxSuccess 50 $ do
             monadicIO $
-                withFixture @IO (InitialADA 10000) (PayLovelace 10) $ \_ activeLayer Fixture{..} -> do
-                    let (AccountIdHdRnd hdAccountId)  = fixtureAccountId
-                    let (HdRootId (InDb rootAddress)) = fixtureHdRootId
-                    let sourceWallet = V1.WalletId (sformat build rootAddress)
-                    let accountIndex = hdAccountId ^. hdAccountIdIx . to getHdAccountIx
-                    let destinations =
-                            fmap (\(addr, coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)
-                                 ) fixturePayees
-                    let newPayment = V1.Payment {
-                                     pmtSource           = V1.PaymentSource sourceWallet accountIndex
-                                   , pmtDestinations     = destinations
-                                   , pmtGroupingPolicy   = Nothing
-                                   , pmtSpendingPassword = Nothing
-                                   }
+                withPayment (InitialADA 10000) (PayLovelace 10) $ \activeLayer newPayment -> do
                     res <- liftIO ((WalletLayer.pay activeLayer) mempty
                                                                  IgnoreGrouping
                                                                  SenderPaysFee
@@ -205,7 +227,6 @@ spec = describe "NewPayment" $ do
         prop "newTransaction works (fake signer, ReceiverPaysFee)" $ withMaxSuccess 50 $ do
             monadicIO $
                 withFixture @IO (InitialADA 10000) (PayADA 1) $ \_ _ Fixture{..} -> do
-                    allWallets <- Kernel.hdWallets <$> Kernel.getWalletSnapshot fixturePw
                     let opts = (newOptions Kernel.cardanoFee) {
                                csoExpenseRegulation = ReceiverPaysFee
                              , csoInputGrouping     = IgnoreGrouping
@@ -220,26 +241,21 @@ spec = describe "NewPayment" $ do
                                   )
                     liftIO ((bimap STB STB res) `shouldSatisfy` isRight)
 
+    describe "Generating a new payment (Servant)" $ do
+
+        prop "works as expected in the happy path scenario" $ withMaxSuccess 50 $
+            monadicIO $
+                withPayment (InitialADA 1000) (PayADA 1) $ \activeLayer newPayment -> do
+                    res <- liftIO (runExceptT . runHandler' $ Handlers.newTransaction activeLayer newPayment)
+                    liftIO ((bimap identity STB res) `shouldSatisfy` isRight)
+
     describe "EstimateFees" $ do
 
         describe "Estimating fees (wallet layer)" $ do
 
             prop "estimating fees works (SenderPaysFee)" $ withMaxSuccess 50 $ do
                 monadicIO $
-                    withFixture @IO (InitialADA 10000) (PayLovelace 10) $ \_ activeLayer Fixture{..} -> do
-                        let (AccountIdHdRnd hdAccountId)  = fixtureAccountId
-                        let (HdRootId (InDb rootAddress)) = fixtureHdRootId
-                        let sourceWallet = V1.WalletId (sformat build rootAddress)
-                        let accountIndex = hdAccountId ^. hdAccountIdIx . to getHdAccountIx
-                        let destinations =
-                                fmap (\(addr, coin) -> V1.PaymentDistribution (V1.V1 addr) (V1.V1 coin)
-                                     ) fixturePayees
-                        let newPayment = V1.Payment {
-                                         pmtSource           = V1.PaymentSource sourceWallet accountIndex
-                                       , pmtDestinations     = destinations
-                                       , pmtGroupingPolicy   = Nothing
-                                       , pmtSpendingPassword = Nothing
-                                       }
+                    withPayment (InitialADA 10000) (PayLovelace 10) $ \activeLayer newPayment -> do
                         res <- liftIO ((WalletLayer.estimateFees activeLayer) mempty
                                                                               IgnoreGrouping
                                                                               SenderPaysFee
@@ -314,17 +330,10 @@ spec = describe "NewPayment" $ do
                              Left e  -> fail (formatToString build e)
                              Right x -> x `shouldSatisfy` (> (Coin 0))
 
-{--
-    describe "Generating a new payment (Servant)" $ do
-        prop "works as expected in the happy path scenario" $ do
-            monadicIO $
-                withFixture $ \keystore layer Fixture{..} -> do
-                    liftIO $ Keystore.insert (WalletIdHdRnd fixtureHdRootId) fixtureESK keystore
-                    let (HdRootId hdRoot) = fixtureHdRootId
-                        (AccountIdHdRnd myAccountId) = fixtureAccountId
-                        wId = sformat build (view fromDb hdRoot)
-                        accIdx = myAccountId ^. hdAccountIdIx . to getHdAccountIx
-                        req = V1.NewAddress Nothing accIdx (V1.WalletId wId)
-                    res <- liftIO (runExceptT . runHandler' $ Handlers.newAddress layer req)
-                    liftIO ((bimap identity STB res) `shouldSatisfy` isRight)
---}
+        describe "Estimating fees (Servant)" $ do
+            prop "works as expected in the happy path scenario" $ withMaxSuccess 50 $
+                monadicIO $
+                    withPayment (InitialADA 1000) (PayADA 1) $ \activeLayer newPayment -> do
+                        res <- liftIO (runExceptT . runHandler' $ Handlers.estimateFees activeLayer newPayment)
+                        liftIO ((bimap identity STB res) `shouldSatisfy` isRight)
+
