{-# LANGUAGE CPP, DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, StandaloneDeriving, UndecidableInstances #-}
-- | Functions for extracting values from the query string, form data, cookies, etc.
--
-- For in-depth documentation see the following section of the Happstack Crash Course:
--
-- <http://www.happstack.com/docs/crashcourse/index.html#parsing-request-data-from-the-query_string-cookies-and-request-body>
module Happstack.Server.RqData
    ( -- * Looking up keys
      -- ** Form Values and Query Parameters
      look
    , looks
    , lookText
    , lookText'
    , lookTexts
    , lookTexts'
    , lookBS
    , lookBSs
    , lookRead
    , lookReads
    , lookFile
    , lookPairs
    , lookPairsBS
    -- ** Cookies
    , lookCookie
    , lookCookieValue
    , readCookieValue
    -- ** low-level
    , lookInput
    , lookInputs
    -- * Filters
    -- The look* functions normally search the QUERY_STRING and the Request
    -- body for matches keys.
    , body
    , queryString
    , bytestring
    -- * Validation and Parsing
    , checkRq
    , checkRqM
    , readRq
    , unsafeReadRq
    -- * Handling POST\/PUT Requests
    , decodeBody
    -- ** Body Policy
    , BodyPolicy(..)
    , defaultBodyPolicy
    -- * RqData Monad & Error Reporting
    , RqData
    , mapRqData
    , Errors(..)
    -- ** Using RqData with ServerMonad
    , getDataFn
    , withDataFn
    , FromData(..)
    , getData
    , withData
    -- * HasRqData class
    , RqEnv
    , HasRqData(askRqEnv, localRqEnv,rqDataError)
    ) where

import Control.Applicative                      (Applicative((<*>), pure), Alternative((<|>), empty), WrappedMonad(WrapMonad, unwrapMonad))
import Control.Monad                            (MonadPlus(mzero, mplus))
import Control.Monad.Reader                     (ReaderT(ReaderT, runReaderT), MonadReader(ask, local), mapReaderT)
import qualified Control.Monad.State.Lazy as Lazy      (StateT, mapStateT)
import qualified Control.Monad.State.Strict as Strict  (StateT, mapStateT)
import qualified Control.Monad.Writer.Lazy as Lazy     (WriterT, mapWriterT)
import qualified Control.Monad.Writer.Strict as Strict (WriterT, mapWriterT)
import qualified Control.Monad.RWS.Lazy as Lazy        (RWST, mapRWST)
import qualified Control.Monad.RWS.Strict as Strict    (RWST, mapRWST)
#if !MIN_VERSION_transformers(0,6,0)
import qualified Control.Monad.Trans.Error as DeprecatedError
#endif
import Control.Monad.Except                     (throwError)
import Control.Monad.Trans                      (MonadIO(..), lift)
import Control.Monad.Trans.Except               (ExceptT, mapExceptT)
import qualified Data.ByteString.Char8          as P
import qualified Data.ByteString.Lazy.Char8     as L
import qualified Data.ByteString.Lazy.UTF8      as LU
import Data.Char                                (toLower)
import Data.Either                              (partitionEithers)
import Data.Generics                            (Data, Typeable)
import Data.Maybe                               (fromJust)
import Data.Monoid                              (Monoid(mempty, mappend, mconcat))
import qualified Data.Semigroup                 as SG
import           Data.Text                      (Text)
import qualified Data.Text.Lazy                 as LazyText
import qualified Data.Text.Lazy.Encoding        as LazyText
import Happstack.Server.Cookie                  (Cookie (cookieValue))
import Happstack.Server.Internal.Monads
import Happstack.Server.Types
import Happstack.Server.Internal.MessageWrap    (BodyPolicy(..), bodyInput, defaultBodyPolicy)
import Happstack.Server.Response                (requestEntityTooLarge, toResponse)
import Network.URI                              (unEscapeString)

newtype ReaderError r e a = ReaderError { forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError :: ReaderT r (Either e) a }
    deriving (forall a b. a -> ReaderError r e b -> ReaderError r e a
forall a b. (a -> b) -> ReaderError r e a -> ReaderError r e b
forall r e a b. a -> ReaderError r e b -> ReaderError r e a
forall r e a b. (a -> b) -> ReaderError r e a -> ReaderError r e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ReaderError r e b -> ReaderError r e a
$c<$ :: forall r e a b. a -> ReaderError r e b -> ReaderError r e a
fmap :: forall a b. (a -> b) -> ReaderError r e a -> ReaderError r e b
$cfmap :: forall r e a b. (a -> b) -> ReaderError r e a -> ReaderError r e b
Functor, forall a. a -> ReaderError r e a
forall {r} {e}.
(Monoid e, Error e) =>
Applicative (ReaderError r e)
forall r e a. (Monoid e, Error e) => a -> ReaderError r e a
forall r e a b.
(Monoid e, Error e) =>
ReaderError r e a -> ReaderError r e b -> ReaderError r e b
forall r e a b.
(Monoid e, Error e) =>
ReaderError r e a -> (a -> ReaderError r e b) -> ReaderError r e b
forall a b.
ReaderError r e a -> ReaderError r e b -> ReaderError r e b
forall a b.
ReaderError r e a -> (a -> ReaderError r e b) -> ReaderError r e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ReaderError r e a
$creturn :: forall r e a. (Monoid e, Error e) => a -> ReaderError r e a
>> :: forall a b.
ReaderError r e a -> ReaderError r e b -> ReaderError r e b
$c>> :: forall r e a b.
(Monoid e, Error e) =>
ReaderError r e a -> ReaderError r e b -> ReaderError r e b
>>= :: forall a b.
ReaderError r e a -> (a -> ReaderError r e b) -> ReaderError r e b
$c>>= :: forall r e a b.
(Monoid e, Error e) =>
ReaderError r e a -> (a -> ReaderError r e b) -> ReaderError r e b
Monad)

#if MIN_VERSION_transformers(0,6,0)
deriving instance (Monoid e, MonadPlus (Either e)) => MonadPlus (ReaderError r e)
#else
deriving instance (Monoid e, DeprecatedError.Error e, MonadPlus (Either e)) => MonadPlus (ReaderError r e)
#endif

#if MIN_VERSION_transformers(0,6,0)
instance (Monoid e) => MonadReader r (ReaderError r e) where
#else
instance (DeprecatedError.Error e, Monoid e) => MonadReader r (ReaderError r e) where
#endif
    ask :: ReaderError r e r
ask = forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: forall a. (r -> r) -> ReaderError r e a -> ReaderError r e a
local r -> r
f ReaderError r e a
m = forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError ReaderError r e a
m)

