add negative test paths for network layer network tip

cardano-foundation · Jun 11, 2019 · af06b91 · af06b91
1 parent 95f27b8
commit af06b91
Show file tree

Hide file tree

Showing 3 changed files with 64 additions and 10 deletions.
diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal
@@ -115,6 +115,7 @@ test-suite integration
     , cardano-wallet-launcher
     , directory
     , hspec
+    , servant
     , text-class
     , transformers
   type:

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -18,6 +18,9 @@
 module Cardano.Wallet.Jormungandr.Network
     ( newNetworkLayer
 
+    -- * Exception
+    , ErrUnexpectedNetworkFailure (..)
+
     -- * Re-export
     , BaseUrl (..)
     , newManager

diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
@@ -1,7 +1,8 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Cardano.Wallet.Jormungandr.NetworkSpec
     ( spec
@@ -11,18 +12,26 @@ import Prelude
 
 import Cardano.Launcher
     ( Command (..), StdStream (..), launch )
+import Cardano.Wallet.Jormungandr.Api
+    ( GetTipId, api )
 import Cardano.Wallet.Jormungandr.Compatibility
     ( Jormungandr, Network (..) )
 import Cardano.Wallet.Jormungandr.Network
-    ( BaseUrl (..), Scheme (..) )
+    ( BaseUrl (..), ErrUnexpectedNetworkFailure (..), Scheme (..) )
 import Cardano.Wallet.Network
-    ( NetworkLayer (..), defaultRetryPolicy, waitForConnection )
+    ( ErrNetworkTip (..)
+    , NetworkLayer (..)
+    , defaultRetryPolicy
+    , waitForConnection
+    )
 import Cardano.Wallet.Primitive.Types
     ( BlockHeader (..), SlotId (..) )
 import Control.Concurrent
     ( threadDelay )
 import Control.Concurrent.Async
     ( Async, async, cancel )
+import Control.Exception
+    ( SomeException, bracket, catch )
 import Control.Monad
     ( void )
 import Control.Monad.Trans.Except
@@ -31,27 +40,69 @@ import Data.Either
     ( isRight )
 import Data.Functor
     ( ($>) )
+import Data.Proxy
+    ( Proxy (..) )
+import Servant.Links
+    ( safeLink )
 import System.Directory
     ( removePathForcibly )
 import Test.Hspec
-    ( Spec, afterAll, beforeAll, describe, it, shouldSatisfy )
+    ( Spec
+    , afterAll
+    , beforeAll
+    , describe
+    , it
+    , shouldReturn
+    , shouldSatisfy
+    , shouldThrow
+    )
 
 import qualified Cardano.Wallet.Jormungandr.Network as Jormungandr
 
 spec :: Spec
 spec = do
-    describe "Happy Paths" $ beforeAll startNode $ afterAll killNode $ do
+    let startNode' = startNode url (`waitForConnection` defaultRetryPolicy)
+    describe "Happy Paths" $ beforeAll startNode' $ afterAll killNode $ do
         it "get network tip" $ \(_, nw) -> do
             resp <- runExceptT $ networkTip nw
             resp `shouldSatisfy` isRight
             let (Right slot) = slotId . snd <$> resp
             slot `shouldSatisfy` (>= SlotId 0 0)
+
+    describe "Error paths" $ do
+        it "networkTip: ErrNetworkUnreachable" $ do
+            nw <- Jormungandr.newNetworkLayer url
+            let msg x =
+                    "Expected a ErrNetworkUnreachable' failure but got "
+                    <> show x
+            let action = do
+                    res <- runExceptT $ networkTip nw
+                    res `shouldSatisfy` \case
+                        Left (ErrNetworkTipNetworkUnreachable _) -> True
+                        _ -> error (msg res)
+            action `shouldReturn` ()
+
+        it "networkTip: throws on invalid url" $ do
+            let wrongUrl = BaseUrl Http "localhost" 8081 "/not-valid-prefix"
+            let wait nw = waitForConnection nw defaultRetryPolicy
+                    `catch` (\(_ :: SomeException) -> return ())
+            let test (_, nw) = do
+                    let io = void $ runExceptT $ networkTip nw
+                    shouldThrow io $ \(ErrUnexpectedNetworkFailure link _) ->
+                        show link == show (safeLink api (Proxy @GetTipId))
+            bracket (startNode wrongUrl wait) killNode test
   where
+    url :: BaseUrl
+    url = BaseUrl Http "localhost" 8081 "/api"
+
     second :: Int
     second = 1000000
 
-    startNode :: IO (Async (), NetworkLayer (Jormungandr 'Testnet) IO)
-    startNode = do
+    startNode
+        :: BaseUrl
+        -> (forall n. NetworkLayer n IO -> IO ())
+        -> IO (Async (), NetworkLayer (Jormungandr 'Testnet) IO)
+    startNode baseUrl wait = do
         removePathForcibly "/tmp/cardano-wallet-jormungandr"
         let dir = "test/data/jormungandr"
         handle <- async $ void $ launch
@@ -62,9 +113,8 @@ spec = do
                 ] (return ())
                 Inherit
             ]
-        let baseUrl = BaseUrl Http "localhost" 8081 "/api"
         nw <- Jormungandr.newNetworkLayer baseUrl
-        waitForConnection nw defaultRetryPolicy $> (handle, nw)
+        wait nw $> (handle, nw)
 
     killNode :: (Async (), a) -> IO ()
     killNode (h, _) = do