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