#if MIN_VERSION_transformers(0,6,0)
instance (Monoid e) => Applicative (ReaderError r e) where
#else
instance (Monoid e, DeprecatedError.Error e) => Applicative (ReaderError r e) where
#endif
    pure :: forall a. a -> ReaderError r e a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
    (ReaderError (ReaderT r -> Either e (a -> b)
f)) <*> :: forall a b.
ReaderError r e (a -> b) -> ReaderError r e a -> ReaderError r e b
<*> (ReaderError (ReaderT r -> Either e a
a))
        = forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
env -> (r -> Either e (a -> b)
f r
env) forall e a b.
Monoid e =>
Either e (a -> b) -> Either e a -> Either e b
`apEither` (r -> Either e a
a r
env)

#if MIN_VERSION_transformers(0,6,0)
instance (MonadPlus (Either e), Monoid e) => Alternative (ReaderError r e) where
#else
instance (Monoid e, DeprecatedError.Error e) => Alternative (ReaderError r e) where
#endif
    empty :: forall a. ReaderError r e a
empty = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall (f :: * -> *) a. Alternative f => f a
empty
    ReaderError r e a
f <|> :: forall a.
ReaderError r e a -> ReaderError r e a -> ReaderError r e a
<|> ReaderError r e a
g = forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad forall a b. (a -> b) -> a -> b
$ (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad ReaderError r e a
f) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad ReaderError r e a
g)

apEither :: (Monoid e) => Either e (a -> b) -> Either e a -> Either e b
apEither :: forall e a b.
Monoid e =>
Either e (a -> b) -> Either e a -> Either e b
apEither (Left e
errs1) (Left e
errs2) = forall a b. a -> Either a b
Left (e
errs1 forall a. Monoid a => a -> a -> a
`mappend` e
errs2)
apEither (Left e
errs)  Either e a
_            = forall a b. a -> Either a b
Left e
errs
apEither Either e (a -> b)
_            (Left e
errs)  = forall a b. a -> Either a b
Left e
errs
apEither (Right a -> b
f)    (Right a
a)    = forall a b. b -> Either a b
Right (a -> b
f a
a)

-- | a list of errors
newtype Errors a = Errors { forall a. Errors a -> [a]
unErrors :: [a] }
    deriving (Errors a -> Errors a -> Bool
forall a. Eq a => Errors a -> Errors a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Errors a -> Errors a -> Bool
$c/= :: forall a. Eq a => Errors a -> Errors a -> Bool
== :: Errors a -> Errors a -> Bool
$c== :: forall a. Eq a => Errors a -> Errors a -> Bool
Eq, Errors a -> Errors a -> Bool
Errors a -> Errors a -> Ordering
Errors a -> Errors a -> Errors a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (Errors a)
forall a. Ord a => Errors a -> Errors a -> Bool
forall a. Ord a => Errors a -> Errors a -> Ordering
forall a. Ord a => Errors a -> Errors a -> Errors a
min :: Errors a -> Errors a -> Errors a
$cmin :: forall a. Ord a => Errors a -> Errors a -> Errors a
max :: Errors a -> Errors a -> Errors a
$cmax :: forall a. Ord a => Errors a -> Errors a -> Errors a
>= :: Errors a -> Errors a -> Bool
$c>= :: forall a. Ord a => Errors a -> Errors a -> Bool
> :: Errors a -> Errors a -> Bool
$c> :: forall a. Ord a => Errors a -> Errors a -> Bool
<= :: Errors a -> Errors a -> Bool
$c<= :: forall a. Ord a => Errors a -> Errors a -> Bool
< :: Errors a -> Errors a -> Bool
$c< :: forall a. Ord a => Errors a -> Errors a -> Bool
compare :: Errors a -> Errors a -> Ordering
$ccompare :: forall a. Ord a => Errors a -> Errors a -> Ordering
Ord, Int -> Errors a -> ShowS
forall a. Show a => Int -> Errors a -> ShowS
forall a. Show a => [Errors a] -> ShowS
forall a. Show a => Errors a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Errors a] -> ShowS
$cshowList :: forall a. Show a => [Errors a] -> ShowS
show :: Errors a -> String
$cshow :: forall a. Show a => Errors a -> String
showsPrec :: Int -> Errors a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Errors a -> ShowS
Show, ReadPrec [Errors a]
ReadPrec (Errors a)
ReadS [Errors a]
forall a. Read a => ReadPrec [Errors a]
forall a. Read a => ReadPrec (Errors a)
forall a. Read a => Int -> ReadS (Errors a)
forall a. Read a => ReadS [Errors a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Errors a]
$creadListPrec :: forall a. Read a => ReadPrec [Errors a]
readPrec :: ReadPrec (Errors a)
$creadPrec :: forall a. Read a => ReadPrec (Errors a)
readList :: ReadS [Errors a]
$creadList :: forall a. Read a => ReadS [Errors a]
readsPrec :: Int -> ReadS (Errors a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Errors a)
Read, Errors a -> DataType
Errors a -> Constr
forall {a}. Data a => Typeable (Errors a)
forall a. Data a => Errors a -> DataType
forall a. Data a => Errors a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> Errors a -> Errors a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Errors a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Errors a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Errors a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Errors a -> c (Errors a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Errors a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Errors a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Errors a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Errors a -> c (Errors a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Errors a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Errors a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Errors a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Errors a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Errors a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
gmapT :: (forall b. Data b => b -> b) -> Errors a -> Errors a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Errors a -> Errors a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Errors a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Errors a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Errors a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Errors a))
dataTypeOf :: Errors a -> DataType
$cdataTypeOf :: forall a. Data a => Errors a -> DataType
toConstr :: Errors a -> Constr
$ctoConstr :: forall a. Data a => Errors a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Errors a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Errors a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Errors a -> c (Errors a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Errors a -> c (Errors a)
Data, Typeable)

