module Web.Twain
( ResponderM,
get,
put,
patch,
post,
delete,
route,
notFound,
param,
paramEither,
paramMaybe,
params,
queryParam,
queryParamMaybe,
queryParamEither,
queryParams,
pathParam,
pathParamMaybe,
pathParamEither,
pathParams,
cookieParam,
cookieParamMaybe,
cookieParamEither,
cookieParams,
file,
fileMaybe,
files,
fromBody,
header,
headers,
request,
send,
next,
redirect301,
redirect302,
redirect303,
text,
html,
json,
xml,
css,
raw,
status,
withHeader,
withCookie,
withCookie',
expireCookie,
HttpError (..),
onException,
withParseBodyOpts,
withMaxBodySize,
ParsableParam (..),
module Network.HTTP.Types,
module Network.Wai,
FileInfo (..),
)
where
import Control.Exception (SomeException, handle)
import Control.Monad.Catch (throwM)
import Data.Aeson (ToJSON)
import qualified Data.Aeson as JSON
import Data.ByteString.Char8 as Char8
import Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.Either.Combinators (rightToMaybe)
import qualified Data.List as L
import Data.Maybe (fromMaybe)
import Data.Text as T
import Data.Text.Encoding
import Data.Time
import qualified Data.Vault.Lazy as V
import Data.Word (Word64)
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Parse hiding (Param)
import Network.Wai.Request
import System.Environment (lookupEnv)
import Web.Cookie
import Web.Twain.Internal
import Web.Twain.Types
get :: PathPattern -> ResponderM a -> Middleware
get :: forall a. PathPattern -> ResponderM a -> Middleware
get = forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route (forall a. a -> Maybe a
Just ByteString
"GET")
put :: PathPattern -> ResponderM a -> Middleware
put :: forall a. PathPattern -> ResponderM a -> Middleware
put = forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route (forall a. a -> Maybe a
Just ByteString
"PUT")
patch :: PathPattern -> ResponderM a -> Middleware
patch :: forall a. PathPattern -> ResponderM a -> Middleware
patch = forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route (forall a. a -> Maybe a
Just ByteString
"PATCH")
post :: PathPattern -> ResponderM a -> Middleware
post :: forall a. PathPattern -> ResponderM a -> Middleware
post = forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route (forall a. a -> Maybe a
Just ByteString
"POST")
delete :: PathPattern -> ResponderM a -> Middleware
delete :: forall a. PathPattern -> ResponderM a -> Middleware
delete = forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route (forall a. a -> Maybe a
Just ByteString
"DELETE")
route :: Maybe Method -> PathPattern -> ResponderM a -> Middleware
route :: forall a.
Maybe ByteString -> PathPattern -> ResponderM a -> Middleware
route Maybe ByteString
method PathPattern
pat (ResponderM Request -> IO (Either RouteAction (a, Request))
responder) Application
app Request
req Response -> IO ResponseReceived
respond = do
let maxM :: Maybe Word64
maxM = ResponderOptions -> Word64
optsMaxBodySize forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Key a -> Vault -> Maybe a
V.lookup Key ResponderOptions
responderOptsKey (Request -> Vault
vault Request
req)
Request
req' <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
req) (forall a b c. (a -> b -> c) -> b -> a -> c
flip Word64 -> Request -> IO Request
requestSizeCheck Request
req) Maybe Word64
maxM
case Maybe ByteString -> PathPattern -> Request -> Maybe [Param]
match Maybe ByteString
method PathPattern
pat Request
req' of
Maybe [Param]
Nothing -> Application
app Request
req' Response -> IO ResponseReceived
respond
Just [Param]
pathParams -> do
let preq :: ParsedRequest
preq = Request -> ParsedRequest
parseRequest Request
req'
preq' :: ParsedRequest
preq' = ParsedRequest
preq {preqPathParams :: [Param]
preqPathParams = [Param]
pathParams}
req'' :: Request
req'' = Request
req' {vault :: Vault
vault = forall a. Key a -> a -> Vault -> Vault
V.insert Key ParsedRequest
parsedReqKey ParsedRequest
preq' (Request -> Vault
vault Request
req')}
Either RouteAction (a, Request)
eres <- Request -> IO (Either RouteAction (a, Request))
responder Request
req''
case Either RouteAction (a, Request)
eres of
Left (Respond Response
res) -> Response -> IO ResponseReceived
respond Response
res
Either RouteAction (a, Request)
_ -> Application
app Request
req'' Response -> IO ResponseReceived
respond
notFound :: ResponderM a -> Application
notFound :: forall a. ResponderM a -> Application
notFound (ResponderM Request -> IO (Either RouteAction (a, Request))
responder) Request
req Response -> IO ResponseReceived
respond = do
let preq :: ParsedRequest
preq = Request -> ParsedRequest
parseRequest Request
req
req' :: Request
req' = Request
req {vault :: Vault
vault = forall a. Key a -> a -> Vault -> Vault
V.insert Key ParsedRequest
parsedReqKey ParsedRequest
preq (Request -> Vault
vault Request
req)}
Either RouteAction (a, Request)
eres <- Request -> IO (Either RouteAction (a, Request))
responder Request
req'
case Either RouteAction (a, Request)
eres of
Left (Respond Response
res) -> Response -> IO ResponseReceived
respond forall a b. (a -> b) -> a -> b
$ (Status -> Status) -> Response -> Response
mapResponseStatus (forall a b. a -> b -> a
const Status
status404) Response
res
Either RouteAction (a, Request)
_ -> Response -> IO ResponseReceived
respond forall a b. (a -> b) -> a -> b
$ Status -> Response -> Response
status Status
status404 forall a b. (a -> b) -> a -> b
$ Text -> Response
text Text
"Not found."
onException :: (SomeException -> ResponderM a) -> Middleware
onException :: forall a. (SomeException -> ResponderM a) -> Middleware
onException SomeException -> ResponderM a
h Application
app Request
req Response -> IO ResponseReceived
respond = do
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO ResponseReceived
handler forall a b. (a -> b) -> a -> b
$ Application
app Request
req Response -> IO ResponseReceived
respond
where
handler :: SomeException -> IO ResponseReceived
handler SomeException
err = do
let preq :: ParsedRequest
preq = Request -> ParsedRequest
parseRequest Request
req
req' :: Request
req' = Request
req {vault :: Vault
vault = forall a. Key a -> a -> Vault -> Vault
V.insert Key ParsedRequest
parsedReqKey ParsedRequest
preq (Request -> Vault
vault Request
req)}
let (ResponderM Request -> IO (Either RouteAction (a, Request))
responder) = SomeException -> ResponderM a
h SomeException
err
Either RouteAction (a, Request)
eres <- Request -> IO (Either RouteAction (a, Request))
responder Request
req'
case Either RouteAction (a, Request)
eres of
Left (Respond Response
res) -> Response -> IO ResponseReceived
respond Response
res
Either RouteAction (a, Request)
_ -> Application
app Request
req' Response -> IO ResponseReceived
respond
withMaxBodySize :: Word64 -> Middleware
withMaxBodySize :: Word64 -> Middleware
withMaxBodySize Word64
max Application
app Request
req Response -> IO ResponseReceived
respond = do
let optsM :: Maybe ResponderOptions
optsM = forall a. Key a -> Vault -> Maybe a
V.lookup Key ResponderOptions
responderOptsKey (Request -> Vault
vault Request
req)
opts :: ResponderOptions
opts = forall a. a -> Maybe a -> a
fromMaybe ResponderOptions
defaultResponderOpts Maybe ResponderOptions
optsM
opts' :: ResponderOptions
opts' = ResponderOptions
opts {optsMaxBodySize :: Word64
optsMaxBodySize = Word64
max}
let req' :: Request
req' = Request
req {vault :: Vault
vault = forall a. Key a -> a -> Vault -> Vault
V.insert Key ResponderOptions
responderOptsKey ResponderOptions
opts' (Request -> Vault
vault Request
req)}
Application
app Request
req' Response -> IO ResponseReceived
respond
withParseBodyOpts :: ParseRequestBodyOptions -> Middleware
withParseBodyOpts :: ParseRequestBodyOptions -> Middleware
withParseBodyOpts ParseRequestBodyOptions
parseBodyOpts Application
app Request
req Response -> IO ResponseReceived
respond = do
let optsM :: Maybe ResponderOptions
optsM = forall a. Key a -> Vault -> Maybe a
V.lookup Key ResponderOptions
responderOptsKey (Request -> Vault
vault Request
req)
opts :: ResponderOptions
opts = forall a. a -> Maybe a -> a
fromMaybe ResponderOptions
defaultResponderOpts Maybe ResponderOptions
optsM
opts' :: ResponderOptions
opts' = ResponderOptions
opts {optsParseBody :: ParseRequestBodyOptions
optsParseBody = ParseRequestBodyOptions
parseBodyOpts}
let req' :: Request
req' = Request
req {vault :: Vault
vault = forall a. Key a -> a -> Vault -> Vault
V.insert Key ResponderOptions
responderOptsKey ResponderOptions
opts' (Request -> Vault
vault Request
req)}
Application
app Request
req' Response -> IO ResponseReceived
respond
param :: ParsableParam a => Text -> ResponderM a
param :: forall a. ParsableParam a => Text -> ResponderM a
param Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
params
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResponderM a
next (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. ResponderM a
next) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
paramEither :: ParsableParam a => Text -> ResponderM (Either HttpError a)
paramEither :: forall a.
ParsableParam a =>
Text -> ResponderM (Either HttpError a)
paramEither Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
pM of
Maybe Text
Nothing ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Status -> String -> HttpError
HttpError Status
status400 (String
"missing parameter: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name)
Just Text
p -> forall a. ParsableParam a => Text -> Either HttpError a
parseParam Text
p
paramMaybe :: ParsableParam a => Text -> ResponderM (Maybe a)
paramMaybe :: forall a. ParsableParam a => Text -> ResponderM (Maybe a)
paramMaybe Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
params
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
params :: ResponderM [Param]
params :: ResponderM [Param]
params = ParsedRequest -> [Param]
concatParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM ParsedRequest
parseBodyForm
queryParam :: ParsableParam a => Text -> ResponderM a
queryParam :: forall a. ParsableParam a => Text -> ResponderM a
queryParam Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
queryParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResponderM a
next (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. ResponderM a
next) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
queryParamEither :: ParsableParam a => Text -> ResponderM (Either HttpError a)
queryParamEither :: forall a.
ParsableParam a =>
Text -> ResponderM (Either HttpError a)
queryParamEither Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
queryParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
pM of
Maybe Text
Nothing ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Status -> String -> HttpError
HttpError Status
status400 (String
"missing parameter: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name)
Just Text
p -> forall a. ParsableParam a => Text -> Either HttpError a
parseParam Text
p
queryParamMaybe :: ParsableParam a => Text -> ResponderM (Maybe a)
queryParamMaybe :: forall a. ParsableParam a => Text -> ResponderM (Maybe a)
queryParamMaybe Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
queryParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
queryParams :: ResponderM [Param]
queryParams :: ResponderM [Param]
queryParams = ParsedRequest -> [Param]
preqQueryParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM ParsedRequest
parseBodyForm
pathParam :: ParsableParam a => Text -> ResponderM a
pathParam :: forall a. ParsableParam a => Text -> ResponderM a
pathParam Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
pathParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResponderM a
next (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. ResponderM a
next) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
pathParamEither :: ParsableParam a => Text -> ResponderM (Either HttpError a)
pathParamEither :: forall a.
ParsableParam a =>
Text -> ResponderM (Either HttpError a)
pathParamEither Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
pathParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
pM of
Maybe Text
Nothing ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Status -> String -> HttpError
HttpError Status
status400 (String
"missing parameter: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name)
Just Text
p -> forall a. ParsableParam a => Text -> Either HttpError a
parseParam Text
p
pathParamMaybe :: ParsableParam a => Text -> ResponderM (Maybe a)
pathParamMaybe :: forall a. ParsableParam a => Text -> ResponderM (Maybe a)
pathParamMaybe Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
pathParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
pathParams :: ResponderM [Param]
pathParams :: ResponderM [Param]
pathParams = ParsedRequest -> [Param]
preqPathParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM ParsedRequest
parseBodyForm
cookieParam :: ParsableParam a => Text -> ResponderM a
cookieParam :: forall a. ParsableParam a => Text -> ResponderM a
cookieParam Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
cookieParams
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResponderM a
next (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. ResponderM a
next) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
cookieParamEither :: ParsableParam a => Text -> ResponderM (Either HttpError a)
cookieParamEither :: forall a.
ParsableParam a =>
Text -> ResponderM (Either HttpError a)
cookieParamEither Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
cookieParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe Text
pM of
Maybe Text
Nothing ->
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Status -> String -> HttpError
HttpError Status
status400 (String
"missing parameter: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name)
Just Text
p -> forall a. ParsableParam a => Text -> Either HttpError a
parseParam Text
p
cookieParamMaybe :: ParsableParam a => Text -> ResponderM (Maybe a)
cookieParamMaybe :: forall a. ParsableParam a => Text -> ResponderM (Maybe a)
cookieParamMaybe Text
name = do
Maybe Text
pM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [Param]
cookieParams
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Maybe a
Nothing (forall a b. Either a b -> Maybe b
rightToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParsableParam a => Text -> Either HttpError a
parseParam) Maybe Text
pM
cookieParams :: ResponderM [Param]
cookieParams :: ResponderM [Param]
cookieParams = ParsedRequest -> [Param]
preqCookieParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM ParsedRequest
parseBodyForm
file :: Text -> ResponderM (FileInfo BL.ByteString)
file :: Text -> ResponderM (FileInfo ByteString)
file Text
name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ResponderM a
next forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> ResponderM (Maybe (FileInfo ByteString))
fileMaybe Text
name
fileMaybe :: Text -> ResponderM (Maybe (FileInfo BL.ByteString))
fileMaybe :: Text -> ResponderM (Maybe (FileInfo ByteString))
fileMaybe Text
name = do
Maybe (FileInfo ByteString)
fM <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) (Text -> ByteString
encodeUtf8 Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [(ByteString, FileInfo ByteString)]
files
case forall c. FileInfo c -> c
fileContent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FileInfo ByteString)
fM of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ByteString
"" -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Just ByteString
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FileInfo ByteString)
fM
files :: ResponderM [File BL.ByteString]
files :: ResponderM [(ByteString, FileInfo ByteString)]
files = Maybe ParsedBody -> [(ByteString, FileInfo ByteString)]
fs forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedRequest -> Maybe ParsedBody
preqBody forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM ParsedRequest
parseBodyForm
where
fs :: Maybe ParsedBody -> [(ByteString, FileInfo ByteString)]
fs Maybe ParsedBody
bodyM = case Maybe ParsedBody
bodyM of
Just (FormBody ([Param]
_, [(ByteString, FileInfo ByteString)]
fs)) -> [(ByteString, FileInfo ByteString)]
fs
Maybe ParsedBody
_ -> []
fromBody :: JSON.FromJSON a => ResponderM a
fromBody :: forall a. FromJSON a => ResponderM a
fromBody = do
Value
json <- ResponderM Value
parseBodyJson
case forall a. FromJSON a => Value -> Result a
JSON.fromJSON Value
json of
JSON.Error String
msg -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ Status -> String -> HttpError
HttpError Status
status400 String
msg
JSON.Success a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return a
a
header :: Text -> ResponderM (Maybe Text)
Text
name = do
let ciname :: HeaderName
ciname = forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
encodeUtf8 Text
name)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Eq a => a -> a -> Bool
(==) HeaderName
ciname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM [(HeaderName, ByteString)]
headers
headers :: ResponderM [Header]
= Request -> [(HeaderName, ByteString)]
requestHeaders forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResponderM Request
request
request :: ResponderM Request
request :: ResponderM Request
request = ResponderM Request
getRequest
send :: Response -> ResponderM a
send :: forall a. Response -> ResponderM a
send Response
res = forall a.
(Request -> IO (Either RouteAction (a, Request))) -> ResponderM a
ResponderM forall a b. (a -> b) -> a -> b
$ \Request
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Response -> RouteAction
Respond Response
res)
next :: ResponderM a
next :: forall a. ResponderM a
next = forall a.
(Request -> IO (Either RouteAction (a, Request))) -> ResponderM a
ResponderM forall a b. (a -> b) -> a -> b
$ \Request
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left RouteAction
Next)
text :: Text -> Response
text :: Text -> Response
text =
Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status200 [(HeaderName
hContentType, ByteString
"text/plain; charset=utf-8")] forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
html :: BL.ByteString -> Response
html :: ByteString -> Response
html =
Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status200 [(HeaderName
hContentType, ByteString
"text/html; charset=utf-8")]
json :: ToJSON a => a -> Response
json :: forall a. ToJSON a => a -> Response
json =
Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status200 [(HeaderName
hContentType, ByteString
"application/json; charset=utf-8")] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
JSON.encode
css :: BL.ByteString -> Response
css :: ByteString -> Response
css =
Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status200 [(HeaderName
hContentType, ByteString
"text/css; charset=utf-8")]
xml :: BL.ByteString -> Response
xml :: ByteString -> Response
xml = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status200 [(HeaderName
hContentType, ByteString
"application/xml; charset=utf-8")]
raw :: Status -> [Header] -> BL.ByteString -> Response
raw :: Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status [(HeaderName, ByteString)]
headers ByteString
body =
if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
L.any ((HeaderName
hContentLength forall a. Eq a => a -> a -> Bool
==) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(HeaderName, ByteString)]
headers
then Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status [(HeaderName, ByteString)]
headers ByteString
body
else
let len :: (HeaderName, ByteString)
len = (HeaderName
hContentLength, String -> ByteString
Char8.pack (forall a. Show a => a -> String
show (ByteString -> Int64
BL.length ByteString
body)))
in Status -> [(HeaderName, ByteString)] -> ByteString -> Response
responseLBS Status
status ((HeaderName, ByteString)
len forall a. a -> [a] -> [a]
: [(HeaderName, ByteString)]
headers) ByteString
body
status :: Status -> Response -> Response
status :: Status -> Response -> Response
status Status
s = (Status -> Status) -> Response -> Response
mapResponseStatus (forall a b. a -> b -> a
const Status
s)
withHeader :: Header -> Response -> Response
(HeaderName, ByteString)
header = ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> Response -> Response
mapResponseHeaders ((HeaderName, ByteString)
header forall a. a -> [a] -> [a]
:)
withCookie :: Text -> Text -> Response -> Response
withCookie :: Text -> Text -> Response -> Response
withCookie Text
key Text
val Response
res =
let setCookie :: SetCookie
setCookie =
SetCookie
defaultSetCookie
{ setCookieName :: ByteString
setCookieName = Text -> ByteString
encodeUtf8 Text
key,
setCookieValue :: ByteString
setCookieValue = Text -> ByteString
encodeUtf8 Text
val,
setCookiePath :: Maybe ByteString
setCookiePath = forall a. a -> Maybe a
Just ByteString
"/",
setCookieHttpOnly :: Bool
setCookieHttpOnly = Bool
True
}
header :: (HeaderName, ByteString)
header = (forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Set-Cookie", SetCookie -> ByteString
setCookieByteString SetCookie
setCookie)
in ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> Response -> Response
mapResponseHeaders ((HeaderName, ByteString)
header forall a. a -> [a] -> [a]
:) Response
res
withCookie' :: SetCookie -> Response -> Response
withCookie' :: SetCookie -> Response -> Response
withCookie' SetCookie
setCookie Response
res =
let header :: (HeaderName, ByteString)
header = (forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Set-Cookie", SetCookie -> ByteString
setCookieByteString SetCookie
setCookie)
in ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> Response -> Response
mapResponseHeaders ((HeaderName, ByteString)
header forall a. a -> [a] -> [a]
:) Response
res
expireCookie :: Text -> Response -> Response
expireCookie :: Text -> Response -> Response
expireCookie Text
key Response
res = do
let zeroTime :: UTCTime
zeroTime = Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
0) (Integer -> DiffTime
secondsToDiffTime Integer
0)
setCookie :: SetCookie
setCookie =
SetCookie
defaultSetCookie
{ setCookieName :: ByteString
setCookieName = Text -> ByteString
encodeUtf8 Text
key,
setCookiePath :: Maybe ByteString
setCookiePath = forall a. a -> Maybe a
Just ByteString
"/",
setCookieHttpOnly :: Bool
setCookieHttpOnly = Bool
True,
setCookieExpires :: Maybe UTCTime
setCookieExpires = forall a. a -> Maybe a
Just UTCTime
zeroTime
}
header :: (HeaderName, ByteString)
header = (forall s. FoldCase s => s -> CI s
CI.mk ByteString
"Set-Cookie", SetCookie -> ByteString
setCookieByteString SetCookie
setCookie)
in ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> Response -> Response
mapResponseHeaders ((HeaderName, ByteString)
header forall a. a -> [a] -> [a]
:) Response
res
redirect301 :: Text -> Response
redirect301 :: Text -> Response
redirect301 Text
url = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status301 [(HeaderName
hLocation, Text -> ByteString
encodeUtf8 Text
url)] ByteString
""
redirect302 :: Text -> Response
redirect302 :: Text -> Response
redirect302 Text
url = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status302 [(HeaderName
hLocation, Text -> ByteString
encodeUtf8 Text
url)] ByteString
""
redirect303 :: Text -> Response
redirect303 :: Text -> Response
redirect303 Text
url = Status -> [(HeaderName, ByteString)] -> ByteString -> Response
raw Status
status303 [(HeaderName
hLocation, Text -> ByteString
encodeUtf8 Text
url)] ByteString
""