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

Refactor NoContentVerb into NoContentVerbWithStatus (#1532)

Browse Source 
There are several HTTP status codes that correspond to a response body
with `NoContent`. This commit introduces `NoContentVerbWithStatus` which
generalizes `NoContentVerb` to cases when the return status may be
different from 204. The former replaces the latter anywhere possible.

`NoContentVerb` is kept as a special case of `NoContentVerbWithStatus`
for backwards compatibility.
This commit is contained in:
Nicolas BACQUEY 2022-03-03 16:37:29 +01:00
parent d05da71f09
commit 0a1d32d21e
8 changed files with 42 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
servant-client-core/src/Servant/Client/Core/HasClient.hs
View File

@ -74,7 +74,7 @@ import Servant.API
FromSourceIO (..), Header', Headers (..), HttpVersion,
IsSecure, MimeRender (mimeRender),
MimeUnrender (mimeUnrender), NoContent (NoContent),
NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
NoContentVerbWithStatus, QueryFlag, QueryParam', QueryParams, Raw,
ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
@ -280,14 +280,16 @@ instance {-# OVERLAPPING #-}
hoistClientMonad _ _ f ma = f ma
instance (RunClient m, ReflectMethod method) =>
HasClient m (NoContentVerb method) where
type Client m (NoContentVerb method)
instance
( RunClient m, ReflectMethod method, KnownNat status
) => HasClient m (NoContentVerbWithStatus method status) where
type Client m (NoContentVerbWithStatus method status)
= m NoContent
clientWithRoute _pm Proxy req = do
_response <- runRequest req { requestMethod = method }
_response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
return NoContent
where method = reflectMethod (Proxy :: Proxy method)
status = statusFromNat (Proxy :: Proxy status)
hoistClientMonad _ _ f ma = f ma

7
servant-docs/src/Servant/Docs/Internal.hs
View File

@ -961,17 +961,18 @@ instance {-# OVERLAPPABLE #-}
status = fromInteger $ natVal (Proxy :: Proxy status)
p = Proxy :: Proxy a
instance (ReflectMethod method) =>
HasDocs (NoContentVerb method) where
instance (KnownNat status, ReflectMethod method) =>
HasDocs (NoContentVerbWithStatus method status) where
docsFor Proxy (endpoint, action) DocOptions{..} =
single endpoint' action'
where endpoint' = endpoint & method .~ method'
action' = action & response.respStatus .~ 204
action' = action & response.respStatus .~ status
& response.respTypes .~ []
& response.respBody .~ []
& response.respHeaders .~ []
method' = reflectMethod (Proxy :: Proxy method)
status = fromInteger $ natVal (Proxy :: Proxy status)
-- | TODO: mention the endpoint is streaming, its framing strategy
--

4
servant-foreign/src/Servant/Foreign/Internal.hs
View File

@ -337,8 +337,8 @@ instance (Elem JSON list, HasForeignType lang ftype a, ReflectMethod 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
=> HasForeign lang ftype (NoContentVerbWithStatus method status) where
type Foreign ftype (NoContentVerbWithStatus method status) = Req ftype
foreignFor lang Proxy Proxy req =
req & reqFuncName . _FunctionName %~ (methodLC :)

11
servant-server/src/Servant/Server/Internal.hs
View File

@ -72,7 +72,7 @@ import Servant.API
((:<|>) (..), (:>), Accept (..), BasicAuth, Capture',
CaptureAll, Description, EmptyAPI, Fragment,
FramingRender (..), FramingUnrender (..), FromSourceIO (..),
Header', If, IsSecure (..), NoContentVerb, QueryFlag,
Header', If, IsSecure (..), NoContentVerbWithStatus, QueryFlag,
QueryParam', QueryParams, Raw, ReflectMethod (reflectMethod),
RemoteHost, ReqBody', SBool (..), SBoolI (..), SourceIO,
Stream, StreamBody', Summary, ToSourceIO (..), Vault, Verb,
@ -315,14 +315,15 @@ instance {-# OVERLAPPING #-}
where method = reflectMethod (Proxy :: Proxy method)
status = statusFromNat (Proxy :: Proxy status)
instance (ReflectMethod method) =>
HasServer (NoContentVerb method) context where
instance (KnownNat status, ReflectMethod method) =>
HasServer (NoContentVerbWithStatus method status) context where
type ServerT (NoContentVerb method) m = m NoContent
type ServerT (NoContentVerbWithStatus method status) m = m NoContent
hoistServerWithContext _ _ nt s = nt s
route Proxy _ = noContentRouter method status204
route Proxy _ = noContentRouter method status
where method = reflectMethod (Proxy :: Proxy method)
status = statusFromNat (Proxy :: Proxy status)
instance {-# OVERLAPPABLE #-}
( MimeRender ctype chunk, ReflectMethod method, KnownNat status,

10
servant-swagger/src/Servant/Swagger/Internal.hs
View File

@ -132,10 +132,10 @@ mkEndpointWithSchemaRef mref path _ = mempty
responseContentTypes = allContentType (Proxy :: Proxy cs)
responseHeaders = toAllResponseHeaders (Proxy :: Proxy hs)
mkEndpointNoContentVerb :: forall proxy method.
(SwaggerMethod method)
mkEndpointNoContentVerb :: forall proxy method status.
(SwaggerMethod method, KnownNat status)
=> FilePath -- ^ Endpoint path.
-> proxy (NoContentVerb method) -- ^ Method
-> proxy (NoContentVerbWithStatus method status) -- ^ Method
-> Swagger
mkEndpointNoContentVerb path _ = mempty
& paths.at path ?~
@ -143,7 +143,7 @@ mkEndpointNoContentVerb path _ = mempty
& at code ?~ Inline mempty))
where
method = swaggerMethod (Proxy :: Proxy method)
code = 204 -- hardcoded in servant-server
code = fromIntegral (natVal (Proxy :: Proxy status))
-- | Add parameter to every operation in the spec.
addParam :: Param -> Swagger -> Swagger
@ -266,7 +266,7 @@ instance (AllAccept cs, AllToResponseHeader hs, KnownNat status, SwaggerMethod m
=> HasSwagger (Verb method status cs (Headers hs NoContent)) where
toSwagger = mkEndpointNoContent "/"
instance (SwaggerMethod method) => HasSwagger (NoContentVerb method) where
instance (KnownNat status, SwaggerMethod method) => HasSwagger (NoContentVerbWithStatus method status) where
toSwagger = mkEndpointNoContentVerb "/"
instance (HasSwagger a, HasSwagger b) => HasSwagger (a :<|> b) where

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

@ -139,11 +139,12 @@ import Servant.API.Verbs
(Delete, DeleteAccepted, DeleteNoContent,
DeleteNonAuthoritative, Get, GetAccepted, GetNoContent,
GetNonAuthoritative, GetPartialContent, GetResetContent,
NoContentVerb, Patch, PatchAccepted, PatchNoContent,
PatchNonAuthoritative, Post, PostAccepted, PostCreated,
PostNoContent, PostNonAuthoritative, PostResetContent, Put,
PutAccepted, PutCreated, PutNoContent, PutNonAuthoritative,
ReflectMethod (reflectMethod), StdMethod (..), Verb)
NoContentVerb, NoContentVerbWithStatus, Patch, PatchAccepted,
PatchNoContent, PatchNonAuthoritative, Post, PostAccepted,
PostCreated, PostNoContent, PostNonAuthoritative,
PostResetContent, Put, PutAccepted, PutCreated, PutNoContent,
PutNonAuthoritative, ReflectMethod (reflectMethod),
StdMethod (..), Verb)
import Servant.API.WithNamedContext
(WithNamedContext)
import Servant.Links

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

@ -29,12 +29,17 @@ 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)
-- | @NoContentVerbWithStatus@ is a specific type to represent 'NoContent' responses.
-- It does not require either a list of content types (because there's no content).
-- It still requires a status code, because several statuses may have no content.
-- (e.g. 204, 301, 302, or 303).
data NoContentVerbWithStatus (method :: k1) (statusCode :: Nat)
deriving (Typeable, Generic)
-- | @NoContentVerb@ is a specialization of type @NoContentVerbWithStatus@,
-- which is kept for backwards compatibility.
type NoContentVerb (method :: k1) = NoContentVerbWithStatus method 204
-- * 200 responses
--
-- The 200 response is the workhorse of web servers, but also fairly generic.

6
servant/src/Servant/Links.hs
View File

@ -189,7 +189,7 @@ import Servant.API.UVerb
import Servant.API.Vault
(Vault)
import Servant.API.Verbs
(Verb, NoContentVerb)
(Verb, NoContentVerbWithStatus)
import Servant.API.WithNamedContext
(WithNamedContext)
import Web.HttpApiData
@ -572,8 +572,8 @@ 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
instance HasLink (NoContentVerbWithStatus m s) where
type MkLink (NoContentVerbWithStatus m s) r = r
toLink toA _ = toA
instance HasLink Raw where