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)

296
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,44 +130,9 @@ 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
getDelete :: BaseUrl -> EitherT ServantError IO ()
getDeleteString :: BaseUrl -> EitherT ServantError IO String
getCapture :: String -> BaseUrl -> EitherT ServantError IO Person
getBody :: Person -> BaseUrl -> EitherT ServantError IO Person
getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
getQueryParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
getQueryFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
getMatrixParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person
getMatrixParams :: [String] -> BaseUrl -> EitherT ServantError IO [Person]
getMatrixFlag :: Bool -> BaseUrl -> EitherT ServantError IO Bool
getRawSuccess :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,
MediaType, [HTTP.Header], C.Response ByteString)
getRawFailure :: Method -> BaseUrl -> EitherT ServantError IO (Int, ByteString,
MediaType, [HTTP.Header], C.Response ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> BaseUrl
-> EitherT ServantError IO (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool)
( getGet
:<|> getDelete
:<|> getDeleteString
:<|> getCapture
:<|> getBody
:<|> getQueryParam
:<|> getQueryParams
:<|> getQueryFlag
:<|> getMatrixParam
:<|> getMatrixParams
:<|> getMatrixFlag
:<|> getRawSuccess
:<|> getRawFailure
:<|> getMultiple
:<|> getRespHeaders)
= client api
type FailApi = type FailApi =
"get" :> Raw "get" :> Raw
:<|> "delete" :> Raw
:<|> "capture" :> Capture "name" String :> Raw :<|> "capture" :> Capture "name" String :> Raw
:<|> "body" :> Raw :<|> "body" :> Raw
failApi :: Proxy FailApi failApi :: Proxy FailApi
@ -175,6 +141,7 @@ failApi = Proxy
failServer :: Application failServer :: Application
failServer = serve failApi ( failServer = serve failApi (
(\ _request respond -> respond $ responseLBS ok200 [] "") (\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _request respond -> respond $ responseLBS ok200 [] "")
:<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "") :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")
:<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "") :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")
) )
@ -182,141 +149,180 @@ failServer = serve failApi (
withFailServer :: (BaseUrl -> IO a) -> IO a withFailServer :: (BaseUrl -> IO a) -> IO a
withFailServer action = withWaiDaemon (return failServer) action withFailServer action = withWaiDaemon (return failServer) action
spec :: Spec spec :: IO ()
spec = do spec = withServer $ \ baseUrl -> do
it "Servant.API.Get" $ withServer $ \ host -> do let getGet :: EitherT ServantError IO Person
(Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice 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
:<|> getDelete
:<|> getCapture
:<|> getBody
:<|> getQueryParam
:<|> getQueryParams
:<|> getQueryFlag
:<|> getMatrixParam
:<|> getMatrixParams
:<|> getMatrixFlag
:<|> getRawSuccess
:<|> getRawFailure
:<|> getMultiple
:<|> getRespHeaders)
= client api baseUrl
context "Servant.API.Delete" $ do hspec $ do
it "return no body" $ withServer $ \ host -> do it "Servant.API.Get" $ do
(Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right () (Arrow.left show <$> runEitherT getGet) `shouldReturn` Right alice
it "return body" $ withServer $ \ host -> do it "Servant.API.Delete" $ do
(Arrow.left show <$> runEitherT (getDeleteString host)) `shouldReturn` Right "ok" (Arrow.left show <$> runEitherT getDelete) `shouldReturn` Right ()
it "Servant.API.Capture" $ withServer $ \ host -> do it "Servant.API.Capture" $ do
(Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0) (Arrow.left show <$> runEitherT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.ReqBody" $ withServer $ \ host -> do it "Servant.API.ReqBody" $ 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
(code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream") (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream")
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
(code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream") (code, body, ct) `shouldBe` (400, "rawFailure", "application"//"octet-stream")
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")]
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 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)
context "client correctly handles error status codes" $ do context "client correctly handles error status codes" $ do
let test :: (WrappedApi, String) -> Spec let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) = test (WrappedApi api, desc) =
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") :
[] []
context "client returns errors appropriately" $ do failSpec :: IO ()
it "reports FailureResponse" $ withFailServer $ \ host -> do failSpec = withFailServer $ \ baseUrl -> do
Left res <- runEitherT (getDelete host) let getGet :: EitherT ServantError IO Person
case res of getDelete :: EitherT ServantError IO ()
FailureResponse (Status 404 "Not Found") _ _ -> return () getCapture :: String -> EitherT ServantError IO Person
_ -> fail $ "expected 404 response, but got " <> show res getBody :: Person -> EitherT ServantError IO Person
( getGet
:<|> getDelete
:<|> getCapture
:<|> getBody)
= client failApi baseUrl
it "reports DecodeFailure" $ withFailServer $ \ host -> do hspec $ do
Left res <- runEitherT (getCapture "foo" host) context "client returns errors appropriately" $ do
case res of it "reports FailureResponse" $ do
DecodeFailure _ ("application/json") _ -> return () Left res <- runEitherT getDelete
_ -> fail $ "expected DecodeFailure, but got " <> show res case res of
FailureResponse (Status 404 "Not Found") _ _ -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports ConnectionError" $ do it "reports DecodeFailure" $ do
Right host <- return $ parseBaseUrl "127.0.0.1:987654" Left res <- runEitherT (getCapture "foo")
Left res <- runEitherT (getGet host) case res of
case res of DecodeFailure _ ("application/json") _ -> return ()
ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return () _ -> fail $ "expected DecodeFailure, but got " <> show res
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ withFailServer $ \ host -> do it "reports ConnectionError" $ do
Left res <- runEitherT (getGet host) Right _ <- return $ parseBaseUrl "127.0.0.1:987654"
case res of Left res <- runEitherT getGet
UnsupportedContentType ("application/octet-stream") _ -> return () case res of
_ -> fail $ "expected UnsupportedContentType, but got " <> show res ConnectionError (C.FailedConnectionException2 "127.0.0.1" 987654 False _) -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports InvalidContentTypeHeader" $ withFailServer $ \ host -> do it "reports UnsupportedContentType" $ do
Left res <- runEitherT (getBody alice host) Left res <- runEitherT getGet
case res of case res of
InvalidContentTypeHeader "fooooo" _ -> return () UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res _ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ do
Left res <- runEitherT (getBody alice)
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 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