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

Review fixes

Browse Source
This commit is contained in:
Julian K. Arni 2016-01-08 17:43:10 +01:00
parent 783a849c67
commit f1b6603c52
7 changed files with 237 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
servant-client/src/Servant/Client.hs
View File

@ -24,7 +24,6 @@ module Servant.Client
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad
import Control.Monad.Trans.Except
import Data.ByteString.Lazy (ByteString)
import Data.List
@ -420,6 +419,6 @@ It may seem to make more sense to have:
But this means that if another instance exists that does *not* require
non-empty lists, but is otherwise more specific, no instance will be overall
more specific. This in turns generally means adding yet another instance (one
more specific. This in turn generally means adding yet another instance (one
for empty and one for non-empty lists).
-}

2
servant-client/src/Servant/Common/Req.hs
View File

@ -156,7 +156,7 @@ performRequest reqMethod req reqHost manager = do
performRequestCT :: MimeUnrender ct result =>
Proxy ct -> Method -> Req -> BaseUrl -> Manager
-> ExceptT ServantError IO ([HTTP.Header], result)
-> ExceptT ServantError IO ([HTTP.Header], result)
performRequestCT ct reqMethod req reqHost manager = do
let acceptCT = contentType ct
(_status, respBody, respCT, hdrs, _response) <-

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

