From aa1f1d556744fc932ed92561c0a3ca809f3f7805 Mon Sep 17 00:00:00 2001
From: Rodney Lorrimar <rodney.lorrimar@iohk.io>
Date: Thu, 11 Jul 2019 18:41:01 +1000
Subject: [PATCH 1/2] Jormungandr.NetworkSpec: Add more error path tests

---
 .../Cardano/Wallet/Jormungandr/NetworkSpec.hs | 20 ++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
index 8a324f2eeea..dac07979a23 100644
--- a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
+++ b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
@@ -55,11 +55,13 @@ import Control.Monad.Trans.Except
 import Control.Retry
     ( limitRetries, retrying )
 import Data.Either
-    ( isRight )
+    ( isLeft, isRight )
 import Data.Functor
     ( ($>) )
 import Data.Proxy
     ( Proxy (..) )
+import Network.HTTP.Client
+    ( defaultManagerSettings, newManager )
 import Servant.Links
     ( safeLink )
 import System.Directory
@@ -164,6 +166,22 @@ spec = do
                         show link == show (safeLink api (Proxy @GetTipId))
             bracket (startNode wrongUrl wait) killNode test
 
+    describe "White-box error path tests" $
+        beforeAll startNode' $ afterAll killNode $ do
+
+        it "can't fetch a block that doesn't exist" $ \_ -> do
+            mgr <- newManager defaultManagerSettings
+            let jml = Jormungandr.mkJormungandrLayer mgr url
+            let nonexistent = Hash "kitten"
+            res <- runExceptT (Jormungandr.getBlock jml nonexistent)
+            res `shouldBe` Left (ErrGetBlockNotFound nonexistent)
+
+        it "can't fetch a blocks from a parent that doesn't exist" $ \_ -> do
+            mgr <- newManager defaultManagerSettings
+            let jml = Jormungandr.mkJormungandrLayer mgr url
+            let nonexistent = Hash "cat"
+            res <- runExceptT (Jormungandr.getDescendantIds jml nonexistent 42)
+            res `shouldSatisfy` isLeft
 
     -- NOTE: 'Right ()' just means that the format wasn't obviously wrong.
     -- The tx may still be rejected.

From 431a3c24d32ff96221fda47835892b3fe817c354 Mon Sep 17 00:00:00 2001
From: Johannes Lund <johannes.lund@iohk.io>
Date: Thu, 11 Jul 2019 12:19:46 +0200
Subject: [PATCH 2/2] Export and check for 'ErrGetDescendantsParentNotFound'

---
 .../src/Cardano/Wallet/Jormungandr/Network.hs      |  5 ++++-
 .../Cardano/Wallet/Jormungandr/NetworkSpec.hs      | 14 +++++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
index bb9cc6ac959..5412dd46ee5 100644
--- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
+++ b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs
@@ -21,9 +21,12 @@ module Cardano.Wallet.Jormungandr.Network
     , JormungandrLayer (..)
     , mkJormungandrLayer
 
-    -- * Exception
+    -- * Exceptions
     , ErrUnexpectedNetworkFailure (..)
+
+    -- * Errors
     , ErrGetInitialFeePolicy (..)
+    , ErrGetDescendants (..)
 
     -- * Re-export
     , BaseUrl (..)
diff --git a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
index dac07979a23..749050cf3c3 100644
--- a/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
+++ b/lib/jormungandr/test/integration/Cardano/Wallet/Jormungandr/NetworkSpec.hs
@@ -18,7 +18,11 @@ import Cardano.Wallet.Jormungandr.Api
 import Cardano.Wallet.Jormungandr.Compatibility
     ( Jormungandr, Network (..), block0 )
 import Cardano.Wallet.Jormungandr.Network
-    ( BaseUrl (..), ErrUnexpectedNetworkFailure (..), Scheme (..) )
+    ( BaseUrl (..)
+    , ErrGetDescendants (..)
+    , ErrUnexpectedNetworkFailure (..)
+    , Scheme (..)
+    )
 import Cardano.Wallet.Jormungandr.Primitive.Types
     ( Tx (..) )
 import Cardano.Wallet.Network
@@ -55,7 +59,7 @@ import Control.Monad.Trans.Except
 import Control.Retry
     ( limitRetries, retrying )
 import Data.Either
-    ( isLeft, isRight )
+    ( isRight )
 import Data.Functor
     ( ($>) )
 import Data.Proxy
@@ -181,7 +185,11 @@ spec = do
             let jml = Jormungandr.mkJormungandrLayer mgr url
             let nonexistent = Hash "cat"
             res <- runExceptT (Jormungandr.getDescendantIds jml nonexistent 42)
-            res `shouldSatisfy` isLeft
+            res `shouldSatisfy` \case
+                Left (ErrGetDescendantsParentNotFound _) -> True
+                Left (ErrGetDescendantsNetworkUnreachable _) -> False
+                Right _ -> False
+
 
     -- NOTE: 'Right ()' just means that the format wasn't obviously wrong.
     -- The tx may still be rejected.