@@ -48,13 +48,13 @@ data ServantError
4848 { responseContentType :: MediaType
4949 , responseBody :: ByteString
5050 }
51− | ConnectionError
52− { connectionError :: HttpException
53− }
5451 | InvalidContentTypeHeader
5552 { responseContentTypeHeader :: ByteString
5653 , responseBody :: ByteString
5754 }
55+ | ConnectionError
56+ { connectionError :: SomeException
57+ }
5858 deriving (Show, Typeable)
5959
6060instance Exception ServantError
@@ -152,11 +152,11 @@ performRequest reqMethod req isWantedStatus reqHost = do
152152 }
153153
154154 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
155− catchHttpException $
156− Client.httpLbs request manager
155+ catchConnectionError $
156+ Client.httpLbs request manager
157157 case eResponse of
158158 Left err ->
159− left $ ConnectionError err
159+ left . ConnectionError $ SomeException err
160160
161161 Right response -> do
162162 let status = Client.responseStatus response
@@ -189,6 +189,7 @@ performRequestNoBody reqMethod req wantedStatus reqHost = do
189189 _ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
190190 return ()
191191
192−catchHttpException :: IO a -> IO (Either HttpException a)
193−catchHttpException action =
194− catch (Right <$> action) (pure . Left)
192+catchConnectionError :: IO a -> IO (Either ServantError a)
193+catchConnectionError action =
194+ catch (Right <$> action) $ \e ->
195+ pure . Left . ConnectionError $ SomeException (e :: HttpException)