Merge pull request #263 from input-output-hk/KtorZ/integration-test-e…

…rror-handling

Integration test: Polling for wallet fixture & Better error handling

.weeder.yaml

@@ -7,17 +7,15 @@
       - module:
         - name: Test.Integration.Framework.DSL
         - identifier:
-          - </>
           - expectError
+          - expectEventually
           - expectSuccess
-          - getFromResponse
       - module:
         - name: Test.Integration.Framework.Request
         - identifier:
           - ClientError
           - DecodeFailure
-          - NonJson
-          - None
+          - HttpException
           - unsafeRequest
   - section:
     - name: test:unit
@@ -26,14 +24,6 @@
       - module:
         - name: Spec
         - identifier: main
-- package:
-  - name: cardano-wallet-launcher
-  - section:
-    - name: library
-    - message:
-      - name: Module not compiled
-      - module: Cardano.Launcher.Windows
-
 - package:
   - name: cardano-wallet-jormungandr
   - section:
@@ -43,4 +33,11 @@
       - module:
         - name: Spec
         - identifier: main
+- package:
+  - name: cardano-wallet-launcher
+  - section:
+    - name: library
+    - message:
+      - name: Module not compiled
+      - module: Cardano.Launcher.Windows
 

lib/http-bridge/test/integration/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 
@@ -21,9 +22,13 @@ import Cardano.Wallet.Compatibility.HttpBridge
 import Control.Concurrent
     ( forkIO, threadDelay )
 import Control.Concurrent.Async
-    ( async, cancel, link )
+    ( async, cancel, link, race )
+import Control.Exception
+    ( throwIO )
 import Control.Monad
-    ( void )
+    ( forM, void )
+import Data.Aeson
+    ( Value (..), (.:) )
 import Data.Function
     ( (&) )
 import Data.Proxy
@@ -35,7 +40,7 @@ import Network.HTTP.Client
 import Servant
     ( (:>), serve )
 import System.Directory
-    ( removePathForcibly )
+    ( createDirectoryIfMissing, removePathForcibly )
 import System.IO
     ( IOMode (..), hClose, openFile )
 import Test.Hspec
@@ -44,13 +49,17 @@ import Test.Integration.Faucet
     ( initFaucet )
 import Test.Integration.Framework.DSL
     ( Context (..), tearDown )
+import Test.Integration.Framework.Request
+    ( Headers (Default), Payload (Empty), request )
 
 import qualified Cardano.LauncherSpec as Launcher
 import qualified Cardano.Wallet.DB.MVar as MVar
 import qualified Cardano.Wallet.Network.HttpBridge as HttpBridge
 import qualified Cardano.Wallet.Network.HttpBridgeSpec as HttpBridge
 import qualified Cardano.Wallet.Transaction.HttpBridge as HttpBridge
 import qualified Cardano.WalletSpec as Wallet
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.Text as T
 import qualified Network.Wai.Handler.Warp as Warp
 import qualified Test.Integration.Scenario.Transactions as Transactions
 import qualified Test.Integration.Scenario.Wallets as Wallets
@@ -70,24 +79,17 @@ main = do
             describe "Wallets API endpoint tests" Wallets.spec
             describe "Transactions API endpoint tests" Transactions.spec
   where
-    clusterWarmUpDelay :: Int
-    clusterWarmUpDelay = 20 * 1000 * 1000 -- 20 seconds in microseconds
+    oneSecond :: Int
+    oneSecond = 1 * 1000 * 1000 -- 1 second in microseconds
 
-    bridgeWarmUpDelay :: Int
-    bridgeWarmUpDelay = 1 * 1000 * 1000 -- 1 second in microseconds
-
-    walletWarmUpDelay :: Int
-    walletWarmUpDelay = 1 * 1000 * 1000 -- 1 second in microseconds
-
-    humanReadable :: Int -> String
-    humanReadable d =
-        show (d `div` (1000 * 1000)) <> "s"
-
-    wait :: (String, Int) -> IO ()
-    wait (component, delay) = do
-        putStrLn $ "Waiting " <> humanReadable delay
-            <> " for " <> component <> " to warm-up..."
-        threadDelay delay
+    wait :: String -> IO () -> IO ()
+    wait component action = do
+        putStrLn $ "Waiting for " <> component <> " to warm-up..."
+        race (threadDelay (60*oneSecond)) action >>= \case
+            Left _ ->
+                fail $ "Waited too long for " <> component <> " to start."
+            Right _ ->
+                return ()
 
     -- Run a local cluster of cardano-sl nodes, a cardano-http-bridge on top and
     -- a cardano wallet server connected to the bridge.
@@ -96,24 +98,36 @@ main = do
         let stateDir = "./test/data/cardano-node-simple"
         let networkDir = "/tmp/cardano-http-bridge/networks"
         let bridgePort = 8080
