{-# LANGUAGE FlexibleInstances, TypeFamilies, OverloadedStrings #-}
{- |
Support for using Reform with the Haskell Web Framework Happstack. <http://happstack.com/>
-}
module Text.Reform.Happstack where

import Control.Applicative                 (Applicative((<*>)), Alternative, (<$>), (<|>), (*>), optional)
import Control.Monad                       (msum, mplus)
import Control.Monad.Trans                 (liftIO)
import Data.ByteString.Lazy                (ByteString)
import qualified Data.ByteString.Lazy.UTF8 as UTF8
import Data.Either                         (lefts, rights)
import Data.Maybe                          (mapMaybe)
import Data.Monoid                         (Monoid)
import Data.Text.Lazy                      (Text)
import qualified Data.Text.Lazy            as TL
import System.Random                       (randomIO)
import Text.Reform.Backend              (FormInput(..), FileType, CommonFormError(NoFileFound, MultiFilesFound), commonFormError)
import Text.Reform.Core                 (Environment(..), Form, Proved(..), Value(..), View(..), (++>), eitherForm, runForm, mapView, viewForm)
import Text.Reform.Result               (Result(..), FormRange)
import Happstack.Server                 (Cookie(..), CookieLife(Session), ContentType, Happstack, Input(..), Method(GET, HEAD, POST), ServerMonad(localRq), ToMessage(..), Request(rqMethod), addCookie, askRq, expireCookie, forbidden, lookCookie, lookInputs, lookText, body, escape, method, mkCookie, getDataFn)

-- FIXME: we should really look at Content Type and check for non-UTF-8 encodings
instance FormInput [Input] where
    type FileType [Input] = (FilePath, FilePath, ContentType)
    getInputStrings :: [Input] -> [String]
getInputStrings [Input]
inputs = (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
UTF8.toString ([ByteString] -> [String]) -> [ByteString] -> [String]
forall a b. (a -> b) -> a -> b
$ [Either String ByteString] -> [ByteString]
forall a b. [Either a b] -> [b]
rights ([Either String ByteString] -> [ByteString])
-> [Either String ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ (Input -> Either String ByteString)
-> [Input] -> [Either String ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Either String ByteString
inputValue [Input]
inputs
    getInputFile :: [Input] -> Either error (FileType [Input])
getInputFile [Input]
inputs =
        case [ (String
tmpFilePath, String
uploadName, ContentType
contentType) | (Input (Left String
tmpFilePath) (Just String
uploadName) ContentType
contentType) <- [Input]
inputs ] of
          [(String
tmpFilePath, String
uploadName, ContentType
contentType)] -> (String, String, ContentType)
-> Either error (String, String, ContentType)
forall a b. b -> Either a b
Right (String
tmpFilePath, String
uploadName, ContentType
contentType)
          []   -> error -> Either error (String, String, ContentType)
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ [Input] -> CommonFormError [Input]
forall input. input -> CommonFormError input
NoFileFound [Input]
inputs)
          [(String, String, ContentType)]
_    -> error -> Either error (String, String, ContentType)
forall a b. a -> Either a b
Left (CommonFormError (ErrorInputType error) -> error
forall e. FormError e => CommonFormError (ErrorInputType e) -> e
commonFormError (CommonFormError (ErrorInputType error) -> error)
-> CommonFormError (ErrorInputType error) -> error
forall a b. (a -> b) -> a -> b
$ [Input] -> CommonFormError [Input]
forall input. input -> CommonFormError input
MultiFilesFound [Input]
inputs)

-- | create an 'Environment' to be used with 'runForm'
environment :: (Happstack m) => Environment m [Input]
environment :: Environment m [Input]
environment =
    (FormId -> m (Value [Input])) -> Environment m [Input]
forall (m :: * -> *) input.
(FormId -> m (Value input)) -> Environment m input
Environment ((FormId -> m (Value [Input])) -> Environment m [Input])
-> (FormId -> m (Value [Input])) -> Environment m [Input]
forall a b. (a -> b) -> a -> b
$ \FormId
formId ->
        do [Input]
ins <- String -> m [Input]
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m [Input]
lookInputs (FormId -> String
forall a. Show a => a -> String
show FormId
formId)
           case [Input]
ins of
             []  -> Value [Input] -> m (Value [Input])
forall (m :: * -> *) a. Monad m => a -> m a
return (Value [Input] -> m (Value [Input]))
-> Value [Input] -> m (Value [Input])
forall a b. (a -> b) -> a -> b
$ Value [Input]
forall a. Value a
Missing
             [Input]
_   -> Value [Input] -> m (Value [Input])
forall (m :: * -> *) a. Monad m => a -> m a
return (Value [Input] -> m (Value [Input]))
-> Value [Input] -> m (Value [Input])
forall a b. (a -> b) -> a -> b
$ [Input] -> Value [Input]
forall a. a -> Value a
Found [Input]
ins

-- | similar to 'eitherForm environment' but includes double-submit
-- (Cross Site Request Forgery) CSRF protection.
--
-- The form must have been created using 'happstackViewForm'
--
-- see also: 'happstackViewForm'
happstackEitherForm :: (Happstack m) =>
                       ([(Text, Text)] -> view -> view) -- ^ wrap raw form html inside a <form> tag
                    -> Text                                 -- ^ form prefix
                    -> Form m [Input] error view proof a    -- ^ Form to run
                    -> m (Either view a)                    -- ^ Result
happstackEitherForm :: ([(Text, Text)] -> view -> view)
-> Text -> Form m [Input] error view proof a -> m (Either view a)
happstackEitherForm [(Text, Text)] -> view -> view
toForm Text
prefix Form m [Input] error view proof a
frm =
    do Method
mthd <- Request -> Method
rqMethod (Request -> Method) -> m Request -> m Method
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       case Method
mthd of
         Method
POST ->
             do Text -> m ()
forall (m :: * -> *). Happstack m => Text -> m ()
checkCSRF Text
csrfName
                -- expireCookie csrfName
                Either view a
r <- Environment m [Input]
-> Text -> Form m [Input] error view proof a -> m (Either view a)
forall (m :: * -> *) input error view proof a.
Monad m =>
Environment m input
-> Text -> Form m input error view proof a -> m (Either view a)
eitherForm Environment m [Input]
forall (m :: * -> *). Happstack m => Environment m [Input]
environment Text
prefix Form m [Input] error view proof a
frm
                case Either view a
r of
                  (Left view
view) -> view -> Either view a
forall a b. a -> Either a b
Left (view -> Either view a) -> m view -> m (Either view a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Text, Text)] -> view -> view) -> Text -> view -> m view
forall (m :: * -> *) view.
Happstack m =>
([(Text, Text)] -> view -> view) -> Text -> view -> m view
happstackView [(Text, Text)] -> view -> view
toForm Text
prefix view
view
                  (Right a
a)   -> Either view a -> m (Either view a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either view a
forall a b. b -> Either a b
Right a
a)
         Method
_  ->
             do view -> Either view a
forall a b. a -> Either a b
Left (view -> Either view a) -> m view -> m (Either view a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Text, Text)] -> view -> view)
-> Text -> Form m [Input] error view proof a -> m view
forall (m :: * -> *) view input error proof a.
Happstack m =>
([(Text, Text)] -> view -> view)
-> Text -> Form m input error view proof a -> m view
happstackViewForm [(Text, Text)] -> view -> view
toForm Text
prefix Form m [Input] error view proof a
frm

