{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
-- | 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))
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)
import Control.Monad.Error                      (Error(noMsg, strMsg), ErrorT, mapErrorT)
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 { ReaderError r e a -> ReaderT r (Either e) a
unReaderError :: ReaderT r (Either e) a }
    deriving (a -> ReaderError r e b -> ReaderError r e a
(a -> b) -> ReaderError r e a -> ReaderError r e b
(forall a b. (a -> b) -> ReaderError r e a -> ReaderError r e b)
-> (forall a b. a -> ReaderError r e b -> ReaderError r e a)
-> Functor (ReaderError r e)
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
<$ :: 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 :: (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, Applicative (ReaderError r e)
a -> ReaderError r e a
Applicative (ReaderError r e)
-> (forall a b.
    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. a -> ReaderError r e a)
-> Monad (ReaderError r e)
ReaderError r e a -> (a -> ReaderError r e b) -> ReaderError r e b
ReaderError r e a -> ReaderError r e b -> ReaderError r e b
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 :: a -> ReaderError r e a
$creturn :: forall r e a. (Monoid e, Error e) => a -> ReaderError r e a
>> :: 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
>>= :: 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
$cp1Monad :: forall r e. (Monoid e, Error e) => Applicative (ReaderError r e)
Monad, Monad (ReaderError r e)
Alternative (ReaderError r e)
ReaderError r e a
Alternative (ReaderError r e)
-> Monad (ReaderError r e)
-> (forall a. ReaderError r e a)
-> (forall a.
    ReaderError r e a -> ReaderError r e a -> ReaderError r e a)
-> MonadPlus (ReaderError r e)
ReaderError r e a -> ReaderError r e a -> ReaderError r e a
forall a. ReaderError r e a
forall a.
ReaderError r e a -> ReaderError r e a -> ReaderError r e a
forall r e. (Monoid e, Error e) => Monad (ReaderError r e)
forall r e. (Monoid e, Error e) => Alternative (ReaderError r e)
forall r e a. (Monoid e, Error e) => ReaderError r e a
forall r e a.
(Monoid e, Error e) =>
ReaderError r e a -> ReaderError r e a -> ReaderError r e a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ReaderError r e a -> ReaderError r e a -> ReaderError r e a
$cmplus :: forall r e a.
(Monoid e, Error e) =>
ReaderError r e a -> ReaderError r e a -> ReaderError r e a
mzero :: ReaderError r e a
$cmzero :: forall r e a. (Monoid e, Error e) => ReaderError r e a
$cp2MonadPlus :: forall r e. (Monoid e, Error e) => Monad (ReaderError r e)
$cp1MonadPlus :: forall r e. (Monoid e, Error e) => Alternative (ReaderError r e)
MonadPlus)

instance (Error e, Monoid e) => MonadReader r (ReaderError r e) where
    ask :: ReaderError r e r
ask = ReaderT r (Either e) r -> ReaderError r e r
forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError ReaderT r (Either e) r
forall r (m :: * -> *). MonadReader r m => m r
ask
    local :: (r -> r) -> ReaderError r e a -> ReaderError r e a
local r -> r
f ReaderError r e a
m = ReaderT r (Either e) a -> ReaderError r e a
forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError (ReaderT r (Either e) a -> ReaderError r e a)
-> ReaderT r (Either e) a -> ReaderError r e a
forall a b. (a -> b) -> a -> b
$ (r -> r) -> ReaderT r (Either e) a -> ReaderT r (Either e) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (ReaderError r e a -> ReaderT r (Either e) a
forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError ReaderError r e a
m)

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

instance (Monoid e, Error e) => Alternative (ReaderError r e) where
    empty :: ReaderError r e a
empty = WrappedMonad (ReaderError r e) a -> ReaderError r e a
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad WrappedMonad (ReaderError r e) a
forall (f :: * -> *) a. Alternative f => f a
empty
    ReaderError r e a
f <|> :: ReaderError r e a -> ReaderError r e a -> ReaderError r e a
<|> ReaderError r e a
g = WrappedMonad (ReaderError r e) a -> ReaderError r e a
forall (m :: * -> *) a. WrappedMonad m a -> m a
unwrapMonad (WrappedMonad (ReaderError r e) a -> ReaderError r e a)
-> WrappedMonad (ReaderError r e) a -> ReaderError r e a
forall a b. (a -> b) -> a -> b
$ (ReaderError r e a -> WrappedMonad (ReaderError r e) a
forall (m :: * -> *) a. m a -> WrappedMonad m a
WrapMonad ReaderError r e a
f) WrappedMonad (ReaderError r e) a
-> WrappedMonad (ReaderError r e) a
-> WrappedMonad (ReaderError r e) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ReaderError r e a -> WrappedMonad (ReaderError r e) 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 :: Either e (a -> b) -> Either e a -> Either e b
apEither (Left e
errs1) (Left e
errs2) = e -> Either e b
forall a b. a -> Either a b
Left (e
errs1 e -> e -> e
forall a. Monoid a => a -> a -> a
`mappend` e
errs2)
apEither (Left e
errs)  Either e a
_            = e -> Either e b
forall a b. a -> Either a b
Left e
errs
apEither Either e (a -> b)
_            (Left e
errs)  = e -> Either e b
forall a b. a -> Either a b
Left e
errs
apEither (Right a -> b
f)    (Right a
a)    = b -> Either e b
forall a b. b -> Either a b
Right (a -> b
f a
a)

-- | a list of errors
newtype Errors a = Errors { Errors a -> [a]
unErrors :: [a] }
    deriving (Errors a -> Errors a -> Bool
(Errors a -> Errors a -> Bool)
-> (Errors a -> Errors a -> Bool) -> Eq (Errors a)
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, Eq (Errors a)
Eq (Errors a)
-> (Errors a -> Errors a -> Ordering)
-> (Errors a -> Errors a -> Bool)
-> (Errors a -> Errors a -> Bool)
-> (Errors a -> Errors a -> Bool)
-> (Errors a -> Errors a -> Bool)
-> (Errors a -> Errors a -> Errors a)
-> (Errors a -> Errors a -> Errors a)
-> Ord (Errors a)
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
$cp1Ord :: forall a. Ord a => Eq (Errors a)
Ord, Int -> Errors a -> ShowS
[Errors a] -> ShowS
Errors a -> String
(Int -> Errors a -> ShowS)
-> (Errors a -> String) -> ([Errors a] -> ShowS) -> Show (Errors a)
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)
Int -> ReadS (Errors a)
ReadS [Errors a]
(Int -> ReadS (Errors a))
-> ReadS [Errors a]
-> ReadPrec (Errors a)
-> ReadPrec [Errors a]
-> Read (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, Typeable (Errors a)
DataType
Constr
Typeable (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 (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Errors a))
-> (Errors a -> Constr)
-> (Errors a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Errors a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Errors a)))
-> ((forall b. Data b => b -> b) -> Errors a -> Errors a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Errors a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Errors a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Errors a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Errors a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Errors a -> m (Errors a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Errors a -> m (Errors a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Errors a -> m (Errors a))
-> Data (Errors a)
Errors a -> DataType
Errors a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Errors a))
(forall b. Data b => b -> b) -> Errors a -> Errors a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Errors a -> c (Errors a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Errors a)
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 u. Int -> (forall d. Data d => d -> u) -> Errors a -> u
forall u. (forall d. Data d => d -> u) -> Errors a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Errors a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Errors a -> m (Errors 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))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Errors a))
$cErrors :: Constr
$tErrors :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Errors a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Errors a -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall a. Data a => Typeable (Errors a)
Data, Typeable)

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

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

