From b440af900b083864faecc38a2e6083dd0a8b3562 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sat, 7 Sep 2019 18:13:46 +0300 Subject: [PATCH 1/6] Implemented NoContentVerb and server instances for it --- servant-server/src/Servant/Server/Internal.hs | 26 +++++++++++++++++-- servant-server/test/Servant/ServerSpec.hs | 6 ++--- servant/src/Servant/API.hs | 3 ++- servant/src/Servant/API/Verbs.hs | 16 ++++++++---- servant/src/Servant/Links.hs | 6 ++++- servant/src/Servant/Test/ComprehensiveAPI.hs | 2 +- 6 files changed, 46 insertions(+), 13 deletions(-) diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 9b1a77eb..196895cf 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -75,10 +75,12 @@ import Servant.API IsSecure (..), QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod), RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO, Stream, StreamBody', - Summary, ToSourceIO (..), Vault, Verb, WithNamedContext) + Summary, ToSourceIO (..), Vault, Verb, NoContentVerb, + WithNamedContext) import Servant.API.ContentTypes (AcceptHeader (..), AllCTRender (..), AllCTUnrender (..), - AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH) + AllMime, MimeRender (..), MimeUnrender (..), canHandleAcceptH, + NoContent (NoContent)) import Servant.API.Modifiers (FoldLenient, FoldRequired, RequestArgument, unfoldRequestArgument) @@ -262,6 +264,17 @@ methodRouter splitHeaders method proxy status action = leafRouter route' let bdy = if allowedMethodHead method request then "" else body in Route $ responseLBS status ((hContentType, cs contentT) : headers) bdy +noContentRouter :: Method + -> Status + -> Delayed env (Handler b) + -> Router env +noContentRouter method status action = leafRouter route' + where + route' env request respond = + runAction (action `addMethodCheck` methodCheck method request) + env request respond $ \ output -> + Route $ responseLBS status [] "" + instance {-# OVERLAPPABLE #-} ( AllCTRender ctypes a, ReflectMethod method, KnownNat status ) => HasServer (Verb method status ctypes a) context where @@ -285,6 +298,15 @@ instance {-# OVERLAPPING #-} where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) +instance {-# OVERLAPPABLE #-} + (ReflectMethod method + ) => HasServer (NoContentVerb method) context where + + type ServerT (NoContentVerb method) m = m NoContent + hoistServerWithContext _ _ nt s = nt s + + route Proxy _ = noContentRouter method status204 + where method = reflectMethod (Proxy :: Proxy method) instance {-# OVERLAPPABLE #-} ( MimeRender ctype chunk, ReflectMethod method, KnownNat status, diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index d7583dc2..ff87d04b 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -51,7 +51,7 @@ import Servant.API JSON, NoContent (..), NoFraming, OctetStream, Patch, PlainText, Post, Put, QueryFlag, QueryParam, QueryParams, Raw, RemoteHost, ReqBody, SourceIO, StdMethod (..), Stream, Verb, - addHeader) + NoContentVerb, addHeader) import Servant.Server (Context ((:.), EmptyContext), Handler, Server, Tagged (..), emptyServer, err400, err401, err403, err404, serve, serveWithContext) @@ -103,7 +103,7 @@ spec = do type VerbApi method status = Verb method status '[JSON] Person - :<|> "noContent" :> Verb method status '[JSON] NoContent + :<|> "noContent" :> NoContentVerb method :<|> "header" :> Verb method status '[JSON] (Headers '[Header "H" Int] Person) :<|> "headerNC" :> Verb method status '[JSON] (Headers '[Header "H" Int] NoContent) :<|> "accept" :> ( Verb method status '[JSON] Person @@ -140,7 +140,7 @@ verbSpec = describe "Servant.API.Verb" $ do it "returns no content on NoContent" $ do response <- THW.request method "/noContent" [] "" - liftIO $ statusCode (simpleStatus response) `shouldBe` status + liftIO $ statusCode (simpleStatus response) `shouldBe` 204 liftIO $ simpleBody response `shouldBe` "" -- HEAD should not return body diff --git a/servant/src/Servant/API.hs b/servant/src/Servant/API.hs index b9c1c78b..772a3887 100644 --- a/servant/src/Servant/API.hs +++ b/servant/src/Servant/API.hs @@ -130,7 +130,8 @@ import Servant.API.Verbs Post, PostAccepted, PostCreated, PostNoContent, PostNonAuthoritative, PostResetContent, Put, PutAccepted, PutCreated, PutNoContent, PutNonAuthoritative, - ReflectMethod (reflectMethod), StdMethod (..), Verb) + ReflectMethod (reflectMethod), StdMethod (..), + Verb, NoContentVerb) import Servant.API.WithNamedContext (WithNamedContext) import Servant.Links diff --git a/servant/src/Servant/API/Verbs.hs b/servant/src/Servant/API/Verbs.hs index b7d4c048..9ae1c2fd 100644 --- a/servant/src/Servant/API/Verbs.hs +++ b/servant/src/Servant/API/Verbs.hs @@ -29,6 +29,12 @@ import Network.HTTP.Types.Method data Verb (method :: k1) (statusCode :: Nat) (contentTypes :: [*]) (a :: *) deriving (Typeable, Generic) +-- | @NoContentVerb@ is a specific type to represent 'NoContent' responses. +-- It does not require either a list of content types (because there's +-- no content) or a status code (because it should always be 204). +data NoContentVerb (method :: k1) + deriving (Typeable, Generic) + -- * 200 responses -- -- The 200 response is the workhorse of web servers, but also fairly generic. @@ -113,15 +119,15 @@ type PutNonAuthoritative = Verb 'PUT 203 -- If the document view should be reset, use @205 Reset Content@. -- | 'GET' with 204 status code. -type GetNoContent = Verb 'GET 204 +type GetNoContent = NoContentVerb 'GET -- | 'POST' with 204 status code. -type PostNoContent = Verb 'POST 204 +type PostNoContent = NoContentVerb 'POST -- | 'DELETE' with 204 status code. -type DeleteNoContent = Verb 'DELETE 204 +type DeleteNoContent = NoContentVerb 'DELETE -- | 'PATCH' with 204 status code. -type PatchNoContent = Verb 'PATCH 204 +type PatchNoContent = NoContentVerb 'PATCH -- | 'PUT' with 204 status code. -type PutNoContent = Verb 'PUT 204 +type PutNoContent = NoContentVerb 'PUT -- ** 205 Reset Content diff --git a/servant/src/Servant/Links.hs b/servant/src/Servant/Links.hs index 77f882df..0d07c201 100644 --- a/servant/src/Servant/Links.hs +++ b/servant/src/Servant/Links.hs @@ -177,7 +177,7 @@ import Servant.API.TypeLevel import Servant.API.Vault (Vault) import Servant.API.Verbs - (Verb) + (Verb, NoContentVerb) import Servant.API.WithNamedContext (WithNamedContext) import Web.HttpApiData @@ -546,6 +546,10 @@ instance HasLink (Verb m s ct a) where type MkLink (Verb m s ct a) r = r toLink toA _ = toA +instance HasLink (NoContentVerb m) where + type MkLink (NoContentVerb m) r = r + toLink toA _ = toA + instance HasLink Raw where type MkLink Raw a = a toLink toA _ = toA diff --git a/servant/src/Servant/Test/ComprehensiveAPI.hs b/servant/src/Servant/Test/ComprehensiveAPI.hs index 76800be4..4445986a 100644 --- a/servant/src/Servant/Test/ComprehensiveAPI.hs +++ b/servant/src/Servant/Test/ComprehensiveAPI.hs @@ -64,7 +64,7 @@ type ComprehensiveAPIWithoutStreamingOrRaw' endpoint = :<|> "res-headers" :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|> "foo" :> GET :<|> "vault" :> Vault :> GET - :<|> "post-no-content" :> Verb 'POST 204 '[JSON] NoContent + :<|> "post-no-content" :> PostNoContent :<|> "post-int" :> Verb 'POST 204 '[JSON] Int :<|> "named-context" :> WithNamedContext "foo" '[] GET :<|> "capture-all" :> CaptureAll "foo" Int :> GET From 0ec5af11f5b47bdf5e9f4a755947bdf8e99d25fd Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sat, 7 Sep 2019 18:14:07 +0300 Subject: [PATCH 2/6] Fixed docs for NoContent endpoints --- servant-docs/golden/comprehensive.md | 11 +---------- servant-docs/src/Servant/Docs/Internal.hs | 12 ++++++++++++ 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/servant-docs/golden/comprehensive.md b/servant-docs/golden/comprehensive.md index 2277af31..5bb7c4e9 100644 --- a/servant-docs/golden/comprehensive.md +++ b/servant-docs/golden/comprehensive.md @@ -399,16 +399,7 @@ - Status code 204 - Headers: [] -- Supported content types are: - - - `application/json;charset=utf-8` - - `application/json` - -- Example (`application/json;charset=utf-8`, `application/json`): - -```javascript - -``` +- No response body ## GET /raw diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 051a9dbc..d5b51d93 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -862,6 +862,18 @@ instance {-# OVERLAPPABLE #-} status = fromInteger $ natVal (Proxy :: Proxy status) p = Proxy :: Proxy a +instance (ReflectMethod method) => + HasDocs (NoContentVerb method) where + docsFor Proxy (endpoint, action) DocOptions{..} = + single endpoint' action' + + where endpoint' = endpoint & method .~ method' + action' = action & response.respStatus .~ 204 + & response.respTypes .~ [] + & response.respBody .~ [] + & response.respHeaders .~ [] + method' = reflectMethod (Proxy :: Proxy method) + -- | TODO: mention the endpoint is streaming, its framing strategy -- -- Also there are no samples. From 0cbed24f234f0e78e5ea865cc07c217001661263 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sat, 7 Sep 2019 18:25:11 +0300 Subject: [PATCH 3/6] Added HasClient and HasForeign instances for NoContentVerb --- .../src/Servant/Client/Core/HasClient.hs | 17 +++++++++++++++-- servant-client/test/Servant/ClientTestUtils.hs | 4 ++-- servant-foreign/src/Servant/Foreign/Internal.hs | 13 +++++++++++++ 3 files changed, 30 insertions(+), 4 deletions(-) diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 604a3405..879aff31 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -50,8 +50,9 @@ import Servant.API MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData, - ToSourceIO (..), Vault, Verb, WithNamedContext, contentType, - getHeadersHList, getResponse, toQueryParam, toUrlPiece) + ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext, + contentType, getHeadersHList, getResponse, toQueryParam, + toUrlPiece) import Servant.API.ContentTypes (contentTypes) import Servant.API.Modifiers @@ -241,6 +242,18 @@ instance {-# OVERLAPPING #-} hoistClientMonad _ _ f ma = f ma +instance {-# OVERLAPPING #-} + ( RunClient m, ReflectMethod method + ) => HasClient m (NoContentVerb method) where + type Client m (NoContentVerb method) + = m NoContent + clientWithRoute _pm Proxy req = do + _response <- runRequest req { requestMethod = method } + return NoContent + where method = reflectMethod (Proxy :: Proxy method) + + hoistClientMonad _ _ f ma = f ma + instance {-# OVERLAPPING #-} -- Note [Non-Empty Content Types] ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls diff --git a/servant-client/test/Servant/ClientTestUtils.hs b/servant-client/test/Servant/ClientTestUtils.hs index f9fa4ce3..1509574c 100644 --- a/servant-client/test/Servant/ClientTestUtils.hs +++ b/servant-client/test/Servant/ClientTestUtils.hs @@ -85,7 +85,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = Get '[JSON] Person :<|> "get" :> Get '[JSON] Person - :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent + :<|> "deleteEmpty" :> DeleteNoContent :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person @@ -101,7 +101,7 @@ type Api = ReqBody '[JSON] [(String, [Rational])] :> Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) - :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent + :<|> "deleteContentType" :> DeleteNoContent :<|> "redirectWithCookie" :> Raw :<|> "empty" :> EmptyAPI diff --git a/servant-foreign/src/Servant/Foreign/Internal.hs b/servant-foreign/src/Servant/Foreign/Internal.hs index 486177d3..0f3b1248 100644 --- a/servant-foreign/src/Servant/Foreign/Internal.hs +++ b/servant-foreign/src/Servant/Foreign/Internal.hs @@ -244,6 +244,19 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod method) method = reflectMethod (Proxy :: Proxy method) methodLC = toLower $ decodeUtf8 method +instance (HasForeignType lang ftype NoContent, ReflectMethod method) + => HasForeign lang ftype (NoContentVerb method) where + type Foreign ftype (NoContentVerb method) = Req ftype + + foreignFor lang Proxy Proxy req = + req & reqFuncName . _FunctionName %~ (methodLC :) + & reqMethod .~ method + & reqReturnType .~ Just retType + where + retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy NoContent) + method = reflectMethod (Proxy :: Proxy method) + methodLC = toLower $ decodeUtf8 method + -- | TODO: doesn't taking framing into account. instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method) => HasForeign lang ftype (Stream method status framing ct a) where From dcf307d67a34419b0bc53f9d8ad3aa0c64fc7335 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sun, 8 Sep 2019 12:44:10 +0300 Subject: [PATCH 4/6] Fixed tests for servant-http-streams --- servant-http-streams/test/Servant/ClientSpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/servant-http-streams/test/Servant/ClientSpec.hs b/servant-http-streams/test/Servant/ClientSpec.hs index 59197dec..aa0e0fb8 100644 --- a/servant-http-streams/test/Servant/ClientSpec.hs +++ b/servant-http-streams/test/Servant/ClientSpec.hs @@ -115,7 +115,7 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = Get '[JSON] Person :<|> "get" :> Get '[JSON] Person - :<|> "deleteEmpty" :> DeleteNoContent '[JSON] NoContent + :<|> "deleteEmpty" :> DeleteNoContent :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person @@ -131,7 +131,7 @@ type Api = ReqBody '[JSON] [(String, [Rational])] :> Get '[JSON] (String, Maybe Int, Bool, [(String, [Rational])]) :<|> "headers" :> Get '[JSON] (Headers TestHeaders Bool) - :<|> "deleteContentType" :> DeleteNoContent '[JSON] NoContent + :<|> "deleteContentType" :> DeleteNoContent :<|> "redirectWithCookie" :> Raw :<|> "empty" :> EmptyAPI From 8550926d90d022e3c3432b3689be93c363cac029 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sun, 8 Sep 2019 13:32:25 +0300 Subject: [PATCH 5/6] Updated docs --- doc/tutorial/ApiType.lhs | 7 +++---- doc/tutorial/Server.lhs | 26 +++++++++++++------------- 2 files changed, 16 insertions(+), 17 deletions(-) diff --git a/doc/tutorial/ApiType.lhs b/doc/tutorial/ApiType.lhs index 28f3ef9c..365c33a7 100644 --- a/doc/tutorial/ApiType.lhs +++ b/doc/tutorial/ApiType.lhs @@ -177,13 +177,12 @@ type UserAPI5 = "user" :> Capture "userid" Integer :> Get '[JSON] User -- except that we explicitly say that "userid" -- must be an integer - :<|> "user" :> Capture "userid" Integer :> DeleteNoContent '[JSON] NoContent + :<|> "user" :> Capture "userid" Integer :> DeleteNoContent -- equivalent to 'DELETE /user/:userid' ``` -In the second case, `DeleteNoContent` specifies a 204 response code, -`JSON` specifies the content types on which the handler will match, -and `NoContent` says that the response will always be empty. +In the second case, `DeleteNoContent` specifies a 204 response code +and that the response will always be empty. ### `QueryParam`, `QueryParams`, `QueryFlag` diff --git a/doc/tutorial/Server.lhs b/doc/tutorial/Server.lhs index 2714ef89..4b3ff083 100644 --- a/doc/tutorial/Server.lhs +++ b/doc/tutorial/Server.lhs @@ -830,7 +830,7 @@ type UserAPI3 = -- view the user with given userid, in JSON Capture "userid" Int :> Get '[JSON] User :<|> -- delete the user with given userid. empty response - Capture "userid" Int :> DeleteNoContent '[JSON] NoContent + Capture "userid" Int :> DeleteNoContent ``` We can instead factor out the `userid`: @@ -838,7 +838,7 @@ We can instead factor out the `userid`: ``` haskell type UserAPI4 = Capture "userid" Int :> ( Get '[JSON] User - :<|> DeleteNoContent '[JSON] NoContent + :<|> DeleteNoContent ) ``` @@ -896,13 +896,13 @@ type API1 = "users" :> -- we factor out the Request Body type API2 = ReqBody '[JSON] User :> ( Get '[JSON] User -- just display the same user back, don't register it - :<|> PostNoContent '[JSON] NoContent -- register the user. empty response + :<|> PostNoContent -- register the user. empty response ) -- we factor out a Header type API3 = Header "Authorization" Token :> ( Get '[JSON] SecretData -- get some secret data, if authorized - :<|> ReqBody '[JSON] SecretData :> PostNoContent '[JSON] NoContent -- add some secret data, if authorized + :<|> ReqBody '[JSON] SecretData :> PostNoContent -- add some secret data, if authorized ) newtype Token = Token ByteString @@ -915,11 +915,11 @@ API type only at the end. ``` haskell type UsersAPI = Get '[JSON] [User] -- list users - :<|> ReqBody '[JSON] User :> PostNoContent '[JSON] NoContent -- add a user + :<|> ReqBody '[JSON] User :> PostNoContent -- add a user :<|> Capture "userid" Int :> ( Get '[JSON] User -- view a user - :<|> ReqBody '[JSON] User :> PutNoContent '[JSON] NoContent -- update a user - :<|> DeleteNoContent '[JSON] NoContent -- delete a user + :<|> ReqBody '[JSON] User :> PutNoContent -- update a user + :<|> DeleteNoContent -- delete a user ) usersServer :: Server UsersAPI @@ -948,11 +948,11 @@ usersServer = getUsers :<|> newUser :<|> userOperations ``` haskell type ProductsAPI = Get '[JSON] [Product] -- list products - :<|> ReqBody '[JSON] Product :> PostNoContent '[JSON] NoContent -- add a product + :<|> ReqBody '[JSON] Product :> PostNoContent -- add a product :<|> Capture "productid" Int :> ( Get '[JSON] Product -- view a product - :<|> ReqBody '[JSON] Product :> PutNoContent '[JSON] NoContent -- update a product - :<|> DeleteNoContent '[JSON] NoContent -- delete a product + :<|> ReqBody '[JSON] Product :> PutNoContent -- update a product + :<|> DeleteNoContent -- delete a product ) data Product = Product { productId :: Int } @@ -996,11 +996,11 @@ abstract that away: -- indexed by values of type 'i' type APIFor a i = Get '[JSON] [a] -- list 'a's - :<|> ReqBody '[JSON] a :> PostNoContent '[JSON] NoContent -- add an 'a' + :<|> ReqBody '[JSON] a :> PostNoContent -- add an 'a' :<|> Capture "id" i :> ( Get '[JSON] a -- view an 'a' given its "identifier" of type 'i' - :<|> ReqBody '[JSON] a :> PutNoContent '[JSON] NoContent -- update an 'a' - :<|> DeleteNoContent '[JSON] NoContent -- delete an 'a' + :<|> ReqBody '[JSON] a :> PutNoContent -- update an 'a' + :<|> DeleteNoContent -- delete an 'a' ) -- Build the appropriate 'Server' From b4372b5c148f6ff8d359295a86eecf397c306439 Mon Sep 17 00:00:00 2001 From: Catherine Galkina Date: Sun, 8 Sep 2019 15:04:18 +0300 Subject: [PATCH 6/6] Removed unnecessary OVERLAPPING/OVERLAPPABLE pragmas --- servant-client-core/src/Servant/Client/Core/HasClient.hs | 5 ++--- servant-server/src/Servant/Server/Internal.hs | 5 ++--- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/servant-client-core/src/Servant/Client/Core/HasClient.hs b/servant-client-core/src/Servant/Client/Core/HasClient.hs index 879aff31..78307244 100644 --- a/servant-client-core/src/Servant/Client/Core/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/HasClient.hs @@ -242,9 +242,8 @@ instance {-# OVERLAPPING #-} hoistClientMonad _ _ f ma = f ma -instance {-# OVERLAPPING #-} - ( RunClient m, ReflectMethod method - ) => HasClient m (NoContentVerb method) where +instance (RunClient m, ReflectMethod method) => + HasClient m (NoContentVerb method) where type Client m (NoContentVerb method) = m NoContent clientWithRoute _pm Proxy req = do diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index 196895cf..b9a94035 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -298,9 +298,8 @@ instance {-# OVERLAPPING #-} where method = reflectMethod (Proxy :: Proxy method) status = toEnum . fromInteger $ natVal (Proxy :: Proxy status) -instance {-# OVERLAPPABLE #-} - (ReflectMethod method - ) => HasServer (NoContentVerb method) context where +instance (ReflectMethod method) => + HasServer (NoContentVerb method) context where type ServerT (NoContentVerb method) m = m NoContent hoistServerWithContext _ _ nt s = nt s