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

changes to fix tests for baseurl changes

Browse source 
initial changes to fix tests for baseurl changes

more test fixes

moving some test spec stuff around
This commit is contained in:
Brandon Martin 2015-05-05 09:39:35 -06:00
parent 8f100a14e8
commit f5dd4bfdbd
4 changed files with 175 additions and 162 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client/servant-client.cabal
View file

@ -85,3 +85,4 @@ test-suite spec
, text , text
, wai , wai
, warp , warp
, transformers

32
servant-client/src/Servant/Client.hs
View file

@ -61,7 +61,7 @@ client p = clientWithRoute p defReq
-- influences the creation of an HTTP request. It's mostly -- influences the creation of an HTTP request. It's mostly
-- an internal class, you can just use 'client'. -- an internal class, you can just use 'client'.
class HasClient layout where class HasClient layout where
type Client layout :: * type Client' layout :: *
clientWithRoute :: Proxy layout -> Req -> Client layout clientWithRoute :: Proxy layout -> Req -> Client layout
type Client layout = Client' layout type Client layout = Client' layout
@ -107,7 +107,7 @@ instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
instance (KnownSymbol capture, ToText a, HasClient sublayout) instance (KnownSymbol capture, ToText a, HasClient sublayout)
=> HasClient (Capture capture a :> sublayout) where => HasClient (Capture capture a :> sublayout) where
type Client (Capture capture a :> sublayout) = type Client' (Capture capture a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req baseurl val = clientWithRoute Proxy req baseurl val =
@ -188,7 +188,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Get (ct ': cts) (Headers ls a)) where ) => HasClient (Get (ct ': cts) (Headers ls a)) where
type Client (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client' (Get (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -223,7 +223,7 @@ instance
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (Header sym a :> sublayout) where => HasClient (Header sym a :> sublayout) where
type Client (Header sym a :> sublayout) = type Client' (Header sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
clientWithRoute Proxy req baseurl mval = clientWithRoute Proxy req baseurl mval =
@ -268,7 +268,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Post (ct ': cts) (Headers ls a)) where ) => HasClient (Post (ct ': cts) (Headers ls a)) where
type Client (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client' (Post (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -307,7 +307,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Put (ct ': cts) (Headers ls a)) where ) => HasClient (Put (ct ': cts) (Headers ls a)) where
type Client (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client' (Put (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req [200, 201] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -346,7 +346,7 @@ instance
#endif #endif
( MimeUnrender ct a, BuildHeadersTo ls ( MimeUnrender ct a, BuildHeadersTo ls
) => HasClient (Patch (ct ': cts) (Headers ls a)) where ) => HasClient (Patch (ct ': cts) (Headers ls a)) where
type Client (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a) type Client' (Patch (ct ': cts) (Headers ls a)) = EitherT ServantError IO (Headers ls a)
clientWithRoute Proxy req baseurl = do clientWithRoute Proxy req baseurl = do
(hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req [200, 201, 204] baseurl
return $ Headers { getResponse = resp return $ Headers { getResponse = resp
@ -381,7 +381,7 @@ instance
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (QueryParam sym a :> sublayout) where => HasClient (QueryParam sym a :> sublayout) where
type Client (QueryParam sym a :> sublayout) = type Client' (QueryParam sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
@ -427,7 +427,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (QueryParams sym a :> sublayout) where => HasClient (QueryParams sym a :> sublayout) where
type Client (QueryParams sym a :> sublayout) = type Client' (QueryParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req baseurl paramlist = clientWithRoute Proxy req baseurl paramlist =
@ -466,7 +466,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, HasClient sublayout) instance (KnownSymbol sym, HasClient sublayout)
=> HasClient (QueryFlag sym :> sublayout) where => HasClient (QueryFlag sym :> sublayout) where
type Client (QueryFlag sym :> sublayout) = type Client' (QueryFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req baseurl flag = clientWithRoute Proxy req baseurl flag =
@ -507,7 +507,7 @@ instance (KnownSymbol sym, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (MatrixParam sym a :> sublayout) where => HasClient (MatrixParam sym a :> sublayout) where
type Client (MatrixParam sym a :> sublayout) = type Client' (MatrixParam sym a :> sublayout) =
Maybe a -> Client sublayout Maybe a -> Client sublayout
-- if mparam = Nothing, we don't add it to the query string -- if mparam = Nothing, we don't add it to the query string
@ -552,7 +552,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, ToText a, HasClient sublayout) instance (KnownSymbol sym, ToText a, HasClient sublayout)
=> HasClient (MatrixParams sym a :> sublayout) where => HasClient (MatrixParams sym a :> sublayout) where
type Client (MatrixParams sym a :> sublayout) = type Client' (MatrixParams sym a :> sublayout) =
[a] -> Client sublayout [a] -> Client sublayout
clientWithRoute Proxy req baseurl paramlist = clientWithRoute Proxy req baseurl paramlist =
@ -591,7 +591,7 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
instance (KnownSymbol sym, HasClient sublayout) instance (KnownSymbol sym, HasClient sublayout)
=> HasClient (MatrixFlag sym :> sublayout) where => HasClient (MatrixFlag sym :> sublayout) where
type Client (MatrixFlag sym :> sublayout) = type Client' (MatrixFlag sym :> sublayout) =
Bool -> Client sublayout Bool -> Client sublayout
clientWithRoute Proxy req baseurl flag = clientWithRoute Proxy req baseurl flag =
@ -607,7 +607,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 full `Response`. -- back the full `Response`.
instance HasClient Raw where instance HasClient Raw where
type Client Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) type Client' Raw = H.Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
clientWithRoute :: Proxy Raw -> Req -> Client Raw clientWithRoute :: Proxy Raw -> Req -> Client Raw
clientWithRoute Proxy req httpMethod baseurl = do clientWithRoute Proxy req httpMethod baseurl = do
@ -634,7 +634,7 @@ instance HasClient Raw where
instance (MimeRender ct a, HasClient sublayout) instance (MimeRender ct a, HasClient sublayout)
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where => HasClient (ReqBody (ct ': cts) a :> sublayout) where
type Client (ReqBody (ct ': cts) a :> sublayout) = type Client' (ReqBody (ct ': cts) a :> sublayout) =
a -> Client sublayout a -> Client sublayout
clientWithRoute Proxy req baseurl body = clientWithRoute Proxy req baseurl body =
@ -648,7 +648,7 @@ instance (MimeRender ct a, HasClient sublayout)
-- | Make the querying function append @path@ to the request path. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
type Client (path :> sublayout) = Client sublayout type Client' (path :> sublayout) = Client sublayout
clientWithRoute Proxy req baseurl = clientWithRoute Proxy req baseurl =
clientWithRoute (Proxy :: Proxy sublayout) clientWithRoute (Proxy :: Proxy sublayout)

188
servant-client/test/Servant/ClientSpec.hs
View file

@ -9,6 +9,7 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fcontext-stack=100 #-} {-# OPTIONS_GHC -fcontext-stack=100 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where module Servant.ClientSpec where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
@ -129,28 +130,43 @@ 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 ServantError IO Person type FailApi =
getDelete :: BaseUrl -> EitherT ServantError IO () "get" :> Raw
getDeleteString :: BaseUrl -> EitherT ServantError IO String :<|> "delete" :> Raw
getCapture :: String -> BaseUrl -> EitherT ServantError IO Person :<|> "capture" :> Capture "name" String :> Raw
getBody :: Person -> BaseUrl -> EitherT ServantError IO Person :<|> "body" :> Raw
getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person failApi :: Proxy FailApi
getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person] failApi = Proxy
getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person failServer :: Application
getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person] failServer = serve failApi (
getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool (\ _request respond -> respond $ responseLBS ok200 [] "")
getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, :<|> (\ _request respond -> respond $ responseLBS ok200 [] "")
MediaType, [HTTP.Header], C.Response ByteString) :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString, :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
MediaType, [HTTP.Header], C.Response ByteString) )
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> BaseUrl withFailServer :: (BaseUrl -> IO a) -> IO a
-> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])]) withFailServer action = withWaiDaemon (return failServer) action
getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool)
spec :: IO ()
spec = withServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person
getDelete :: EitherT ServantError IO ()
getCapture :: String -> EitherT ServantError IO Person
getBody :: Person -> EitherT ServantError IO Person
getQueryParam :: Maybe String -> EitherT ServantError IO Person
getQueryParams :: [String] -> EitherT ServantError IO [Person]
getQueryFlag :: Bool -> EitherT ServantError IO Bool
getMatrixParam :: Maybe String -> EitherT ServantError IO Person
getMatrixParams :: [String] -> EitherT ServantError IO [Person]
getMatrixFlag :: Bool -> EitherT ServantError IO Bool
getRawSuccess :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getRawFailure :: Method -> EitherT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], C.Response ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: EitherT ServantError IO (Headers TestHeaders Bool)
( getGet ( getGet
:<|> getDelete :<|> getDelete
:<|> getDeleteString
:<|> getCapture :<|> getCapture
:<|> getBody :<|> getBody
:<|> getQueryParam :<|> getQueryParam
@ -163,76 +179,54 @@ getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool)
:<|> getRawFailure :<|> getRawFailure
:<|> getMultiple :<|> getMultiple
:<|> getRespHeaders) :<|> getRespHeaders)
= client api = client api baseUrl
type FailApi = hspec $ do
"get" :> Raw it "Servant.API.Get" $ do
:<|> "capture" :> Capture "name" String :> Raw (Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice
:<|> "body" :> Raw
failApi :: Proxy FailApi
failApi = Proxy
failServer :: Application it "Servant.API.Delete" $ do
failServer = serve failApi ( (Arrow.left show <$> runEitherT getDelete) `shouldReturn` Right ()
(\ _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 it "Servant.API.Capture" $ do
withFailServer action = withWaiDaemon (return failServer) action (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
spec :: Spec it "Servant.API.ReqBody" $ do
spec = do
it "Servant.API.Get" $ withServer $ \ host -> do
(Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice
context "Servant.API.Delete" $ do
it "return no body" $ withServer $ \ host -> do
(Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right ()
it "return body" $ withServer $ \ host -> do
(Arrow.left show <$> runEitherT (getDeleteString host)) `shouldReturn` Right "ok"
it "Servant.API.Capture" $ withServer $ \ host -> do
(Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ withServer $ \ host -> do
let p = Person "Clara" 42 let p = Person "Clara" 42
(Arrow.left show <$> runEitherT (getBody p host)) `shouldReturn` Right p (Arrow.left show <$> runEitherT (getBody p)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ withServer $ \ host -> do it "Servant.API.QueryParam" $ do
Arrow.left show <$> runEitherT (getQueryParam (Just "alice") host) `shouldReturn` Right alice Arrow.left show <$> runEitherT (getQueryParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob") host) Left FailureResponse{..} <- runEitherT (getQueryParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found" responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ withServer $ \ host -> do it "Servant.API.QueryParam.QueryParams" $ do
(Arrow.left show <$> runEitherT (getQueryParams [] host)) `shouldReturn` Right [] (Arrow.left show <$> runEitherT (getQueryParams [])) `shouldReturn` Right []
(Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"] host)) (Arrow.left show <$> runEitherT (getQueryParams ["alice", "bob"]))
`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) $ do
(Arrow.left show <$> runEitherT (getQueryFlag flag host)) `shouldReturn` Right flag (Arrow.left show <$> runEitherT (getQueryFlag flag)) `shouldReturn` Right flag
it "Servant.API.MatrixParam" $ withServer $ \ host -> do it "Servant.API.MatrixParam" $ do
Arrow.left show <$> runEitherT (getMatrixParam (Just "alice") host) `shouldReturn` Right alice Arrow.left show <$> runEitherT (getMatrixParam (Just "alice")) `shouldReturn` Right alice
Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob") host) Left FailureResponse{..} <- runEitherT (getMatrixParam (Just "bob"))
responseStatus `shouldBe` Status 400 "bob not found" responseStatus `shouldBe` Status 400 "bob not found"
it "Servant.API.MatrixParam.MatrixParams" $ withServer $ \ host -> do it "Servant.API.MatrixParam.MatrixParams" $ do
Arrow.left show <$> runEitherT (getMatrixParams [] host) `shouldReturn` Right [] Arrow.left show <$> runEitherT (getMatrixParams []) `shouldReturn` Right []
Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"] host) Arrow.left show <$> runEitherT (getMatrixParams ["alice", "bob"])
`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) $ do
Arrow.left show <$> runEitherT (getMatrixFlag flag host) `shouldReturn` Right flag Arrow.left show <$> runEitherT (getMatrixFlag flag) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ withServer $ \ host -> do it "Servant.API.Raw on success" $ do
res <- runEitherT (getRawSuccess methodGet host) res <- runEitherT (getRawSuccess methodGet)
case res of case res of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do Right (code, body, ct, _, response) -> do
@ -240,8 +234,8 @@ spec = do
C.responseBody response `shouldBe` body C.responseBody response `shouldBe` body
C.responseStatus response `shouldBe` ok200 C.responseStatus response `shouldBe` ok200
it "Servant.API.Raw on failure" $ withServer $ \ host -> do it "Servant.API.Raw on failure" $ do
res <- runEitherT (getRawFailure methodGet host) res <- runEitherT (getRawFailure methodGet)
case res of case res of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do Right (code, body, ct, _, response) -> do
@ -249,8 +243,8 @@ spec = do
C.responseBody response `shouldBe` body C.responseBody response `shouldBe` body
C.responseStatus response `shouldBe` badRequest400 C.responseStatus response `shouldBe` badRequest400
it "Returns headers appropriately" $ withServer $ \ host -> do it "Returns headers appropriately" $ withServer $ \ _ -> do
res <- runEitherT (getRespHeaders host) res <- runEitherT getRespHeaders
case res of case res of
Left e -> assertFailure $ show e Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")] Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
@ -259,8 +253,7 @@ spec = 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 result <- Arrow.left show <$> runEitherT (getMultiple cap num flag body)
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)
@ -271,52 +264,65 @@ spec = do
it desc $ it desc $
withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $ withWaiDaemon (return (serve api (left $ ServantErr 500 "error message" "" []))) $
\ host -> do \ host -> do
let getResponse :: BaseUrl -> EitherT ServantError IO () let getResponse :: EitherT ServantError IO ()
getResponse = client api getResponse = client api host
Left FailureResponse{..} <- runEitherT (getResponse host) Left FailureResponse{..} <- runEitherT getResponse
responseStatus `shouldBe` (Status 500 "error message") responseStatus `shouldBe` (Status 500 "error message")
mapM_ test $ mapM_ test $
(WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy Delete), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
(WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") :
(WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") :
[] []
failSpec :: IO ()
failSpec = withFailServer $ \ baseUrl -> do
let getGet :: EitherT ServantError IO Person
getDelete :: EitherT ServantError IO ()
getCapture :: String -> EitherT ServantError IO Person
getBody :: Person -> EitherT ServantError IO Person
( getGet
:<|> getDelete
:<|> getCapture
:<|> getBody)
= client failApi baseUrl
hspec $ do
context "client returns errors appropriately" $ do context "client returns errors appropriately" $ do
it "reports FailureResponse" $ withFailServer $ \ host -> do it "reports FailureResponse" $ do
Left res <- runEitherT (getDelete host) Left res <- runEitherT getDelete
case res of case res of
FailureResponse (Status 404 "Not Found") _ _ -> return () FailureResponse (Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res _ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ withFailServer $ \ host -> do it "reports DecodeFailure" $ do
Left res <- runEitherT (getCapture "foo" host) Left res <- runEitherT (getCapture "foo")
case res of case res of
DecodeFailure _ ("application/json") _ -> return () DecodeFailure _ ("application/json") _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res _ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ do it "reports ConnectionError" $ do
Right host <- return $ parseBaseUrl "127.0.0.1:987654" Right _ <- return $ parseBaseUrl "127.0.0.1:987654"
Left res <- runEitherT (getGet host) Left res <- runEitherT getGet
case res of case res of
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return () ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res _ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ withFailServer $ \ host -> do it "reports UnsupportedContentType" $ do
Left res <- runEitherT (getGet host) Left res <- runEitherT getGet
case res of case res of
UnsupportedContentType ("application/octet-stream") _ -> return () UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res _ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do it "reports InvalidContentTypeHeader" $ do
Left res <- runEitherT (getBody alice host) Left res <- runEitherT (getBody alice)
case res of case res of
InvalidContentTypeHeader "fooooo" _ -> return () InvalidContentTypeHeader "fooooo" _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where data WrappedApi where
WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a, WrappedApi :: (HasServer api, Server api ~ EitherT ServantErr IO a,
HasClient api, Client api ~ (BaseUrl -> EitherT ServantError IO ())) => HasClient api, Client' api ~ EitherT ServantError IO ()) =>
Proxy api -> WrappedApi Proxy api -> WrappedApi

8
servant-client/test/Spec.hs
View file

@ -1 +1,7 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-} import Servant.ClientSpec (spec, failSpec)
main :: IO ()
main = do
spec
failSpec