diff options
| -rw-r--r-- | slackbuilder.cabal | 1 | ||||
| -rw-r--r-- | 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 |