53 lines
1.9 KiB
Haskell
53 lines
1.9 KiB
Haskell
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
module Servant.API.Put where
|
|
|
|
import Control.Monad.Trans.Either
|
|
import Data.Aeson
|
|
import Data.Proxy
|
|
import Data.String.Conversions
|
|
import Data.Typeable
|
|
import Network.HTTP.Types
|
|
import Network.Wai
|
|
import Servant.Server
|
|
|
|
-- | Endpoint for PUT requests, usually used to update a ressource.
|
|
-- The type @a@ is the type of the response body that's returned.
|
|
--
|
|
-- Example:
|
|
--
|
|
-- > -- PUT /books/:isbn
|
|
-- > -- with a Book as request body, returning the updated Book
|
|
-- > type MyApi = "books" :> Capture "isbn" Text :> ReqBody Book :> Put Book
|
|
data Put a
|
|
deriving Typeable
|
|
|
|
-- | When implementing the handler for a 'Put' endpoint,
|
|
-- just like for 'Servant.API.Delete.Delete', 'Servant.API.Get.Get'
|
|
-- and 'Servant.API.Post.Post', the handler code runs in the
|
|
-- @EitherT (Int, String) IO@ monad, where the 'Int' represents
|
|
-- the status code and the 'String' a message, returned in case of
|
|
-- failure. You can quite handily use 'Control.Monad.Trans.EitherT.left'
|
|
-- to quickly fail if some conditions are not met.
|
|
--
|
|
-- If successfully returning a value, we just require that its type has
|
|
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
|
-- yielding status code 200 along the way.
|
|
instance ToJSON a => HasServer (Put a) where
|
|
type Server (Put a) = EitherT (Int, String) IO a
|
|
|
|
route Proxy action request respond
|
|
| null (pathInfo request) && requestMethod request == methodPut = do
|
|
e <- runEitherT action
|
|
respond . succeedWith $ case e of
|
|
Right out ->
|
|
responseLBS ok200 [("Content-Type", "application/json")] (encode out)
|
|
Left (status, message) ->
|
|
responseLBS (mkStatus status (cs message)) [] (cs message)
|
|
| null (pathInfo request) && requestMethod request /= methodPut =
|
|
respond $ failWith WrongMethod
|
|
|
|
| otherwise = respond $ failWith NotFound
|