@ -3,8 +3,10 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
@ -13,7 +15,7 @@ module Servant.ServerSpec where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Control.Monad (forM_, when)
import Control.Monad (forM_, when, unless)
import Control.Monad.Trans.Except (ExceptT, throwE)
import Data.Aeson (FromJSON, ToJSON, decode', encode)
import Data.ByteString.Conversion ()
@ -23,82 +25,144 @@ import Data.String (fromString)
import Data.String.Conversions (cs)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Types (hAccept, hContentType,
methodDelete, methodGet, methodHead,
methodPatch, methodPost, methodPut,
ok200, parseQuery, Status(..))
import Network.HTTP.Types (Status (..), hAccept, hContentType,
methodDelete, methodGet,
methodHead, methodPatch,
methodPost, methodPut, ok200,
parseQuery)
import Network.Wai (Application, Request, pathInfo,
queryString, rawQueryString,
responseLBS, responseBuilder)
import Network.Wai.Internal (Response(ResponseBuilder))
responseBuilder, responseLBS)
import Network.Wai.Internal (Response (ResponseBuilder))
import Network.Wai.Test (defaultRequest, request,
runSession, simpleBody)
runSession, simpleBody,
simpleHeaders, simpleStatus)
import Servant.API ((:<|>) (..), (:>), Capture, Delete,
Get, Header (..), Headers,
HttpVersion, IsSecure (..), JSON,
Patch, PlainText, Post, Put,
Get, Header (..),
Headers, HttpVersion,
IsSecure (..), JSON,
NoContent (..), Patch, PlainText,
Post, Put,
QueryFlag, QueryParam, QueryParams,
Raw, RemoteHost, ReqBody, GetNoContent,
PostNoContent, addHeader, NoContent(..))
import Servant.Server (Server, serve, ServantErr(..), err404)
import Test.Hspec (Spec, describe, it, shouldBe)
Raw, RemoteHost, ReqBody,
StdMethod (..), Verb, addHeader)
import Servant.Server (ServantErr (..), Server, err404,
serve)
import Test.Hspec (Spec, context, describe, it,
shouldBe, shouldContain)
import Test.Hspec.Wai (get, liftIO, matchHeaders,
matchStatus, post, request,
matchStatus, request,
shouldRespondWith, with, (<:>))
import Servant.Server.Internal.RoutingApplication (toApplication, RouteResult(..))
import Servant.Server.Internal.RoutingApplication
(toApplication, RouteResult(..))
import Servant.Server.Internal.Router
(tweakResponse, runRouter,
Router, Router'(LeafRouter))
-- * test data types
data Person = Person {
name :: String,
age :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Person
instance FromJSON Person
alice :: Person
alice = Person "Alice" 42
data Animal = Animal {
species :: String,
numberOfLegs :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Animal
instance FromJSON Animal
jerry :: Animal
jerry = Animal "Mouse" 4
tweety :: Animal
tweety = Animal "Bird" 2
-- * specs
-- * Specs
spec :: Spec
spec = do
verbSpec
captureSpec
getSpec
headSpec
postSpec
putSpec
patchSpec
queryParamSpec
reqBodySpec
headerSpec
rawSpec
unionSpec
routerSpec
alternativeSpec
responseHeadersSpec
miscReqCombinatorsSpec
routerSpec
miscCombinatorSpec
------------------------------------------------------------------------------
-- * verbSpec {{{
------------------------------------------------------------------------------
type VerbApi method status
= Verb method status '[JSON] Person
:<|> "noContent" :> Verb method status '[JSON] NoContent
:<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)
:<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)
verbSpec :: Spec
verbSpec = describe "Servant.API.Verb" $ do
let server :: Server (VerbApi method status)
server = return alice
:<|> return NoContent
:<|> return (addHeader 5 alice)
:<|> return (addHeader 10 NoContent)
get200 = Proxy :: Proxy (VerbApi 'GET 200)
post210 = Proxy :: Proxy (VerbApi 'POST 210)
put203 = Proxy :: Proxy (VerbApi 'PUT 203)
delete280 = Proxy :: Proxy (VerbApi 'DELETE 280)
patch214 = Proxy :: Proxy (VerbApi 'PATCH 214)
wrongMethod m = if m == methodPatch then methodPost else methodPatch
test desc api method (status :: Int) = context desc $
with (return $ serve api server) $ do
-- HEAD and 214/215 need not return bodies
unless (status `elem` [214, 215] || method == methodHead) $
it "returns the person" $ do
response <- Test.Hspec.Wai.request method "/" [] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
it "returns no content on NoContent" $ do
response <- Test.Hspec.Wai.request method "/noContent" [] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
liftIO $ simpleBody response `shouldBe` ""
-- HEAD should not return body
when (method == methodHead) $
it "HEAD returns no content body" $ do
response <- Test.Hspec.Wai.request method "/" [] ""
liftIO $ simpleBody response `shouldBe` ""
it "throws 405 on wrong method " $ do
Test.Hspec.Wai.request (wrongMethod method) "/" [] ""
`shouldRespondWith` 405
it "returns headers" $ do
response1 <- Test.Hspec.Wai.request method "/header" [] ""
liftIO $ statusCode (simpleStatus response1) `shouldBe` status
liftIO $ simpleHeaders response1 `shouldContain` [("H", "5")]
response2 <- Test.Hspec.Wai.request method "/header" [] ""
liftIO $ statusCode (simpleStatus response2) `shouldBe` status
liftIO $ simpleHeaders response2 `shouldContain` [("H", "5")]
it "handles trailing '/' gracefully" $ do
response <- Test.Hspec.Wai.request method "/headerNC/" [] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
it "returns 406 if the Accept header is not supported" $ do
Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
`shouldRespondWith` 406
it "responds if the Accept header is supported" $ do
response <- Test.Hspec.Wai.request method ""
[(hAccept, "application/json")] ""
liftIO $ statusCode (simpleStatus response) `shouldBe` status
it "sets the Content-Type header" $ do
response <- Test.Hspec.Wai.request method "" [] ""
liftIO $ simpleHeaders response `shouldContain`
[("Content-Type", "application/json")]
test "GET 200" get200 methodGet 200
test "POST 210" post210 methodPost 210
test "PUT 203" put203 methodPut 203
test "DELETE 280" delete280 methodDelete 280
test "PATCH 214" patch214 methodPatch 214
test "GET 200 with HEAD" get200 methodHead 200
-- }}}
------------------------------------------------------------------------------
-- * captureSpec {{{
------------------------------------------------------------------------------
type CaptureApi = Capture "legs" Integer :> Get '[JSON] Animal
captureApi :: Proxy CaptureApi
@ -128,68 +192,10 @@ captureSpec = do
it "strips the captured path snippet from pathInfo" $ do
get "/captured/foo" `shouldRespondWith` (fromString (show ["foo" :: String]))
type GetApi = Get '[JSON] Person
:<|> "empty" :> GetNoContent '[JSON] NoContent
:<|> "emptyWithHeaders" :> GetNoContent '[JSON] (Headers '[Header "H" Int] NoContent)
:<|> "post" :> PostNoContent '[JSON] NoContent
getApi :: Proxy GetApi
getApi = Proxy
getSpec :: Spec
getSpec = do
describe "Servant.API.Get" $ do
let server = return alice
:<|> return NoContent
:<|> return (addHeader 5 NoContent)
:<|> return NoContent
with (return $ serve getApi server) $ do
it "allows to GET a Person" $ do
response <- get "/"
return response `shouldRespondWith` 200
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
it "throws 405 (wrong method) on POSTs" $ do
post "/" "" `shouldRespondWith` 405
post "/empty" "" `shouldRespondWith` 405
it "returns headers" $ do
get "/emptyWithHeaders" `shouldRespondWith` 204 { matchHeaders = [ "H" <:> "5" ] }
it "returns 406 if the Accept header is not supported" $ do
Test.Hspec.Wai.request methodGet "" [(hAccept, "crazy/mime")] ""
`shouldRespondWith` 406
headSpec :: Spec
headSpec = do
describe "Servant.API.Head" $ do
let server = return alice
:<|> return NoContent
:<|> return (addHeader 5 NoContent)
:<|> return NoContent
with (return $ serve getApi server) $ do
it "allows to GET a Person" $ do
response <- Test.Hspec.Wai.request methodHead "/" [] ""
return response `shouldRespondWith` 200
liftIO $ decode' (simpleBody response) `shouldBe` (Nothing :: Maybe Person)
it "does not allow HEAD to POST route" $ do
response <- Test.Hspec.Wai.request methodHead "/post" [] ""
return response `shouldRespondWith` 405
it "throws 405 (wrong method) on POSTs" $ do
post "/" "" `shouldRespondWith` 405
post "/empty" "" `shouldRespondWith` 405
it "returns 406 if the Accept header is not supported" $ do
Test.Hspec.Wai.request methodHead "" [(hAccept, "crazy/mime")] ""
`shouldRespondWith` 406
-- }}}
------------------------------------------------------------------------------
-- * queryParamSpec {{{
------------------------------------------------------------------------------
type QueryParamApi = QueryParam "name" String :> Get '[JSON] Person
:<|> "a" :> QueryParams "names" String :> Get '[JSON] Person
@ -274,122 +280,41 @@ queryParamSpec = do
name = "Alice"
}
type PostApi =
ReqBody '[JSON] Person :> Post '[JSON] Integer
:<|> "bla" :> ReqBody '[JSON] Person :> Post '[JSON] Integer
:<|> "empty" :> Post '[JSON] ()
-- }}}
------------------------------------------------------------------------------
-- * reqBodySpec {{{
------------------------------------------------------------------------------
type ReqBodyApi = ReqBody '[JSON] Person :> Post '[JSON] Person
:<|> "blah" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
postApi :: Proxy PostApi
postApi = Proxy
reqBodyApi :: Proxy ReqBodyApi
reqBodyApi = Proxy
postSpec :: Spec
postSpec = do
describe "Servant.API.Post and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve postApi server) $ do
let post' x = Test.Hspec.Wai.request methodPost x [(hContentType
, "application/json;charset=utf-8")]
reqBodySpec :: Spec
reqBodySpec = describe "Servant.API.ReqBody" $ do
it "allows to POST a Person" $ do
post' "/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
let server :: Server ReqBodyApi
server = return :<|> return . age
mkReq method x = Test.Hspec.Wai.request method x
[(hContentType, "application/json;charset=utf-8")]
it "allows alternative routes if all have request bodies" $ do
post' "/bla" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
with (return $ serve reqBodyApi server) $ do
it "handles trailing '/' gracefully" $ do
post' "/bla/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "passes the argument to the handler" $ do
response <- mkReq methodPost "" (encode alice)
liftIO $ decode' (simpleBody response) `shouldBe` Just alice
it "correctly rejects invalid request bodies with status 400" $ do
post' "/" "some invalid body" `shouldRespondWith` 400
it "rejects invalid request bodies with status 400" $ do
mkReq methodPut "/blah" "some invalid body" `shouldRespondWith` 400
it "responds with 415 if the request body media type is unsupported" $ do
let post'' x = Test.Hspec.Wai.request methodPost x [(hContentType
, "application/nonsense")]
post'' "/" "anything at all" `shouldRespondWith` 415
it "responds with 415 if the request body media type is unsupported" $ do
Test.Hspec.Wai.request methodPost "/"
[(hContentType, "application/nonsense")] "" `shouldRespondWith` 415
type PutApi =
ReqBody '[JSON] Person :> Put '[JSON] Integer
:<|> "bla" :> ReqBody '[JSON] Person :> Put '[JSON] Integer
:<|> "empty" :> Put '[JSON] ()
putApi :: Proxy PutApi
putApi = Proxy
putSpec :: Spec
putSpec = do
describe "Servant.API.Put and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve putApi server) $ do
let put' x = Test.Hspec.Wai.request methodPut x [(hContentType
, "application/json;charset=utf-8")]
it "allows to put a Person" $ do
put' "/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "allows alternative routes if all have request bodies" $ do
put' "/bla" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "handles trailing '/' gracefully" $ do
put' "/bla/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "correctly rejects invalid request bodies with status 400" $ do
put' "/" "some invalid body" `shouldRespondWith` 400
it "responds with 415 if the request body media type is unsupported" $ do
let put'' x = Test.Hspec.Wai.request methodPut x [(hContentType
, "application/nonsense")]
put'' "/" "anything at all" `shouldRespondWith` 415
type PatchApi =
ReqBody '[JSON] Person :> Patch '[JSON] Integer
:<|> "bla" :> ReqBody '[JSON] Person :> Patch '[JSON] Integer
:<|> "empty" :> Patch '[JSON] ()
patchApi :: Proxy PatchApi
patchApi = Proxy
patchSpec :: Spec
patchSpec = do
describe "Servant.API.Patch and .ReqBody" $ do
let server = return . age :<|> return . age :<|> return ()
with (return $ serve patchApi server) $ do
let patch' x = Test.Hspec.Wai.request methodPatch x [(hContentType
, "application/json;charset=utf-8")]
it "allows to patch a Person" $ do
patch' "/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "allows alternative routes if all have request bodies" $ do
patch' "/bla" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "handles trailing '/' gracefully" $ do
patch' "/bla/" (encode alice) `shouldRespondWith` "42"{
matchStatus = 200
}
it "correctly rejects invalid request bodies with status 400" $ do
patch' "/" "some invalid body" `shouldRespondWith` 400
it "responds with 415 if the request body media type is unsupported" $ do
let patch'' x = Test.Hspec.Wai.request methodPatch x [(hContentType
, "application/nonsense")]
patch'' "/" "anything at all" `shouldRespondWith` 415
-- }}}
------------------------------------------------------------------------------
-- * headerSpec {{{
------------------------------------------------------------------------------
type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] ()
headerApi :: Proxy (HeaderApi a)
@ -418,12 +343,19 @@ headerSpec = describe "Servant.API.Header" $ do
it "passes the header to the handler (String)" $
delete' "/" "" `shouldRespondWith` 200
-- }}}
------------------------------------------------------------------------------
-- * rawSpec {{{
------------------------------------------------------------------------------
type RawApi = "foo" :> Raw
rawApi :: Proxy RawApi
rawApi = Proxy
rawApplication :: Show a => (Request -> a) -> Application
rawApplication f request_ respond = respond $ responseLBS ok200 [] (cs $ show $ f request_)
rawApplication f request_ respond = respond $ responseLBS ok200 []
(cs $ show $ f request_)
rawSpec :: Spec
rawSpec = do
@ -444,7 +376,10 @@ rawSpec = do
liftIO $ do
simpleBody response `shouldBe` cs (show ["bar" :: String])
-- }}}
------------------------------------------------------------------------------
-- * alternativeSpec {{{
------------------------------------------------------------------------------
type AlternativeApi =
"foo" :> Get '[JSON] Person
:<|> "bar" :> Get '[JSON] Animal
@ -452,11 +387,12 @@ type AlternativeApi =
:<|> "bar" :> Post '[JSON] Animal
:<|> "bar" :> Put '[JSON] Animal
:<|> "bar" :> Delete '[JSON] ()
unionApi :: Proxy AlternativeApi
unionApi = Proxy
unionServer :: Server AlternativeApi
unionServer =
alternativeApi :: Proxy AlternativeApi
alternativeApi = Proxy
alternativeServer :: Server AlternativeApi
alternativeServer =
return alice
:<|> return jerry
:<|> return "a string"
@ -464,10 +400,10 @@ unionServer =
:<|> return jerry
:<|> return ()
unionSpec :: Spec
unionSpec = do
alternativeSpec :: Spec
alternativeSpec = do
describe "Servant.API.Alternative" $ do
with (return $ serve unionApi unionServer) $ do
with (return $ serve alternativeApi alternativeServer) $ do
it "unions endpoints" $ do
response <- get "/foo"
@ -484,7 +420,10 @@ unionSpec = do
it "returns 404 if the path does not exist" $ do
get "/nonexistent" `shouldRespondWith` 404
-- }}}
------------------------------------------------------------------------------
-- * responseHeaderSpec {{{
------------------------------------------------------------------------------
type ResponseHeadersApi =
Get '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
:<|> Post '[JSON] (Headers '[Header "H1" Int, Header "H2" String] String)
@ -501,26 +440,29 @@ responseHeadersSpec :: Spec
responseHeadersSpec = describe "ResponseHeaders" $ do
with (return $ serve (Proxy :: Proxy ResponseHeadersApi) responseHeadersServer) $ do
let methods = [(methodGet, 200), (methodPost, 200), (methodPut, 200), (methodPatch, 200)]
let methods = [methodGet, methodPost, methodPut, methodPatch]
it "includes the headers in the response" $
forM_ methods $ \(method, expected) ->
forM_ methods $ \method ->
Test.Hspec.Wai.request method "/" [] ""
`shouldRespondWith` "\"hi\""{ matchHeaders = ["H1" <:> "5", "H2" <:> "kilroy"]
, matchStatus = expected
, matchStatus = 200
}
it "responds with not found for non-existent endpoints" $
forM_ methods $ \(method,_) ->
forM_ methods $ \method ->
Test.Hspec.Wai.request method "blahblah" [] ""
`shouldRespondWith` 404
it "returns 406 if the Accept header is not supported" $
forM_ methods $ \(method,_) ->
forM_ methods $ \method ->
Test.Hspec.Wai.request method "" [(hAccept, "crazy/mime")] ""
`shouldRespondWith` 406
-- }}}
------------------------------------------------------------------------------
-- * routerSpec {{{
------------------------------------------------------------------------------
routerSpec :: Spec
routerSpec = do
describe "Servant.Server.Internal.Router" $ do
@ -539,6 +481,10 @@ routerSpec = do
it "calls f on route result" $ do
get "" `shouldRespondWith` 202
-- }}}
------------------------------------------------------------------------------
-- * miscCombinatorSpec {{{
------------------------------------------------------------------------------
type MiscCombinatorsAPI
= "version" :> HttpVersion :> Get '[JSON] String
:<|> "secure" :> IsSecure :> Get '[JSON] String
@ -557,8 +503,8 @@ miscServ = versionHandler
secureHandler NotSecure = return "not secure"
hostHandler = return . show
miscReqCombinatorsSpec :: Spec
miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
miscCombinatorSpec :: Spec
miscCombinatorSpec = with (return $ serve miscApi miscServ) $
describe "Misc. combinators for request inspection" $ do
it "Successfully gets the HTTP version specified in the request" $
go "/version" "\"HTTP/1.0\""
@ -570,3 +516,35 @@ miscReqCombinatorsSpec = with (return $ serve miscApi miscServ) $
go "/host" "\"0.0.0.0:0\""
where go path res = Test.Hspec.Wai.get path `shouldRespondWith` res
-- }}}
------------------------------------------------------------------------------
-- * Test data types {{{
------------------------------------------------------------------------------
data Person = Person {
name :: String,
age :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Person
instance FromJSON Person
alice :: Person
alice = Person "Alice" 42
data Animal = Animal {
species :: String,
numberOfLegs :: Integer
}
deriving (Eq, Show, Generic)
instance ToJSON Animal
instance FromJSON Animal
jerry :: Animal
jerry = Animal "Mouse" 4
tweety :: Animal
tweety = Animal "Bird" 2
-- }}}

4
servant/src/Servant/API.hs
View File

@ -70,7 +70,7 @@ import Servant.API.ResponseHeaders (AddHeader (addHeader),
getHeadersHList, getResponse)
import Servant.API.Sub ((:>))
import Servant.API.Vault (Vault)
import Servant.API.Verbs (Created, Delete, DeleteAccepted,
import Servant.API.Verbs (PostCreated, Delete, DeleteAccepted,
DeleteNoContent,
DeleteNonAuthoritative, Get,
GetAccepted, GetNoContent,
@ -87,7 +87,7 @@ import Servant.API.Verbs (Created, Delete, DeleteAccepted,
PutAccepted, PutNoContent,
PutNoContent, PutNonAuthoritative,
ReflectMethod (reflectMethod),
Verb)
Verb, StdMethod(..))
import Servant.Utils.Links (HasLink (..), IsElem, IsElem',
URI (..), safeLink)
import Web.HttpApiData (FromHttpApiData (..),

2
servant/src/Servant/API/ContentTypes.hs
View File

@ -304,7 +304,7 @@ instance MimeRender OctetStream ByteString where
instance MimeRender OctetStream BS.ByteString where
mimeRender _ = fromStrict
-- | A type for responses with content-body.
-- | A type for responses without content-body.
data NoContent = NoContent
deriving (Show, Eq, Read)

15
servant/src/Servant/API/Verbs.hs
View File

@ -3,17 +3,20 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE PolyKinds #-}
module Servant.API.Verbs where
module Servant.API.Verbs
( module Servant.API.Verbs
, StdMethod(GET, POST, HEAD, PUT, DELETE, TRACE, CONNECT, OPTIONS, PATCH)
) where
import Data.Typeable (Typeable)
import Data.Proxy (Proxy)
import GHC.Generics (Generic)
import GHC.TypeLits (Nat)
import Network.HTTP.Types.Method (Method, StdMethod (..),
methodDelete, methodGet, methodHead,
methodPatch, methodPost, methodPut)
import Servant.API.ContentTypes (NoContent(..))
-- | @Verb@ is a general type for representing HTTP verbs/methods. For
-- | @Verb@ is a general type for representing HTTP verbs (a.k.a. methods). For
-- convenience, type synonyms for each verb with a 200 response code are
-- provided, but you are free to define your own:
--
@ -55,7 +58,7 @@ type Patch contentTypes a = Verb 'PATCH 200 contentTypes a
-- | 'POST' with 201 status code.
--
type Created contentTypes a = Verb 'POST 201 contentTypes a
type PostCreated contentTypes a = Verb 'POST 201 contentTypes a
-- ** 202 Accepted
@ -141,11 +144,11 @@ type PutResetContent contentTypes noContent = Verb 'PUT 205 contentTypes noConte
-- RFC7233 Section 4.1>
-- | 'GET' with 206 status code.
type GetPartialContent contentTypes noContent = Verb 'GET 205 contentTypes noContent
type GetPartialContent contentTypes noContent = Verb 'GET 206 contentTypes noContent
class ReflectMethod a where
reflectMethod :: proxy a -> Method
reflectMethod :: Proxy a -> Method
instance ReflectMethod 'GET where
reflectMethod _ = methodGet

4
servant/src/Servant/Utils/Links.hs
View File

@ -74,9 +74,7 @@
-- >>> safeLink api bad_link
-- ...
-- Could not deduce (Or
-- (IsElem'
-- (Verb 'Network.HTTP.Types.Method.DELETE 200 '[JSON] ())
-- (Verb 'Network.HTTP.Types.Method.GET 200 '[JSON] Int))
-- (IsElem' (Verb 'DELETE 200 '[JSON] ()) (Verb 'GET 200 '[JSON] Int))
-- (IsElem'
-- ("hello" :> Delete '[JSON] ())
-- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))