ReqBody content types.
This commit is contained in:
Julian K. Arni
parent
380acb3efa
commit
8028cceee7
|
|
@ -2,6 +2,11 @@ master
|
|||
------
|
||||
|
||||
* Added support for matrix parameters, see e.g. http://www.w3.org/DesignIssues/MatrixURIs.html
|
||||
* Add support for serializing based on Accept header
|
||||
(https://github.com/haskell-servant/servant-server/issues/9)
|
||||
* Ignore trailing slashes
|
||||
(https://github.com/haskell-servant/servant-server/issues/5)
|
||||
|
||||
|
||||
0.2.3
|
||||
-----
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ import Servant
|
|||
-- * Example
|
||||
|
||||
-- | A greet message data type
|
||||
newtype Greet = Greet { msg :: Text }
|
||||
newtype Greet = Greet { _msg :: Text }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance FromJSON Greet
|
||||
|
|
@ -27,11 +27,11 @@ instance ToJSON Greet
|
|||
-- API specification
|
||||
type TestApi =
|
||||
-- GET /hello/:name?capital={true, false} returns a Greet as JSON
|
||||
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get Greet
|
||||
"hello" :> Capture "name" Text :> QueryParam "capital" Bool :> Get '[JSON] Greet
|
||||
|
||||
-- POST /greet with a Greet as JSON in the request body,
|
||||
-- returns a Greet as JSON
|
||||
:<|> "greet" :> ReqBody Greet :> Post Greet
|
||||
:<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet
|
||||
|
||||
-- DELETE /greet/:greetid
|
||||
:<|> "greet" :> Capture "greetid" Text :> Delete
|
||||
|
|
|
|||
|
|
@ -35,24 +35,24 @@ library
|
|||
Servant.Server.Internal
|
||||
Servant.Utils.StaticFiles
|
||||
build-depends:
|
||||
base >=4.7 && <5
|
||||
, aeson
|
||||
, attoparsec
|
||||
, bytestring
|
||||
, either >= 4.3
|
||||
, http-types
|
||||
, network-uri >= 2.6
|
||||
, http-media == 0.4.*
|
||||
, safe
|
||||
, servant >= 0.2.2
|
||||
, split
|
||||
, string-conversions
|
||||
, system-filepath
|
||||
, text
|
||||
, transformers
|
||||
, wai
|
||||
, wai-app-static >= 3.0.0.6
|
||||
, warp
|
||||
base >= 4.7 && < 5
|
||||
, aeson >= 0.7 && < 0.9
|
||||
, attoparsec >= 0.12 && < 0.13
|
||||
, bytestring >= 0.10 && < 0.11
|
||||
, either >= 4.3 && < 4.4
|
||||
, http-media >= 0.4 && < 0.5
|
||||
, http-types >= 0.8 && < 0.9
|
||||
, network-uri >= 2.6 && < 2.7
|
||||
, safe >= 0.3 && < 0.4
|
||||
, servant >= 0.2 && < 0.4
|
||||
, split >= 0.2 && < 0.3
|
||||
, string-conversions >= 0.3 && < 0.4
|
||||
, system-filepath >= 0.4 && < 0.5
|
||||
, text >= 1.2 && < 1.3
|
||||
, transformers >= 0.3 && < 0.5
|
||||
, wai >= 3.0 && < 3.1
|
||||
, wai-app-static >= 3.0 && < 3.1
|
||||
, warp >= 3.0 && < 3.1
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
|
|
|||
|
|
@ -9,12 +9,17 @@ module Servant.Server
|
|||
|
||||
, -- * Handlers for all standard combinators
|
||||
HasServer(..)
|
||||
|
||||
, -- * Building new Content-Types
|
||||
Accept(..)
|
||||
, MimeRender(..)
|
||||
) where
|
||||
|
||||
import Data.Proxy (Proxy)
|
||||
import Network.Wai (Application)
|
||||
|
||||
import Servant.Server.Internal
|
||||
import Servant.Server.ContentTypes (Accept(..), MimeRender(..))
|
||||
|
||||
|
||||
-- * Implementing Servers
|
||||
|
|
@ -23,8 +28,8 @@ import Servant.Server.Internal
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> Get [Book] -- GET /books
|
||||
-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
|
||||
-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
|
||||
-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = listAllBooks :<|> postBook
|
||||
|
|
|
|||
|
|
@ -9,15 +9,21 @@
|
|||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Servant.Server.ContentTypes where
|
||||
|
||||
import Data.Aeson (ToJSON(..), encode)
|
||||
import Control.Monad (join)
|
||||
import Data.Aeson (ToJSON(..), FromJSON(..), encode, decode)
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Data.String.Conversions (cs)
|
||||
import qualified Data.Text.Lazy.Encoding as Text
|
||||
import qualified Data.Text.Lazy as Text
|
||||
import qualified Network.HTTP.Media as M
|
||||
|
||||
|
||||
import Servant.API (XML, HTML, JSON, JavaScript, CSS, PlainText)
|
||||
import Servant.API ( XML, HTML, JSON, JavaScript, CSS, PlainText
|
||||
, OctetStream)
|
||||
|
||||
-- * Accept class
|
||||
|
||||
-- | Instances of 'Accept' represent mimetypes. They are used for matching
|
||||
-- against the @Accept@ HTTP header of the request, and for setting the
|
||||
|
|
@ -25,35 +31,59 @@ import Servant.API (XML, HTML, JSON, JavaScript, CSS, PlainText)
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- instance Accept HTML where
|
||||
-- contentType _ = "text" // "html"
|
||||
-- > instance Accept HTML where
|
||||
-- > contentType _ = "text" // "html"
|
||||
--
|
||||
class Accept ctype where
|
||||
contentType :: Proxy ctype -> M.MediaType
|
||||
|
||||
-- | @text/html;charset=utf-8@
|
||||
instance Accept HTML where
|
||||
contentType _ = "text" M.// "html"
|
||||
|
||||
-- | @application/json;charset=utf-8@
|
||||
instance Accept JSON where
|
||||
contentType _ = "application" M.// "json"
|
||||
contentType _ = "application" M.// "json" M./: ("charset", "utf-8")
|
||||
|
||||
-- | @application/xml;charset=utf-8@
|
||||
instance Accept XML where
|
||||
contentType _ = "application" M.// "xml"
|
||||
|
||||
-- | @application/javascript;charset=utf-8@
|
||||
instance Accept JavaScript where
|
||||
contentType _ = "application" M.// "javascript"
|
||||
|
||||
-- | @text/css;charset=utf-8@
|
||||
instance Accept CSS where
|
||||
contentType _ = "text" M.// "css"
|
||||
|
||||
-- | @text/plain;charset=utf-8@
|
||||
instance Accept PlainText where
|
||||
contentType _ = "text" M.// "plain"
|
||||
|
||||
-- | @application/octet-stream@
|
||||
instance Accept OctetStream where
|
||||
contentType _ = "application" M.// "octet-stream"
|
||||
|
||||
newtype AcceptHeader = AcceptHeader BS.ByteString
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Render (serializing)
|
||||
|
||||
-- | Instantiate this class to register a way of serializing a type based
|
||||
-- on the @Accept@ header.
|
||||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > data MyContentType
|
||||
-- >
|
||||
-- > instance Accept MyContentType where
|
||||
-- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
|
||||
-- >
|
||||
-- > instance Show a => MimeRender MyContentType where
|
||||
-- > toByteString _ val = pack ("This is MINE! " ++ show val)
|
||||
-- >
|
||||
-- > type MyAPI = "path" :> Get '[MyContentType] Int
|
||||
class Accept ctype => MimeRender ctype a where
|
||||
toByteString :: Proxy ctype -> a -> ByteString
|
||||
|
||||
|
|
@ -71,18 +101,53 @@ instance ( AllMimeRender ctyps a, IsEmpty ctyps ~ 'False
|
|||
lkup = zip (map fst amrs) $ map (\(a,b) -> (cs $ show a, b)) amrs
|
||||
|
||||
|
||||
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- * MimeRender Instances
|
||||
|
||||
-- | @encode@
|
||||
instance ToJSON a => MimeRender JSON a where
|
||||
toByteString _ = encode
|
||||
|
||||
-- | @encodeUtf8@
|
||||
instance MimeRender PlainText Text.Text where
|
||||
toByteString _ = Text.encodeUtf8
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- * Unrender
|
||||
class Accept ctype => MimeUnrender ctype a where
|
||||
fromByteString :: Proxy ctype -> ByteString -> Maybe a
|
||||
|
||||
class AllCTUnrender list a where
|
||||
handleCTypeH :: Proxy list
|
||||
-> ByteString -- Content-Type header
|
||||
-> ByteString -- Request body
|
||||
-> Maybe a
|
||||
|
||||
instance ( AllMimeUnrender ctyps a, IsEmpty ctyps ~ 'False
|
||||
) => AllCTUnrender ctyps a where
|
||||
handleCTypeH _ ctypeH body = join $ M.mapContentMedia lkup (cs ctypeH)
|
||||
where lkup = amu (Proxy :: Proxy ctyps) body
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- * Utils (Internal)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- Check that all elements of list are instances of MimeRender
|
||||
--------------------------------------------------------------------------
|
||||
class AllMimeRender ls a where
|
||||
amr :: Proxy ls -> a -> [(M.MediaType, ByteString)] -- list of content-types/response pairs
|
||||
amr :: Proxy ls
|
||||
-> a -- value to serialize
|
||||
-> [(M.MediaType, ByteString)] -- content-types/response pairs
|
||||
|
||||
instance ( MimeRender ctyp a ) => AllMimeRender '[ctyp] a where
|
||||
amr _ a = [(contentType pctyp, toByteString pctyp a)]
|
||||
where pctyp = Proxy :: Proxy ctyp
|
||||
|
||||
instance ( MimeRender ctyp a
|
||||
, MimeRender ctyp' a
|
||||
, MimeRender ctyp' a -- at least two elems to avoid overlap
|
||||
, AllMimeRender ctyps a
|
||||
) => AllMimeRender (ctyp ': ctyp' ': ctyps) a where
|
||||
amr _ a = (contentType pctyp, toByteString pctyp a)
|
||||
|
|
@ -96,19 +161,39 @@ instance ( MimeRender ctyp a
|
|||
instance AllMimeRender '[] a where
|
||||
amr _ _ = []
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- Check that all elements of list are instances of MimeUnrender
|
||||
--------------------------------------------------------------------------
|
||||
class AllMimeUnrender ls a where
|
||||
amu :: Proxy ls -> ByteString -> [(M.MediaType, Maybe a)]
|
||||
|
||||
instance ( MimeUnrender ctyp a ) => AllMimeUnrender '[ctyp] a where
|
||||
amu _ val = [(contentType pctyp, fromByteString pctyp val)]
|
||||
where pctyp = Proxy :: Proxy ctyp
|
||||
|
||||
instance ( MimeUnrender ctyp a
|
||||
, MimeUnrender ctyp' a
|
||||
, AllMimeUnrender ctyps a
|
||||
) => AllMimeUnrender (ctyp ': ctyp' ': ctyps) a where
|
||||
amu _ val = (contentType pctyp, fromByteString pctyp val)
|
||||
:(contentType pctyp', fromByteString pctyp' val)
|
||||
:(amu pctyps val)
|
||||
where pctyp = Proxy :: Proxy ctyp
|
||||
pctyps = Proxy :: Proxy ctyps
|
||||
pctyp' = Proxy :: Proxy ctyp'
|
||||
|
||||
type family IsEmpty (ls::[*]) where
|
||||
IsEmpty '[] = 'True
|
||||
IsEmpty x = 'False
|
||||
|
||||
--------------------------------------------------------------------------
|
||||
-- MimeRender Instances
|
||||
--------------------------------------------------------------------------
|
||||
-- * MimeUnrender Instances
|
||||
|
||||
instance ToJSON a => MimeRender JSON a where
|
||||
toByteString _ = encode
|
||||
-- | @decode@
|
||||
instance FromJSON a => MimeUnrender JSON a where
|
||||
fromByteString _ = decode
|
||||
|
||||
instance Show a => MimeRender PlainText a where
|
||||
toByteString _ = encode . show
|
||||
-- | @Text.decodeUtf8'@
|
||||
instance MimeUnrender PlainText Text.Text where
|
||||
fromByteString _ = either (const Nothing) Just . Text.decodeUtf8'
|
||||
|
||||
instance MimeRender PlainText String where
|
||||
toByteString _ = encode
|
||||
|
|
|
|||
|
|
@ -31,9 +31,11 @@ import Network.Wai ( Response, Request, ResponseReceived, Application
|
|||
import Servant.API ( QueryParams, QueryParam, QueryFlag, ReqBody, Header
|
||||
, MatrixParams, MatrixParam, MatrixFlag,
|
||||
, Capture, Get, Delete, Put, Post, Patch, Raw, (:>), (:<|>)(..))
|
||||
import Servant.Server.ContentTypes (AllCTRender(..), AcceptHeader(..))
|
||||
import Servant.Server.ContentTypes ( AllCTRender(..), AcceptHeader(..)
|
||||
, AllCTUnrender(..) )
|
||||
import Servant.Common.Text (FromText, fromText)
|
||||
|
||||
|
||||
data ReqBodyState = Uncalled
|
||||
| Called !B.ByteString
|
||||
| Done !B.ByteString
|
||||
|
|
@ -175,8 +177,8 @@ class HasServer layout where
|
|||
-- represented by @a@ and if it fails tries @b@. You must provide a request
|
||||
-- handler for each route.
|
||||
--
|
||||
-- > type MyApi = "books" :> Get [Book] -- GET /books
|
||||
-- > :<|> "books" :> ReqBody Book :> Post Book -- POST /books
|
||||
-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
|
||||
-- > :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = listAllBooks :<|> postBook
|
||||
|
|
@ -207,7 +209,7 @@ captured _ = fromText
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> Capture "isbn" Text :> Get Book
|
||||
-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = getBook
|
||||
|
|
@ -265,10 +267,12 @@ instance HasServer Delete where
|
|||
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
|
||||
-- to quickly fail if some conditions are not met.
|
||||
--
|
||||
-- If successfully returning a value, we just require that its type has
|
||||
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
||||
-- yielding status code 200 along the way.
|
||||
instance ( AllCTRender ctypes a, ToJSON a
|
||||
-- If successfully returning a value, we use the type-level list, combined
|
||||
-- with the request's @Accept@ header, to encode the value for you
|
||||
-- (returning a status code of 200). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Get ctypes a) where
|
||||
type Server (Get ctypes a) = EitherT (Int, String) IO a
|
||||
route Proxy action request respond
|
||||
|
|
@ -301,7 +305,7 @@ instance ( AllCTRender ctypes a, ToJSON a
|
|||
-- > deriving (Eq, Show, FromText, ToText)
|
||||
-- >
|
||||
-- > -- GET /view-my-referer
|
||||
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get Referer
|
||||
-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = viewReferer
|
||||
|
|
@ -327,11 +331,13 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
|
|||
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
|
||||
-- to quickly fail if some conditions are not met.
|
||||
--
|
||||
-- If successfully returning a value, we just require that its type has
|
||||
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
||||
-- yielding status code 201 along the way.
|
||||
instance ( AllCTRender ctypes a, ToJSON a
|
||||
)=> HasServer (Post ctypes a) where
|
||||
-- If successfully returning a value, we use the type-level list, combined
|
||||
-- with the request's @Accept@ header, to encode the value for you
|
||||
-- (returning a status code of 201). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Post ctypes a) where
|
||||
type Server (Post ctypes a) = EitherT (Int, String) IO a
|
||||
|
||||
route Proxy action request respond
|
||||
|
|
@ -358,10 +364,12 @@ instance ( AllCTRender ctypes a, ToJSON a
|
|||
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
|
||||
-- to quickly fail if some conditions are not met.
|
||||
--
|
||||
-- If successfully returning a value, we just require that its type has
|
||||
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
||||
-- yielding status code 200 along the way.
|
||||
instance ( AllCTRender ctypes a, ToJSON a
|
||||
-- If successfully returning a value, we use the type-level list, combined
|
||||
-- with the request's @Accept@ header, to encode the value for you
|
||||
-- (returning a status code of 201). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Put ctypes a) where
|
||||
type Server (Put ctypes a) = EitherT (Int, String) IO a
|
||||
|
||||
|
|
@ -423,7 +431,7 @@ instance (Typeable a, ToJSON a) => HasServer (Patch a) where
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> QueryParam "author" Text :> Get [Book]
|
||||
-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = getBooksBy
|
||||
|
|
@ -462,7 +470,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> QueryParams "authors" Text :> Get [Book]
|
||||
-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = getBooksBy
|
||||
|
|
@ -495,7 +503,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
|
|||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> QueryFlag "published" :> Get [Book]
|
||||
-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = getBooks
|
||||
|
|
@ -654,27 +662,38 @@ instance HasServer Raw where
|
|||
-- | If you use 'ReqBody' in one of the endpoints for your API,
|
||||
-- this automatically requires your server-side handler to be a function
|
||||
-- that takes an argument of the type specified by 'ReqBody'.
|
||||
-- The @Content-Type@ header is inspected, and the list provided is used to
|
||||
-- attempt deserialization. If the request does not have a @Content-Type@
|
||||
-- header, it is treated as @application/octet-stream@.
|
||||
-- This lets servant worry about extracting it from the request and turning
|
||||
-- it into a value of the type you specify.
|
||||
--
|
||||
--
|
||||
-- All it asks is for a 'FromJSON' instance.
|
||||
--
|
||||
-- Example:
|
||||
--
|
||||
-- > type MyApi = "books" :> ReqBody Book :> Post Book
|
||||
-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
|
||||
-- >
|
||||
-- > server :: Server MyApi
|
||||
-- > server = postBook
|
||||
-- > where postBook :: Book -> EitherT (Int, String) IO Book
|
||||
-- > postBook book = ...insert into your db...
|
||||
instance (FromJSON a, HasServer sublayout)
|
||||
=> HasServer (ReqBody a :> sublayout) where
|
||||
instance ( AllCTUnrender list a, HasServer sublayout
|
||||
) => HasServer (ReqBody list a :> sublayout) where
|
||||
|
||||
type Server (ReqBody a :> sublayout) =
|
||||
type Server (ReqBody list a :> sublayout) =
|
||||
a -> Server sublayout
|
||||
|
||||
route Proxy subserver request respond = do
|
||||
mrqbody <- eitherDecode' <$> lazyRequestBody request
|
||||
-- See HTTP RFC 2616, section 7.2.1
|
||||
-- http://www.w3.org/Protocols/rfc2616/rfc2616-sec7.html#sec7.2.1
|
||||
-- See also "W3C Internet Media Type registration, consistency of use"
|
||||
-- http://www.w3.org/2001/tag/2002/0129-mime
|
||||
let contentTypeH = fromMaybe "application/octet-stream"
|
||||
$ lookup hContentType $ requestHeaders request
|
||||
mrqbody <- handleCTypeH (Proxy :: Proxy list) (cs contentTypeH)
|
||||
<$> lazyRequestBody request
|
||||
case mrqbody of
|
||||
Left e -> respond . failWith $ InvalidBody e
|
||||
Right v -> route (Proxy :: Proxy sublayout) (subserver v) request respond
|
||||
|
|
|
|||
|
|
@ -16,11 +16,13 @@ import Data.Proxy (Proxy(Proxy))
|
|||
import Data.String (fromString)
|
||||
import Data.String.Conversions (cs)
|
||||
import GHC.Generics (Generic)
|
||||
import Network.HTTP.Types (parseQuery, ok200, status409)
|
||||
import Network.Wai (Application, Request, responseLBS, pathInfo, queryString, rawQueryString)
|
||||
import Network.Wai.Test (runSession, request, defaultRequest, simpleBody)
|
||||
import Network.HTTP.Types (parseQuery, ok200, status409, methodPost, hContentType)
|
||||
import Network.Wai ( Application, Request, responseLBS, pathInfo
|
||||
, queryString, rawQueryString )
|
||||
import Network.Wai.Test (runSession, defaultRequest, simpleBody, request)
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Test.Hspec.Wai (liftIO, with, get, post, shouldRespondWith, matchStatus)
|
||||
import Test.Hspec.Wai ( liftIO, with, get, post, shouldRespondWith
|
||||
, matchStatus, request )
|
||||
|
||||
import Servant.API (JSON)
|
||||
import Servant.API.Capture (Capture)
|
||||
|
|
@ -171,6 +173,7 @@ queryParamSpec = do
|
|||
name = "john"
|
||||
}
|
||||
|
||||
|
||||
it "allows to retrieve value-less GET parameters" $
|
||||
(flip runSession) (serve queryParamApi qpServer) $ do
|
||||
let params3 = "?capitalize"
|
||||
|
|
@ -290,8 +293,8 @@ matrixParamSpec = do
|
|||
}
|
||||
|
||||
type PostApi =
|
||||
ReqBody Person :> Post '[JSON] Integer
|
||||
:<|> "bla" :> ReqBody Person :> Post '[JSON] Integer
|
||||
ReqBody '[JSON] Person :> Post '[JSON] Integer
|
||||
:<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
|
||||
postApi :: Proxy PostApi
|
||||
postApi = Proxy
|
||||
|
||||
|
|
@ -299,23 +302,26 @@ postSpec :: Spec
|
|||
postSpec = do
|
||||
describe "Servant.API.Post and .ReqBody" $ do
|
||||
with (return (serve postApi (return . age :<|> return . age))) $ do
|
||||
let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
|
||||
, "application/json")]
|
||||
|
||||
it "allows to POST a Person" $ do
|
||||
post "/" (encode alice) `shouldRespondWith` "42"{
|
||||
post' "/" (encode alice) `shouldRespondWith` "42"{
|
||||
matchStatus = 201
|
||||
}
|
||||
|
||||
it "allows alternative routes if all have request bodies" $ do
|
||||
post "/bla" (encode alice) `shouldRespondWith` "42"{
|
||||
post' "/bla" (encode alice) `shouldRespondWith` "42"{
|
||||
matchStatus = 201
|
||||
}
|
||||
|
||||
it "handles trailing '/' gracefully" $ do
|
||||
post "/bla/" (encode alice) `shouldRespondWith` "42"{
|
||||
post' "/bla/" (encode alice) `shouldRespondWith` "42"{
|
||||
matchStatus = 201
|
||||
}
|
||||
|
||||
it "correctly rejects invalid request bodies with status 400" $ do
|
||||
post "/" "some invalid body" `shouldRespondWith` 400
|
||||
post' "/" "some invalid body" `shouldRespondWith` 400
|
||||
|
||||
|
||||
type RawApi = "foo" :> Raw
|
||||
|
|
@ -376,7 +382,7 @@ errorsSpec = do
|
|||
let ib = InvalidBody "The body is invalid"
|
||||
let wm = WrongMethod
|
||||
let nf = NotFound
|
||||
|
||||
|
||||
describe "Servant.Server.Internal.RouteMismatch" $ do
|
||||
it "HttpError > *" $ do
|
||||
ib <> he `shouldBe` he
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user