Merge pull request #972 from phadej/stream-status-test

Add test for Stream status setting
This commit is contained in:
Oleg Grenrus 2018-06-09 12:25:46 +03:00 committed by GitHub
commit 352596398e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -17,57 +17,62 @@
module Servant.ServerSpec where module Servant.ServerSpec where
import Control.Monad (forM_, when, unless) import Control.Monad
import Control.Monad.Error.Class (MonadError (..)) (forM_, unless, when)
import Data.Aeson (FromJSON, ToJSON, decode', encode) import Control.Monad.Error.Class
import qualified Data.ByteString.Base64 as Base64 (MonadError (..))
import Data.Char (toUpper) import Data.Aeson
(FromJSON, ToJSON, decode', encode)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64
import Data.Char
(toUpper)
import Data.Monoid import Data.Monoid
import Data.Proxy (Proxy (Proxy)) import Data.Proxy
import Data.String (fromString) (Proxy (Proxy))
import Data.String.Conversions (cs) import Data.String
import qualified Data.Text as T (fromString)
import GHC.Generics (Generic) import Data.String.Conversions
import Network.HTTP.Types (Status (..), hAccept, hContentType, (cs)
methodDelete, methodGet, import qualified Data.Text as T
methodHead, methodPatch, import GHC.Generics
methodPost, methodPut, ok200, (Generic)
imATeapot418, import Network.HTTP.Types
parseQuery) (Status (..), hAccept, hContentType, imATeapot418,
import Network.Wai (Application, Request, requestHeaders, pathInfo, methodDelete, methodGet, methodHead, methodPatch, methodPost,
queryString, rawQueryString, methodPut, ok200, parseQuery)
responseLBS) import Network.Wai
import Network.Wai.Test (defaultRequest, request, (Application, Request, pathInfo, queryString, rawQueryString,
runSession, simpleBody, requestHeaders, responseLBS)
simpleHeaders, simpleStatus) import Network.Wai.Test
import Servant.API ((:<|>) (..), (:>), AuthProtect, (defaultRequest, request, runSession, simpleBody,
BasicAuth, BasicAuthData(BasicAuthData), simpleHeaders, simpleStatus)
Capture, CaptureAll, Delete, Get, Header, import Servant.API
Headers, HttpVersion, ((:<|>) (..), (:>), AuthProtect, BasicAuth,
IsSecure (..), JSON, BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
NoContent (..), Patch, PlainText, EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
Post, Put, EmptyAPI, JSON, NoContent (..), NoFraming, OctetStream, Patch,
QueryFlag, QueryParam, QueryParams, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
Raw, RemoteHost, ReqBody, RemoteHost, ReqBody, StdMethod (..), Stream,
StdMethod (..), Verb, addHeader) StreamGenerator (..), Verb, addHeader)
import Servant.API.Internal.Test.ComprehensiveAPI import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Server (Server, Handler, Tagged (..), err401, err403, import Servant.Server
err404, serve, serveWithContext, (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
Context((:.), EmptyContext), emptyServer) emptyServer, err401, err403, err404, serve, serveWithContext)
import Test.Hspec (Spec, context, describe, it, import Test.Hspec
shouldBe, shouldContain) (Spec, context, describe, it, shouldBe, shouldContain)
import qualified Test.Hspec.Wai as THW import Test.Hspec.Wai
import Test.Hspec.Wai (get, liftIO, matchHeaders, (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
matchStatus, shouldRespondWith, with, (<:>))
with, (<:>)) import qualified Test.Hspec.Wai as THW
import Servant.Server.Internal.BasicAuth (BasicAuthCheck(BasicAuthCheck),
BasicAuthResult(Authorized,Unauthorized))
import Servant.Server.Experimental.Auth import Servant.Server.Experimental.Auth
(AuthHandler, AuthServerData, (AuthHandler, AuthServerData, mkAuthHandler)
mkAuthHandler) import Servant.Server.Internal.BasicAuth
(BasicAuthCheck (BasicAuthCheck),
BasicAuthResult (Authorized, Unauthorized))
import Servant.Server.Internal.Context import Servant.Server.Internal.Context
(NamedContext(..)) (NamedContext (..))
-- * comprehensive api test -- * comprehensive api test
@ -105,6 +110,7 @@ type VerbApi method status
:<|> "accept" :> ( Verb method status '[JSON] Person :<|> "accept" :> ( Verb method status '[JSON] Person
:<|> Verb method status '[PlainText] String :<|> Verb method status '[PlainText] String
) )
:<|> "stream" :> Stream method status NoFraming OctetStream (StreamGenerator BS.ByteString)
verbSpec :: Spec verbSpec :: Spec
verbSpec = describe "Servant.API.Verb" $ do verbSpec = describe "Servant.API.Verb" $ do
@ -114,6 +120,8 @@ verbSpec = describe "Servant.API.Verb" $ do
:<|> return (addHeader 5 alice) :<|> return (addHeader 5 alice)
:<|> return (addHeader 10 NoContent) :<|> return (addHeader 10 NoContent)
:<|> (return alice :<|> return "B") :<|> (return alice :<|> return "B")
:<|> return (StreamGenerator $ \f _ -> f "bytestring")
get200 = Proxy :: Proxy (VerbApi 'GET 200) get200 = Proxy :: Proxy (VerbApi 'GET 200)
post210 = Proxy :: Proxy (VerbApi 'POST 210) post210 = Proxy :: Proxy (VerbApi 'POST 210)
put203 = Proxy :: Proxy (VerbApi 'PUT 203) put203 = Proxy :: Proxy (VerbApi 'PUT 203)
@ -179,6 +187,11 @@ verbSpec = describe "Servant.API.Verb" $ do
liftIO $ simpleHeaders response `shouldContain` liftIO $ simpleHeaders response `shouldContain`
[("Content-Type", "application/json;charset=utf-8")] [("Content-Type", "application/json;charset=utf-8")]
it "works for Stream as for Result" $ do
response <- THW.request method "/stream" [] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
liftIO $ simpleBody response `shouldBe` "bytestring"
test "GET 200" get200 methodGet 200 test "GET 200" get200 methodGet 200
test "POST 210" post210 methodPost 210 test "POST 210" post210 methodPost 210
test "PUT 203" put203 methodPut 203 test "PUT 203" put203 methodPut 203