instance SG.Semigroup (Errors a) where
    (Errors [a]
x) <> :: Errors a -> Errors a -> Errors a
<> (Errors [a]
y) = forall a. [a] -> Errors a
Errors ([a]
x forall a. [a] -> [a] -> [a]
++ [a]
y)

instance Monoid (Errors a) where
    mempty :: Errors a
mempty = forall a. [a] -> Errors a
Errors []
    mappend :: Errors a -> Errors a -> Errors a
mappend = forall a. Semigroup a => a -> a -> a
(SG.<>)
    mconcat :: [Errors a] -> Errors a
mconcat [Errors a]
errs = forall a. [a] -> Errors a
Errors forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. Errors a -> [a]
unErrors [Errors a]
errs

#if MIN_VERSION_transformers(0,6,0)
instance (Alternative (Either (Errors a))) => MonadPlus (Either (Errors a)) where
  mzero = Left (Errors [])
  (Left _) `mplus` n = n
  m        `mplus` _ = m

instance Alternative (Either (Errors a)) where
  empty = Left (Errors [])
  (Left _) <|> n = n
  m        <|> _ = m
#endif

#if !MIN_VERSION_transformers(0,6,0)
instance DeprecatedError.Error (Errors String) where
    noMsg :: Errors String
noMsg = forall a. [a] -> Errors a
Errors []
    strMsg :: String -> Errors String
strMsg String
str = forall a. [a] -> Errors a
Errors [String
str]
#endif

strMsg :: a -> Errors a
strMsg :: forall a. a -> Errors a
strMsg a
errMsg = forall a. [a] -> Errors a
Errors [a
errMsg]

{- commented out to avoid 'Defined but not used' warning.
readerError :: (Monoid e, Error e) => e -> ReaderError r e b
readerError e = mapReaderErrorT ((Left e) `apEither`) (return ())

mapReaderErrorT :: (Either e a -> Either e' b) -> (ReaderError r e a) -> (ReaderError r e' b)
mapReaderErrorT f m = ReaderError $ mapReaderT f (unReaderError m)
-}

runReaderError :: ReaderError r e a -> r -> Either e a
runReaderError :: forall r e a. ReaderError r e a -> r -> Either e a
runReaderError = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError

-- | the environment used to lookup query parameters. It consists of
-- the triple: (query string inputs, body inputs, cookie inputs)
type RqEnv = ([(String, Input)], Maybe [(String, Input)], [(String, Cookie)])

-- | An applicative functor and monad for looking up key/value pairs
-- in the QUERY_STRING, Request body, and cookies.
newtype RqData a = RqData { forall a. RqData a -> ReaderError RqEnv (Errors String) a
unRqData :: ReaderError RqEnv (Errors String) a }
    deriving (forall a b. a -> RqData b -> RqData a
forall a b. (a -> b) -> RqData a -> RqData b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RqData b -> RqData a
$c<$ :: forall a b. a -> RqData b -> RqData a
fmap :: forall a b. (a -> b) -> RqData a -> RqData b
$cfmap :: forall a b. (a -> b) -> RqData a -> RqData b
Functor, Applicative RqData
forall a. a -> RqData a
forall a b. RqData a -> RqData b -> RqData b
forall a b. RqData a -> (a -> RqData b) -> RqData b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RqData a
$creturn :: forall a. a -> RqData a
>> :: forall a b. RqData a -> RqData b -> RqData b
$c>> :: forall a b. RqData a -> RqData b -> RqData b
>>= :: forall a b. RqData a -> (a -> RqData b) -> RqData b
$c>>= :: forall a b. RqData a -> (a -> RqData b) -> RqData b
Monad, Monad RqData
Alternative RqData
forall a. RqData a
forall a. RqData a -> RqData a -> RqData a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: forall a. RqData a -> RqData a -> RqData a
$cmplus :: forall a. RqData a -> RqData a -> RqData a
mzero :: forall a. RqData a
$cmzero :: forall a. RqData a
MonadPlus, Functor RqData
forall a. a -> RqData a
forall a b. RqData a -> RqData b -> RqData a
forall a b. RqData a -> RqData b -> RqData b
forall a b. RqData (a -> b) -> RqData a -> RqData b
forall a b c. (a -> b -> c) -> RqData a -> RqData b -> RqData c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. RqData a -> RqData b -> RqData a
$c<* :: forall a b. RqData a -> RqData b -> RqData a
*> :: forall a b. RqData a -> RqData b -> RqData b
$c*> :: forall a b. RqData a -> RqData b -> RqData b
liftA2 :: forall a b c. (a -> b -> c) -> RqData a -> RqData b -> RqData c
$cliftA2 :: forall a b c. (a -> b -> c) -> RqData a -> RqData b -> RqData c
<*> :: forall a b. RqData (a -> b) -> RqData a -> RqData b
$c<*> :: forall a b. RqData (a -> b) -> RqData a -> RqData b
pure :: forall a. a -> RqData a
$cpure :: forall a. a -> RqData a
Applicative, Applicative RqData
forall a. RqData a
forall a. RqData a -> RqData [a]
forall a. RqData a -> RqData a -> RqData a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. RqData a -> RqData [a]
$cmany :: forall a. RqData a -> RqData [a]
some :: forall a. RqData a -> RqData [a]
$csome :: forall a. RqData a -> RqData [a]
<|> :: forall a. RqData a -> RqData a -> RqData a
$c<|> :: forall a. RqData a -> RqData a -> RqData a
empty :: forall a. RqData a
$cempty :: forall a. RqData a
Alternative, MonadReader RqEnv )

