git.iko.soy/servant
on master help sign in
Merge pull request #13 from haskell-servant/jkarni/content-types

Jkarni/content types

commitcae0b6e252f0ff030570270d064fa982eec8a3da authorJulian Arni <jkarni@gmail.com> dateTue 24 Feb 2015, 15:01 (12 years ago) parentc1377e0b96a2d2
9 files changed+213−118
compare with master
unifiedsplit
CHANGELOG.md+5 default.nix+15 example/greet.hs+3−3 servant-server.cabal+17−17 src/Servant.hs−2 src/Servant/Server.hs+3−2 src/Servant/Server/Internal.hs+101−61 test/Servant/ServerSpec.hs+67−32 test/Servant/Utils/StaticFilesSpec.hs+2−1
CHANGELOG.md+5
@@ -2,6 +2,11 @@ master
22------
33
44* Added support for matrix parameters, see e.g. http://www.w3.org/DesignIssues/MatrixURIs.html
5+* Add support for serializing based on Accept header
6+ (https://github.com/haskell-servant/servant-server/issues/9)
7+* Ignore trailing slashes
8+ (https://github.com/haskell-servant/servant-server/issues/5)
9+
510
6110.2.3
712-----
default.nixnew file+15
@@ -0,0 +1,15 @@
1+{ pkgs ? import <nixpkgs> { config.allowUnfree = true; }
2+, src ? builtins.filterSource (path: type:
3+ type != "unknown" &&
4+ baseNameOf path != ".git" &&
5+ baseNameOf path != "result" &&
6+ baseNameOf path != "dist") ./.
7+, servant ? import ../servant {}
8+}:
9+pkgs.haskellPackages.buildLocalCabalWithArgs {
10+ name = "servant-server";
11+ inherit src;
12+ args = {
13+ inherit servant;
14+ };
15+}
example/greet.hs+3−3
@@ -18,7 +18,7 @@ import Servant
1818-- * Example
1919
2020-- | A greet message data type
21−newtype Greet = Greet { msg :: Text }
21+newtype Greet = Greet { _msg :: Text }
2222 deriving (Generic, Show)
2323
2424instance FromJSON Greet
@@ -27,11 +27,11 @@ instance ToJSON Greet
2727-- API specification
2828type TestApi =
2929 -- GET /hello/:name?capital={true, false} returns a Greet as JSON
30− "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
30+ "hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
3131
3232 -- POST /greet with a Greet as JSON in the request body,
3333 -- returns a Greet as JSON
34− :<|> "greet" :> ReqBody Greet :> Post Greet
34+ :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
3535
3636 -- DELETE /greet/:greetid
3737 :<|> "greet" :> Capture "greetid" Text :> Delete
servant-server.cabal+17−17
@@ -34,23 +34,23 @@ library
3434 Servant.Server.Internal
3535 Servant.Utils.StaticFiles
3636 build-depends:
37− base >=4.7 && <5
38− , aeson
39− , attoparsec
40− , bytestring
41− , either >= 4.3
42− , http-types
43− , network-uri >= 2.6
44− , safe
45− , servant >= 0.2.2
46− , split
47− , string-conversions
48− , system-filepath
49− , text
50− , transformers
51− , wai
52− , wai-app-static >= 3.0.0.6
53− , warp
37+ base >= 4.7 && < 5
38+ , aeson >= 0.7 && < 0.9
39+ , attoparsec >= 0.12 && < 0.13
40+ , bytestring >= 0.10 && < 0.11
41+ , either >= 4.3 && < 4.4
42+ , http-types >= 0.8 && < 0.9
43+ , network-uri >= 2.6 && < 2.7
44+ , safe >= 0.3 && < 0.4
45+ , servant >= 0.2 && < 0.4
46+ , split >= 0.2 && < 0.3
47+ , string-conversions >= 0.3 && < 0.4
48+ , system-filepath >= 0.4 && < 0.5
49+ , text >= 1.2 && < 1.3
50+ , transformers >= 0.3 && < 0.5
51+ , wai >= 3.0 && < 3.1
52+ , wai-app-static >= 3.0 && < 3.1
53+ , warp >= 3.0 && < 3.1
5454 hs-source-dirs: src
5555 default-language: Haskell2010
5656 ghc-options: -Wall
src/Servant.hs−2
@@ -8,7 +8,6 @@ module Servant (
88 -- | Using your types in request paths and query string parameters
99 module Servant.Common.Text,
1010 -- | Utilities on top of the servant core
11− module Servant.QQ,
1211 module Servant.Utils.Links,
1312 module Servant.Utils.StaticFiles,
1413 -- | Useful re-exports
@@ -19,6 +18,5 @@ import Data.Proxy
1918import Servant.API
2019import Servant.Common.Text
2120import Servant.Server
22−import Servant.QQ
2321import Servant.Utils.Links
2422import Servant.Utils.StaticFiles
src/Servant/Server.hs+3−2
@@ -9,6 +9,7 @@ module Servant.Server
99
1010 , -- * Handlers for all standard combinators
1111 HasServer(..)
12+
1213 ) where
1314
1415import Data.Proxy (Proxy)
@@ -23,8 +24,8 @@ import Servant.Server.Internal
2324--
2425-- Example:
2526--
26−-- > type MyApi = "books" :> Get [Book] -- GET /books
27−-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
27+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
28+-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
2829-- >
2930-- > server :: Server MyApi
3031-- > server = listAllBooks :<|> postBook
src/Servant/Server/Internal.hs+101−61
@@ -9,7 +9,7 @@ module Servant.Server.Internal where
99
1010import Control.Applicative ((<$>))
1111import Control.Monad.Trans.Either (EitherT, runEitherT)
12−import Data.Aeson (ToJSON, FromJSON, encode, eitherDecode')
12+import Data.Aeson (ToJSON)
1313import qualified Data.ByteString as B
1414import qualified Data.ByteString.Lazy as BL
1515import Data.IORef (newIORef, readIORef, writeIORef)
@@ -24,12 +24,18 @@ import qualified Data.Text as T
2424import Data.Typeable
2525import GHC.TypeLits (KnownSymbol, symbolVal)
2626import Network.HTTP.Types hiding (Header)
27−import Network.Wai (Response, Request, ResponseReceived, Application, pathInfo, requestBody,
28− strictRequestBody, lazyRequestBody, requestHeaders, requestMethod,
27+import Network.Wai ( Response, Request, ResponseReceived, Application
28+ , pathInfo, requestBody, strictRequestBody
29+ , lazyRequestBody, requestHeaders, requestMethod,
2930 rawQueryString, responseLBS)
30−import Servant.API (QueryParams, QueryParam, QueryFlag, MatrixParams, MatrixParam, MatrixFlag, ReqBody, Header, Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))
31+import Servant.API ( QueryParams, QueryParam, QueryFlag, ReqBody, Header
32+ , MatrixParams, MatrixParam, MatrixFlag
33+ , Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))
34+import Servant.API.ContentTypes ( AllCTRender(..), AcceptHeader(..)
35+ , AllCTUnrender(..),)
3136import Servant.Common.Text (FromText, fromText)
3237
38+
3339data ReqBodyState = Uncalled
3440 | Called !B.ByteString
3541 | Done !B.ByteString
@@ -66,39 +72,33 @@ toApplication ra request respond = do
6672 respond $ responseLBS methodNotAllowed405 [] "method not allowed"
6773 routingRespond (Left (InvalidBody err)) =
6874 respond $ responseLBS badRequest400 [] $ fromString $ "Invalid JSON in request body: " ++ err
75+ routingRespond (Left UnsupportedMediaType) =
76+ respond $ responseLBS unsupportedMediaType415 [] "unsupported media type"
6977 routingRespond (Left (HttpError status body)) =
7078 respond $ responseLBS status [] $ fromMaybe (BL.fromStrict $ statusMessage status) body
7179 routingRespond (Right response) =
7280 respond response
7381
82+-- Note that the ordering of the constructors has great significance! It
83+-- determines the Ord instance and, consequently, the monoid instance.
7484-- * Route mismatch
7585data RouteMismatch =
7686 NotFound -- ^ the usual "not found" error
7787 | WrongMethod -- ^ a more informative "you just got the HTTP method wrong" error
88+ | UnsupportedMediaType -- ^ request body has unsupported media type
7889 | InvalidBody String -- ^ an even more informative "your json request body wasn't valid" error
7990 | HttpError Status (Maybe BL.ByteString) -- ^ an even even more informative arbitrary HTTP response code error.
80− deriving (Eq, Show)
91+ deriving (Eq, Ord, Show)
8192
82−-- |
83−-- @
84−-- > mempty = NotFound
85−-- >
86−-- > _ `mappend` HttpError s b = HttpError s b
87−-- > HttpError s b `mappend` _ = HttpError s b
88−-- > NotFound `mappend` x = x
89−-- > WrongMethod `mappend` InvalidBody s = InvalidBody s
90−-- > WrongMethod `mappend` _ = WrongMethod
91−-- > InvalidBody s `mappend` _ = InvalidBody s
92−-- @
9393instance Monoid RouteMismatch where
9494 mempty = NotFound
95+ -- The following isn't great, since it picks @InvalidBody@ based on
96+ -- alphabetical ordering, but any choice would be arbitrary.
97+ --
98+ -- "As one judge said to the other, 'Be just and if you can't be just, be
99+ -- arbitrary'" -- William Burroughs
100+ mappend = max
95101
96− _ `mappend` HttpError s b = HttpError s b
97− HttpError s b `mappend` _ = HttpError s b
98− NotFound `mappend` x = x
99− WrongMethod `mappend` InvalidBody s = InvalidBody s
100− WrongMethod `mappend` _ = WrongMethod
101− InvalidBody s `mappend` _ = InvalidBody s
102102
103103-- | A wrapper around @'Either' 'RouteMismatch' a@.
104104newtype RouteResult a =
@@ -171,8 +171,8 @@ class HasServer layout where
171171-- represented by @a@ and if it fails tries @b@. You must provide a request
172172-- handler for each route.
173173--
174−-- > type MyApi = "books" :> Get [Book] -- GET /books
175−-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
174+-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
175+-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
176176-- >
177177-- > server :: Server MyApi
178178-- > server = listAllBooks :<|> postBook
@@ -203,7 +203,7 @@ captured _ = fromText
203203--
204204-- Example:
205205--
206−-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book
206+-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
207207-- >
208208-- > server :: Server MyApi
209209-- > server = getBook
@@ -225,7 +225,7 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout)
225225 _ -> respond $ failWith NotFound
226226
227227 where captureProxy = Proxy :: Proxy (Capture capture a)
228−
228+
229229
230230-- | If you have a 'Delete' endpoint in your API,
231231-- the handler for this endpoint is meant to delete
@@ -261,17 +261,24 @@ instance HasServer Delete where
261261-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
262262-- to quickly fail if some conditions are not met.
263263--
264−-- If successfully returning a value, we just require that its type has
265−-- a 'ToJSON' instance and servant takes care of encoding it for you,
266−-- yielding status code 200 along the way.
267−instance ToJSON result => HasServer (Get result) where
268− type Server (Get result) = EitherT (Int, String) IO result
264+-- If successfully returning a value, we use the type-level list, combined
265+-- with the request's @Accept@ header, to encode the value for you
266+-- (returning a status code of 200). If there was no @Accept@ header or it
267+-- was @*/*@, we return encode using the first @Content-Type@ type on the
268+-- list.
269+instance ( AllCTRender ctypes a
270+ ) => HasServer (Get ctypes a) where
271+ type Server (Get ctypes a) = EitherT (Int, String) IO a
269272 route Proxy action request respond
270273 | pathIsEmpty request && requestMethod request == methodGet = do
271274 e <- runEitherT action
272275 respond . succeedWith $ case e of
273− Right output ->
274− responseLBS ok200 [("Content-Type", "application/json")] (encode output)
276+ Right output -> do
277+ let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
278+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
279+ Nothing -> responseLBS (mkStatus 406 "Not Acceptable") [] ""
280+ Just (contentT, body) -> responseLBS ok200 [ ("Content-Type"
281+ , cs contentT)] body
275282 Left (status, message) ->
276283 responseLBS (mkStatus status (cs message)) [] (cs message)
277284 | pathIsEmpty request && requestMethod request /= methodGet =
@@ -292,7 +299,7 @@ instance ToJSON result => HasServer (Get result) where
292299-- > deriving (Eq, Show, FromText, ToText)
293300-- >
294301-- > -- GET /view-my-referer
295−-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
302+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
296303-- >
297304-- > server :: Server MyApi
298305-- > server = viewReferer
@@ -318,18 +325,25 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
318325-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
319326-- to quickly fail if some conditions are not met.
320327--
321−-- If successfully returning a value, we just require that its type has
322−-- a 'ToJSON' instance and servant takes care of encoding it for you,
323−-- yielding status code 201 along the way.
324−instance ToJSON a => HasServer (Post a) where
325− type Server (Post a) = EitherT (Int, String) IO a
328+-- If successfully returning a value, we use the type-level list, combined
329+-- with the request's @Accept@ header, to encode the value for you
330+-- (returning a status code of 201). If there was no @Accept@ header or it
331+-- was @*/*@, we return encode using the first @Content-Type@ type on the
332+-- list.
333+instance ( AllCTRender ctypes a
334+ ) => HasServer (Post ctypes a) where
335+ type Server (Post ctypes a) = EitherT (Int, String) IO a
326336
327337 route Proxy action request respond
328338 | pathIsEmpty request && requestMethod request == methodPost = do
329339 e <- runEitherT action
330340 respond . succeedWith $ case e of
331− Right out ->
332− responseLBS status201 [("Content-Type", "application/json")] (encode out)
341+ Right output -> do
342+ let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
343+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
344+ Nothing -> responseLBS (mkStatus 406 "") [] ""
345+ Just (contentT, body) -> responseLBS status201 [ ("Content-Type"
346+ , cs contentT)] body
333347 Left (status, message) ->
334348 responseLBS (mkStatus status (cs message)) [] (cs message)
335349 | pathIsEmpty request && requestMethod request /= methodPost =
@@ -344,18 +358,25 @@ instance ToJSON a => HasServer (Post a) where
344358-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
345359-- to quickly fail if some conditions are not met.
346360--
347−-- If successfully returning a value, we just require that its type has
348−-- a 'ToJSON' instance and servant takes care of encoding it for you,
349−-- yielding status code 200 along the way.
350−instance ToJSON a => HasServer (Put a) where
351− type Server (Put a) = EitherT (Int, String) IO a
361+-- If successfully returning a value, we use the type-level list, combined
362+-- with the request's @Accept@ header, to encode the value for you
363+-- (returning a status code of 201). If there was no @Accept@ header or it
364+-- was @*/*@, we return encode using the first @Content-Type@ type on the
365+-- list.
366+instance ( AllCTRender ctypes a
367+ ) => HasServer (Put ctypes a) where
368+ type Server (Put ctypes a) = EitherT (Int, String) IO a
352369
353370 route Proxy action request respond
354371 | pathIsEmpty request && requestMethod request == methodPut = do
355372 e <- runEitherT action
356373 respond . succeedWith $ case e of
357− Right out ->
358− responseLBS ok200 [("Content-Type", "application/json")] (encode out)
374+ Right output -> do
375+ let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
376+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
377+ Nothing -> responseLBS (mkStatus 406 "") [] ""
378+ Just (contentT, body) -> responseLBS status200 [ ("Content-Type"
379+ , cs contentT)] body
359380 Left (status, message) ->
360381 responseLBS (mkStatus status (cs message)) [] (cs message)
361382 | pathIsEmpty request && requestMethod request /= methodPut =
@@ -374,15 +395,22 @@ instance ToJSON a => HasServer (Put a) where
374395-- If successfully returning a value, we just require that its type has
375396-- a 'ToJSON' instance and servant takes care of encoding it for you,
376397-- yielding status code 201 along the way.
377−instance (Typeable a, ToJSON a) => HasServer (Patch a) where
378− type Server (Patch a) = EitherT (Int, String) IO a
398+instance ( AllCTRender ctypes a
399+ , Typeable a
400+ , ToJSON a) => HasServer (Patch ctypes a) where
401+ type Server (Patch ctypes a) = EitherT (Int, String) IO a
379402
380403 route Proxy action request respond
381404 | pathIsEmpty request && requestMethod request == methodPost = do
382405 e <- runEitherT action
383406 respond . succeedWith $ case e of
384407 Right out -> case cast out of
385− Nothing -> responseLBS status200 [("Content-Type", "application/json")] (encode out)
408+ Nothing -> do
409+ let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
410+ case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) out of
411+ Nothing -> responseLBS (mkStatus 406 "") [] ""
412+ Just (contentT, body) -> responseLBS status200 [ ("Content-Type"
413+ , cs contentT)] body
386414 Just () -> responseLBS status204 [] ""
387415 Left (status, message) ->
388416 responseLBS (mkStatus status (cs message)) [] (cs message)
@@ -404,7 +432,7 @@ instance (Typeable a, ToJSON a) => HasServer (Patch a) where
404432--
405433-- Example:
406434--
407−-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
435+-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
408436-- >
409437-- > server :: Server MyApi
410438-- > server = getBooksBy
@@ -443,7 +471,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
443471--
444472-- Example:
445473--
446−-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
474+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
447475-- >
448476-- > server :: Server MyApi
449477-- > server = getBooksBy
@@ -476,7 +504,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
476504--
477505-- Example:
478506--
479−-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]
507+-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
480508-- >
481509-- > server :: Server MyApi
482510-- > server = getBooks
@@ -635,30 +663,42 @@ instance HasServer Raw where
635663-- | If you use 'ReqBody' in one of the endpoints for your API,
636664-- this automatically requires your server-side handler to be a function
637665-- that takes an argument of the type specified by 'ReqBody'.
666+-- The @Content-Type@ header is inspected, and the list provided is used to
667+-- attempt deserialization. If the request does not have a @Content-Type@
668+-- header, it is treated as @application/octet-stream@.
638669-- This lets servant worry about extracting it from the request and turning
639670-- it into a value of the type you specify.
640671--
672+--
641673-- All it asks is for a 'FromJSON' instance.
642674--
643675-- Example:
644676--
645−-- > type MyApi = "books" :> ReqBody Book :> Post Book
677+-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
646678-- >
647679-- > server :: Server MyApi
648680-- > server = postBook
649681-- > where postBook :: Book -> EitherT (Int, String) IO Book
650682-- > postBook book = ...insert into your db...
651−instance (FromJSON a, HasServer sublayout)
652− => HasServer (ReqBody a :> sublayout) where
683+instance ( AllCTUnrender list a, HasServer sublayout
684+ ) => HasServer (ReqBody list a :> sublayout) where
653685
654− type Server (ReqBody a :> sublayout) =
686+ type Server (ReqBody list a :> sublayout) =
655687 a -> Server sublayout
656688
657689 route Proxy subserver request respond = do
658− mrqbody <- eitherDecode' <$> lazyRequestBody request
690+ -- See HTTP RFC 2616, section 7.2.1
691+ -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
692+ -- See also "W3C Internet Media Type registration, consistency of use"
693+ -- http://www.w3.org/2001/tag/2002/0129-mime
694+ let contentTypeH = fromMaybe "application/octet-stream"
695+ $ lookup hContentType $ requestHeaders request
696+ mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
697+ <$> lazyRequestBody request
659698 case mrqbody of
660− Left e -> respond . failWith $ InvalidBody e
661− Right v -> route (Proxy :: Proxy sublayout) (subserver v) request respond
699+ Nothing -> respond . failWith $ UnsupportedMediaType
700+ Just (Left e) -> respond . failWith $ InvalidBody e
701+ Just (Right v) -> route (Proxy :: Proxy sublayout) (subserver v) request respond
662702
663703-- | Make sure the incoming request starts with @"/path"@, strip it and
664704-- pass the rest of the request path to @sublayout@.
test/Servant/ServerSpec.hs+67−32
@@ -8,6 +8,7 @@
88module Servant.ServerSpec where
99
1010
11+import Control.Monad (when)
1112import Control.Monad.Trans.Either (EitherT, left)
1213import Data.Aeson (ToJSON, FromJSON, encode, decode')
1314import Data.Char (toUpper)
@@ -16,21 +17,18 @@ import Data.Proxy (Proxy(Proxy))
1617import Data.String (fromString)
1718import Data.String.Conversions (cs)
1819import GHC.Generics (Generic)
19−import Network.HTTP.Types (parseQuery, ok200, status409)
20−import Network.Wai (Application, Request, responseLBS, pathInfo, queryString, rawQueryString)
21−import Network.Wai.Test (runSession, request, defaultRequest, simpleBody)
20+import Network.HTTP.Types ( parseQuery, ok200, status409, methodPost
21+ , methodDelete, hContentType)
22+import Network.Wai ( Application, Request, responseLBS, pathInfo
23+ , queryString, rawQueryString )
24+import Network.Wai.Test (runSession, defaultRequest, simpleBody, request)
2225import Test.Hspec (Spec, describe, it, shouldBe)
23−import Test.Hspec.Wai (liftIO, with, get, post, shouldRespondWith, matchStatus)
24−
25−import Servant.API.Capture (Capture)
26−import Servant.API.Get (Get)
27−import Servant.API.ReqBody (ReqBody)
28−import Servant.API.Post (Post)
29−import Servant.API.QueryParam (QueryParam, QueryParams, QueryFlag)
30−import Servant.API.MatrixParam (MatrixParam, MatrixParams, MatrixFlag)
31−import Servant.API.Raw (Raw)
32−import Servant.API.Sub ((:>))
33−import Servant.API.Alternative ((:<|>)((:<|>)))
26+import Test.Hspec.Wai ( liftIO, with, get, post, shouldRespondWith
27+ , matchStatus, request )
28+
29+import Servant.API (JSON, Capture, Get, ReqBody, Post, QueryParam
30+ , QueryParams, QueryFlag, MatrixParam, MatrixParams
31+ , MatrixFlag, Raw, (:>), (:<|>)(..), Header, Delete )
3432import Servant.Server (Server, serve)
3533import Servant.Server.Internal (RouteMismatch(..))
3634
@@ -74,12 +72,13 @@ spec = do
7472 queryParamSpec
7573 matrixParamSpec
7674 postSpec
75+ headerSpec
7776 rawSpec
7877 unionSpec
7978 errorsSpec
8079
8180
82−type CaptureApi = Capture "legs" Integer :> Get Animal
81+type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
8382captureApi :: Proxy CaptureApi
8483captureApi = Proxy
8584captureServer :: Integer -> EitherT (Int, String) IO Animal
@@ -105,7 +104,7 @@ captureSpec = do
105104 get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
106105
107106
108−type GetApi = Get Person
107+type GetApi = Get '[JSON] Person
109108getApi :: Proxy GetApi
110109getApi = Proxy
111110
@@ -123,9 +122,9 @@ getSpec = do
123122 post "/" "" `shouldRespondWith` 405
124123
125124
126−type QueryParamApi = QueryParam "name" String :> Get Person
127− :<|> "a" :> QueryParams "names" String :> Get Person
128− :<|> "b" :> QueryFlag "capitalize" :> Get Person
125+type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
126+ :<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
127+ :<|> "b" :> QueryFlag "capitalize" :> Get '[JSON] Person
129128
130129queryParamApi :: Proxy QueryParamApi
131130queryParamApi = Proxy
@@ -170,6 +169,7 @@ queryParamSpec = do
170169 name = "john"
171170 }
172171
172+
173173 it "allows to retrieve value-less GET parameters" $
174174 (flip runSession) (serve queryParamApi qpServer) $ do
175175 let params3 = "?capitalize"
@@ -205,10 +205,10 @@ queryParamSpec = do
205205 name = "Alice"
206206 }
207207
208−type MatrixParamApi = "a" :> MatrixParam "name" String :> Get Person
209− :<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get Person
210− :<|> "c" :> MatrixFlag "capitalize" :> Get Person
211− :<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get Person
208+type MatrixParamApi = "a" :> MatrixParam "name" String :> Get '[JSON] Person
209+ :<|> "b" :> MatrixParams "names" String :> "bsub" :> MatrixParams "names" String :> Get '[JSON] Person
210+ :<|> "c" :> MatrixFlag "capitalize" :> Get '[JSON] Person
211+ :<|> "d" :> Capture "foo" Integer :> MatrixParam "name" String :> MatrixFlag "capitalize" :> "dsub" :> Get '[JSON] Person
212212
213213matrixParamApi :: Proxy MatrixParamApi
214214matrixParamApi = Proxy
@@ -289,8 +289,8 @@ matrixParamSpec = do
289289 }
290290
291291type PostApi =
292− ReqBody Person :> Post Integer
293− :<|> "bla" :> ReqBody Person :> Post Integer
292+ ReqBody '[JSON] Person :> Post '[JSON] Integer
293+ :<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
294294postApi :: Proxy PostApi
295295postApi = Proxy
296296
@@ -298,23 +298,58 @@ postSpec :: Spec
298298postSpec = do
299299 describe "Servant.API.Post and .ReqBody" $ do
300300 with (return (serve postApi (return . age :<|> return . age))) $ do
301+ let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
302+ , "application/json;charset=utf-8")]
303+
301304 it "allows to POST a Person" $ do
302− post "/" (encode alice) `shouldRespondWith` "42"{
305+ post' "/" (encode alice) `shouldRespondWith` "42"{
303306 matchStatus = 201
304307 }
305308
306309 it "allows alternative routes if all have request bodies" $ do
307− post "/bla" (encode alice) `shouldRespondWith` "42"{
310+ post' "/bla" (encode alice) `shouldRespondWith` "42"{
308311 matchStatus = 201
309312 }
310313
311314 it "handles trailing '/' gracefully" $ do
312− post "/bla/" (encode alice) `shouldRespondWith` "42"{
315+ post' "/bla/" (encode alice) `shouldRespondWith` "42"{
313316 matchStatus = 201
314317 }
315318
316319 it "correctly rejects invalid request bodies with status 400" $ do
317− post "/" "some invalid body" `shouldRespondWith` 400
320+ post' "/" "some invalid body" `shouldRespondWith` 400
321+
322+ it "responds with 415 if the requested media type is unsupported" $ do
323+ let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
324+ , "application/nonsense")]
325+ post'' "/" "anything at all" `shouldRespondWith` 415
326+
327+type HeaderApi a = Header "MyHeader" a :> Delete
328+headerApi :: Proxy (HeaderApi a)
329+headerApi = Proxy
330+
331+headerSpec :: Spec
332+headerSpec = describe "Servant.API.Header" $ do
333+
334+ let expectsInt :: Maybe Int -> EitherT (Int,String) IO ()
335+ expectsInt (Just x) = when (x /= 5) $ error "Expected 5"
336+ expectsInt Nothing = error "Expected an int"
337+
338+ let expectsString :: Maybe String -> EitherT (Int,String) IO ()
339+ expectsString (Just x) = when (x /= "more from you") $ error "Expected more from you"
340+ expectsString Nothing = error "Expected a string"
341+
342+ with (return (serve headerApi expectsInt)) $ do
343+ let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"5")]
344+
345+ it "passes the header to the handler (Int)" $
346+ delete' "/" "" `shouldRespondWith` 204
347+
348+ with (return (serve headerApi expectsString)) $ do
349+ let delete' x = Test.Hspec.Wai.request methodDelete x [("MyHeader" ,"more from you")]
350+
351+ it "passes the header to the handler (String)" $
352+ delete' "/" "" `shouldRespondWith` 204
318353
319354
320355type RawApi = "foo" :> Raw
@@ -344,8 +379,8 @@ rawSpec = do
344379
345380
346381type AlternativeApi =
347− "foo" :> Get Person
348− :<|> "bar" :> Get Animal
382+ "foo" :> Get '[JSON] Person
383+ :<|> "bar" :> Get '[JSON] Animal
349384unionApi :: Proxy AlternativeApi
350385unionApi = Proxy
351386
@@ -375,7 +410,7 @@ errorsSpec = do
375410 let ib = InvalidBody "The body is invalid"
376411 let wm = WrongMethod
377412 let nf = NotFound
378−
413+
379414 describe "Servant.Server.Internal.RouteMismatch" $ do
380415 it "HttpError > *" $ do
381416 ib <> he `shouldBe` he
test/Servant/Utils/StaticFilesSpec.hs+2−1
@@ -13,6 +13,7 @@ import System.IO.Temp (withSystemTempDirectory)
1313import Test.Hspec (Spec, describe, it, around_)
1414import Test.Hspec.Wai (with, get, shouldRespondWith)
1515
16+import Servant.API (JSON)
1617import Servant.API.Alternative ((:<|>)((:<|>)))
1718import Servant.API.Capture (Capture)
1819import Servant.API.Get (Get)
@@ -23,7 +24,7 @@ import Servant.ServerSpec (Person(Person))
2324import Servant.Utils.StaticFiles (serveDirectory)
2425
2526type Api =
26− "dummy_api" :> Capture "person_name" String :> Get Person
27+ "dummy_api" :> Capture "person_name" String :> Get '[JSON] Person
2728 :<|> "static" :> Raw
2829
2930