From 09c71046fb97d11a71be2cea040642b13ef59a7f Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Mon, 20 Jan 2020 20:45:35 +1300
Subject: [PATCH] Report encountered exceptions in the response body.

---
 hurl.cabal                  |  2 +-
 src/Network/URI/Fetch.hs    | 11 ++++++++++-
 src/Network/URI/Messages.hs | 22 +++++++++++++++++++++-
 3 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/hurl.cabal b/hurl.cabal
index 814fbef..1353b47 100644
--- a/hurl.cabal
+++ b/hurl.cabal
@@ -83,7 +83,7 @@ library
   -- other-extensions:    
   
   -- Other library packages from which modules are imported.
-  build-depends:       base >=4.9 && <4.10, text >= 1.2 && <1.3,
+  build-depends:       base >=4.9 && <=4.12, text >= 1.2 && <1.3,
                        network-uri >=2.6 && <2.7, bytestring >= 0.10 && < 0.11
   
   -- Directories containing source files.
diff --git a/src/Network/URI/Fetch.hs b/src/Network/URI/Fetch.hs
index 214274f..ac41f54 100644
--- a/src/Network/URI/Fetch.hs
+++ b/src/Network/URI/Fetch.hs
@@ -9,6 +9,7 @@ import           Data.Text (Text)
 import           Network.URI
 import           Data.ByteString.Lazy (ByteString)
 import qualified Data.ByteString.Lazy as B
+import           Control.Exception
 
 #ifdef WITH_HTTP_URI
 import qualified Network.HTTP.Client as HTTP
@@ -87,12 +88,20 @@ fetchURL session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "ht
         (response, (mimetype:_)) -> let mime = Txt.toLower $ convertCharset "utf-8" mimetype
             in resolveCharset (map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" $ mime) response
         (response, []) -> (defaultMIME, Right response)
+  `catches` [
+    Handler $ \e -> do return ("text/plain", Left $ Txt.pack $ trans (locale session) $ Http e),
+    Handler $ \(ErrorCall msg) -> do return ("text/plain", Left $ Txt.pack msg)
+  ]
 #endif
 
 #ifdef WITH_FILE_URI
-fetchURL _ (defaultMIME:_) uri@URI {uriScheme = "file:"} = do
+fetchURL Session {locale = l} (defaultMIME:_) uri@URI {uriScheme = "file:"} = do
     response <- B.readFile $ uriPath uri
     return (defaultMIME, Right response)
+  `catch` \e -> do
+    return (
+        "text/plain",
+        Left $ Txt.pack $ trans l $ ReadFailed $ displayException (e :: IOException))
 #endif
 
 #ifdef WITH_DATA_URI
diff --git a/src/Network/URI/Messages.hs b/src/Network/URI/Messages.hs
index f46605a..d5fd2fb 100644
--- a/src/Network/URI/Messages.hs
+++ b/src/Network/URI/Messages.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- | Module holding localized error messages to be presented as a response.
 --
 -- To localize error messages provided by HURL, provide your translations between
@@ -6,14 +7,33 @@
 -- The lines are formatted:
 --    trans ("LANG":_) (KEY) = "TRANSLATION"
 -- with uppercase indicating the bits you fill in.
+--
+-- Translations between #if WITH_HTTP_URI & #endif are specific to HTTP error handling.
 module Network.URI.Messages (trans, Errors(..)) where
 
+#if WITH_HTTP_URI
+import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))
+import Control.Exception (displayException)
+#endif
+
 --- BEGIN LOCALIZATION
 trans ("en":_) (UnsupportedScheme scheme) = "Unsupported protocol " ++ scheme
 trans ("en":_) (OpenedWith app) = "Opened in " ++ app
+trans ("en":_) (ReadFailed msg) = "Failed to read file: " ++ msg
+#if WITH_HTTP_URI
+trans ("en":_) (Http (InvalidUrlException url msg)) = "Invalid URL " ++ url ++ ": " ++ msg
+trans ("en":_) (Http (HttpExceptionRequest _ (TooManyRedirects _))) = "Too many redirects!"
+trans ("en":_) (Http (HttpExceptionRequest _ ResponseTimeout)) = "The site took too long to respond!"
+trans ("en":_) (Http (HttpExceptionRequest _ ConnectionTimeout)) = "The site took too long to connect!"
+trans ("en":_) (Http (HttpExceptionRequest _ (ConnectionFailure err))) = "Could not connect: " ++ displayException err
+trans ("en":_) (Http (HttpExceptionRequest _ _)) = "The site doesn't appear to speak the same language as me!"
+#endif
 --- END LOCALIZATION
 
 trans (_:locales) err = trans locales err
 trans [] err = trans ["en"] err
 
-data Errors = UnsupportedScheme String | OpenedWith String
+data Errors = UnsupportedScheme String | OpenedWith String | ReadFailed String
+#if WITH_HTTP_URI
+    | Http HttpException
+#endif
-- 
2.30.2