-- | similar to 'viewForm' but includes double-submit
-- (Cross Site Request Forgery) CSRF protection.
--
-- Must be used with 'happstackEitherForm'.
--
-- see also: 'happstackEitherForm'.
happstackViewForm :: (Happstack m) =>
                     ([(Text, Text)] -> view -> view)        -- ^ wrap raw form html inside a @\<form\>@ tag
                  -> Text
                  -> Form m input error view proof a
                  -> m view
happstackViewForm :: ([(Text, Text)] -> view -> view)
-> Text -> Form m input error view proof a -> m view
happstackViewForm [(Text, Text)] -> view -> view
toForm Text
prefix Form m input error view proof a
frm =
    do view
formChildren <- Text -> Form m input error view proof a -> m view
forall (m :: * -> *) input error view proof a.
Monad m =>
Text -> Form m input error view proof a -> m view
viewForm Text
prefix Form m input error view proof a
frm
       ([(Text, Text)] -> view -> view) -> Text -> view -> m view
forall (m :: * -> *) view.
Happstack m =>
([(Text, Text)] -> view -> view) -> Text -> view -> m view
happstackView [(Text, Text)] -> view -> view
toForm Text
prefix view
formChildren

-- | Utility Function: wrap the @view@ in a @\<form\>@ that includes
-- double-submit CSRF protection.
--
-- calls 'addCSRFCookie' to set the cookie and adds the token as a
-- hidden field.
--
-- see also: 'happstackViewForm', 'happstackEitherForm', 'checkCSRF'
happstackView :: (Happstack m) =>
                 ([(Text, Text)] -> view -> view)        -- ^ wrap raw form html inside a @\<form\>@ tag
              -> Text
              -> view
              -> m view
