eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Merge pull request #14 from haskell-servant/proper-errors

Browse source 
Use `ServantError` to report Errors instead of `String`
This commit is contained in:
Alp Mestanogullari 2015-03-09 09:02:59 +01:00
commit c08baabfdf
5 changed files with 152 additions and 74 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
CHANGELOG.md
View file

@ -3,6 +3,7 @@
* Support content-type aware combinators and `Accept`/`Content-type` headers * Support content-type aware combinators and `Accept`/`Content-type` headers
* Added a lot of tests * Added a lot of tests
* Support multiple concurrent threads * Support multiple concurrent threads
* Use `ServantError` to report Errors instead of `String`
0.2.2 0.2.2
----- -----

1
servant-client.cabal
View file

@ -71,6 +71,7 @@ test-suite spec
, deepseq , deepseq
, either , either
, hspec == 2.* , hspec == 2.*
, http-client
, http-media , http-media
, http-types , http-types
, network >= 2.6 , network >= 2.6

19
src/Servant/Client.hs
View file

@ -11,12 +11,12 @@
module Servant.Client module Servant.Client
( client ( client
, HasClient(..) , HasClient(..)
, ServantError(..)
, module Servant.Common.BaseUrl , module Servant.Common.BaseUrl
) where ) where
import Control.Monad import Control.Monad
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.Aeson
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import Data.List import Data.List
import Data.Proxy import Data.Proxy
@ -29,7 +29,6 @@ import Servant.API
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
import Servant.Common.Req import Servant.Common.Req
import Servant.Common.Text
-- * Accessing APIs as a Client -- * Accessing APIs as a Client
@ -109,7 +108,7 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout)
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance HasClient Delete where instance HasClient Delete where
type Client Delete = BaseUrl -> EitherT String IO () type Client Delete = BaseUrl -> EitherT ServantError IO ()
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
void $ performRequest H.methodDelete req (== 204) host void $ performRequest H.methodDelete req (== 204) host
@ -119,9 +118,9 @@ instance HasClient Delete where
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
type Client (Get (ct ': cts) result) = BaseUrl -> EitherT String IO result type Client (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodGet req 200 host performRequestCT (Proxy :: Proxy ct) H.methodGet req [200] host
-- | If you use a 'Header' in one of your endpoints in your API, -- | If you use a 'Header' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -165,20 +164,20 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
type Client (Post (ct ': cts) a) = BaseUrl -> EitherT String IO a type Client (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req uri = clientWithRoute Proxy req uri =
performRequestCT (Proxy :: Proxy ct) H.methodPost req 201 uri performRequestCT (Proxy :: Proxy ct) H.methodPost req [200,201] uri
-- | If you have a 'Put' endpoint in your API, the client -- | If you have a 'Put' endpoint in your API, the client
-- side querying function that is created when calling 'client' -- side querying function that is created when calling 'client'
-- will just require an argument that specifies the scheme, host -- will just require an argument that specifies the scheme, host
-- and port to send the request to. -- and port to send the request to.
instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
type Client (Put (ct ': cts) a) = BaseUrl -> EitherT String IO a type Client (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
clientWithRoute Proxy req host = clientWithRoute Proxy req host =
performRequestCT (Proxy :: Proxy ct) H.methodPut req 200 host performRequestCT (Proxy :: Proxy ct) H.methodPut req [200,201] host
-- | If you use a 'QueryParam' in one of your endpoints in your API, -- | If you use a 'QueryParam' in one of your endpoints in your API,
-- the corresponding querying function will automatically take -- the corresponding querying function will automatically take
@ -414,7 +413,7 @@ instance (KnownSymbol sym, HasClient sublayout)
-- | Pick a 'Method' and specify where the server you want to query is. You get -- | Pick a 'Method' and specify where the server you want to query is. You get
-- back the status code and the response body as a 'ByteString'. -- back the status code and the response body as a 'ByteString'.
instance HasClient Raw where instance HasClient Raw where
type Client Raw = H.Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType) type Client Raw = H.Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute :: Proxy Raw -> Req -> Client Raw
clientWithRoute Proxy req httpMethod host = clientWithRoute Proxy req httpMethod host =

64
src/Servant/Common/Req.hs
View file

@ -8,7 +8,7 @@ import Control.Monad
import Control.Monad.Catch (MonadThrow) import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
import Data.ByteString.Lazy hiding (pack, filter, map, null) import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)
import Data.IORef import Data.IORef
import Data.String import Data.String
import Data.String.Conversions import Data.String.Conversions
@ -27,6 +27,30 @@ import System.IO.Unsafe
import qualified Network.HTTP.Client as Client import qualified Network.HTTP.Client as Client
data ServantError
= FailureResponse
{ responseStatus :: Status
, responseContentType :: MediaType
, responseBody :: ByteString
}
| DecodeFailure
{ decodeError :: String
, responseContentType :: MediaType
, responseBody :: ByteString
}
| UnsupportedContentType
{ responseContentType :: MediaType
, responseBody :: ByteString
}
| ConnectionError
{ connectionError :: HttpException
}
| InvalidContentTypeHeader
{ responseContentTypeHeader :: ByteString
, responseBody :: ByteString
}
deriving (Show)
data Req = Req data Req = Req
{ reqPath :: String { reqPath :: String
, qs :: QueryText , qs :: QueryText
@ -109,7 +133,7 @@ displayHttpRequest :: Method -> String
displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"
performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType) performRequest :: Method -> Req -> (Int -> Bool) -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
performRequest reqMethod req isWantedStatus reqHost = do performRequest reqMethod req isWantedStatus reqHost = do
partialRequest <- liftIO $ reqToRequest req reqHost partialRequest <- liftIO $ reqToRequest req reqHost
@ -118,43 +142,39 @@ performRequest reqMethod req isWantedStatus reqHost = do
} }
eResponse <- liftIO $ __withGlobalManager $ \ manager -> eResponse <- liftIO $ __withGlobalManager $ \ manager ->
catchStatusCodeException $ catchHttpException $
Client.httpLbs request manager Client.httpLbs request manager
case eResponse of case eResponse of
Left status -> Left err ->
left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status) left $ ConnectionError err
Right response -> do Right response -> do
let status = Client.responseStatus response let status = Client.responseStatus response
unless (isWantedStatus (statusCode status)) $ body = Client.responseBody response
left (displayHttpRequest reqMethod ++ " failed with status: " ++ showStatus status) status_code = statusCode status
ct <- case lookup "Content-Type" $ Client.responseHeaders response of ct <- case lookup "Content-Type" $ Client.responseHeaders response of
Nothing -> pure $ "application"//"octet-stream" Nothing -> pure $ "application"//"octet-stream"
Just t -> case parseAccept t of Just t -> case parseAccept t of
Nothing -> left $ "invalid Content-Type header: " <> cs t Nothing -> left $ InvalidContentTypeHeader (cs t) body
Just t' -> pure t' Just t' -> pure t'
return (statusCode status, Client.responseBody response, ct) unless (isWantedStatus status_code) $
where left $ FailureResponse status ct body
showStatus (Status code message) = return (status_code, body, ct)
show code ++ " - " ++ cs message
performRequestCT :: MimeUnrender ct result => performRequestCT :: MimeUnrender ct result =>
Proxy ct -> Method -> Req -> Int -> BaseUrl -> EitherT String IO result Proxy ct -> Method -> Req -> [Int] -> BaseUrl -> EitherT ServantError IO result
performRequestCT ct reqMethod req wantedStatus reqHost = do performRequestCT ct reqMethod req wantedStatus reqHost = do
let acceptCT = contentType ct let acceptCT = contentType ct
(_status, respBody, respCT) <- (_status, respBody, respCT) <-
performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost performRequest reqMethod (req { reqAccept = [acceptCT] }) (`elem` wantedStatus) reqHost
unless (matches respCT (acceptCT)) $ unless (matches respCT (acceptCT)) $
left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT left $ UnsupportedContentType respCT respBody
either either
(left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++)) (left . (\s -> DecodeFailure s respCT respBody))
return return
(fromByteString ct respBody) (fromByteString ct respBody)
catchStatusCodeException :: IO a -> IO (Either Status a) catchHttpException :: IO a -> IO (Either HttpException a)
catchStatusCodeException action = catchHttpException action =
catch (Right <$> action) $ \e -> catch (Right <$> action) (pure . Left)
case e of
Client.StatusCodeException status _ _ -> return $ Left status
exc -> throwIO exc

141
test/Servant/ClientSpec.hs
View file

@ -5,9 +5,13 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fcontext-stack=25 #-} {-# OPTIONS_GHC -fcontext-stack=25 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where module Servant.ClientSpec where
import Control.Applicative
import qualified Control.Arrow as Arrow
import Control.Concurrent import Control.Concurrent
import Control.Exception import Control.Exception
import Control.Monad.Trans.Either import Control.Monad.Trans.Either
@ -19,6 +23,7 @@ import Data.Monoid
import Data.Proxy import Data.Proxy
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics import GHC.Generics
import Network.HTTP.Client (HttpException(..))
import Network.HTTP.Media import Network.HTTP.Media
import Network.HTTP.Types import Network.HTTP.Types
import Network.Socket import Network.Socket
@ -29,7 +34,6 @@ import Test.Hspec.QuickCheck
import Test.QuickCheck import Test.QuickCheck
import Servant.API import Servant.API
import Servant.API.ContentTypes
import Servant.Client import Servant.Client
import Servant.Server import Servant.Server
@ -58,6 +62,10 @@ 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 HttpException where
a == b = show a == show b
alice :: Person alice :: Person
alice = Person "Alice" 42 alice = Person "Alice" 42
@ -110,21 +118,21 @@ server = serve api (
withServer :: (BaseUrl -> IO a) -> IO a withServer :: (BaseUrl -> IO a) -> IO a
withServer action = withWaiDaemon (return server) action withServer action = withWaiDaemon (return server) action
getGet :: BaseUrl -> EitherT String IO Person getGet :: BaseUrl -> EitherT ServantError IO Person
getDelete :: BaseUrl -> EitherT String IO () getDelete :: BaseUrl -> EitherT ServantError IO ()
getCapture :: String -> BaseUrl -> EitherT String IO Person getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
getBody :: Person -> BaseUrl -> EitherT String IO Person getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person] getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person] getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType) getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType) getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, MediaType)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> BaseUrl -> BaseUrl
-> EitherT String IO (String, Maybe Int, Bool, [(String, [Rational])]) -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
( getGet ( getGet
:<|> getDelete :<|> getDelete
:<|> getCapture :<|> getCapture
@ -140,65 +148,82 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
:<|> getMultiple) :<|> getMultiple)
= client api = client api
type FailApi =
"get" :> Raw
:<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw
failApi :: Proxy FailApi
failApi = Proxy
failServer :: Application
failServer = serve failApi (
(\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
:<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
)
withFailServer :: (BaseUrl -> IO a) -> IO a
withFailServer action = withWaiDaemon (return failServer) action
spec :: Spec spec :: Spec
spec = do spec = do
it "Servant.API.Get" $ withServer $ \ host -> do it "Servant.API.Get" $ withServer $ \ host -> do
runEitherT (getGet host) `shouldReturn` Right alice (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
it "Servant.API.Delete" $ withServer $ \ host -> do it "Servant.API.Delete" $ withServer $ \ host -> do
runEitherT (getDelete host) `shouldReturn` Right () (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
it "Servant.API.Capture" $ withServer $ \ host -> do it "Servant.API.Capture" $ withServer $ \ host -> do
runEitherT (getCapture "Paula" host) `shouldReturn` Right (Person "Paula" 0) (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ withServer $ \ host -> do it "Servant.API.ReqBody" $ withServer $ \ host -> do
let p = Person "Clara" 42 let p = Person "Clara" 42
runEitherT (getBody p host) `shouldReturn` Right p (Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ withServer $ \ host -> do it "Servant.API.QueryParam" $ withServer $ \ host -> do
runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice
Left result <- runEitherT (getQueryParam (Just "bob") host) Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host)
result `shouldContain` "bob not found" responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do
runEitherT (getQueryParams [] host) `shouldReturn` Right [] (Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right []
runEitherT (getQueryParams ["alice", "bob"] host) (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host))
`shouldReturn` Right [Person "alice" 0, Person "bob" 1] `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.QueryParam.QueryFlag" $ context "Servant.API.QueryParam.QueryFlag" $
forM_ [False, True] $ \ flag -> forM_ [False, True] $ \ flag ->
it (show flag) $ withServer $ \ host -> do it (show flag) $ withServer $ \ host -> do
runEitherT (getQueryFlag flag host) `shouldReturn` Right flag (Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag
{-
it "Servant.API.MatrixParam" $ withServer $ \ host -> do it "Servant.API.MatrixParam" $ withServer $ \ host -> do
runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice
Left result <- runEitherT (getMatrixParam (Just "bob") host) Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host)
result `shouldContain` "bob not found" responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do
runEitherT (getMatrixParams [] host) `shouldReturn` Right [] Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right []
runEitherT (getMatrixParams ["alice", "bob"] host) Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host)
`shouldReturn` Right [Person "alice" 0, Person "bob" 1] `shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.MatrixParam.MatrixFlag" $ context "Servant.API.MatrixParam.MatrixFlag" $
forM_ [False, True] $ \ flag -> forM_ [False, True] $ \ flag ->
it (show flag) $ withServer $ \ host -> do it (show flag) $ withServer $ \ host -> do
runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag
-}
it "Servant.API.Raw on success" $ withServer $ \ host -> do it "Servant.API.Raw on success" $ withServer $ \ host -> do
runEitherT (getRawSuccess methodGet host) `shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream") (Arrow.left show <$> runEitherT (getRawSuccess methodGet host))
`shouldReturn` Right (200, "rawSuccess", "application"//"octet-stream")
it "Servant.API.Raw on failure" $ withServer $ \ host -> do it "Servant.API.Raw on failure" $ withServer $ \ host -> do
runEitherT (getRawFailure methodGet host) `shouldReturn` Right (400, "rawFailure", "application"//"octet-stream") (Arrow.left show <$> runEitherT (getRawFailure methodGet host))
`shouldReturn` Right (400, "rawFailure", "application"//"octet-stream")
modifyMaxSuccess (const 20) $ do modifyMaxSuccess (const 20) $ do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $
property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
ioProperty $ do ioProperty $ do
withServer $ \ host -> do withServer $ \ host -> do
result <- runEitherT (getMultiple cap num flag body host) result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body host)
return $ return $
result === Right (cap, num, flag, body) result === Right (cap, num, flag, body)
@ -209,20 +234,52 @@ spec = do
it desc $ it desc $
withWaiDaemon (return (serve api (left (500, "error message")))) $ withWaiDaemon (return (serve api (left (500, "error message")))) $
\ host -> do \ host -> do
let getResponse :: BaseUrl -> EitherT String IO () let getResponse :: BaseUrl -> EitherT ServantError IO ()
getResponse = client api getResponse = client api
Left result <- runEitherT (getResponse host) Left FailureResponse{..} <- runEitherT (getResponse host)
result `shouldContain` "error message" responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $ mapM_ test $
(WrappedApi (Proxy :: Proxy Delete), "Delete") : (WrappedApi (Proxy :: Proxy Delete), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
[] []
context "client returns errors appropriately" $ do
it "reports FailureResponse" $ withFailServer $ \ host -> do
Left res <- runEitherT (getDelete host)
case res of
FailureResponse (Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ withFailServer $ \ host -> do
Left res <- runEitherT (getCapture "foo" host)
case res of
DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ do
Right host <- return $ parseBaseUrl "127.0.0.1:987654"
Left res <- runEitherT (getGet host)
case res of
ConnectionError (FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ withFailServer $ \ host -> do
Left res <- runEitherT (getGet host)
case res of
UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do
Left res <- runEitherT (getBody alice host)
case res of
InvalidContentTypeHeader "fooooo" _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a, WrappedApi :: (HasServer api, Server api ~ EitherT (Int, String) IO a,
HasClient api, Client api ~ (BaseUrl -> EitherT String IO ())) => HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi