002ee3c · servant · git.iko.soy

doc/tutorial/ApiType.lhs+3−4

compare with master

unifiedsplit

@@ -177,13 +177,12 @@ type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User

177 -- except that we explicitly say that "userid"

178 -- must be an integer

179

180− :<|> "user" :> Capture "userid" Integer :> DeleteNoContent '[JSON] NoContent

180+ :<|> "user" :> Capture "userid" Integer :> DeleteNoContent

181 -- equivalent to 'DELETE /user/:userid'

182```

183

184−In the second case, `DeleteNoContent` specifies a 204 response code,

184+In the second case, `DeleteNoContent` specifies a 204 response code

185−`JSON` specifies the content types on which the handler will match,

186−and `NoContent` says that the response will always be empty.

185+and that the response will always be empty.

187

186

188### `QueryParam`, `QueryParams`, `QueryFlag`

187### `QueryParam`, `QueryParams`, `QueryFlag`

189

188

doc/tutorial/Server.lhs+13−13

@@ -830,7 +830,7 @@ type UserAPI3 = -- view the user with given userid, in JSON

830 Capture "userid" Int :> Get '[JSON] User

831

832 :<|> -- delete the user with given userid. empty response

833− Capture "userid" Int :> DeleteNoContent '[JSON] NoContent

833+ Capture "userid" Int :> DeleteNoContent

834```

835

836We can instead factor out the `userid`:

@@ -838,7 +838,7 @@ We can instead factor out the `userid`:

838``` haskell

839type UserAPI4 = Capture "userid" Int :>

840 ( Get '[JSON] User

841− :<|> DeleteNoContent '[JSON] NoContent

841+ :<|> DeleteNoContent

842 )

843```

844

@@ -896,13 +896,13 @@ type API1 = "users" :>

896-- we factor out the Request Body

897type API2 = ReqBody '[JSON] User :>

898 ( Get '[JSON] User -- just display the same user back, don't register it

899− :<|> PostNoContent '[JSON] NoContent -- register the user. empty response

899+ :<|> PostNoContent -- register the user. empty response

900 )

901

902-- we factor out a Header

903type API3 = Header "Authorization" Token :>

904 ( Get '[JSON] SecretData -- get some secret data, if authorized

905− :<|> ReqBody '[JSON] SecretData :> PostNoContent '[JSON] NoContent -- add some secret data, if authorized

905+ :<|> ReqBody '[JSON] SecretData :> PostNoContent -- add some secret data, if authorized

906 )

907

908newtype Token = Token ByteString

@@ -915,11 +915,11 @@ API type only at the end.

915``` haskell

916type UsersAPI =

917 Get '[JSON] [User] -- list users

918− :<|> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent -- add a user

918+ :<|> ReqBody '[JSON] User :> PostNoContent -- add a user

919 :<|> Capture "userid" Int :>

920 ( Get '[JSON] User -- view a user

921− :<|> ReqBody '[JSON] User :> PutNoContent '[JSON] NoContent -- update a user

921+ :<|> ReqBody '[JSON] User :> PutNoContent -- update a user

922− :<|> DeleteNoContent '[JSON] NoContent -- delete a user

922+ :<|> DeleteNoContent -- delete a user

923 )

924

925usersServer :: Server UsersAPI

@@ -948,11 +948,11 @@ usersServer = getUsers :<|> newUser :<|> userOperations

948``` haskell

949type ProductsAPI =

950 Get '[JSON] [Product] -- list products

951− :<|> ReqBody '[JSON] Product :> PostNoContent '[JSON] NoContent -- add a product

951+ :<|> ReqBody '[JSON] Product :> PostNoContent -- add a product

952 :<|> Capture "productid" Int :>

953 ( Get '[JSON] Product -- view a product

954− :<|> ReqBody '[JSON] Product :> PutNoContent '[JSON] NoContent -- update a product

954+ :<|> ReqBody '[JSON] Product :> PutNoContent -- update a product

955− :<|> DeleteNoContent '[JSON] NoContent -- delete a product

955+ :<|> DeleteNoContent -- delete a product

956 )

957

958data Product = Product { productId :: Int }

@@ -996,11 +996,11 @@ abstract that away:

996-- indexed by values of type 'i'

997type APIFor a i =

998 Get '[JSON] [a] -- list 'a's

999− :<|> ReqBody '[JSON] a :> PostNoContent '[JSON] NoContent -- add an 'a'

999+ :<|> ReqBody '[JSON] a :> PostNoContent -- add an 'a'

1000 :<|> Capture "id" i :>

1001 ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i'

1002− :<|> ReqBody '[JSON] a :> PutNoContent '[JSON] NoContent -- update an 'a'