instance Error (Errors String) where
    noMsg :: Errors String
noMsg = [String] -> Errors String
forall a. [a] -> Errors a
Errors []
    strMsg :: String -> Errors String
strMsg String
str = [String] -> Errors String
forall a. [a] -> Errors a
Errors [String
str]

{- 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 :: ReaderError r e a -> r -> Either e a
runReaderError = ReaderT r (Either e) a -> r -> Either e a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ReaderT r (Either e) a -> r -> Either e a)
-> (ReaderError r e a -> ReaderT r (Either e) a)
-> ReaderError r e a
-> r
-> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderError r e a -> ReaderT r (Either e) a
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 { RqData a -> ReaderError RqEnv (Errors String) a
unRqData :: ReaderError RqEnv (Errors String) a }
    deriving (a -> RqData b -> RqData a
(a -> b) -> RqData a -> RqData b
(forall a b. (a -> b) -> RqData a -> RqData b)
-> (forall a b. a -> RqData b -> RqData a) -> Functor RqData
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
<$ :: a -> RqData b -> RqData a
$c<$ :: forall a b. a -> RqData b -> RqData a
fmap :: (a -> b) -> RqData a -> RqData b
$cfmap :: forall a b. (a -> b) -> RqData a -> RqData b
Functor, Applicative RqData
a -> RqData a
Applicative RqData
-> (forall a b. RqData a -> (a -> RqData b) -> RqData b)
-> (forall a b. RqData a -> RqData b -> RqData b)
-> (forall a. a -> RqData a)
-> Monad RqData
RqData a -> (a -> RqData b) -> RqData b
RqData a -> RqData b -> RqData b
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 :: a -> RqData a
$creturn :: forall a. a -> RqData a
>> :: RqData a -> RqData b -> RqData b
$c>> :: forall a b. RqData a -> RqData b -> RqData b
>>= :: RqData a -> (a -> RqData b) -> RqData b
$c>>= :: forall a b. RqData a -> (a -> RqData b) -> RqData b
$cp1Monad :: Applicative RqData
Monad, Monad RqData
Alternative RqData
RqData a
Alternative RqData
-> Monad RqData
-> (forall a. RqData a)
-> (forall a. RqData a -> RqData a -> RqData a)
-> MonadPlus RqData
RqData a -> RqData a -> RqData a
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 :: RqData a -> RqData a -> RqData a
$cmplus :: forall a. RqData a -> RqData a -> RqData a
mzero :: RqData a
$cmzero :: forall a. RqData a
$cp2MonadPlus :: Monad RqData
$cp1MonadPlus :: Alternative RqData
MonadPlus, Functor RqData
a -> RqData a
Functor RqData
-> (forall a. a -> RqData a)
-> (forall a b. RqData (a -> b) -> RqData a -> RqData b)
-> (forall a b c.
    (a -> b -> c) -> RqData a -> RqData b -> RqData c)
-> (forall a b. RqData a -> RqData b -> RqData b)
-> (forall a b. RqData a -> RqData b -> RqData a)
-> Applicative RqData
RqData a -> RqData b -> RqData b
RqData a -> RqData b -> RqData a
RqData (a -> b) -> RqData a -> RqData b
(a -> b -> c) -> RqData a -> RqData b -> RqData c
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
<* :: RqData a -> RqData b -> RqData a
$c<* :: forall a b. RqData a -> RqData b -> RqData a
*> :: RqData a -> RqData b -> RqData b
$c*> :: forall a b. RqData a -> RqData b -> RqData b
liftA2 :: (a -> b -> c) -> RqData a -> RqData b -> RqData c
$cliftA2 :: forall a b c. (a -> b -> c) -> RqData a -> RqData b -> RqData c
<*> :: RqData (a -> b) -> RqData a -> RqData b
$c<*> :: forall a b. RqData (a -> b) -> RqData a -> RqData b
pure :: a -> RqData a
$cpure :: forall a. a -> RqData a
$cp1Applicative :: Functor RqData
Applicative, Applicative RqData
RqData a
Applicative RqData
-> (forall a. RqData a)
-> (forall a. RqData a -> RqData a -> RqData a)
-> (forall a. RqData a -> RqData [a])
-> (forall a. RqData a -> RqData [a])
-> Alternative RqData
RqData a -> RqData a -> RqData a
RqData a -> RqData [a]
RqData a -> RqData [a]
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 :: RqData a -> RqData [a]
$cmany :: forall a. RqData a -> RqData [a]
some :: RqData a -> RqData [a]
$csome :: forall a. RqData a -> RqData [a]
<|> :: RqData a -> RqData a -> RqData a
$c<|> :: forall a. RqData a -> RqData a -> RqData a
empty :: RqData a
$cempty :: forall a. RqData a
$cp1Alternative :: Applicative RqData
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    = ReaderError RqEnv (Errors String) RqEnv -> RqData RqEnv
forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData ReaderError RqEnv (Errors String) RqEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
    localRqEnv :: (RqEnv -> RqEnv) -> RqData a -> RqData a
localRqEnv RqEnv -> RqEnv
f (RqData ReaderError RqEnv (Errors String) a
re) = ReaderError RqEnv (Errors String) a -> RqData a
forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData (ReaderError RqEnv (Errors String) a -> RqData a)
-> ReaderError RqEnv (Errors String) a -> RqData a
forall a b. (a -> b) -> a -> b
$ (RqEnv -> RqEnv)
-> ReaderError RqEnv (Errors String) a
-> ReaderError RqEnv (Errors String) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local RqEnv -> RqEnv
f ReaderError RqEnv (Errors String) a
re
    rqDataError :: Errors String -> RqData a
rqDataError Errors String
e = (Either (Errors String) () -> Either (Errors String) a)
-> RqData () -> RqData a
forall a b.
(Either (Errors String) a -> Either (Errors String) b)
-> RqData a -> RqData b
mapRqData ((Errors String -> Either (Errors String) (() -> a)
forall a b. a -> Either a b
Left Errors String
e) Either (Errors String) (() -> a)
-> Either (Errors String) () -> Either (Errors String) a
forall e a b.
Monoid e =>
Either e (a -> b) -> Either e a -> Either e b
`apEither`) (() -> RqData ()
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 = ServerPartT m RqEnv
forall (m :: * -> *). (ServerMonad m, MonadIO m) => m RqEnv
smAskRqEnv
    rqDataError :: Errors String -> ServerPartT m a
rqDataError Errors String
_e = ServerPartT m a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    localRqEnv :: (RqEnv -> RqEnv) -> ServerPartT m a -> ServerPartT m a
localRqEnv = (RqEnv -> RqEnv) -> ServerPartT m a -> ServerPartT m a
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      = m RqEnv -> ReaderT s m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> ReaderT s m a -> ReaderT s m a
localRqEnv RqEnv -> RqEnv
f  = (m a -> m a) -> ReaderT s m a -> ReaderT s m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((RqEnv -> RqEnv) -> m a -> m a
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> ReaderT s m a
rqDataError Errors String
e = m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> StateT s m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> StateT s m a -> StateT s m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Lazy.mapStateT ((RqEnv -> RqEnv) -> m (a, s) -> m (a, s)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> StateT s m a
rqDataError Errors String
e = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> StateT s m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> StateT s m a -> StateT s m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, s) -> m (a, s)) -> StateT s m a -> StateT s m a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
Strict.mapStateT ((RqEnv -> RqEnv) -> m (a, s) -> m (a, s)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> StateT s m a
rqDataError Errors String
e = m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> WriterT w m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> WriterT w m a -> WriterT w m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Lazy.mapWriterT ((RqEnv -> RqEnv) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> WriterT w m a
rqDataError Errors String
e = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> WriterT w m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> WriterT w m a -> WriterT w m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, w) -> m (a, w)) -> WriterT w m a -> WriterT w m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
Strict.mapWriterT ((RqEnv -> RqEnv) -> m (a, w) -> m (a, w)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> WriterT w m a
rqDataError Errors String
e = m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> RWST r w s m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> RWST r w s m a -> RWST r w s m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
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 ((RqEnv -> RqEnv) -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> RWST r w s m a
rqDataError Errors String
e = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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      = m RqEnv -> RWST r w s m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> RWST r w s m a -> RWST r w s m a
localRqEnv RqEnv -> RqEnv
f  = (m (a, s, w) -> m (a, s, w)) -> RWST r w s m a -> RWST r w s m a
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 ((RqEnv -> RqEnv) -> m (a, s, w) -> m (a, s, w)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> RWST r w s m a
rqDataError Errors String
e = m a -> RWST r w s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError Errors String
e)

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

instance (Monad m, HasRqData m) => HasRqData (ExceptT e m) where
    askRqEnv :: ExceptT e m RqEnv
askRqEnv      = m RqEnv -> ExceptT e m RqEnv
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
    localRqEnv :: (RqEnv -> RqEnv) -> ExceptT e m a -> ExceptT e m a
localRqEnv RqEnv -> RqEnv
f  = (m (Either e a) -> m (Either e a))
-> ExceptT e m a -> ExceptT e m a
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT ((RqEnv -> RqEnv) -> m (Either e a) -> m (Either e a)
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
f)
    rqDataError :: Errors String -> ExceptT e m a
rqDataError Errors String
e = m a -> ExceptT e m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Errors String -> m a
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 :: RqData a -> RqEnv -> Either [String] a
runRqData RqData a
rqData RqEnv
rqEnv =
    (Errors String -> Either [String] a)
-> (a -> Either [String] a)
-> Either (Errors String) a
-> Either [String] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([String] -> Either [String] a
forall a b. a -> Either a b
Left ([String] -> Either [String] a)
-> (Errors String -> [String])
-> Errors String
-> Either [String] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errors String -> [String]
forall a. Errors a -> [a]
unErrors) a -> Either [String] a
forall a b. b -> Either a b
Right (Either (Errors String) a -> Either [String] a)
-> Either (Errors String) a -> Either [String] a
forall a b. (a -> b) -> a -> b
$ ReaderError RqEnv (Errors String) a
-> RqEnv -> Either (Errors String) a
forall r e a. ReaderError r e a -> r -> Either e a
runReaderError (RqData a -> ReaderError RqEnv (Errors String) a
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 :: (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 = ReaderError RqEnv (Errors String) b -> RqData b
forall a. ReaderError RqEnv (Errors String) a -> RqData a
RqData (ReaderError RqEnv (Errors String) b -> RqData b)
-> ReaderError RqEnv (Errors String) b -> RqData b
forall a b. (a -> b) -> a -> b
$ ReaderT RqEnv (Either (Errors String)) b
-> ReaderError RqEnv (Errors String) b
forall r e a. ReaderT r (Either e) a -> ReaderError r e a
ReaderError (ReaderT RqEnv (Either (Errors String)) b
 -> ReaderError RqEnv (Errors String) b)
-> ReaderT RqEnv (Either (Errors String)) b
-> ReaderError RqEnv (Errors String) b
forall a b. (a -> b) -> a -> b
$ (Either (Errors String) a -> Either (Errors String) b)
-> ReaderT RqEnv (Either (Errors String)) a
-> ReaderT RqEnv (Either (Errors String)) 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 (ReaderError RqEnv (Errors String) a
-> ReaderT RqEnv (Either (Errors String)) a
forall r e a. ReaderError r e a -> ReaderT r (Either e) a
unReaderError (RqData a -> ReaderError RqEnv (Errors String) a
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 :: String -> String -> Either String a
unsafeReadRq String
key String
val =
    case ReadS a
forall a. Read a => ReadS a
reads String
val of
      [(a
a,[])] -> a -> Either String a
forall a b. b -> Either a b
Right a
a
      [(a, String)]
_        -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"readRq failed while parsing key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which has the value: " String -> ShowS
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 :: String -> String -> Either String a
readRq String
key String
val =
    case String -> Maybe a
forall a. FromReqURI a => String -> Maybe a
fromReqURI String
val of
      (Just a
a) -> a -> Either String a
forall a b. b -> Either a b
Right a
a
      Maybe a
_        -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"readRq failed while parsing key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" which has the value: " String -> ShowS
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 :: 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)  -> Errors String -> m b
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (String -> Errors String
forall a. Error a => String -> a
strMsg String
e)
         (Right b
b) -> b -> m 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 :: 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)  -> Errors String -> m b
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (String -> Errors String
forall a. Error a => String -> a
strMsg String
e)
         (Right b
b) -> b -> m 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 = (,)   (a -> b -> (a, b)) -> RqData a -> RqData (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RqData a
forall a. FromData a => RqData a
fromData RqData (b -> (a, b)) -> RqData b -> RqData (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData 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 = (,,)  (a -> b -> c -> (a, b, c))
-> RqData a -> RqData (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RqData a
forall a. FromData a => RqData a
fromData RqData (b -> c -> (a, b, c)) -> RqData b -> RqData (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData b
forall a. FromData a => RqData a
fromData RqData (c -> (a, b, c)) -> RqData c -> RqData (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData c
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 = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> RqData a -> RqData (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RqData a
forall a. FromData a => RqData a
fromData RqData (b -> c -> d -> (a, b, c, d))
-> RqData b -> RqData (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData b
forall a. FromData a => RqData a
fromData RqData (c -> d -> (a, b, c, d))
-> RqData c -> RqData (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData c
forall a. FromData a => RqData a
fromData RqData (d -> (a, b, c, d)) -> RqData d -> RqData (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RqData d
forall a. FromData a => RqData a
fromData

instance FromData a => FromData (Maybe a) where
    fromData :: RqData (Maybe a)
fromData = (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> RqData a -> RqData (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RqData a
forall a. FromData a => RqData a
fromData) RqData (Maybe a) -> RqData (Maybe a) -> RqData (Maybe a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe a -> RqData (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
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 :: a -> [(a, b)] -> [b]
lookups a
a = ((a, b) -> b) -> [(a, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> b
forall a b. (a, b) -> b
snd ([(a, b)] -> [b]) -> ([(a, b)] -> [(a, b)]) -> [(a, b)] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, b) -> a
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 -> String -> [(String, Input)]
forall a. HasCallStack => String -> a
error (String -> [(String, Input)]) -> String -> [(String, Input)]
forall a b. (a -> b) -> a -> b
$ String
funName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldName String -> ShowS
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 :: String -> m Input
lookInput String
name
    = do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- m RqEnv
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 String -> [(String, Input)] -> Maybe Input
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name ([(String, Input)]
query [(String, Input)] -> [(String, Input)] -> [(String, Input)]
forall a. [a] -> [a] -> [a]
++ [(String, Input)]
bdy) of
           Just Input
i  -> Input -> m Input
forall (m :: * -> *) a. Monad m => a -> m a
return (Input -> m Input) -> Input -> m Input
forall a b. (a -> b) -> a -> b
$ Input
i
           Maybe Input
Nothing -> Errors String -> m Input
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (String -> Errors String
forall a. Error a => String -> a
strMsg (String -> Errors String) -> String -> Errors String
forall a b. (a -> b) -> a -> b
$ String
"Parameter not found: " String -> ShowS
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 :: String -> m [Input]
lookInputs String
name
    = do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- m RqEnv
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
         [Input] -> m [Input]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Input] -> m [Input]) -> [Input] -> m [Input]
forall a b. (a -> b) -> a -> b
$ String -> [(String, Input)] -> [Input]
forall a b. Eq a => a -> [(a, b)] -> [b]
lookups String
name ([(String, Input)]
query [(String, Input)] -> [(String, Input)] -> [(String, Input)]
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 :: String -> m ByteString
lookBS String
n =
    do Either String ByteString
i <- (Input -> Either String ByteString)
-> m Input -> m (Either String ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Input -> Either String ByteString
inputValue (String -> m Input
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Input
lookInput String
n)
       case Either String ByteString
i of
         (Left String
_fp) -> Errors String -> m ByteString
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (Errors String -> m ByteString) -> Errors String -> m ByteString
forall a b. (a -> b) -> a -> b
$ (String -> Errors String
forall a. Error a => String -> a
strMsg (String -> Errors String) -> String -> Errors String
forall a b. (a -> b) -> a -> b
$ String
"lookBS: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is a file.")
         (Right ByteString
bs) -> ByteString -> m ByteString
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 :: String -> m [ByteString]
lookBSs String
n =
    do [Either String ByteString]
is <- ([Input] -> [Either String ByteString])
-> m [Input] -> m [Either String ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Input -> Either String ByteString)
-> [Input] -> [Either String ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Input -> Either String ByteString
inputValue) (String -> m [Input]
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m [Input]
lookInputs String
n)
       case [Either String ByteString] -> ([String], [ByteString])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String ByteString]
is of
         ([], [ByteString]
bs) -> [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return [ByteString]
bs
         ([String]
_fp, [ByteString]
_) -> Errors String -> m [ByteString]
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (String -> Errors String
forall a. Error a => String -> a
strMsg (String -> Errors String) -> String -> Errors String
forall a b. (a -> b) -> a -> b
$ String
"lookBSs: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
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 :: String -> m String
look = (ByteString -> String) -> m ByteString -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> String
LU.toString (m ByteString -> m String)
-> (String -> m ByteString) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
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 :: String -> m [String]
looks = ([ByteString] -> [String]) -> m [ByteString] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
LU.toString) (m [ByteString] -> m [String])
-> (String -> m [ByteString]) -> String -> m [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [ByteString]
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 :: String -> m Text
lookText = (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
LazyText.decodeUtf8 (m ByteString -> m Text)
-> (String -> m ByteString) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ByteString
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' :: String -> m Text
lookText' = (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
LazyText.toStrict (m Text -> m Text) -> (String -> m Text) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Text
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 :: String -> m [Text]
lookTexts = ([ByteString] -> [Text]) -> m [ByteString] -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Text
LazyText.decodeUtf8) (m [ByteString] -> m [Text])
-> (String -> m [ByteString]) -> String -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [ByteString]
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' :: String -> m [Text]
lookTexts' = ([Text] -> [Text]) -> m [Text] -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
LazyText.toStrict) (m [Text] -> m [Text])
-> (String -> m [Text]) -> String -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m [Text]
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 :: String -> m Cookie
lookCookie String
name
    = do ([(String, Input)]
_query,Maybe [(String, Input)]
_body, [(String, Cookie)]
cookies) <- m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
         case String -> [(String, Cookie)] -> Maybe Cookie
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
name) [(String, Cookie)]
cookies of -- keys are lowercased
           Maybe Cookie
Nothing -> Errors String -> m Cookie
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (Errors String -> m Cookie) -> Errors String -> m Cookie
forall a b. (a -> b) -> a -> b
$ String -> Errors String
forall a. Error a => String -> a
strMsg (String -> Errors String) -> String -> Errors String
forall a b. (a -> b) -> a -> b
$ String
"lookCookie: cookie not found: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
           Just Cookie
c  -> Cookie -> m Cookie
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 ShowS -> (Cookie -> String) -> Cookie -> String
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 :: String -> m String
lookCookieValue = (Cookie -> String) -> m Cookie -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> String
cookieValue (m Cookie -> m String)
-> (String -> m Cookie) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m Cookie
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 :: String -> m a
readCookieValue String
name = (Cookie -> String) -> m Cookie -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cookie -> String
cookieValue (String -> m Cookie
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Cookie
lookCookie String
name) m String -> (String -> Either String a) -> m a
forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (String -> String -> Either String a
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 :: String -> m a
lookRead String
name = String -> m String
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m String
look String
name m String -> (String -> Either String a) -> m a
forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (String -> String -> Either String a
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 :: String -> m [a]
lookReads String
name =
    do [String]
vals <- String -> m [String]
forall (m :: * -> *).
(Functor m, Monad m, HasRqData m) =>
String -> m [String]
looks String
name
       (String -> m a) -> [String] -> m [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\String
v -> (String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
v) m String -> (String -> Either String a) -> m a
forall (m :: * -> *) a b.
(Monad m, HasRqData m) =>
m a -> (a -> Either String b) -> m b
`checkRq` (String -> String -> Either String a
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 :: String -> m (String, String, ContentType)
lookFile String
n =
    do Input
i <- String -> m Input
forall (m :: * -> *). (Monad m, HasRqData m) => String -> m Input
lookInput String
n
       case Input -> Either String ByteString
inputValue Input
i of
         (Right ByteString
_) -> Errors String -> m (String, String, ContentType)
forall (m :: * -> *) a. HasRqData m => Errors String -> m a
rqDataError (Errors String -> m (String, String, ContentType))
-> Errors String -> m (String, String, ContentType)
forall a b. (a -> b) -> a -> b
$ (String -> Errors String
forall a. Error a => String -> a
strMsg (String -> Errors String) -> String -> Errors String
forall a b. (a -> b) -> a -> b
$ String
"lookFile: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" was found but is not a file.")
         (Left String
fp) -> (String, String, ContentType) -> m (String, String, ContentType)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
fp, Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
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 :: m [(String, Either String String)]
lookPairs =
    do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- m RqEnv
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
       [(String, Either String String)]
-> m [(String, Either String String)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, Either String String)]
 -> m [(String, Either String String)])
-> [(String, Either String String)]
-> m [(String, Either String String)]
forall a b. (a -> b) -> a -> b
$ ((String, Input) -> (String, Either String String))
-> [(String, Input)] -> [(String, Either String String)]
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 -> String -> Either String String
forall a b. a -> Either a b
Left String
fp ; Right ByteString
bs -> String -> Either String String
forall a b. b -> Either a b
Right (ByteString -> String
LU.toString ByteString
bs)) (Either String ByteString -> Either String String)
-> Either String ByteString -> Either String String
forall a b. (a -> b) -> a -> b
$ Input -> Either String ByteString
inputValue Input
vbs)) ([(String, Input)]
query [(String, Input)] -> [(String, Input)] -> [(String, Input)]
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 :: m [(String, Either String ByteString)]
lookPairsBS =
    do ([(String, Input)]
query, Maybe [(String, Input)]
mBody, [(String, Cookie)]
_cookies) <- m RqEnv
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
       [(String, Either String ByteString)]
-> m [(String, Either String ByteString)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, Either String ByteString)]
 -> m [(String, Either String ByteString)])
-> [(String, Either String ByteString)]
-> m [(String, Either String ByteString)]
forall a b. (a -> b) -> a -> b
$ ((String, Input) -> (String, Either String ByteString))
-> [(String, Input)] -> [(String, Either String ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,Input
vbs) -> (String
n, Input -> Either String ByteString
inputValue Input
vbs)) ([(String, Input)]
query [(String, Input)] -> [(String, Input)] -> [(String, Input)]
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 :: BodyPolicy -> m ()
decodeBody BodyPolicy
bp =
    do Request
rq <- m Request
forall (m :: * -> *). ServerMonad m => m Request
askRq
       ([(String, Input)]
_, Maybe String
me) <- BodyPolicy -> Request -> m ([(String, Input)], Maybe String)
forall (m :: * -> *).
MonadIO m =>
BodyPolicy -> Request -> m ([(String, Input)], Maybe String)
bodyInput BodyPolicy
bp Request
rq
       case Maybe String
me of
         Maybe String
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         Just String
e  -> 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
requestEntityTooLarge (String -> Response
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 :: RqData a -> m (Either [String] a)
getDataFn RqData a
rqData =
    do RqEnv
rqEnv <- m RqEnv
forall (m :: * -> *). HasRqData m => m RqEnv
askRqEnv
       Either [String] a -> m (Either [String] a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RqData a -> RqEnv -> Either [String] a
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 :: RqData a -> (a -> m r) -> m r
withDataFn RqData a
fn a -> m r
handle = RqData a -> m (Either [String] a)
forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn RqData a
fn m (Either [String] a) -> (Either [String] a -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([String] -> m r) -> (a -> m r) -> Either [String] a -> m r
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (m r -> [String] -> m r
forall a b. a -> b -> a
const m r
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 :: m (Either [String] a)
getData = RqData a -> m (Either [String] a)
forall (m :: * -> *) a.
(HasRqData m, ServerMonad m) =>
RqData a -> m (Either [String] a)
getDataFn RqData a
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 :: (a -> m r) -> m r
withData = RqData a -> (a -> m r) -> m r
forall (m :: * -> *) a r.
(HasRqData m, MonadPlus m, ServerMonad m) =>
RqData a -> (a -> m r) -> m r
withDataFn RqData a
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 :: m a -> m a
body m a
rqData = (RqEnv -> RqEnv) -> m a -> m a
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
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 :: m a -> m a
queryString m a
rqData = (RqEnv -> RqEnv) -> m a -> m a
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
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, [a] -> Maybe [a]
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 :: m a -> m a
bytestring m a
rqData = (RqEnv -> RqEnv) -> m a -> m a
forall (m :: * -> *) a.
HasRqData m =>
(RqEnv -> RqEnv) -> m a -> m a
localRqEnv RqEnv -> RqEnv
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) = (((a, Input) -> Bool) -> [(a, Input)] -> [(a, Input)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Input) -> Bool
forall a. (a, Input) -> Bool
bsf [(a, Input)]
query, ((a, Input) -> Bool) -> [(a, Input)] -> [(a, Input)]
forall a. (a -> Bool) -> [a] -> [a]
filter (a, Input) -> Bool
forall a. (a, Input) -> Bool
bsf ([(a, Input)] -> [(a, Input)]) -> f [(a, Input)] -> f [(a, Input)]
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