happstackView :: ([(Text, Text)] -> view -> view) -> Text -> view -> m view
happstackView [(Text, Text)] -> view -> view
toForm Text
prefix view
view =
    do Text
csrfToken <- Text -> m Text
forall (m :: * -> *). Happstack m => Text -> m Text
addCSRFCookie Text
csrfName
       view -> m view
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Text, Text)] -> view -> view
toForm [(Text
csrfName, Text
csrfToken)] view
view)

-- | Utility Function: add a cookie for CSRF protection
addCSRFCookie :: (Happstack m) =>
                 Text    -- ^ name to use for the cookie
              -> m Text
addCSRFCookie :: Text -> m Text
addCSRFCookie Text
name =
    do Maybe Cookie
mc <- m Cookie -> m (Maybe Cookie)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Cookie -> m (Maybe Cookie)) -> m Cookie -> m (Maybe Cookie)
forall a b. (a -> b) -> a -> b
$ String -> m Cookie
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie (Text -> String
TL.unpack Text
name)
       case Maybe Cookie
mc of
         Maybe Cookie
Nothing ->
             do Integer
i <- IO Integer -> m Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> m Integer) -> IO Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ IO Integer
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
                CookieLife -> Cookie -> m ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie CookieLife
Session ((String -> String -> Cookie
mkCookie (Text -> String
TL.unpack Text
name) (Integer -> String
forall a. Show a => a -> String
show Integer
i)) { httpOnly :: Bool
httpOnly = Bool
True })
                Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer
i :: Integer))
         (Just Cookie
c) ->
             Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
TL.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Cookie -> String
cookieValue Cookie
c)

-- | Utility Function: get CSRF protection cookie
getCSRFCookie :: (Happstack m) => Text -> m Text
getCSRFCookie :: Text -> m Text
getCSRFCookie Text
name = String -> Text
TL.pack (String -> Text) -> (Cookie -> String) -> Cookie -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookie -> String
cookieValue (Cookie -> Text) -> m Cookie -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m Cookie
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie (Text -> String
TL.unpack Text
name)

-- | Utility Function: check that the CSRF cookie and hidden field exist and are equal
--
-- If the check fails, this function will call:
--
-- > escape $ forbidden (toResponse "CSRF check failed.")
checkCSRF :: (Happstack m) => Text -> m ()
checkCSRF :: Text -> m ()
checkCSRF Text
name =
    do Maybe Text
mc <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> m Text
forall (m :: * -> *). Happstack m => Text -> m Text
getCSRFCookie Text
name
       Maybe Text