-- | A class for monads which contain a 'RqEnv'
class HasRqData m where
    askRqEnv :: m RqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> m a -> m a
    -- | lift some 'Errors' into 'RqData'
    rqDataError :: Errors String -> m a

instance HasRqData RqData where
    askRqEnv :: RqData RqEnv
askRqEnv    = forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData forall r (m :: * -> *). MonadReader r m => m r
ask
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> RqData a -> RqData a
localRqEnv RqEnv -> RqEnv
f (RqData ReaderError RqEnv (Errors String) a
re) = forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RqEnv -> RqEnv
f ReaderError RqEnv (Errors String) a
re
    rqDataError :: forall a. Errors String -> RqData a
rqDataError Errors String
e = forall a b.
(Either (Errors String) a -> Either (Errors String) b)
-> RqData a -> RqData b
mapRqData ((forall a b. a -> Either a b
Left Errors String
e) forall e a b.
Monoid e =>
Either e (a -> b) -> Either e a -> Either e b
`apEither`) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- instance (MonadPlus m, MonadIO m, ServerMonad m) => (HasRqData m) where
instance (MonadIO m, MonadPlus m) => HasRqData (ServerPartT m) where
    askRqEnv :: ServerPartT m RqEnv
askRqEnv = forall (m :: * -> *). (ServerMonad m, MonadIO m) => m RqEnv
smAskRqEnv
    rqDataError :: forall a. Errors String -> ServerPartT m a
rqDataError Errors String
_e = forall (m :: * -> *) a. MonadPlus m => m a
mzero
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> ServerPartT m a -> ServerPartT m a
localRqEnv = forall (m :: * -> *) b.
(ServerMonad m, MonadIO m) =>
(RqEnv -> RqEnv) -> m b -> m b
smLocalRqEnv

------------------------------------------------------------------------------
-- HasRqData instances for ReaderT, StateT, WriterT, RWST, and ErrorT
------------------------------------------------------------------------------

instance (Monad m, HasRqData m) => HasRqData (ReaderT s m) where
    askRqEnv :: ReaderT s m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> ReaderT s m a -> ReaderT s m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> ReaderT s m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m) => HasRqData (Lazy.StateT s m) where
    askRqEnv :: StateT s m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> StateT s m a -> StateT s m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> StateT s m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m) => HasRqData (Strict.StateT s m) where
    askRqEnv :: StateT s m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> StateT s m a -> StateT s m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> StateT s m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m, Monoid w) => HasRqData (Lazy.WriterT w m) where
    askRqEnv :: WriterT w m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> WriterT w m a -> WriterT w m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> WriterT w m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m, Monoid w) => HasRqData (Strict.WriterT w m) where
    askRqEnv :: WriterT w m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> WriterT w m a -> WriterT w m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> WriterT w m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m, Monoid w) => HasRqData (Lazy.RWST r w s m) where
    askRqEnv :: RWST r w s m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> RWST r w s m a -> RWST r w s m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Lazy.mapRWST (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> RWST r w s m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

instance (Monad m, HasRqData m, Monoid w) => HasRqData (Strict.RWST r w s m) where
    askRqEnv :: RWST r w s m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> RWST r w s m a -> RWST r w s m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) a s w (n :: * -> *) b w' r.
