NetworkLayer.listen: don't "die" when node backend fails

"die" will exit the process, which might not be what we want in all
cases. Throw an exception instead, which will also result in the
process exiting, but could be caught if needed.

src/Cardano/Wallet.hs

@@ -35,6 +35,8 @@ import Cardano.Wallet.Primitive.Model
     ( Wallet, applyBlock, initWallet )
 import Cardano.Wallet.Primitive.Types
     ( Block (..), WalletId (..), WalletMetadata (..), WalletName (..) )
+import Control.Exception
+    ( Exception )
 import Control.Monad.IO.Class
     ( liftIO )
 import Control.Monad.Trans.Except
@@ -84,7 +86,7 @@ newtype CreateWalletError
 
 -- | Create a new instance of the wallet layer.
 mkWalletLayer
-    :: (Show e0)
+    :: (Exception e0)
     => DBLayer IO SeqState
     -> NetworkLayer IO e0 e1
     -> WalletLayer SeqState

src/Cardano/Wallet/Network.hs

@@ -17,16 +17,14 @@ import Cardano.Wallet.Primitive.Types
     ( Block (..), BlockHeader (..), Hash (..), SignedTx, SlotId (..) )
 import Control.Concurrent
     ( threadDelay )
+import Control.Exception
+    ( Exception, throwIO )
 import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Control.Monad.Trans.Except
     ( ExceptT, runExceptT )
 import Data.Time.Units
     ( Millisecond, toMicroseconds )
-import Fmt
-    ( fmt, (+||), (||+) )
-import System.Exit
-    ( die )
 
 
 data NetworkLayer m e0 e1 = NetworkLayer
@@ -75,7 +73,7 @@ data TickResult a
 -- | Retrieve blocks from a chain producer and execute some given action for
 -- each block.
 listen
-    :: forall e0 e1. (Show e0)
+    :: forall e0 e1. (Exception e0)
     => NetworkLayer IO e0 e1
     -> ([Block] -> IO ())
     -> IO ()
@@ -93,8 +91,7 @@ listen network action = do
         -- which is fair price to pay in order NOT to have to do any slotting
         -- arithmetic nor track how many blocks are present per epochs.
         case res of
-            Left err ->
-                die $ fmt $ "Chain producer error: "+||err||+""
+            Left err -> throwIO err
             Right bs | length bs < 2 ->
                 pure (Sleep, current)
             Right blocks ->

src/Cardano/Wallet/Network/HttpBridge.hs

@@ -196,7 +196,14 @@ data HttpBridgeError
       -- ^ Could not connect to or read from the node API.
     | BadResponseFromNode String
       -- ^ The node returned an unexpected response.
-    deriving (Show, Eq)
+    deriving (Eq)
+
+instance Show HttpBridgeError where
+    show (NodeUnavailable msg) =
+        "Could not connect to or read from the node API: " ++ msg
+    show (BadResponseFromNode msg) =
+        "The node returned an unexpected response: " ++ msg
+instance Exception HttpBridgeError
 
 blockHeaderHash
     :: WithHash algorithm (ApiT BlockHeader)

test/integration/Cardano/Wallet/Network/HttpBridgeSpec.hs

@@ -41,7 +41,7 @@ import Test.Hspec
     , beforeAll
     , describe
     , it
-    , shouldEndWith
+    , shouldContain
     , shouldReturn
     , shouldSatisfy
     )
@@ -109,36 +109,36 @@ spec = do
 
             let signed = sign txEmpty []
             (Left err) <- runExceptT $ postTx network signed
-            (show err) `shouldEndWith`
-                "Transaction failed verification: transaction has no inputs\\\"})\""
+            (show err) `shouldContain`
+                "Transaction failed verification: transaction has no inputs"
 
         it "empty tx fails 2" $ \(_, network) -> do
 
             let signed = sign txEmpty [pkWitness]
             (Left err) <- runExceptT $ postTx network signed
-            (show err) `shouldEndWith`
-                "Transaction failed verification: transaction has no inputs\\\"})\""
+            (show err) `shouldContain`
+                "Transaction failed verification: transaction has no inputs"
 
         it "old tx fails" $ \(_, network) -> do
 
             let signed = sign txNonEmpty [pkWitness]
             (Left err) <- runExceptT $ postTx network signed
-            (show err) `shouldEndWith`
-                "Failed to send to peers: Blockchain protocol error\\\"})\""
+            (show err) `shouldContain`
+                "Failed to send to peers: Blockchain protocol error"
 
         it "tx fails - more inputs than witnesses" $ \(_, network) -> do
 
             let signed = sign txNonEmpty []
             (Left err) <- runExceptT $ postTx network signed
-            (show err) `shouldEndWith`
-                "Transaction failed verification: transaction has more inputs than witnesses\\\"})\""
+            (show err) `shouldContain`
+                "Transaction failed verification: transaction has more inputs than witnesses"
 
         it "tx fails - more witnesses than inputs" $ \(_, network) -> do
 
             let signed = sign txNonEmpty [pkWitness, pkWitness]
             (Left err) <- runExceptT $ postTx network signed
-            (show err) `shouldEndWith`
-                "Transaction failed verification: transaction has more witnesses than inputs\\\"})\""
+            (show err) `shouldContain`
+                "Transaction failed verification: transaction has more witnesses than inputs"
   where
     sign :: Tx -> [TxWitness] -> SignedTx
     sign tx witnesses = SignedTx . toBS $ encodeSignedTx (tx, witnesses)