mi <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String -> m Text
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m Text
lookText (Text -> String
TL.unpack Text
name)
       case (Maybe Text
mc, Maybe Text
mi) of
         (Just Text
c, Just Text
c')
             | Text
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c' -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         (Maybe Text, Maybe Text)
_ -> m Response -> m ()
forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape (m Response -> m ()) -> m Response -> m ()
forall a b. (a -> b) -> a -> b
$ Response -> m Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
forbidden (Text -> Response
forall a. ToMessage a => a -> Response
toResponse (Text
"CSRF check failed." :: Text))

-- | generate the name to use for the csrf cookie
--
-- Currently this returns the static cookie "reform-csrf". Using the prefix would allow
csrfName :: Text
csrfName :: Text
csrfName = Text
"reform-csrf"

-- | This function allows you to embed a a single 'Form' into a HTML page.
--
-- In general, you will want to use the 'reform' function instead,
-- which allows more than one 'Form' to be used on the same page.
--
-- see also: 'reform'
reformSingle :: (ToMessage b, Happstack m, Alternative m, Monoid view) =>
                  ([(Text, Text)] -> view -> view)            -- ^ wrap raw form html inside a <form> tag
               -> Text                                      -- ^ prefix
               -> (a -> m b)                                  -- ^ handler used when form validates
               -> Maybe ([(FormRange, error)] -> view -> m b) -- ^ handler used when form does not validate
               -> Form m [Input] error view proof a           -- ^ the formlet
               -> m view
reformSingle :: ([(Text, Text)] -> view -> view)
-> Text
-> (a -> m b)
-> Maybe ([(FormRange, error)] -> view -> m b)
-> Form m [Input] error view proof a
-> m view
reformSingle [(Text, Text)] -> view -> view
toForm Text
prefix a -> m b
handleSuccess Maybe ([(FormRange, error)] -> view -> m b)
mHandleFailure Form m [Input] error view proof a
form =
    [m view] -> m view
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ do [Method] -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method [Method
GET, Method
HEAD]
              Text
csrfToken <- Text -> m Text
forall (m :: * -> *). Happstack m => Text -> m Text
addCSRFCookie Text
csrfName
              [(Text, Text)] -> view -> view
toForm [(Text
csrfName, Text
csrfToken)] (view -> view) -> m view -> m view
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Form m [Input] error view proof a -> m view
forall (m :: * -> *) input error view proof a.
Monad m =>
Text -> Form m input error view proof a -> m view
viewForm Text
prefix Form m [Input] error view proof a
form

         , do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
              Text -> m ()
forall (m :: * -> *). Happstack m => Text -> m ()
checkCSRF Text
csrfName
              (View error view
v, m (Result error (Proved proof a))
mresult) <- Environment m [Input]
-> Text
-> Form m [Input] error view proof a
-> m (View error view, m (Result error (Proved proof a)))
forall (m :: * -> *) input error view proof a.
Monad m =>
Environment m input
-> Text
-> Form m input error view proof a
-> m (View error view, m (Result error (Proved proof a)))
runForm Environment m [Input]
forall (m :: * -> *). Happstack m => Environment m [Input]
environment Text
prefix Form m [Input] error view proof a
form
              Result error (Proved proof a)
result <- m (Result error (Proved proof a))
mresult
              case Result error (Proved proof a)
result of
                (Ok Proved proof a
a)         ->
                    (m Response -> m view
forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape (m Response -> m view) -> (m b -> m Response) -> m b -> m view
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Response) -> m b -> m Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Response
forall a. ToMessage a => a -> Response
toResponse) (m b -> m view) -> m b -> m view
forall a b. (a -> b) -> a -> b
$ do -- expireCookie csrfName
                                                    a -> m b
handleSuccess (Proved proof a -> a
forall proofs a. Proved proofs a -> a
unProved Proved proof a
a)
                (Error [(FormRange, error)]
errors) ->
                    do Text
csrfToken <- Text -> m Text
forall (m :: * -> *). Happstack m => Text -> m Text
addCSRFCookie Text
csrfName
                       case Maybe ([(FormRange, error)] -> view -> m b)
mHandleFailure of
                         (Just [(FormRange, error)] -> view -> m b
handleFailure) ->
                             (m Response -> m view
forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape (m Response -> m view) -> (m b -> m Response) -> m b -> m view
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Response) -> m b -> m Response
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Response
forall a. ToMessage a => a -> Response
toResponse) (m b -> m view) -> m b -> m view
forall a b. (a -> b) -> a -> b
$
                               [(FormRange, error)] -> view -> m b
handleFailure [(FormRange, error)]
errors ([(Text, Text)] -> view -> view
toForm [(Text
csrfName, Text
csrfToken)] (View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [(FormRange, error)]
errors))
                         Maybe ([(FormRange, error)] -> view -> m b)
Nothing ->
                             view -> m view