(m (a, s, w) -> n (b, s, w')) -> RWST r w s m a -> RWST r w' s n b
Strict.mapRWST (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> RWST r w s m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

#if !MIN_VERSION_transformers(0,6,0)
instance (Monad m, DeprecatedError.Error e, HasRqData m) => HasRqData (DeprecatedError.ErrorT e m) where
    askRqEnv :: ErrorT e m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> ErrorT e m a -> ErrorT e m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ErrorT e m a -> ErrorT e' n b
DeprecatedError.mapErrorT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> ErrorT e m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)
#endif

instance (Monad m, HasRqData m) => HasRqData (ExceptT e m) where
    askRqEnv :: ExceptT e m RqEnv
askRqEnv      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: forall a. (RqEnv -> RqEnv) -> ExceptT e m a -> ExceptT e m a
localRqEnv RqEnv -> RqEnv
f  = forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT (forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: forall a. Errors String -> ExceptT e m a
rqDataError Errors String
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

-- | apply 'RqData a' to a 'RqEnv'
--
-- see also: 'getData', 'getDataFn', 'withData', 'withDataFn', 'RqData', 'getDataFn'
runRqData :: RqData a -> RqEnv -> Either [String] a
runRqData :: forall a. RqData a -> RqEnv -> Either [String] a
runRqData RqData a
rqData RqEnv
rqEnv =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Errors a -> [a]
unErrors) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r e a. ReaderError r e a -> r -> Either e a
runReaderError (forall a. RqData a -> ReaderError RqEnv (Errors String) a
unRqData RqData a
rqData) RqEnv
rqEnv

-- | transform the result of 'RqData a'.
--
-- This is similar to 'fmap' except it also allows you to modify the
-- 'Errors' not just 'a'.
mapRqData :: (Either (Errors String) a -> Either (Errors String) b) -> RqData a -> RqData b
mapRqData :: forall a b.
(Either (Errors String) a -> Either (Errors String) b)
-> RqData a -> RqData b
mapRqData Either (Errors String) a -> Either (Errors String) b
f RqData a
m = forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData forall a b. (a -> b) -> a -> b
$ forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT Either (Errors String) a -> Either (Errors String) b
f (forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError (forall a. RqData a -> ReaderError RqEnv (Errors String) a
unRqData RqData a
m))

-- | use 'read' to convert a 'String' to a value of type 'a'
--
-- > look "key" `checkRq` (unsafeReadRq "key")
--
-- use with 'checkRq'
--
-- NOTE: This function is marked unsafe because some Read instances
-- are vulnerable to attacks that attempt to create an out of memory
-- condition. For example:
--
-- > read "1e10000000000000" :: Integer
--
-- see also: 'readRq'
unsafeReadRq :: (Read a) =>
          String -- ^ name of key (only used for error reporting)
       -> String -- ^ 'String' to 'read'
       -> Either String a -- ^ 'Left' on error, 'Right' on success
unsafeReadRq :: forall a. Read a => String -> String -> Either String a
unsafeReadRq String
key String
val =
    case forall a. Read a => ReadS a
reads String
val of
      [(a
a,[])] -> forall a b. b -> Either a b
Right a
a
      [(a, String)]
_        -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"readRq failed while parsing key: " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
" which has the value: " forall a. [a] -> [a] -> [a]
++ String
val

-- | use 'fromReqURI' to convert a 'String' to a value of type 'a'
--
-- > look "key" `checkRq` (readRq "key")
--
-- use with 'checkRq'
readRq :: (FromReqURI a) =>
          String -- ^ name of key (only used for error reporting)
       -> String -- ^ 'String' to 'read'
       -> Either String a -- ^ 'Left' on error, 'Right' on success
readRq :: forall a. FromReqURI a => String -> String -> Either String a
readRq String
key String
val =
    case forall a. FromReqURI a => String -> Maybe a
fromReqURI String
val of
      (Just a
a) -> forall a b. b -> Either a b
Right a
a
      Maybe a
_        -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"readRq failed while parsing key: " forall a. [a] -> [a] -> [a]
++ String
key forall a. [a] -> [a] -> [a]
++ String
" which has the value: " forall a. [a] -> [a] -> [a]
++ String
val

-- | convert or validate a value
--
-- This is similar to 'fmap' except that the function can fail by
-- returning Left and an error message. The error will be propagated
-- by calling 'rqDataError'.
--
-- This function is useful for a number of things including:
--
--  (1) Parsing a 'String' into another type
--
--  (2) Checking that a value meets some requirements (for example, that is an Int between 1 and 10).
--
-- Example usage at:
--
-- <http://happstack.com/docs/crashcourse/RqData.html#rqdatacheckrq>
checkRq :: (Monad m, HasRqData m) => m a -> (a -> Either String b) -> m b
checkRq :: forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
checkRq m a
rq a -> Either String b
f =
    do a
a <- m a
rq
       case a -> Either String b
f a
a of
         (Left String
e)  -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (forall a. a -> Errors a
strMsg String
e)
         (Right b
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | like 'checkRq' but the check function can be monadic
checkRqM :: (Monad m, HasRqData m) => m a -> (a -> m (Either String b)) -> m b
checkRqM :: forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> m (Either String b)) -> m b
checkRqM m a
rq a -> m (Either String b)
f =
    do a
a  <- m a
rq
       Either String b
eb <- a -> m (Either String b)
f a
a
       case Either String b
eb of
         (Left String
e)  -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (forall a. a -> Errors a
strMsg String
e)
         (Right b
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | Used by 'withData' and 'getData'. Make your preferred data
-- type an instance of 'FromData' to use those functions.
class FromData a where
    fromData :: RqData a
{-
instance (Eq a,Show a,Xml a,G.Data a) => FromData a where
    fromData = do mbA <- lookPairs >>= return . normalize . fromPairs
                  case mbA of
                    Just a -> return a
                    Nothing -> fail "FromData G.Data failure"
--    fromData = lookPairs >>= return . normalize . fromPairs
-}
instance (FromData a, FromData b) => FromData (a,b) where
    fromData :: RqData (a, b)
fromData = (,)   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData

instance (FromData a, FromData b, FromData c) => FromData (a,b,c) where
    fromData :: RqData (a, b, c)
fromData = (,,)  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData

instance (FromData a, FromData b, FromData c, FromData d) => FromData (a,b,c,d) where
    fromData :: RqData (a, b, c, d)
fromData = (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. FromData a => RqData a
fromData

instance FromData a => FromData (Maybe a) where
    fromData :: RqData (Maybe a)
fromData = (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromData a => RqData a
fromData) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)

-- | similar to 'Data.List.lookup' but returns all matches not just the first
lookups :: (Eq a) => a -> [(a, b)] -> [b]
lookups :: forall a b. Eq a => a -> [(a, b)] -> [b]
lookups a
a = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((a
a forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

fromMaybeBody :: String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody :: String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody String
funName String
fieldName Maybe [(String, Input)]
mBody =
    case Maybe [(String, Input)]
mBody of
      Maybe [(String, Input)]
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
funName forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
fieldName forall a. [a] -> [a] -> [a]
++ String
" failed because the request body has not been decoded yet. Try using 'decodeBody' to decode the body. Or the 'queryString' filter to ignore the body."
      (Just [(String, Input)]
bdy) -> [(String, Input)]
bdy

-- | Gets the first matching named input parameter
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- see also: 'lookInputs'
lookInput :: (Monad m, HasRqData m) => String -> m Input
lookInput :: forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Input
lookInput String
name
    = do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
         let bdy :: [(String, Input)]
bdy = String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody String
"lookInput" String
name Maybe [(String, Input)]
mBody
         case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name ([(String, Input)]
query forall a. [a] -> [a] -> [a]
++ [(String, Input)]
bdy) of
           Just Input
i  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Input
i
           Maybe Input
Nothing -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (forall a. a -> Errors a
strMsg forall a b. (a -> b) -> a -> b
$ String
"Parameter not found: " forall a. [a] -> [a] -> [a]
++ String
name)

-- | Gets all matches for the named input parameter
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- see also: 'lookInput'
lookInputs :: (Monad m, HasRqData m) => String -> m [Input]
lookInputs :: forall (m :: * -> *). (Monad m, HasRqData m) => String -> m [Input]
lookInputs String
name
    = do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
         let bdy :: [(String, Input)]
bdy = String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody String
"lookInputs" String
name Maybe [(String, Input)]
mBody
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> [b]
lookups String
name ([(String, Input)]
query forall a. [a] -> [a] -> [a]
++ [(String, Input)]
bdy)

-- | Gets the first matching named input parameter as a lazy 'ByteString'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- see also: 'lookBSs'
lookBS :: (Functor m, Monad m, HasRqData m) => String -> m L.ByteString
lookBS :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m ByteString
lookBS String
n =
    do Either String ByteString
i <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Input -> Either String ByteString
inputValue (forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Input
lookInput String
n)
       case Either String ByteString
i of
         (Left String
_fp) -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError forall a b. (a -> b) -> a -> b
$ (forall a. a -> Errors a
strMsg forall a b. (a -> b) -> a -> b
$ String
"lookBS: " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" is a file.")
         (Right ByteString
bs) -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs

-- | Gets all matches for the named input parameter as lazy 'ByteString's
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- see also: 'lookBS'
lookBSs :: (Functor m, Monad m, HasRqData m) => String -> m [L.ByteString]
lookBSs :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [ByteString]
lookBSs String
n =
    do [Either String ByteString]
is <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map Input -> Either String ByteString
inputValue) (forall (m :: * -> *). (Monad m, HasRqData m) => String -> m [Input]
lookInputs String
n)
       case forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String ByteString]
is of
         ([], [ByteString]
bs) -> forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
bs
         ([String]
_fp, [ByteString]
_) -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (forall a. a -> Errors a
strMsg forall a b. (a -> b) -> a -> b
$ String
"lookBSs: " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" is a file.")

-- | Gets the first matching named input parameter as a 'String'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- Example:
--
-- > handler :: ServerPart Response
-- > handler =
-- >      do foo <- look "foo"
-- >         ok $ toResponse $ "foo = " ++ foo
--
-- see also: 'looks', 'lookBS', and 'lookBSs'
look :: (Functor m, Monad m, HasRqData m) => String -> m String
look :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
LU.toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m ByteString
lookBS

-- | Gets all matches for the named input parameter as 'String's
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'look' and 'lookBSs'
looks :: (Functor m, Monad m, HasRqData m) => String -> m [String]
looks :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [String]
looks = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
LU.toString) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [ByteString]
lookBSs

-- | Gets the first matching named input parameter as a lazy 'Text'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookTexts', 'look', 'looks', 'lookBS', and 'lookBSs'
lookText :: (Functor m, Monad m, HasRqData m) => String -> m LazyText.Text
lookText :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m Text
lookText = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
LazyText.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m ByteString
lookBS

-- | Gets the first matching named input parameter as a strict 'Text'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookTexts', 'look', 'looks', 'lookBS', and 'lookBSs'
lookText' :: (Functor m, Monad m, HasRqData m) => String -> m Text
lookText' :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m Text
lookText' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
LazyText.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m Text
lookText

-- | Gets all matches for the named input parameter as lazy 'Text's
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookText', 'looks' and 'lookBSs'
lookTexts :: (Functor m, Monad m, HasRqData m) => String -> m [LazyText.Text]
lookTexts :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [Text]
lookTexts = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
LazyText.decodeUtf8) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [ByteString]
lookBSs

-- | Gets all matches for the named input parameter as strict 'Text's
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookText'', 'looks' and 'lookBSs'
lookTexts' :: (Functor m, Monad m, HasRqData m) => String -> m [Text]
lookTexts' :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [Text]
lookTexts' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
LazyText.toStrict) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [Text]
lookTexts