1002+ :<|> ReqBody '[JSON] a :> PutNoContent -- update an 'a'

1003− :<|> DeleteNoContent '[JSON] NoContent -- delete an 'a'

1003+ :<|> DeleteNoContent -- delete an 'a'

1004 )

1005

1006-- Build the appropriate 'Server'

servant-client-core/src/Servant/Client/Core/HasClient.hs+14−2

@@ -50,8 +50,9 @@ import Servant.API

50 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,

51 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,

52 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,

53− ToSourceIO (..), Vault, Verb, WithNamedContext, contentType,

53+ ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext,

54− getHeadersHList, getResponse, toQueryParam, toUrlPiece)

54+ contentType, getHeadersHList, getResponse, toQueryParam,

55+ toUrlPiece)

55import Servant.API.ContentTypes

56import Servant.API.ContentTypes

56 (contentTypes)

57 (contentTypes)

57import Servant.API.Modifiers

58import Servant.API.Modifiers

@@ -241,6 +242,17 @@ instance {-# OVERLAPPING #-}

241

242

242 hoistClientMonad _ _ f ma = f ma

243 hoistClientMonad _ _ f ma = f ma

243

244

245+instance (RunClient m, ReflectMethod method) =>

246+ HasClient m (NoContentVerb method) where

247+ type Client m (NoContentVerb method)

248+ = m NoContent

249+ clientWithRoute _pm Proxy req = do

250+ _response <- runRequest req { requestMethod = method }

251+ return NoContent

252+ where method = reflectMethod (Proxy :: Proxy method)

253+

254+ hoistClientMonad _ _ f ma = f ma

255+

244instance {-# OVERLAPPING #-}

256instance {-# OVERLAPPING #-}

245 -- Note [Non-Empty Content Types]

257 -- Note [Non-Empty Content Types]

246 ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls

258 ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls

servant-client/test/Servant/ClientTestUtils.hs+2−2

@@ -85,7 +85,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]

85type Api =

86 Get '[JSON] Person

87 :<|> "get" :> Get '[JSON] Person

88− :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent

88+ :<|> "deleteEmpty" :> DeleteNoContent

89 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person

90 :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]

91 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person

@@ -101,7 +101,7 @@ type Api =

101 ReqBody '[JSON] [(String, [Rational])] :>

102 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

103 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

104− :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

104+ :<|> "deleteContentType" :> DeleteNoContent

105 :<|> "redirectWithCookie" :> Raw

106 :<|> "empty" :> EmptyAPI

107

servant-docs/golden/comprehensive.md+1−10

@@ -399,16 +399,7 @@

399- Status code 204

400- Headers: []

401

402−- Supported content types are:

402+- No response body

403−

404− - `application/json;charset=utf-8`

405− - `application/json`

406−

407−- Example (`application/json;charset=utf-8`, `application/json`):

408−

409−```javascript

410−

411−```

412

403

413## GET /raw

404## GET /raw

414

405

servant-docs/src/Servant/Docs/Internal.hs+12

@@ -862,6 +862,18 @@ instance {-# OVERLAPPABLE #-}

862 status = fromInteger $ natVal (Proxy :: Proxy status)

863 p = Proxy :: Proxy a

864

865+instance (ReflectMethod method) =>

866+ HasDocs (NoContentVerb method) where

867+ docsFor Proxy (endpoint, action) DocOptions{..} =

868+ single endpoint' action'

869+

870+ where endpoint' = endpoint & method .~ method'

871+ action' = action & response.respStatus .~ 204

872+ & response.respTypes .~ []

873+ & response.respBody .~ []

874+ & response.respHeaders .~ []

875+ method' = reflectMethod (Proxy :: Proxy method)

876+

865-- | TODO: mention the endpoint is streaming, its framing strategy

877-- | TODO: mention the endpoint is streaming, its framing strategy

866--

878--

867-- Also there are no samples.

879-- Also there are no samples.

servant-foreign/src/Servant/Foreign/Internal.hs+13

@@ -244,6 +244,19 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method)

244 method = reflectMethod (Proxy :: Proxy method)

245 methodLC = toLower $ decodeUtf8 method

246

247+instance (HasForeignType lang ftype NoContent, ReflectMethod method)

248+ => HasForeign lang ftype (NoContentVerb method) where

249+ type Foreign ftype (NoContentVerb method) = Req ftype

250+

251+ foreignFor lang Proxy Proxy req =

252+ req & reqFuncName . _FunctionName %~ (methodLC :)

253+ & reqMethod .~ method

254+ & reqReturnType .~ Just retType

255+ where

256+ retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy NoContent)

257+ method = reflectMethod (Proxy :: Proxy method)

