diff --git a/servant-client/CHANGELOG.md b/servant-client/CHANGELOG.md index 814e20f9..7667277c 100644 --- a/servant-client/CHANGELOG.md +++ b/servant-client/CHANGELOG.md @@ -1,5 +1,6 @@ 0.3 --- +* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Support content-type aware combinators and `Accept`/`Content-type` headers * Added a lot of tests * Support multiple concurrent threads diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 67b6c8de..2a9007c6 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -117,11 +117,41 @@ instance (KnownSymbol capture, ToText a, HasClient sublayout) -- side querying function that is created when calling 'client' -- will just require an argument that specifies the scheme, host -- and port to send the request to. -instance HasClient Delete where - type Client Delete = BaseUrl -> EitherT ServantError IO () - +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPABLE #-} +#endif + (MimeUnrender ct a) => HasClient (Delete (ct ': cts) a) where + type Client (Delete (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a clientWithRoute Proxy req host = - void $ performRequest H.methodDelete req (`elem` [200, 202, 204]) host + snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] host + +-- | If you have a 'Delete xs ()' endpoint, the client expects a 204 No Content +-- HTTP header. +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPING #-} +#endif + HasClient (Delete (ct ': cts) ()) where + type Client (Delete (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO () + clientWithRoute Proxy req host = + void $ performRequestNoBody H.methodDelete req [204] host + +-- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the +-- corresponding headers. +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPING #-} +#endif + ( MimeUnrender ct a, BuildHeadersTo ls + ) => HasClient (Delete (ct ': cts) (Headers ls a)) where + type Client (Delete (ct ': cts) (Headers ls a)) = BaseUrl -> EitherT ServantError IO (Headers ls a) + clientWithRoute Proxy req host = do + (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req [200, 202] host + return $ Headers { getResponse = resp + , getHeadersHList = buildHeadersTo hdrs + } + -- | If you have a 'Get' endpoint in your API, the client -- side querying function that is created when calling 'client' diff --git a/servant-client/test/Servant/ClientSpec.hs b/servant-client/test/Servant/ClientSpec.hs index 382b3c79..87849465 100644 --- a/servant-client/test/Servant/ClientSpec.hs +++ b/servant-client/test/Servant/ClientSpec.hs @@ -79,7 +79,8 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] type Api = "get" :> Get '[JSON] Person - :<|> "delete" :> Delete + :<|> "delete" :> Delete '[JSON] () + :<|> "deleteString" :> Delete '[JSON] String :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person @@ -104,6 +105,7 @@ server :: Application server = serve api ( return alice :<|> return () + :<|> return "ok" :<|> (\ name -> return $ Person name 0) :<|> return :<|> (\ name -> case name of @@ -129,6 +131,7 @@ withServer action = withWaiDaemon (return server) action getGet :: BaseUrl -> EitherT ServantError IO Person getDelete :: BaseUrl -> EitherT ServantError IO () +getDeleteString :: BaseUrl -> EitherT ServantError IO String getCapture :: String -> BaseUrl -> EitherT ServantError IO Person getBody :: Person -> BaseUrl -> EitherT ServantError IO Person getQueryParam :: Maybe String -> BaseUrl -> EitherT ServantError IO Person @@ -147,6 +150,7 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] getRespHeaders :: BaseUrl -> EitherT ServantError IO (Headers TestHeaders Bool) ( getGet :<|> getDelete + :<|> getDeleteString :<|> getCapture :<|> getBody :<|> getQueryParam @@ -183,8 +187,12 @@ spec = do it "Servant.API.Get" $ withServer $ \ host -> do (Arrow.left show <$> runEitherT (getGet host)) `shouldReturn` Right alice - it "Servant.API.Delete" $ withServer $ \ host -> do - (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right () + context "Servant.API.Delete" $ do + it "return no body" $ withServer $ \ host -> do + (Arrow.left show <$> runEitherT (getDelete host)) `shouldReturn` Right () + + it "return body" $ withServer $ \ host -> do + (Arrow.left show <$> runEitherT (getDeleteString host)) `shouldReturn` Right "ok" it "Servant.API.Capture" $ withServer $ \ host -> do (Arrow.left show <$> runEitherT (getCapture "Paula" host)) `shouldReturn` Right (Person "Paula" 0) @@ -268,7 +276,7 @@ spec = do Left FailureResponse{..} <- runEitherT (getResponse host) responseStatus `shouldBe` (Status 500 "error message") mapM_ test $ - (WrappedApi (Proxy :: Proxy Delete), "Delete") : + (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") : (WrappedApi (Proxy :: Proxy (Post '[JSON] ())), "Post") : (WrappedApi (Proxy :: Proxy (Put '[JSON] ())), "Put") : diff --git a/servant-docs/CHANGELOG.md b/servant-docs/CHANGELOG.md index 94524a55..44cbdde5 100644 --- a/servant-docs/CHANGELOG.md +++ b/servant-docs/CHANGELOG.md @@ -1,5 +1,6 @@ 0.4 --- +* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Allow for extra information to be added to the docs * Support content-type aware combinators of *servant-0.3* * Render endpoints in a canonical order (https://github.com/haskell-servant/servant-docs/pull/15) diff --git a/servant-docs/example/greet.hs b/servant-docs/example/greet.hs index 0a8cdb2b..1835b290 100644 --- a/servant-docs/example/greet.hs +++ b/servant-docs/example/greet.hs @@ -53,6 +53,9 @@ instance ToParam (MatrixParam "lang" String) where "Get the greeting message selected language. Default is en." Normal +instance ToSample () () where + toSample _ = Just () + instance ToSample Greet Greet where toSample _ = Just $ Greet "Hello, haskeller!" @@ -90,7 +93,7 @@ type TestApi = :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] (Headers '[Header "X-Example" Int] Greet) -- DELETE /greet/:greetid - :<|> "greet" :> Capture "greetid" Text :> Delete + :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] () testApi :: Proxy TestApi testApi = Proxy @@ -100,7 +103,7 @@ testApi = Proxy -- notes. extra :: ExtraInfo TestApi extra = - extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete)) $ + extraInfo (Proxy :: Proxy ("greet" :> Capture "greetid" Text :> Delete '[JSON] ())) $ defAction & headers <>~ ["unicorns"] & notes <>~ [ DocNote "Title" ["This is some text"] , DocNote "Second secton" ["And some more"] diff --git a/servant-docs/src/Servant/Docs/Internal.hs b/servant-docs/src/Servant/Docs/Internal.hs index 4baf6396..f0e18456 100644 --- a/servant-docs/src/Servant/Docs/Internal.hs +++ b/servant-docs/src/Servant/Docs/Internal.hs @@ -651,14 +651,38 @@ instance (KnownSymbol sym, ToCapture (Capture sym a), HasDocs sublayout) symP = Proxy :: Proxy sym -instance HasDocs Delete where +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPABLe #-} +#endif + (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts) + => HasDocs (Delete cts a) where docsFor Proxy (endpoint, action) = single endpoint' action' where endpoint' = endpoint & method .~ DocDELETE + action' = action & response.respBody .~ sampleByteStrings t p + & response.respTypes .~ supportedTypes t + t = Proxy :: Proxy cts + p = Proxy :: Proxy a - action' = action & response.respBody .~ [] - & response.respStatus .~ 204 +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPING #-} +#endif + (ToSample a b, IsNonEmpty cts, AllMimeRender cts b, SupportedTypes cts + , AllHeaderSamples ls , GetHeaders (HList ls) ) + => HasDocs (Delete cts (Headers ls a)) where + docsFor Proxy (endpoint, action) = + single endpoint' action' + + where hdrs = allHeaderToSample (Proxy :: Proxy ls) + endpoint' = endpoint & method .~ DocDELETE + action' = action & response.respBody .~ sampleByteStrings t p + & response.respTypes .~ supportedTypes t + & response.respHeaders .~ hdrs + t = Proxy :: Proxy cts + p = Proxy :: Proxy a instance #if MIN_VERSION_base(4,8,0) diff --git a/servant-jquery/CHANGELOG.md b/servant-jquery/CHANGELOG.md index 99eeaf5f..e3a18b22 100644 --- a/servant-jquery/CHANGELOG.md +++ b/servant-jquery/CHANGELOG.md @@ -1,5 +1,6 @@ 0.3 --- +* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Extend `HeaderArg` to support more advanced HTTP header handling (https://github.com/haskell-servant/servant-jquery/pull/6) * Support content-type aware combinators (but require that endpoints support JSON) * Add support for Matrix params (https://github.com/haskell-servant/servant-jquery/pull/11) diff --git a/servant-jquery/src/Servant/JQuery/Internal.hs b/servant-jquery/src/Servant/JQuery/Internal.hs index 85896c2b..15810a2f 100644 --- a/servant-jquery/src/Servant/JQuery/Internal.hs +++ b/servant-jquery/src/Servant/JQuery/Internal.hs @@ -215,8 +215,8 @@ instance (KnownSymbol sym, HasJQ sublayout) where str = symbolVal (Proxy :: Proxy sym) -instance HasJQ Delete where - type JQ Delete = AjaxReq +instance Elem JSON list => HasJQ (Delete list a) where + type JQ (Delete list a) = AjaxReq jqueryFor Proxy req = req & funcName %~ ("delete" <>) diff --git a/servant-server/CHANGELOG.md b/servant-server/CHANGELOG.md index 0a75ffb0..433f9caf 100644 --- a/servant-server/CHANGELOG.md +++ b/servant-server/CHANGELOG.md @@ -1,5 +1,6 @@ 0.3 --- +* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Add a `RouteMismatch` constructor for arbitrary HTTP response codes (https://github.com/haskell-servant/servant-server/pull/22) * Add support for the `Patch` combinator * Support for `Accept`/`Content-type` headers and for the content-type aware combinators in *servant-0.3* diff --git a/servant-server/example/greet.hs b/servant-server/example/greet.hs index 78521af6..4c9df6ef 100644 --- a/servant-server/example/greet.hs +++ b/servant-server/example/greet.hs @@ -34,7 +34,7 @@ type TestApi = :<|> "greet" :> ReqBody '[JSON] Greet :> Post '[JSON] Greet -- DELETE /greet/:greetid - :<|> "greet" :> Capture "greetid" Text :> Delete + :<|> "greet" :> Capture "greetid" Text :> Delete '[JSON] () testApi :: Proxy TestApi testApi = Proxy diff --git a/servant-server/src/Servant/Server/Internal.hs b/servant-server/src/Servant/Server/Internal.hs index a712e757..423e7ac1 100644 --- a/servant-server/src/Servant/Server/Internal.hs +++ b/servant-server/src/Servant/Server/Internal.hs @@ -258,20 +258,74 @@ instance (KnownSymbol capture, FromText a, HasServer sublayout) -- to be returned. You can use 'Control.Monad.Trans.Either.left' to -- painlessly error out if the conditions for a successful deletion -- are not met. -instance HasServer Delete where +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPABLE #-} +#endif + ( AllCTRender ctypes a + ) => HasServer (Delete ctypes a) where - type ServerT Delete m = m () + type ServerT (Delete ctypes a) m = m a route Proxy action request respond | pathIsEmpty request && requestMethod request == methodDelete = do e <- runEitherT action - respond $ succeedWith $ case e of - Right () -> responseLBS status204 [] "" + respond $ case e of + Right output -> do + let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request + case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of + Nothing -> failWith UnsupportedMediaType + Just (contentT, body) -> succeedWith $ + responseLBS status200 [ ("Content-Type" , cs contentT)] body + Left err -> succeedWith $ responseServantErr err + | pathIsEmpty request && requestMethod request /= methodDelete = + respond $ failWith WrongMethod + | otherwise = respond $ failWith NotFound + +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPING #-} +#endif + HasServer (Delete ctypes ()) where + + type ServerT (Delete ctypes ()) m = m () + + route Proxy action request respond + | pathIsEmpty request && requestMethod request == methodDelete = do + e <- runEitherT action + respond . succeedWith $ case e of + Right () -> responseLBS noContent204 [] "" Left err -> responseServantErr err | pathIsEmpty request && requestMethod request /= methodDelete = respond $ failWith WrongMethod | otherwise = respond $ failWith NotFound +-- Add response headers +instance +#if MIN_VERSION_base(4,8,0) + {-# OVERLAPPING #-} +#endif + ( GetHeaders (Headers h v), AllCTRender ctypes v + ) => HasServer (Delete ctypes (Headers h v)) where + + type ServerT (Delete ctypes (Headers h v)) m = m (Headers h v) + + route Proxy action request respond + | pathIsEmpty request && requestMethod request == methodDelete = do + e <- runEitherT action + respond $ case e of + Right output -> do + let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request + headers = getHeaders output + case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of + Nothing -> failWith UnsupportedMediaType + Just (contentT, body) -> succeedWith $ + responseLBS status200 ( ("Content-Type" , cs contentT) : headers) body + Left err -> succeedWith $ responseServantErr err + | pathIsEmpty request && requestMethod request /= methodDelete = + respond $ failWith WrongMethod + | otherwise = respond $ failWith NotFound + -- | When implementing the handler for a 'Get' endpoint, -- just like for 'Servant.API.Delete.Delete', 'Servant.API.Post.Post' -- and 'Servant.API.Put.Put', the handler code runs in the diff --git a/servant-server/test/Servant/ServerSpec.hs b/servant-server/test/Servant/ServerSpec.hs index be8f0665..2689a4e2 100644 --- a/servant-server/test/Servant/ServerSpec.hs +++ b/servant-server/test/Servant/ServerSpec.hs @@ -443,7 +443,7 @@ patchSpec = do , "application/nonsense")] patch'' "/" "anything at all" `shouldRespondWith` 415 -type HeaderApi a = Header "MyHeader" a :> Delete +type HeaderApi a = Header "MyHeader" a :> Delete '[JSON] () headerApi :: Proxy (HeaderApi a) headerApi = Proxy @@ -503,7 +503,7 @@ type AlternativeApi = :<|> "foo" :> Get '[PlainText] T.Text :<|> "bar" :> Post '[JSON] Animal :<|> "bar" :> Put '[JSON] Animal - :<|> "bar" :> Delete + :<|> "bar" :> Delete '[JSON] () unionApi :: Proxy AlternativeApi unionApi = Proxy diff --git a/servant/CHANGELOG.md b/servant/CHANGELOG.md index 80c864f9..92973987 100644 --- a/servant/CHANGELOG.md +++ b/servant/CHANGELOG.md @@ -1,5 +1,6 @@ 0.3 --- +* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body * Multiple content-type/accept support for all the relevant combinators * Provide *JSON*, *PlainText*, *OctetStream* and *FormUrlEncoded* content types out of the box * Type-safe link generation to API endpoints diff --git a/servant/src/Servant/API/Delete.hs b/servant/src/Servant/API/Delete.hs index cca4ae37..9bfb0166 100644 --- a/servant/src/Servant/API/Delete.hs +++ b/servant/src/Servant/API/Delete.hs @@ -1,4 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE KindSignatures #-} {-# OPTIONS_HADDOCK not-home #-} module Servant.API.Delete (Delete) where @@ -10,7 +12,7 @@ import Data.Typeable ( Typeable ) -- -- >>> -- DELETE /books/:isbn -- >>> type MyApi = "books" :> Capture "isbn" Text :> Delete -data Delete +data Delete (contentTypes :: [*]) a deriving Typeable diff --git a/servant/src/Servant/Utils/Links.hs b/servant/src/Servant/Utils/Links.hs index b1df40c0..2a5cebf0 100644 --- a/servant/src/Servant/Utils/Links.hs +++ b/servant/src/Servant/Utils/Links.hs @@ -22,7 +22,7 @@ -- >>> -- >>> -- >>> type Hello = "hello" :> Get '[JSON] Int --- >>> type Bye = "bye" :> QueryParam "name" String :> Delete +-- >>> type Bye = "bye" :> QueryParam "name" String :> Delete '[JSON] () -- >>> type API = Hello :<|> Bye -- >>> let api = Proxy :: Proxy API -- @@ -48,11 +48,11 @@ -- If the API has an endpoint with parameters then we can generate links with -- or without those: -- --- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete) +-- >>> let with = Proxy :: Proxy ("bye" :> QueryParam "name" String :> Delete '[JSON] ()) -- >>> print $ safeLink api with "Hubert" -- bye?name=Hubert -- --- >>> let without = Proxy :: Proxy ("bye" :> Delete) +-- >>> let without = Proxy :: Proxy ("bye" :> Delete '[JSON] ()) -- >>> print $ safeLink api without -- bye -- @@ -70,15 +70,15 @@ -- Attempting to construct a link to an endpoint that does not exist in api -- will result in a type error like this: -- --- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete) +-- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] ()) -- >>> safeLink api bad_link -- -- :64:1: -- Could not deduce (Or --- (IsElem' Delete (Get '[JSON] Int)) +-- (IsElem' (Delete '[JSON] ()) (Get '[JSON] Int)) -- (IsElem' --- ("hello" :> Delete) --- ("bye" :> (QueryParam "name" String :> Delete)))) +-- ("hello" :> Delete '[JSON] ()) +-- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ())))) -- arising from a use of ‘safeLink’ -- In the expression: safeLink api bad_link -- In an equation for ‘it’: it = safeLink api bad_link @@ -176,6 +176,7 @@ type family IsElem endpoint api :: Constraint where IsElem (Get ct typ) (Get ct' typ) = IsSubList ct ct' IsElem (Post ct typ) (Post ct' typ) = IsSubList ct ct' IsElem (Put ct typ) (Put ct' typ) = IsSubList ct ct' + IsElem (Delete ct typ) (Delete ct' typ) = IsSubList ct ct' IsElem e e = () IsElem e a = IsElem' e a @@ -349,8 +350,8 @@ instance HasLink (Put y r) where type MkLink (Put y r) = URI toLink _ = linkURI -instance HasLink Delete where - type MkLink Delete = URI +instance HasLink (Delete y r) where + type MkLink (Delete y r) = URI toLink _ = linkURI instance HasLink Raw where diff --git a/servant/test/Servant/Utils/LinksSpec.hs b/servant/test/Servant/Utils/LinksSpec.hs index ca017be6..0fa17b3a 100644 --- a/servant/test/Servant/Utils/LinksSpec.hs +++ b/servant/test/Servant/Utils/LinksSpec.hs @@ -12,20 +12,20 @@ import Servant.API type TestApi = -- Capture and query/matrix params - "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete + "hello" :> Capture "name" String :> QueryParam "capital" Bool :> Delete '[JSON] () :<|> "parent" :> MatrixParams "name" String :> "child" :> MatrixParam "gender" String :> Get '[JSON] String -- Flags - :<|> "ducks" :> MatrixFlag "yellow" :> MatrixFlag "loud" :> Delete - :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete + :<|> "ducks" :> MatrixFlag "yellow" :> MatrixFlag "loud" :> Delete '[JSON] () + :<|> "balls" :> QueryFlag "bouncy" :> QueryFlag "fast" :> Delete '[JSON] () -- All of the verbs :<|> "get" :> Get '[JSON] () :<|> "put" :> Put '[JSON] () :<|> "post" :> ReqBody '[JSON] 'True :> Post '[JSON] () - :<|> "delete" :> Header "ponies" :> Delete + :<|> "delete" :> Header "ponies" :> Delete '[JSON] () :<|> "raw" :> Raw type TestLink = "hello" :> "hi" :> Get '[JSON] Bool @@ -55,12 +55,12 @@ shouldBeURI link expected = spec :: Spec spec = describe "Servant.Utils.Links" $ do it "Generates correct links for capture query and matrix params" $ do - let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete) + let l1 = Proxy :: Proxy ("hello" :> Capture "name" String :> Delete '[JSON] ()) apiLink l1 "hi" `shouldBeURI` "hello/hi" let l2 = Proxy :: Proxy ("hello" :> Capture "name" String :> QueryParam "capital" Bool - :> Delete) + :> Delete '[JSON] ()) apiLink l2 "bye" True `shouldBeURI` "hello/bye?capital=true" let l3 = Proxy :: Proxy ("parent" :> MatrixParams "name" String @@ -73,12 +73,12 @@ spec = describe "Servant.Utils.Links" $ do it "Generates correct links for query and matrix flags" $ do let l1 = Proxy :: Proxy ("balls" :> QueryFlag "bouncy" - :> QueryFlag "fast" :> Delete) + :> QueryFlag "fast" :> Delete '[JSON] ()) apiLink l1 True True `shouldBeURI` "balls?bouncy&fast" apiLink l1 False True `shouldBeURI` "balls?fast" let l2 = Proxy :: Proxy ("ducks" :> MatrixFlag "yellow" - :> MatrixFlag "loud" :> Delete) + :> MatrixFlag "loud" :> Delete '[JSON] ()) apiLink l2 True True `shouldBeURI` "ducks;yellow;loud" apiLink l2 False True `shouldBeURI` "ducks;loud" @@ -86,5 +86,5 @@ spec = describe "Servant.Utils.Links" $ do apiLink (Proxy :: Proxy ("get" :> Get '[JSON] ())) `shouldBeURI` "get" apiLink (Proxy :: Proxy ("put" :> Put '[JSON] ())) `shouldBeURI` "put" apiLink (Proxy :: Proxy ("post" :> Post '[JSON] ())) `shouldBeURI` "post" - apiLink (Proxy :: Proxy ("delete" :> Delete)) `shouldBeURI` "delete" + apiLink (Proxy :: Proxy ("delete" :> Delete '[JSON] ())) `shouldBeURI` "delete" apiLink (Proxy :: Proxy ("raw" :> Raw)) `shouldBeURI` "raw"