-- | Gets the named cookie
-- the cookie name is case insensitive
lookCookie :: (Monad m, HasRqData m) => String -> m Cookie
lookCookie :: forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie String
name
    = do ([(String, Input)]
_query,Maybe [(String, Input)]
_body, [(String, Cookie)]
cookies) <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
         case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name) [(String, Cookie)]
cookies of -- keys are lowercased
           Maybe Cookie
Nothing -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError forall a b. (a -> b) -> a -> b
$ forall a. a -> Errors a
strMsg forall a b. (a -> b) -> a -> b
$ String
"lookCookie: cookie not found: " forall a. [a] -> [a] -> [a]
++ String
name
           Just Cookie
c  -> forall (m :: * -> *) a. Monad m => a -> m a
return Cookie
c{cookieValue :: String
cookieValue = Cookie -> String
f Cookie
c}
  where
    f :: Cookie -> String
f = ShowS
unEscapeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cookie -> String
cookieValue 

-- | gets the named cookie as a string
lookCookieValue :: (Functor m, Monad m, HasRqData m) => String -> m String
lookCookieValue :: forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
lookCookieValue = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> String
cookieValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie

-- | gets the named cookie as the requested Read type
readCookieValue :: (Functor m, Monad m, HasRqData m, FromReqURI a) => String -> m a
readCookieValue :: forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m a
readCookieValue String
name = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> String
cookieValue (forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie String
name) forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (forall a. FromReqURI a => String -> String -> Either String a
readRq String
name)

-- | Gets the first matching named input parameter and decodes it using 'Read'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookReads'
lookRead :: (Functor m, Monad m, HasRqData m, FromReqURI a) => String -> m a
lookRead :: forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m a
lookRead String
name = forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look String
name forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (forall a. FromReqURI a => String -> String -> Either String a
readRq String
name)

-- | Gets all matches for the named input parameter and decodes them using 'Read'
--
-- Searches the QUERY_STRING followed by the Request body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookReads'
lookReads :: (Functor m, Monad m, HasRqData m, FromReqURI a) => String -> m [a]
lookReads :: forall (m :: * -> *) a.
(Functor m, Monad m, HasRqData m, FromReqURI a) =>
String -> m [a]
lookReads String
name =
    do [String]
vals <- forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [String]
looks String
name
       forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
v -> (forall (m :: * -> *) a. Monad m => a -> m a
return String
v) forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (forall a. FromReqURI a => String -> String -> Either String a
readRq String
name)) [String]
vals

