git.iko.soy/servant
on fc67c3b help sign in
servant/src/Servant/API/Delete.hs
60 lines 1.9 kB history raw
1{-# LANGUAGE TypeFamilies #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4module Servant.API.Delete where
6import Control.Monad
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Either
9import Data.Proxy
10import Data.String.Conversions
11import Network.HTTP.Types
12import Network.URI
13import Network.Wai
14import Servant.Client
15import Servant.Docs
16import Servant.Server
18import qualified Network.HTTP.Client as Client
20-- | Endpoint for DELETE requests.
21data Delete
23instance HasServer Delete where
24 type Server Delete = EitherT (Int, String) IO ()
26 route Proxy action request respond
27 | null (pathInfo request) && requestMethod request == methodDelete = do
28 e <- runEitherT action
29 respond $ succeedWith $ case e of
30 Right () ->
31 responseLBS status204 [] ""
32 Left (status, message) ->
33 responseLBS (mkStatus status (cs message)) [] (cs message)
34 | null (pathInfo request) && requestMethod request /= methodDelete =
35 respond $ failWith WrongMethod
36 | otherwise = respond $ failWith NotFound
38instance HasClient Delete where
39 type Client Delete = URI -> EitherT String IO ()
41 clientWithRoute Proxy req uri = do
42 partialRequest <- liftIO $ reqToRequest req uri
44 let request = partialRequest { Client.method = methodDelete
45 }
47 innerResponse <- liftIO . __withGlobalManager $ \ manager ->
48 Client.httpLbs request manager
50 when (Client.responseStatus innerResponse /= status204) $
51 left ("HTTP DELETE request failed with status: " ++ show (Client.responseStatus innerResponse))
53instance HasDocs Delete where
54 docsFor Proxy (endpoint, action) =
55 single endpoint' action'
57 where endpoint' = endpoint & method .~ DocDELETE
59 action' = action & response.respBody .~ Nothing
60 & response.respStatus .~ 204