Don't export HttpException
This commit is contained in:
parent
5c25c56d50
commit
ed7d235b26
2 changed files with 11 additions and 10 deletions
|
@ -46,13 +46,13 @@ data ServantError
|
|||
{ responseContentType :: MediaType
|
||||
, responseBody :: ByteString
|
||||
}
|
||||
| ConnectionError
|
||||
{ connectionError :: HttpException
|
||||
}
|
||||
| InvalidContentTypeHeader
|
||||
{ responseContentTypeHeader :: ByteString
|
||||
, responseBody :: ByteString
|
||||
}
|
||||
| ConnectionError
|
||||
{ connectionError :: String
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
data Req = Req
|
||||
|
@ -148,11 +148,11 @@ performRequest reqMethod req isWantedStatus reqHost = do
|
|||
}
|
||||
|
||||
eResponse <- liftIO $ __withGlobalManager $ \ manager ->
|
||||
catchHttpException $
|
||||
Client.httpLbs request manager
|
||||
catchConnectionError $
|
||||
Client.httpLbs request manager
|
||||
case eResponse of
|
||||
Left err ->
|
||||
left $ ConnectionError err
|
||||
left $ ConnectionError (show err)
|
||||
|
||||
Right response -> do
|
||||
let status = Client.responseStatus response
|
||||
|
@ -185,6 +185,7 @@ performRequestNoBody reqMethod req wantedStatus reqHost = do
|
|||
_ <- performRequest reqMethod req (`elem` wantedStatus) reqHost
|
||||
return ()
|
||||
|
||||
catchHttpException :: IO a -> IO (Either HttpException a)
|
||||
catchHttpException action =
|
||||
catch (Right <$> action) (pure . Left)
|
||||
catchConnectionError :: IO a -> IO (Either ServantError a)
|
||||
catchConnectionError action =
|
||||
catch (Right <$> action) $ \e ->
|
||||
pure . Left . ConnectionError . show $ (e :: HttpException)
|
||||
|
|
|
@ -303,7 +303,7 @@ failSpec = withFailServer $ \ baseUrl -> do
|
|||
it "reports ConnectionError" $ do
|
||||
Left res <- runEitherT getGetWrongHost
|
||||
case res of
|
||||
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 19872 False _) -> return ()
|
||||
ConnectionError _ -> return ()
|
||||
_ -> fail $ "expected ConnectionError, but got " <> show res
|
||||
|
||||
it "reports UnsupportedContentType" $ do
|
||||
|
|
Loading…
Add table
Reference in a new issue