-- | Gets the first matching named file
--
-- Files can only appear in the request body. Additionally, the form
-- must set enctype=\"multipart\/form-data\".
--
-- This function returns a tuple consisting of:
--
--  (1) The temporary location of the uploaded file
--
--  (2) The local filename supplied by the browser
--
--  (3) The content-type supplied by the browser
--
-- If the user does not supply a file in the html form input field,
-- the behaviour will depend upon the browser. Most browsers will send
-- a 0-length file with an empty file name, so checking that (2) is
-- not empty is usually sufficient to ensure the field has been
-- filled.
--
-- NOTE: You must move the file from the temporary location before the
-- 'Response' is sent. The temporary files are automatically removed
-- after the 'Response' is sent.
lookFile :: (Monad m, HasRqData m) =>
            String -- ^ name of input field to search for
         -> m (FilePath, FilePath, ContentType) -- ^ (temporary file location, uploaded file name, content-type)
lookFile :: forall (m :: * -> *).
(Monad m, HasRqData m) =>
String -> m (String, String, ContentType)
lookFile String
n =
    do Input
i <- forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Input
lookInput String
n
       case Input -> Either String ByteString
inputValue Input
i of
         (Right ByteString
_) -> forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError forall a b. (a -> b) -> a -> b
$ (forall a. a -> Errors a
strMsg forall a b. (a -> b) -> a -> b
$ String
"lookFile: " forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
" was found but is not a file.")
         (Left String
fp) -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
fp, forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Input -> Maybe String
inputFilename Input
i, Input -> ContentType
inputContentType Input
i)

-- | gets all the input parameters, and converts them to a 'String'
--
-- The results will contain the QUERY_STRING followed by the Request
-- body.
--
-- This function assumes the underlying octets are UTF-8 encoded.
--
-- see also: 'lookPairsBS'
lookPairs :: (Monad m, HasRqData m) => m [(String, Either FilePath String)]
lookPairs :: forall (m :: * -> *).
(Monad m, HasRqData m) =>
m [(String, Either String String)]
lookPairs =
    do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
       let bdy :: [(String, Input)]
bdy = String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody String
"lookPairs" String
"" Maybe [(String, Input)]
mBody
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,Input
vbs)->(String
n, (\Either String ByteString
e -> case Either String ByteString
e of Left String
fp -> forall a b. a -> Either a b
Left String
fp ; Right ByteString
bs -> forall a b. b -> Either a b
Right (ByteString -> String
LU.toString ByteString
bs)) forall a b. (a -> b) -> a -> b
$ Input -> Either String ByteString
inputValue Input
vbs)) ([(String, Input)]
query forall a. [a] -> [a] -> [a]
++ [(String, Input)]
bdy)

-- | gets all the input parameters
--
-- The results will contain the QUERY_STRING followed by the Request
-- body.
--
-- see also: 'lookPairs'
lookPairsBS :: (Monad m, HasRqData m) => m [(String, Either FilePath L.ByteString)]
lookPairsBS :: forall (m :: * -> *).
(Monad m, HasRqData m) =>
m [(String, Either String ByteString)]
lookPairsBS =
    do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
       let bdy :: [(String, Input)]
bdy = String -> String -> Maybe [(String, Input)] -> [(String, Input)]
fromMaybeBody String
"lookPairsBS" String
"" Maybe [(String, Input)]
mBody
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,Input
vbs) -> (String
n, Input -> Either String ByteString
inputValue Input
vbs)) ([(String, Input)]
query forall a. [a] -> [a] -> [a]
++ [(String, Input)]
bdy)

-- | The body of a 'Request' is not received or decoded unless
-- this function is invoked.
--
-- It is an error to try to use the look functions for a
-- 'Request' with out first calling this function.
--
-- It is ok to call 'decodeBody' at the beginning of every request:
--
-- > main = simpleHTTP nullConf $
-- >           do decodeBody (defaultBodyPolicy "/tmp/" 4096 4096 4096)
-- >              handlers
--
-- You can achieve finer granularity quotas by calling 'decodeBody'
-- with different values in different handlers.
--
-- Only the first call to 'decodeBody' will have any effect. Calling
-- it a second time, even with different quota values, will do
-- nothing.
decodeBody :: (ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m, WebMonad Response m) => BodyPolicy -> m ()
decodeBody :: forall (m :: * -> *).
(ServerMonad m, MonadPlus m, MonadIO m, FilterMonad Response m,
 WebMonad Response m) =>
BodyPolicy -> m ()
decodeBody BodyPolicy
bp =
    do Request
rq <- forall (m :: * -> *). ServerMonad m => m Request
askRq
       ([(String, Input)]
_, Maybe String
me) <- forall (m :: * -> *).
MonadIO m =>
BodyPolicy -> Request -> m ([(String, Input)], Maybe String)
bodyInput BodyPolicy
bp Request
rq
       case Maybe String
me of
         Maybe String
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just String
e  -> forall a (m :: * -> *) b.
(WebMonad a m, FilterMonad a m) =>
m a -> m b
escape forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. FilterMonad Response m => a -> m a
requestEntityTooLarge (forall a. ToMessage a => a -> Response
toResponse String
e) -- FIXME: is this the best way to report the error

-- | run 'RqData' in a 'ServerMonad'.
--
-- Example: a simple @GET@ or @POST@ variable based authentication
-- guard.  It handles the request with 'errorHandler' if
-- authentication fails.
--
-- >  data AuthCredentials = AuthCredentials { username :: String,  password :: String }
-- >
-- >  isValid :: AuthCredentials -> Bool
-- >  isValid = const True
-- >
-- >  myRqData :: RqData AuthCredentials
-- >  myRqData = do
-- >     username <- look "username"
-- >     password <- look "password"
-- >     return (AuthCredentials username password)
-- >
-- >  checkAuth :: (String -> ServerPart Response) -> ServerPart Response
-- >  checkAuth errorHandler = do
-- >     d <- getDataFn myRqData
-- >     case d of
-- >         (Left e) -> errorHandler (unlines e)
-- >         (Right a) | isValid a -> mzero
-- >         (Right a) | otherwise -> errorHandler "invalid"
--
-- NOTE: you must call 'decodeBody' prior to calling this function if
-- the request method is POST, PUT, PATCH, etc.
getDataFn :: (HasRqData m, ServerMonad m) =>
             RqData a -- ^ 'RqData' monad to evaluate
          -> m (Either [String] a) -- ^ return 'Left' errors or 'Right' a
