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

Add "Servant.API.Get redirection" test to verify the derived response status

Browse Source
This commit is contained in:
Giorgio Marinelli 2021-12-07 18:47:06 +01:00
parent 8761940ee2
commit 50bc90553d
2 changed files with 10 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
servant-client/test/Servant/ClientTestUtils.hs
View File

@ -64,7 +64,7 @@ import Servant.API
JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender),
NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,
QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,
WithStatus (WithStatus), NamedRoutes, addHeader)
Verb, WithStatus (WithStatus), NamedRoutes, addHeader)
import Servant.API.Generic ((:-))
import Servant.Client
import qualified Servant.Client.Core.Auth as Auth
@ -125,6 +125,7 @@ type Api =
:<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
:<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]
:<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
:<|> "redirection" :> Verb 'GET 301 '[PlainText] Text
:<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
-- This endpoint makes use of a 'Raw' server because it is not currently
-- possible to handle arbitrary binary query param values with
@ -164,6 +165,7 @@ getDeleteEmpty :: ClientM NoContent
getCapture :: String -> ClientM Person
getCaptureAll :: [String] -> ClientM [Person]
getBody :: Person -> ClientM Person
getRedirection :: ClientM Text
getQueryParam :: Maybe String -> ClientM Person
getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response
getQueryParams :: [String] -> ClientM [Person]
@ -190,6 +192,7 @@ getRoot
:<|> getCapture
:<|> getCaptureAll
:<|> getBody
:<|> getRedirection
:<|> getQueryParam
:<|> getQueryParamBinary
:<|> getQueryParams
@ -216,6 +219,7 @@ server = serve api (
:<|> (\ name -> return $ Person name 0)
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> return "redirecting"
:<|> (\ name -> case name of
Just "alice" -> return alice
Just n -> throwError $ ServerError 400 (n ++ " not found") "" []

6
servant-client/test/Servant/SuccessSpec.hs
View File

@ -83,6 +83,9 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
let p = Person "Clara" 42
left show <$> runClient (getBody p) baseUrl `shouldReturn` Right p
it "Servant.API.Get redirection" $ \(_, baseUrl) -> do
left show <$> runClient getRedirection baseUrl `shouldReturn` Right "redirecting"
it "Servant.API FailureResponse" $ \(_, baseUrl) -> do
left show <$> runClient (getQueryParam (Just "alice")) baseUrl `shouldReturn` Right alice
Left (FailureResponse req _) <- runClient (getQueryParam (Just "bob")) baseUrl
@ -111,6 +114,7 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.Fragment" $ \(_, baseUrl) -> do
left id <$> runClient getFragment baseUrl `shouldReturn` Right alice
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
res <- runClient (getRawSuccess HTTP.methodGet) baseUrl
case res of
@ -156,7 +160,7 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
-- In proper situation, extra headers should probably be visible in API type.
-- However, testing for response timeout is difficult, so we test with something which is easy to observe
let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }
let clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }
res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv
case res of
Left e ->