{-# LANGUAGE OverloadedStrings #-} -- |Higher-level handlers to restrict acecss based on HTTP method. module Web.Seacat.RequestHandler.OnMethod ( on , onGet , onPost) where import Control.Applicative ((<$>)) import Data.Either.Utils (forceEither) import Network.HTTP.Types.Method (StdMethod(..), parseMethod) import Network.Wai (requestMethod) import Web.Routes.PathInfo (PathInfo) import Web.Seacat.RequestHandler.Types (Handler, askReq) -- |Run the provided handler on a GET request -- -- For example, you can use this as follows: -- -- > let error405 = utf8Response methodNotAllowed405 "This route only works via GET" -- > in error405 `onGet` doThings onGet :: PathInfo r => Handler r -- ^ The error handler -> Handler r -- ^ The handler -> Handler r onGet = on GET -- |Run the provided handler on a POST request onPost :: PathInfo r => Handler r -- ^ The error handler -> Handler r -- ^ The handler -> Handler r onPost = on POST -- |Run the provided handler if the HTTP method matches, running the -- error handler if not. The error handler should respond with an HTTP -- 405 code. on :: PathInfo r => StdMethod -- ^ The method to run on -> Handler r -- ^ The handler to call if the method doesn't match. -> Handler r -- ^ The handler -> Handler r on method on405 handler = do rmethod <- forceEither . parseMethod . requestMethod <$> askReq if rmethod == method then handler else on405