getDataFn :: forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn RqData a
rqData =
    do RqEnv
rqEnv <- forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
       forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. RqData a -> RqEnv -> Either [String] a
runRqData RqData a
rqData RqEnv
rqEnv)

-- | similar to 'getDataFn', except it calls a sub-handler on success
-- or 'mzero' on failure.
--
-- NOTE: you must call 'decodeBody' prior to calling this function if
-- the request method is POST, PUT, PATCH, etc.
withDataFn :: (HasRqData m, MonadPlus m, ServerMonad m) => RqData a -> (a -> m r) -> m r
withDataFn :: forall (m :: * -> *) a r.
(HasRqData m, MonadPlus m, ServerMonad m) =>
RqData a -> (a -> m r) -> m r
withDataFn RqData a
fn a -> m r
handle = forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn RqData a
fn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall (m :: * -> *) a. MonadPlus m => m a
mzero) a -> m r
handle

-- | A variant of 'getDataFn' that uses 'FromData' to chose your
-- 'RqData' for you.  The example from 'getData' becomes:
--
-- >  data AuthCredentials = AuthCredentials { username :: String,  password :: String }
-- >
-- >  isValid :: AuthCredentials -> Bool
-- >  isValid = const True
-- >
-- >  myRqData :: RqData AuthCredentials
-- >  myRqData = do
-- >     username <- look "username"
-- >     password <- look "password"
-- >     return (AuthCredentials username password)
-- >
-- >  instance FromData AuthCredentials where
-- >     fromData = myRqData
-- >
-- >  checkAuth :: (String -> ServerPart Response) -> ServerPart Response
-- >  checkAuth errorHandler = do
-- >     d <- getData
-- >     case d of
-- >         (Left e) -> errorHandler (unlines e)
-- >         (Right a) | isValid a -> mzero
-- >         (Right a) | otherwise -> errorHandler "invalid"
--
-- NOTE: you must call 'decodeBody' prior to calling this function if
-- the request method is POST, PUT, PATCH, etc.
getData :: (HasRqData m, ServerMonad m, FromData a) => m (Either [String] a)
getData :: forall (m :: * -> *) a.
(HasRqData m, ServerMonad m, FromData a) =>
m (Either [String] a)
getData = forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn forall a. FromData a => RqData a
fromData

-- | similar to 'getData' except it calls a subhandler on success or 'mzero' on failure.
--
-- NOTE: you must call 'decodeBody' prior to calling this function if
-- the request method is POST, PUT, PATCH, etc.
withData :: (HasRqData m, FromData a, MonadPlus m, ServerMonad m) => (a -> m r) -> m r
withData :: forall (m :: * -> *) a r.
(HasRqData m, FromData a, MonadPlus m, ServerMonad m) =>
(a -> m r) -> m r
withData = forall (m :: * -> *) a r.
(HasRqData m, MonadPlus m, ServerMonad m) =>
RqData a -> (a -> m r) -> m r
withDataFn forall a. FromData a => RqData a
fromData

-- | limit the scope to the Request body
--
-- > handler :: ServerPart Response
-- > handler =
-- >     do foo <- body $ look "foo"
-- >        ok $ toResponse $ "foo = " ++ foo
body :: (HasRqData m) => m a -> m a
body :: forall (m :: * -> *) a. HasRqData m => m a -> m a
body m a
rqData = forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv forall {a} {b} {c} {a} {a}. (a, b, c) -> ([a], b, [a])
f m a
rqData
    where
      f :: (a, b, c) -> ([a], b, [a])
f (a
_query, b
bdy, c
_cookies) = ([], b
bdy, [])

-- | limit the scope to the QUERY_STRING
--
-- > handler :: ServerPart Response
-- > handler =
-- >     do foo <- queryString $ look "foo"
-- >        ok $ toResponse $ "foo = " ++ foo
queryString ::  (HasRqData m) => m a -> m a
queryString :: forall (m :: * -> *) a. HasRqData m => m a -> m a
queryString m a
rqData = forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv forall {a} {b} {c} {a} {a}. (a, b, c) -> (a, Maybe [a], [a])
f m a
rqData
    where
      f :: (a, b, c) -> (a, Maybe [a], [a])
f (a
query, b
_body, c
_cookies) = (a
query, forall a. a -> Maybe a
Just [], [])

-- | limit the scope to 'Input's  which produce a 'ByteString' (aka, not a file)
bytestring :: (HasRqData m) => m a -> m a
bytestring :: forall (m :: * -> *) a. HasRqData m => m a -> m a
bytestring m a
rqData = forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv forall {f :: * -> *} {a} {a} {c}.
Functor f =>
([(a, Input)], f [(a, Input)], c)
-> ([(a, Input)], f [(a, Input)], c)
f m a
rqData
    where
      f :: ([(a, Input)], f [(a, Input)], c)
-> ([(a, Input)], f [(a, Input)], c)
f ([(a, Input)]
query, f [(a, Input)]
bdy, c
cookies) = (forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Input) -> Bool
bsf [(a, Input)]
query, forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Input) -> Bool
bsf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [(a, Input)]
bdy, c
cookies)
      bsf :: (a, Input) -> Bool
bsf (a
_, Input
i) =
          case Input -> Either String ByteString
inputValue Input
i of
            (Left  String
_fp) -> Bool
False
            (Right ByteString
_bs) -> Bool
True