@@ -17,57 +17,62 @@
18module Servant.ServerSpec where
18module Servant.ServerSpec where
20−import Control.Monad (forM_, when, unless)
20+import Control.Monad
21+ (forM_, unless, when)
21−import Control.Monad.Error.Class (MonadError (..))
22+import Control.Monad.Error.Class
22−import Data.Aeson (FromJSON, ToJSON, decode', encode)
25+ (FromJSON, ToJSON, decode', encode)
23−import qualified Data.ByteString.Base64 as Base64
26+import qualified Data.ByteString as BS
27+import qualified Data.ByteString.Base64 as Base64
24−import Data.Char (toUpper)
28+import Data.Char
25import Data.Monoid
30import Data.Monoid
26−import Data.Proxy (Proxy (Proxy))
31+import Data.Proxy
27−import Data.String (fromString)
33+import Data.String
28−import Data.String.Conversions (cs)
35+import Data.String.Conversions
29−import qualified Data.Text as T
37+import qualified Data.Text as T
30−import GHC.Generics (Generic)
38+import GHC.Generics
31−import Network.HTTP.Types (Status (..), hAccept, hContentType,
40+import Network.HTTP.Types
41+ (Status (..), hAccept, hContentType, imATeapot418,
32− methodDelete, methodGet,
42+ methodDelete, methodGet, methodHead, methodPatch, methodPost,
33− methodHead, methodPatch,
34− methodPost, methodPut, ok200,
43+ methodPut, ok200, parseQuery)
37−import Network.Wai (Application, Request, requestHeaders, pathInfo,
44+import Network.Wai
38− queryString, rawQueryString,
45+ (Application, Request, pathInfo, queryString, rawQueryString,
39− responseLBS)
46+ requestHeaders, responseLBS)
40−import Network.Wai.Test (defaultRequest, request,
47+import Network.Wai.Test
41− runSession, simpleBody,
48+ (defaultRequest, request, runSession, simpleBody,
42− simpleHeaders, simpleStatus)
49+ simpleHeaders, simpleStatus)
43−import Servant.API ((:<|>) (..), (:>), AuthProtect,
50+import Servant.API
44− BasicAuth, BasicAuthData(BasicAuthData),
51+ ((:<|>) (..), (:>), AuthProtect, BasicAuth,
45− Capture, CaptureAll, Delete, Get, Header,
52+ BasicAuthData (BasicAuthData), Capture, CaptureAll, Delete,
46− Headers, HttpVersion,
53+ EmptyAPI, Get, Header, Headers, HttpVersion, IsSecure (..),
48− NoContent (..), Patch, PlainText,
54+ JSON, NoContent (..), NoFraming, OctetStream, Patch,
50− QueryFlag, QueryParam, QueryParams,
55+ PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,
51− Raw, RemoteHost, ReqBody,
56+ RemoteHost, ReqBody, StdMethod (..), Stream,
52− StdMethod (..), Verb, addHeader)
57+ StreamGenerator (..), Verb, addHeader)
53import Servant.API.Internal.Test.ComprehensiveAPI
58import Servant.API.Internal.Test.ComprehensiveAPI
54−import Servant.Server (Server, Handler, Tagged (..), err401, err403,
59+import Servant.Server
60+ (Context ((:.), EmptyContext), Handler, Server, Tagged (..),
55− err404, serve, serveWithContext,
61+ emptyServer, err401, err403, err404, serve, serveWithContext)
56− Context((:.), EmptyContext), emptyServer)
57−import Test.Hspec (Spec, context, describe, it,
62+import Test.Hspec
58− shouldBe, shouldContain)
63+ (Spec, context, describe, it, shouldBe, shouldContain)
59−import qualified Test.Hspec.Wai as THW
60−import Test.Hspec.Wai (get, liftIO, matchHeaders,
64+import Test.Hspec.Wai
61− matchStatus, shouldRespondWith,
65+ (get, liftIO, matchHeaders, matchStatus, shouldRespondWith,
62− with, (<:>))
66+ with, (<:>))
63−
67+import qualified Test.Hspec.Wai as THW
64−import Servant.Server.Internal.BasicAuth (BasicAuthCheck(BasicAuthCheck),
68+
65− BasicAuthResult(Authorized,Unauthorized))
66import Servant.Server.Experimental.Auth
69import Servant.Server.Experimental.Auth
67− (AuthHandler, AuthServerData,
70+ (AuthHandler, AuthServerData, mkAuthHandler)
68− mkAuthHandler)
71+import Servant.Server.Internal.BasicAuth
72+ (BasicAuthCheck (BasicAuthCheck),
73+ BasicAuthResult (Authorized, Unauthorized))
69import Servant.Server.Internal.Context
74import Servant.Server.Internal.Context
70− (NamedContext(..))
75+ (NamedContext (..))
72-- * comprehensive api test
77-- * comprehensive api test
@@ -105,6 +110,7 @@ type VerbApi method status
105 :<|> "accept" :> ( Verb method status '[JSON] Person
110 :<|> "accept" :> ( Verb method status '[JSON] Person
106 :<|> Verb method status '[PlainText] String
111 :<|> Verb method status '[PlainText] String
113+ :<|> "stream" :> Stream method status NoFraming OctetStream (StreamGenerator BS.ByteString)
109verbSpec :: Spec
115verbSpec :: Spec
110verbSpec = describe "Servant.API.Verb" $ do
116verbSpec = describe "Servant.API.Verb" $ do
@@ -114,6 +120,8 @@ verbSpec = describe "Servant.API.Verb" $ do
114 :<|> return (addHeader 5 alice)
120 :<|> return (addHeader 5 alice)
115 :<|> return (addHeader 10 NoContent)
121 :<|> return (addHeader 10 NoContent)
116 :<|> (return alice :<|> return "B")
122 :<|> (return alice :<|> return "B")
123+ :<|> return (StreamGenerator $ \f _ -> f "bytestring")
117 get200 = Proxy :: Proxy (VerbApi 'GET 200)
125 get200 = Proxy :: Proxy (VerbApi 'GET 200)
118 post210 = Proxy :: Proxy (VerbApi 'POST 210)
126 post210 = Proxy :: Proxy (VerbApi 'POST 210)
119 put203 = Proxy :: Proxy (VerbApi 'PUT 203)
127 put203 = Proxy :: Proxy (VerbApi 'PUT 203)
@@ -179,6 +187,11 @@ verbSpec = describe "Servant.API.Verb" $ do
179 liftIO $ simpleHeaders response `shouldContain`
187 liftIO $ simpleHeaders response `shouldContain`
180 [("Content-Type", "application/json;charset=utf-8")]
188 [("Content-Type", "application/json;charset=utf-8")]
190+ it "works for Stream as for Result" $ do
191+ response <- THW.request method "/stream" [] ""
192+ liftIO $ statusCode (simpleStatus response) `shouldBe` status
193+ liftIO $ simpleBody response `shouldBe` "bytestring"
182 test "GET 200" get200 methodGet 200
195 test "GET 200" get200 methodGet 200
183 test "POST 210" post210 methodPost 210
196 test "POST 210" post210 methodPost 210
184 test "PUT 203" put203 methodPut 203
197 test "PUT 203" put203 methodPut 203