Merge pull request #94 from haskell-servant/tvh/simpler-error
Don't export HttpException
This commit is contained in:
commit
fa6cfbb539
2 changed files with 11 additions and 15 deletions
|
@ -48,13 +48,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 :: SomeException
|
||||||
|
}
|
||||||
deriving (Show, Typeable)
|
deriving (Show, Typeable)
|
||||||
|
|
||||||
instance Exception ServantError
|
instance Exception ServantError
|
||||||
|
@ -152,11 +152,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 $ SomeException err
|
||||||
|
|
||||||
Right response -> do
|
Right response -> do
|
||||||
let status = Client.responseStatus response
|
let status = Client.responseStatus response
|
||||||
|
@ -189,6 +189,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 $ SomeException (e :: HttpException)
|
||||||
|
|
|
@ -68,11 +68,6 @@ instance FromFormUrlEncoded Person where
|
||||||
a <- lookupEither "age" xs
|
a <- lookupEither "age" xs
|
||||||
return $ Person (T.unpack n) (read $ T.unpack a)
|
return $ Person (T.unpack n) (read $ T.unpack a)
|
||||||
|
|
||||||
deriving instance Eq ServantError
|
|
||||||
|
|
||||||
instance Eq C.HttpException where
|
|
||||||
a == b = show a == show b
|
|
||||||
|
|
||||||
alice :: Person
|
alice :: Person
|
||||||
alice = Person "Alice" 42
|
alice = Person "Alice" 42
|
||||||
|
|
||||||
|
@ -311,7 +306,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 a new issue