258+ methodLC = toLower $ decodeUtf8 method

259+

247-- | TODO: doesn't taking framing into account.

260-- | TODO: doesn't taking framing into account.

248instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method)

261instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method)

249 => HasForeign lang ftype (Stream method status framing ct a) where

262 => HasForeign lang ftype (Stream method status framing ct a) where

servant-http-streams/test/Servant/ClientSpec.hs+2−2

@@ -115,7 +115,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String]

115type Api =

116 Get '[JSON] Person

117 :<|> "get" :> Get '[JSON] Person

118− :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent

118+ :<|> "deleteEmpty" :> DeleteNoContent

119 :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person

120 :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person]

121 :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person

@@ -131,7 +131,7 @@ type Api =

131 ReqBody '[JSON] [(String, [Rational])] :>

132 Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])])

133 :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool)

134− :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent

134+ :<|> "deleteContentType" :> DeleteNoContent

135 :<|> "redirectWithCookie" :> Raw

136 :<|> "empty" :> EmptyAPI

137

servant-server/src/Servant/Server/Internal.hs+23−2

@@ -75,10 +75,12 @@ import Servant.API

75 IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw,

76 ReflectMethod (reflectMethod), RemoteHost, ReqBody',

77 SBool (..), SBoolI (..), SourceIO, Stream, StreamBody',

78− Summary, ToSourceIO (..), Vault, Verb, WithNamedContext)

78+ Summary, ToSourceIO (..), Vault, Verb, NoContentVerb,

79+ WithNamedContext)

79import Servant.API.ContentTypes

80import Servant.API.ContentTypes

80 (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),

81 (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..),

81− AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH)

82+ AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH,

83+ NoContent (NoContent))

82import Servant.API.Modifiers

84import Servant.API.Modifiers

83 (FoldLenient, FoldRequired, RequestArgument,

85 (FoldLenient, FoldRequired, RequestArgument,

84 unfoldRequestArgument)

86 unfoldRequestArgument)

@@ -262,6 +264,17 @@ methodRouter splitHeaders method proxy status action = leafRouter route'

262 let bdy = if allowedMethodHead method request then "" else body

264 let bdy = if allowedMethodHead method request then "" else body

263 in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy

265 in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy

264

266

267+noContentRouter :: Method

268+ -> Status

269+ -> Delayed env (Handler b)

270+ -> Router env

271+noContentRouter method status action = leafRouter route'

272+ where

273+ route' env request respond =

274+ runAction (action `addMethodCheck` methodCheck method request)

275+ env request respond $ \ output ->

276+ Route $ responseLBS status [] ""

277+

265instance {-# OVERLAPPABLE #-}

278instance {-# OVERLAPPABLE #-}

266 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status

279 ( AllCTRender ctypes a, ReflectMethod method, KnownNat status

267 ) => HasServer (Verb method status ctypes a) context where

280 ) => HasServer (Verb method status ctypes a) context where

@@ -285,6 +298,14 @@ instance {-# OVERLAPPING #-}

285 where method = reflectMethod (Proxy :: Proxy method)

298 where method = reflectMethod (Proxy :: Proxy method)

286 status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

299 status = toEnum . fromInteger $ natVal (Proxy :: Proxy status)

287

300

301+instance (ReflectMethod method) =>

302+ HasServer (NoContentVerb method) context where

303+

304+ type ServerT (NoContentVerb method) m = m NoContent

305+ hoistServerWithContext _ _ nt s = nt s

306+

307+ route Proxy _ = noContentRouter method status204

308+ where method = reflectMethod (Proxy :: Proxy method)

288

309

289instance {-# OVERLAPPABLE #-}

310instance {-# OVERLAPPABLE #-}

290 ( MimeRender ctype chunk, ReflectMethod method, KnownNat status,

311 ( MimeRender ctype chunk, ReflectMethod method, KnownNat status,

servant-server/test/Servant/ServerSpec.hs+3−3

@@ -51,7 +51,7 @@ import Servant.API

51 JSON, NoContent (..), NoFraming, OctetStream, Patch,

52 PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw,

53 RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb,

54− addHeader)

54+ NoContentVerb, addHeader)

55import Servant.Server

56 (Context ((:.), EmptyContext), Handler, Server, Tagged (..),

57 emptyServer, err400, err401, err403, err404, serve, serveWithContext)

@@ -103,7 +103,7 @@ spec = do

103

104type VerbApi method status

105 = Verb method status '[JSON] Person

106− :<|> "noContent" :> Verb method status '[JSON] NoContent

106+ :<|> "noContent" :> NoContentVerb method

107 :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person)

108 :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent)

109 :<|> "accept" :> ( Verb method status '[JSON] Person

@@ -140,7 +140,7 @@ verbSpec = describe "Servant.API.Verb" $ do

140

141 it "returns no content on NoContent" $ do

142 response <- THW.request method "/noContent" [] ""

143− liftIO $ statusCode (simpleStatus response) `shouldBe` status

143+ liftIO $ statusCode (simpleStatus response) `shouldBe` 204

144 liftIO $ simpleBody response `shouldBe` ""

145

146 -- HEAD should not return body

servant/src/Servant/API.hs+2−1

@@ -130,7 +130,8 @@ import Servant.API.Verbs

130 Post, PostAccepted, PostCreated, PostNoContent,

131 PostNonAuthoritative, PostResetContent, Put, PutAccepted,

132 PutCreated, PutNoContent, PutNonAuthoritative,

133− ReflectMethod (reflectMethod), StdMethod (..), Verb)

133+ ReflectMethod (reflectMethod), StdMethod (..),

134+ Verb, NoContentVerb)

134import Servant.API.WithNamedContext

135import Servant.API.WithNamedContext

135 (WithNamedContext)

136 (WithNamedContext)

136import Servant.Links

137import Servant.Links

servant/src/Servant/API/Verbs.hs+11−5

@@ -29,6 +29,12 @@ import Network.HTTP.Types.Method

29data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) (a :: *)

