From 8908b8ae93d4bd29db149a0a0eb5886d09ac5c3f Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 2 Mar 2025 21:20:09 +0100
Subject: [PATCH] Add a printer for HttpExceptionContent

---
 slackbuilder.cabal         |  1 +
 src/SlackBuilder/Update.hs | 51 +++++++++++++++++++++++++++++++++++---
 2 files changed, 49 insertions(+), 3 deletions(-)

diff --git a/slackbuilder.cabal b/slackbuilder.cabal
index 2beb676..6d146df 100644
--- a/slackbuilder.cabal
+++ b/slackbuilder.cabal
@@ -35,6 +35,7 @@ common dependencies
     directory ^>= 1.3.8,
     exceptions >= 0.10,
     filepath ^>= 1.5,
+    http-types ^>= 0.12.4,
     megaparsec ^>= 9.7,
     modern-uri ^>= 0.3.6,
     memory ^>= 0.18,
diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs
index 7987916..8998bec 100644
--- a/src/SlackBuilder/Update.hs
+++ b/src/SlackBuilder/Update.hs
@@ -18,6 +18,7 @@ import Control.Exception (Exception(..), SomeException(..))
 import Control.Monad.Catch (MonadCatch(..), catches, Handler(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Reader (asks)
+import qualified Data.ByteString.Char8 as Char8
 import Data.Foldable (Foldable(..), find)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
@@ -28,7 +29,7 @@ import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
 import GHC.Records (HasField(..))
 import qualified Network.HTTP.Req as Req
-import Network.HTTP.Client (HttpException(..))
+import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..), responseStatus)
 import System.FilePath
     ( (</>)
     , (<.>)
@@ -71,6 +72,7 @@ import Control.Monad (filterM, void)
 import Data.List (isPrefixOf, isSuffixOf, partition)
 import Data.Functor ((<&>))
 import Data.Bifunctor (Bifunctor(..))
+import Network.HTTP.Types (Status(..))
 
 getAndLogLatest :: PackageDescription -> SlackBuilderT (Maybe PackageUpdateData)
 getAndLogLatest description = do
@@ -278,11 +280,54 @@ handleExceptions action = catches (void action)
         = liftIO (setSGR [SetColor Foreground Dull Red])
         >> liftIO (putStrLn e)
         >> liftIO (setSGR [Reset])
+    showStatus (Status code message) =
+        Char8.pack (show code) <> " \"" <> message <> "\""
+    showHttpExceptionContent (StatusCodeException response _) = Char8.unpack
+        $ "The server returned "
+        <> showStatus (responseStatus response)
+        <> " response status code."
+    showHttpExceptionContent (TooManyRedirects _) =
+        "The server responded with too many redirects for a request."
+    showHttpExceptionContent OverlongHeaders = "Too many total bytes in the HTTP header were returned by the server."
+    showHttpExceptionContent TooManyHeaderFields = "Too many HTTP header fields were returned by the server."
+    showHttpExceptionContent ResponseTimeout = "The server took too long to return a response."
+    showHttpExceptionContent ConnectionTimeout = "Attempting to connect to the server timed out"
+    showHttpExceptionContent (ConnectionFailure connectionException) = displayException connectionException
+    showHttpExceptionContent (InvalidStatusLine statusLine) = Char8.unpack
+        $ "The status line returned by the server could not be parsed: "
+        <> statusLine <> "."
+    showHttpExceptionContent (InvalidHeader headerLine) = Char8.unpack 
+        $ "The given response header line could not be parsed: "
+        <> headerLine <> "."
+    showHttpExceptionContent (InvalidRequestHeader headerLine) = Char8.unpack
+        $ "The given request header is not compliant: "
+        <> headerLine <> "."
+    showHttpExceptionContent (InternalException interalException) = displayException interalException
+    showHttpExceptionContent (ProxyConnectException _ _ status) = Char8.unpack
+        $ showStatus status
+        <> " status code was returned when trying to connect to the proxy server on the given host and port."
+    showHttpExceptionContent NoResponseDataReceived = "No response data was received from the server at all."
+    showHttpExceptionContent TlsNotSupported = "This HTTP client does not have support for secure connections."
+    showHttpExceptionContent (WrongRequestBodyStreamSize _ _)
+        = "The request body provided did not match the expected size."
+    showHttpExceptionContent (ResponseBodyTooShort _ _) =
+        "The returned response body is too short. Provides the expected size and actual size."
+    showHttpExceptionContent InvalidChunkHeaders = "A chunked response body had invalid headers."
+    showHttpExceptionContent IncompleteHeaders = "An incomplete set of response headers were returned."
+    showHttpExceptionContent (InvalidDestinationHost hostLine) = Char8.unpack
+        $ "The host we tried to connect to is invalid"
+        <> hostLine <> "."
+    showHttpExceptionContent (HttpZlibException zlibException) = displayException zlibException
+    showHttpExceptionContent (InvalidProxyEnvironmentVariable environmentName environmentValue) = Text.unpack
+        $ "Values in the proxy environment variable were invalid: "
+        <> environmentName <> "=\"" <> environmentValue <> "\"."
+    showHttpExceptionContent ConnectionClosed = "Attempted to use a Connection which was already closed"
+    showHttpExceptionContent (InvalidProxySettings _) = "Proxy settings are not valid."
     handleHttp :: (MonadIO m, MonadCatch m) => Req.HttpException -> m ()
     handleHttp (Req.VanillaHttpException e)
         | HttpExceptionRequest _ exceptionContent <- e = printException
-            $ show exceptionContent
+            $ showHttpExceptionContent exceptionContent
         | InvalidUrlException url reason <- e = printException $ url <> ": " <> reason
     handleHttp (Req.JsonHttpException e) = printException e
     handleSome :: (MonadIO m, MonadCatch m) => SomeException -> m ()
-    handleSome = printException . displayException
+    handleSome = printException . show