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

Merge pull request #850 from phadej/pull-783

Browse source 
Try to add test for root client request
This commit is contained in:
Oleg Grenrus 2017-11-06 14:29:20 +02:00 committed by GitHub
commit e1c46c2069
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
1 changed files with 16 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -106,10 +106,14 @@ instance FromForm Person
alice :: Person alice :: Person
alice = Person "Alice" 42 alice = Person "Alice" 42
carol :: Person
carol = Person "Carol" 17
type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]
type Api = type Api =
"get" :> Get '[JSON] Person Get '[JSON] Person
:<|> "get" :> Get '[JSON] Person
:<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
@ -132,6 +136,7 @@ type Api =
api :: Proxy Api api :: Proxy Api
api = Proxy api = Proxy
getRoot :: ClientM Person
getGet :: ClientM Person getGet :: ClientM Person
getDeleteEmpty :: ClientM NoContent getDeleteEmpty :: ClientM NoContent
getCapture :: String -> ClientM Person getCapture :: String -> ClientM Person
@ -147,7 +152,8 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
getRespHeaders :: ClientM (Headers TestHeaders Bool) getRespHeaders :: ClientM (Headers TestHeaders Bool)
getDeleteContentType :: ClientM NoContent getDeleteContentType :: ClientM NoContent
getGet getRoot
:<|> getGet
:<|> getDeleteEmpty :<|> getDeleteEmpty
:<|> getCapture :<|> getCapture
:<|> getCaptureAll :<|> getCaptureAll
@ -164,7 +170,8 @@ getGet
server :: Application server :: Application
server = serve api ( server = serve api (
return alice return carol
:<|> return alice
:<|> return NoContent :<|> return NoContent
:<|> (\ name -> return $ Person name 0) :<|> (\ name -> return $ Person name 0)
:<|> (\ names -> return (zipWith Person names [0..])) :<|> (\ names -> return (zipWith Person names [0..]))
@ -299,6 +306,8 @@ runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')
sucessSpec :: Spec sucessSpec :: Spec
sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.Get root" $ \(_, baseUrl) -> do
left show <$> runClient getRoot baseUrl `shouldReturn` Right carol
it "Servant.API.Get" $ \(_, baseUrl) -> do it "Servant.API.Get" $ \(_, baseUrl) -> do
left show <$> runClient getGet baseUrl `shouldReturn` Right alice left show <$> runClient getGet baseUrl `shouldReturn` Right alice
@ -390,14 +399,14 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
context "client returns errors appropriately" $ do context "client returns errors appropriately" $ do
it "reports FailureResponse" $ \(_, baseUrl) -> do it "reports FailureResponse" $ \(_, baseUrl) -> do
let (_ :<|> getDeleteEmpty :<|> _) = client api let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api
Left res <- runClient getDeleteEmpty baseUrl Left res <- runClient getDeleteEmpty baseUrl
case res of case res of
FailureResponse r | responseStatusCode r == HTTP.status404 -> return () FailureResponse r | responseStatusCode r == HTTP.status404 -> return ()
_ -> fail $ "expected 404 response, but got " <> show res _ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ \(_, baseUrl) -> do it "reports DecodeFailure" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> getCapture :<|> _) = client api let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api
Left res <- runClient (getCapture "foo") baseUrl Left res <- runClient (getCapture "foo") baseUrl
case res of case res of
DecodeFailure _ _ -> return () DecodeFailure _ _ -> return ()
@ -411,14 +420,14 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
_ -> fail $ "expected ConnectionError, but got " <> show res _ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
let (getGet :<|> _ ) = client api let (_ :<|> getGet :<|> _ ) = client api
Left res <- runClient getGet baseUrl Left res <- runClient getGet baseUrl
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" $ \(_, baseUrl) -> do it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
Left res <- runClient (getBody alice) baseUrl Left res <- runClient (getBody alice) baseUrl
case res of case res of
InvalidContentTypeHeader _ -> return () InvalidContentTypeHeader _ -> return ()