forall (m :: * -> *) a. Monad m => a -> m a
return (view -> m view) -> view -> m view
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> view -> view
toForm [(Text
csrfName, Text
csrfToken)] (View error view -> [(FormRange, error)] -> view
forall error v. View error v -> [(FormRange, error)] -> v
unView View error view
v [(FormRange, error)]
errors)
         ]

-- | this function embeds a 'Form' in an HTML page.
--
-- When the page is requested with a 'GET' request, the form view will
-- be rendered.
--
-- When the page is requested with a 'POST' request, the form data
-- will be extracted and validated.
--
-- If a value is successfully produced the success handler will be
-- called with the value.
--
-- On failure the failure handler will be called. If no failure
-- handler is provided, then the page will simply be redisplayed. The
-- form will be rendered with the errors and previous submit data shown.
--
-- The first argument to 'reform' is a function which generates the
-- @\<form\>@ tag. It should generally come from the template library
-- you are using, such as the @form@ function from @reform-hsp@.
--
-- The @[(String, String)]@ argument is a list of '(name, value)'
-- pairs for extra hidden fields that should be added to the
-- @\<form\>@ tag. These hidden fields are used to provide cross-site
-- request forgery (CSRF) protection, and to support multiple forms on
-- the same page.
reform :: (ToMessage b, Happstack m, Alternative m, Monoid view) =>
            ([(Text, Text)] -> view -> view)            -- ^ wrap raw form html inside a @\<form\>@ tag
         -> Text                                        -- ^ prefix
         -> (a -> m b)                                  -- ^ success handler used when form validates
         -> Maybe ([(FormRange, error)] -> view -> m b) -- ^ failure handler used when form does not validate
         -> Form m [Input] error view proof a           -- ^ the formlet
         -> m view

reform :: ([(Text, Text)] -> view -> view)
-> Text
-> (a -> m b)
-> Maybe ([(FormRange, error)] -> view -> m b)
-> Form m [Input] error view proof a
-> m view
reform [(Text, Text)] -> view -> view
toForm Text
prefix a -> m b
success Maybe ([(FormRange, error)] -> view -> m b)
failure Form m [Input] error view proof a
form =
    Text -> m view -> m view
forall (m :: * -> *) a. Happstack m => Text -> m a -> m a
guard Text
prefix (([(Text, Text)] -> view -> view)
-> Text
-> (a -> m b)
-> Maybe ([(FormRange, error)] -> view -> m b)
-> Form m [Input] error view proof a
-> m view
forall b (m :: * -> *) view a error proof.
(ToMessage b, Happstack m, Alternative m, Monoid view) =>
([(Text, Text)] -> view -> view)
-> Text
-> (a -> m b)
-> Maybe ([(FormRange, error)] -> view -> m b)
-> Form m [Input] error view proof a
-> m view
reformSingle [(Text, Text)] -> view -> view
toForm' Text
prefix a -> m b
success Maybe ([(FormRange, error)] -> view -> m b)
failure Form m [Input] error view proof a
form)
    where
      toForm' :: [(Text, Text)] -> view -> view
toForm' [(Text, Text)]
hidden view
view = [(Text, Text)] -> view -> view
toForm ((Text
"formname",Text
prefix) (Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text)]
hidden) view
view
      guard :: (Happstack m) => Text -> m a -> m a
      guard :: Text -> m a -> m a
guard Text
formName m a
part =
          (do Method -> m ()
forall (m :: * -> *) method.
(ServerMonad m, MonadPlus m, MatchMethod method) =>
method -> m ()
method Method
POST
              Either [String] Text
submittedName <- RqData Text -> m (Either [String] Text)
forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn (String -> RqData Text
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m Text
lookText String
"formname")
              if (Either [String] Text
submittedName Either [String] Text -> Either [String] Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text -> Either [String] Text
forall a b. b -> Either a b
Right Text
formName))
               then m a
part
               else (Request -> Request) -> m a -> m a
forall (m :: * -> *) a.
ServerMonad m =>
(Request -> Request) -> m a -> m a
localRq (\Request
req -> Request
req { rqMethod :: Method
rqMethod = Method
GET }) m a
part
          ) m a -> m a -> m a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` m a
part