30 deriving (Typeable, Generic)

31

32+-- | @NoContentVerb@ is a specific type to represent 'NoContent' responses.

33+-- It does not require either a list of content types (because there's

34+-- no content) or a status code (because it should always be 204).

35+data NoContentVerb (method :: k1)

36+ deriving (Typeable, Generic)

37+

32-- * 200 responses

38-- * 200 responses

33--

39--

34-- The 200 response is the workhorse of web servers, but also fairly generic.

40-- The 200 response is the workhorse of web servers, but also fairly generic.

@@ -113,15 +119,15 @@ type PutNonAuthoritative = Verb 'PUT 203

113-- If the document view should be reset, use @205 Reset Content@.

119-- If the document view should be reset, use @205 Reset Content@.

114

120

115-- | 'GET' with 204 status code.

121-- | 'GET' with 204 status code.

116−type GetNoContent = Verb 'GET 204

122+type GetNoContent = NoContentVerb 'GET

117-- | 'POST' with 204 status code.

123-- | 'POST' with 204 status code.

118−type PostNoContent = Verb 'POST 204

124+type PostNoContent = NoContentVerb 'POST

119-- | 'DELETE' with 204 status code.

125-- | 'DELETE' with 204 status code.

120−type DeleteNoContent = Verb 'DELETE 204

126+type DeleteNoContent = NoContentVerb 'DELETE

121-- | 'PATCH' with 204 status code.

127-- | 'PATCH' with 204 status code.

122−type PatchNoContent = Verb 'PATCH 204

128+type PatchNoContent = NoContentVerb 'PATCH

123-- | 'PUT' with 204 status code.

129-- | 'PUT' with 204 status code.

124−type PutNoContent = Verb 'PUT 204

130+type PutNoContent = NoContentVerb 'PUT

125

131

126

132

127-- ** 205 Reset Content

133-- ** 205 Reset Content

servant/src/Servant/Links.hs+5−1

@@ -177,7 +177,7 @@ import Servant.API.TypeLevel

177import Servant.API.Vault

178 (Vault)

179import Servant.API.Verbs

180− (Verb)

180+ (Verb, NoContentVerb)

181import Servant.API.WithNamedContext

182 (WithNamedContext)

183import Web.HttpApiData

@@ -546,6 +546,10 @@ instance HasLink (Verb m s ct a) where

546 type MkLink (Verb m s ct a) r = r

547 toLink toA _ = toA

548

549+instance HasLink (NoContentVerb m) where

550+ type MkLink (NoContentVerb m) r = r

551+ toLink toA _ = toA

552+

549instance HasLink Raw where

553instance HasLink Raw where

550 type MkLink Raw a = a

554 type MkLink Raw a = a

551 toLink toA _ = toA

555 toLink toA _ = toA

servant/src/Servant/Test/ComprehensiveAPI.hs+1−1

@@ -64,7 +64,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =

64 :<|> "res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent)

65 :<|> "foo" :> GET

66 :<|> "vault" :> Vault :> GET

67− :<|> "post-no-content" :> Verb 'POST 204 '[JSON] NoContent

67+ :<|> "post-no-content" :> PostNoContent

68 :<|> "post-int" :> Verb 'POST 204 '[JSON] Int

69 :<|> "named-context" :> WithNamedContext "foo" '[] GET

70 :<|> "capture-all" :> CaptureAll "foo" Int :> GET