+        let nodeApiAddress = "127.0.0.1:3101"
         removePathForcibly (networkDir <> "/local")
+        createDirectoryIfMissing True "/tmp/cardano-node-simple"
         handle <-
             openFile "/tmp/cardano-wallet-launcher" WriteMode
-        systemStart <-
-            formatTime defaultTimeLocale "%s" . addUTCTime 5 <$> getCurrentTime
-        cluster <- async $ void $ launch
-            [ cardanoNodeSimple stateDir systemStart ("core0", "127.0.0.1:3000")
-            , cardanoNodeSimple stateDir systemStart ("core1", "127.0.0.1:3001")
-            , cardanoNodeSimple stateDir systemStart ("core2", "127.0.0.1:3002")
-            , cardanoNodeSimple stateDir systemStart ("relay", "127.0.0.1:3100")
-            , cardanoHttpBridge bridgePort"local" networkDir handle
+        start <-
+            formatTime defaultTimeLocale "%s" . addUTCTime 2 <$> getCurrentTime
+        [h0, h1, h2, h3] <- forM ["core0", "core1", "core2", "relay"] $ \x -> do
+            openFile ("/tmp/cardano-node-simple/" <> x) WriteMode
+        cluster <- async $ throwIO =<< launch
+            [ cardanoNodeSimple stateDir start ("core0", "127.0.0.1:3000") h0 []
+            , cardanoNodeSimple stateDir start ("core1", "127.0.0.1:3001") h1 []
+            , cardanoNodeSimple stateDir start ("core2", "127.0.0.1:3002") h2 []
+            , cardanoNodeSimple stateDir start ("relay", "127.0.0.1:3100") h3
+                [ "--node-api-address", nodeApiAddress
+                , "--node-doc-address", "127.0.0.1:3102"
+                , "--tlscert", "/dev/null"
+                , "--tlskey", "/dev/null"
+                , "--tlsca", "/dev/null"
+                , "--no-tls"
+                ]
+            , cardanoHttpBridge bridgePort "local" networkDir handle
+                (waitForCluster nodeApiAddress)
             ]
         link cluster
-        wait ("cluster", clusterWarmUpDelay)
-        wait ("cardano-http-bridge", bridgeWarmUpDelay)
+        wait "cardano-node-simple" (waitForCluster nodeApiAddress)
+        wait "cardano-http-bridge" (threadDelay oneSecond)
         nl <- HttpBridge.newNetworkLayer bridgePort
         cardanoWalletServer nl 1337
-        wait ("cardano-wallet", walletWarmUpDelay)
+        wait "cardano-wallet" (threadDelay oneSecond)
         let baseURL = "http://localhost:1337/"
         manager <- newManager defaultManagerSettings
         faucet <- putStrLn "Creating money out of thin air..." *> initFaucet nl
@@ -124,9 +138,9 @@ main = do
         cancel cluster
         hClose handle
 
-    cardanoNodeSimple stateDir systemStart (nodeId, nodeAddr) = Command
+    cardanoNodeSimple stateDir sysStart (nodeId, nodeAddr) h extra = Command
         "cardano-node-simple"
-        [ "--system-start", systemStart
+        ([ "--system-start", sysStart
         , "--node-id", nodeId
         , "--keyfile", stateDir <> "/keys/" <> nodeId <> ".sk"
         , "--configuration-file", stateDir <> "/configuration.yaml"
@@ -136,17 +150,22 @@ main = do
         , "--listen", nodeAddr
         , "--log-config", stateDir <> "/logs/" <> nodeId <> "/config.json"
         , "--rebuild-db"
-        ] (pure ())
-        NoStream
+        ] ++ extra) (pure ())
+        -- NOTE Ideally, we would give `NoStream` as a handle but if we do, the
+        -- process never terminates on failure (probably because of some
+        -- internal handler waiting for the stdout or stderr to be closed even
+        -- though they're already closed... So, we just redirect the output to
+        -- some places where it's less annoying.
+        (UseHandle h)
 
-    cardanoHttpBridge port template dir handle = Command
+    cardanoHttpBridge port template dir h before = Command
         "cardano-http-bridge"
         [ "start"
         , "--template", template
         , "--port", show port
         , "--networks-dir", dir
-        ] (threadDelay clusterWarmUpDelay)
-        (UseHandle handle)
+        ] before
+        (UseHandle h)
 
     -- NOTE
     -- We start the wallet server in the same process such that we get
@@ -157,3 +176,28 @@ main = do
         wallet <- newWalletLayer @_ @HttpBridge db nl tl
         let settings = Warp.defaultSettings & Warp.setPort serverPort
         Warp.runSettings settings (serve (Proxy @("v2" :> Api)) (server wallet))
+
+    waitForCluster :: String -> IO ()
+    waitForCluster addr = do
+        manager <- newManager defaultManagerSettings
+        let ctx = Context
+                { _cluster = undefined
+                , _logs = undefined
+                , _faucet = undefined
+                , _manager = ("http://" <> T.pack addr, manager)
+                }
+        let err =  "waitForCluster: unexpected positive response from Api"
+        request @Value ctx ("GET", "/api/v1/node-info") Default Empty >>= \case
+            (_, Left _) ->
+                threadDelay oneSecond *> waitForCluster addr
+            (_, Right (Object m)) -> do
+                let parseHeight m0 = do
+                        m1 <- m0 .: "data"
+                        m2 <- m1 .: "localBlockchainHeight"
+                        m2 .: "quantity"
+                case Aeson.parseMaybe @_ @Int parseHeight m of
+                    Just q | q > 0 -> return ()
+                    Just _ -> threadDelay oneSecond *> waitForCluster addr
+                    Nothing -> fail err
+            (_, Right _) ->
+                fail err

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeApplications #-}
@@ -21,6 +22,7 @@ module Test.Integration.Framework.DSL
     , expectListItemFieldEqual
     , expectListSizeEqual
     , expectResponseCode
+    , expectEventually
     , verify
     , Headers(..)
     , Payload(..)
@@ -63,6 +65,10 @@ import Cardano.Wallet.Primitive.Types
     , WalletPassphraseInfo (..)
     , WalletState (..)
     )
