diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index 91908c79462..590b44e45f4 100644 --- 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 index d6575c2a0aa..5606c283bfa 100644 --- 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 index a44641c8d52..2e6ad6e245a 100644 --- 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