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

Add server spec for NoContentVerbWithStatus

Browse source
This commit is contained in:
Nicolas BACQUEY 2022-03-03 16:49:41 +01:00
parent 0a1d32d21e
commit 2f9fcdb45d
1 changed files with 19 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
servant-server/test/Servant/ServerSpec.hs
View file

@ -51,10 +51,11 @@ import Servant.API
BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll, BasicAuthData (BasicAuthData), Capture, Capture', CaptureAll,
Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header, Delete, EmptyAPI, Fragment, Get, HasStatus (StatusOf), Header,
Headers, HttpVersion, IsSecure (..), JSON, Lenient, Headers, HttpVersion, IsSecure (..), JSON, Lenient,
NoContent (..), NoContentVerb, NoFraming, OctetStream, Patch, NoContent (..), NoContentVerb, NoContentVerbWithStatus,
PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, NoFraming, OctetStream, Patch, PlainText, Post, Put,
RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Strict, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody,
UVerb, Union, Verb, WithStatus (..), addHeader) SourceIO, StdMethod (..), Stream, Strict, UVerb, Union, Verb,
WithStatus (..), addHeader)
import Servant.Server import Servant.Server
(Context ((:.), EmptyContext), Handler, Server, Tagged (..), (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
emptyServer, err401, err403, err404, respond, serve, emptyServer, err401, err403, err404, respond, serve,
@ -109,19 +110,21 @@ spec = do
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
type VerbApi method status type VerbApi method status
= Verb method status '[JSON] Person = Verb method status '[JSON] Person
:<|> "noContent" :> NoContentVerb method :<|> "noContent" :> NoContentVerb method
:<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person) :<|> "permanentRedirection" :> NoContentVerbWithStatus method 308
:<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent) :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
:<|> "accept" :> ( Verb method status '[JSON] Person :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
:<|> Verb method status '[PlainText] String :<|> "accept" :> ( Verb method status '[JSON] Person
) :<|> Verb method status '[PlainText] String
)
:<|> "stream" :> Stream method status NoFraming OctetStream (SourceIO BS.ByteString) :<|> "stream" :> Stream method status NoFraming OctetStream (SourceIO BS.ByteString)
verbSpec :: Spec verbSpec :: Spec
verbSpec = describe "Servant.API.Verb" $ do verbSpec = describe "Servant.API.Verb" $ do
let server :: Server (VerbApi method status) let server :: Server (VerbApi method status)
server = return alice server = return alice
:<|> return NoContent
:<|> return NoContent :<|> return NoContent
:<|> return (addHeader 5 alice) :<|> return (addHeader 5 alice)
:<|> return (addHeader 10 NoContent) :<|> return (addHeader 10 NoContent)
@ -150,6 +153,11 @@ verbSpec = describe "Servant.API.Verb" $ do
liftIO $ statusCode (simpleStatus response) `shouldBe` 204 liftIO $ statusCode (simpleStatus response) `shouldBe` 204
liftIO $ simpleBody response `shouldBe` "" liftIO $ simpleBody response `shouldBe` ""
it "returns no content on Permanent Redirection" $ do
response <- THW.request method "/permanentRedirection" [] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` 308
liftIO $ simpleBody response `shouldBe` ""
-- HEAD should not return body -- HEAD should not return body
when (method == methodHead) $ when (method == methodHead) $
it "HEAD returns no content body" $ do it "HEAD returns no content body" $ do