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

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

Browse Source 
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
1 changed files with 59 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
servant-server/test/Servant/ServerSpec.hs
View File

@ -17,55 +17,60 @@
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
(MonadError (..))
import Data.Aeson
(FromJSON, ToJSON, decode', encode)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Base64 as Base64
import Data.Char (toUpper) 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
(fromString)
import Data.String.Conversions
(cs)
import qualified Data.Text as T import qualified Data.Text as T
import GHC.Generics (Generic) import GHC.Generics
import Network.HTTP.Types (Status (..), hAccept, hContentType, (Generic)
methodDelete, methodGet, import Network.HTTP.Types
methodHead, methodPatch, (Status (..), hAccept, hContentType, imATeapot418,
methodPost, methodPut, ok200, methodDelete, methodGet, methodHead, methodPatch, methodPost,
imATeapot418, methodPut, ok200, parseQuery)
parseQuery) import Network.Wai
import Network.Wai (Application, Request, requestHeaders, pathInfo, (Application, Request, pathInfo, queryString, rawQueryString,
queryString, rawQueryString, requestHeaders, responseLBS)
responseLBS) import Network.Wai.Test
import Network.Wai.Test (defaultRequest, request, (defaultRequest, request, runSession, simpleBody,
runSession, simpleBody,
simpleHeaders, simpleStatus) simpleHeaders, simpleStatus)
import Servant.API ((:<|>) (..), (:>), AuthProtect, import Servant.API
BasicAuth, BasicAuthData(BasicAuthData), ((:<|>) (..), (:>), AuthProtect, BasicAuth,
Capture, CaptureAll, Delete, Get, Header, BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
Headers, HttpVersion, EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
IsSecure (..), JSON, JSON, NoContent (..), NoFraming, OctetStream, Patch,
NoContent (..), Patch, PlainText, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
Post, Put, EmptyAPI, RemoteHost, ReqBody, StdMethod (..), Stream,
QueryFlag, QueryParam, QueryParams, StreamGenerator (..), Verb, addHeader)
Raw, RemoteHost, ReqBody,
StdMethod (..), 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 (..))
@ -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