+import Control.Concurrent
+    ( threadDelay )
+import Control.Concurrent.Async
+    ( race )
 import Control.Monad
     ( forM_, unless )
 import Control.Monad.Catch
@@ -136,14 +142,17 @@ expectErrorMessage
     -> (s, Either RequestException a)
     -> m ()
 expectErrorMessage want (_, res) = case res of
-    Left (DecodeFailure msg)  -> BL8.unpack msg `shouldContain` want
-    Left (ClientError _)  -> fail "expectErrorMessage: asserting ClientError not\
-                             \ supported yet"
+    Left (DecodeFailure msg)  ->
+        BL8.unpack msg `shouldContain` want
+    Left (ClientError _)  ->
+        fail "expectErrorMessage: asserting ClientError not supported yet"
+    Left (HttpException _) ->
+        fail "expectErrorMessage: asserting HttpException not supported yet"
     Right a -> wantedErrorButSuccess a
 
 -- | Expect a successful response, without any further assumptions
 expectSuccess
-    :: (MonadIO m, MonadFail m, Show a)
+    :: (MonadIO m, MonadFail m)
     => (s, Either RequestException a)
     -> m ()
 expectSuccess (_, res) = case res of
@@ -152,7 +161,7 @@ expectSuccess (_, res) = case res of
 
 -- | Expect a given response code on the response
 expectResponseCode
-    :: (MonadIO m, MonadFail m)
+    :: (MonadIO m)
     => HTTP.Status
     -> (HTTP.Status, a)
     -> m ()
@@ -212,7 +221,7 @@ expectListSizeEqual l (_, res) = case res of
 -- | Expects wallet from the request to eventually reach the given state or
 -- beyond
 expectEventually
-    :: (MonadIO m, MonadCatch m, MonadFail m, Show a, Ord a)
+    :: (MonadIO m, MonadCatch m, MonadFail m, Ord a)
     => Context
     -> Lens' ApiWallet a
     -> a
@@ -341,17 +350,25 @@ fixtureWallet ctx@(Context _ _ _ faucet) = do
             "passphrase": "cardano-wallet"
             } |]
     r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload
-    expectEventually ctx state Ready r
     let wid = getFromResponse walletId r
-    r' <- request @ApiWallet ctx ("GET", "v2/wallets/" <> wid) Default Empty
-    return $ getFromResponse id r'
+    race (threadDelay sixtySeconds) (checkBalance wid) >>= \case
+        Left _ -> fail "fixtureWallet: waited too long for initial transaction"
+        Right a -> return a
+  where
+    oneSecond = 1*1000*1000
+    sixtySeconds = 60*oneSecond
+    checkBalance :: Text -> IO ApiWallet
+    checkBalance wid = do
+        r <- request @ApiWallet ctx ("GET", "v2/wallets/" <> wid) Default Empty
+        if getFromResponse balanceAvailable r > 0
+            then return (getFromResponse id r)
+            else threadDelay oneSecond *> checkBalance wid
 
 fromQuantity :: Quantity (u :: Symbol) a -> a
 fromQuantity (Quantity a) = a
 
 getFromResponse
-    :: (Show a, Eq a)
-    => Lens' s a
+    :: Lens' s a
     -> (HTTP.Status, Either RequestException s)
     -> a
 getFromResponse getter (_, res) = case res of