{-# LANGUAGE CPP #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

module Web.Spock.Internal.CoreAction
  ( ActionT,
    UploadedFile (..),
    request,
    header,
    rawHeader,
    cookie,
    cookies,
    body,
    jsonBody,
    jsonBody',
    reqMethod,
    files,
    filesMulti,
    params,
    param,
    param',
    paramsGet,
    paramsPost,
    setStatus,
    setHeader,
    redirect,
    setRawMultiHeader,
    MultiHeader (..),
    CookieSettings (..),
    getRequestId,
    logMessage,
    CookieEOL (..),
    defaultCookieSettings,
    setCookie,
    deleteCookie,
    jumpNext,
    middlewarePass,
    modifyVault,
    queryVault,
    bytes,
    lazyBytes,
    text,
    html,
    file,
    json,
    stream,
    response,
    requireBasicAuth,
    withBasicAuthData,
    getContext,
    runInContext,
    preferredFormat,
    ClientPreferredFormat (..),
    respondApp,
    respondMiddleware,
  )
where

import Control.Monad
#if MIN_VERSION_mtl(2,2,0)
import Control.Monad.Except
#else
import Control.Monad.Error
#endif
import Control.Monad.RWS.Strict (runRWST)
import Control.Monad.Reader
import Control.Monad.State hiding (get, put)
import qualified Control.Monad.State as ST
import qualified Data.Aeson as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Lazy as BSL
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as HM
import Data.Maybe
import Data.Monoid
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time
import qualified Data.Vault.Lazy as V
import Network.HTTP.Types.Header (HeaderName, ResponseHeaders)
import Network.HTTP.Types.Status
import qualified Network.Wai as Wai
import Web.HttpApiData
import Web.Spock.Internal.Cookies
import Web.Spock.Internal.Util
import Web.Spock.Internal.Wire
import Web.Spock.Logging
import Data.Foldable (forM_)
import Prelude hiding (head)

-- | Get the original Wai Request object
request :: MonadIO m => ActionCtxT ctx m Wai.Request
request :: forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
request = (RequestInfo ctx -> Request) -> ActionCtxT ctx m Request
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> Request
forall ctx. RequestInfo ctx -> Request
ri_request
{-# INLINE request #-}

-- | Read a header
header :: MonadIO m => T.Text -> ActionCtxT ctx m (Maybe T.Text)
header :: forall (m :: * -> *) ctx.
MonadIO m =>
Text -> ActionCtxT ctx m (Maybe Text)
header Text
t =
  (Maybe ByteString -> Maybe Text)
-> ActionCtxT ctx m (Maybe ByteString)
-> ActionCtxT ctx m (Maybe Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
T.decodeUtf8) (ActionCtxT ctx m (Maybe ByteString)
 -> ActionCtxT ctx m (Maybe Text))
-> ActionCtxT ctx m (Maybe ByteString)
-> ActionCtxT ctx m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ HeaderName -> ActionCtxT ctx m (Maybe ByteString)
forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ActionCtxT ctx m (Maybe ByteString)
rawHeader (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (Text -> ByteString
T.encodeUtf8 Text
t))
{-# INLINE header #-}

-- | Read a header without converting it to text
rawHeader :: MonadIO m => HeaderName -> ActionCtxT ctx m (Maybe BS.ByteString)
rawHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ActionCtxT ctx m (Maybe ByteString)
rawHeader HeaderName
t =
  (Request -> Maybe ByteString)
-> ActionCtxT ctx m Request -> ActionCtxT ctx m (Maybe ByteString)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
t ([(HeaderName, ByteString)] -> Maybe ByteString)
-> (Request -> [(HeaderName, ByteString)])
-> Request
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> [(HeaderName, ByteString)]
Wai.requestHeaders) ActionCtxT ctx m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
request
{-# INLINE rawHeader #-}

-- | Tries to dected the preferred format of the response using the Accept header
preferredFormat :: MonadIO m => ActionCtxT ctx m ClientPreferredFormat
preferredFormat :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m ClientPreferredFormat
preferredFormat =
  do
    mAccept <- Text -> ActionCtxT ctx m (Maybe Text)
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> ActionCtxT ctx m (Maybe Text)
header Text
"accept"
    case mAccept of
      Maybe Text
Nothing -> ClientPreferredFormat -> ActionCtxT ctx m ClientPreferredFormat
forall a. a -> ActionCtxT ctx m a
forall (m :: * -> *) a. Monad m => a -> m a
return ClientPreferredFormat
PrefUnknown
      Just Text
t ->
        ClientPreferredFormat -> ActionCtxT ctx m ClientPreferredFormat
forall a. a -> ActionCtxT ctx m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ClientPreferredFormat -> ActionCtxT ctx m ClientPreferredFormat)
-> ClientPreferredFormat -> ActionCtxT ctx m ClientPreferredFormat
forall a b. (a -> b) -> a -> b
$ Text -> ClientPreferredFormat
detectPreferredFormat Text
t
{-# INLINE preferredFormat #-}

-- | Returns the current request method, e.g. 'GET'
reqMethod :: MonadIO m => ActionCtxT ctx m SpockMethod
reqMethod :: forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m SpockMethod
reqMethod = (RequestInfo ctx -> SpockMethod) -> ActionCtxT ctx m SpockMethod
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> SpockMethod
forall ctx. RequestInfo ctx -> SpockMethod
ri_method
{-# INLINE reqMethod #-}

-- | Get the raw request body
body :: MonadIO m => ActionCtxT ctx m BS.ByteString
body :: forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m ByteString
body =
  do
    b <- (RequestInfo ctx -> RequestBody) -> ActionCtxT ctx m RequestBody
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> RequestBody
forall ctx. RequestInfo ctx -> RequestBody
ri_reqBody
    liftIO $ loadCacheVar (rb_value b)
{-# INLINE body #-}

-- | Parse the request body as json
jsonBody :: (MonadIO m, A.FromJSON a) => ActionCtxT ctx m (Maybe a)
jsonBody :: forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m (Maybe a)
jsonBody =
  do
    b <- ActionCtxT ctx m ByteString
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m ByteString
body
    return $ A.decodeStrict b
{-# INLINE jsonBody #-}

-- | Parse the request body as json and fails with 400 status code on error
jsonBody' :: (MonadIO m, A.FromJSON a) => ActionCtxT ctx m a
jsonBody' :: forall (m :: * -> *) a ctx.
(MonadIO m, FromJSON a) =>
ActionCtxT ctx m a
jsonBody' =
  do
    b <- ActionCtxT ctx m ByteString
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m ByteString
body
    case A.eitherDecodeStrict' b of
      Left String
err ->
        do
          Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
status400
          Text -> ActionCtxT ctx m a
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
text (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse json: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err)
      Right a
val ->
        a -> ActionCtxT ctx m a
forall a. a -> ActionCtxT ctx m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
{-# INLINE jsonBody' #-}

-- | Get the last uploaded file for each form field name.
-- Use 'filesMulti' to retrieve every file when a field has multiple uploads.
files :: MonadIO m => ActionCtxT ctx m (HM.HashMap T.Text UploadedFile)
files :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m (HashMap Text UploadedFile)
files = ([UploadedFile] -> Maybe UploadedFile)
-> HashMap Text [UploadedFile] -> HashMap Text UploadedFile
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe ([UploadedFile] -> Maybe UploadedFile
forall a. [a] -> Maybe a
listToMaybe ([UploadedFile] -> Maybe UploadedFile)
-> ([UploadedFile] -> [UploadedFile])
-> [UploadedFile]
-> Maybe UploadedFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UploadedFile] -> [UploadedFile]
forall a. [a] -> [a]
reverse) (HashMap Text [UploadedFile] -> HashMap Text UploadedFile)
-> ActionCtxT ctx m (HashMap Text [UploadedFile])
-> ActionCtxT ctx m (HashMap Text UploadedFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActionCtxT ctx m (HashMap Text [UploadedFile])
forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m (HashMap Text [UploadedFile])
filesMulti
{-# INLINE files #-}

-- | Get every uploaded file grouped by form field name, in upload order.
filesMulti :: MonadIO m => ActionCtxT ctx m (HM.HashMap T.Text [UploadedFile])
filesMulti :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m (HashMap Text [UploadedFile])
filesMulti =
  do
    b <- (RequestInfo ctx -> RequestBody) -> ActionCtxT ctx m RequestBody
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> RequestBody
forall ctx. RequestInfo ctx -> RequestBody
ri_reqBody
    liftIO $ loadCacheVar (rb_files b)
{-# INLINE filesMulti #-}

-- | Get all request GET params
paramsGet :: MonadIO m => ActionCtxT ctx m [(T.Text, T.Text)]
paramsGet :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
paramsGet = (RequestInfo ctx -> [(Text, Text)])
-> ActionCtxT ctx m [(Text, Text)]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> [(Text, Text)]
forall ctx. RequestInfo ctx -> [(Text, Text)]
ri_getParams
{-# INLINE paramsGet #-}

-- | Get all request POST params
paramsPost :: MonadIO m => ActionCtxT ctx m [(T.Text, T.Text)]
paramsPost :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
paramsPost =
  do
    b <- (RequestInfo ctx -> RequestBody) -> ActionCtxT ctx m RequestBody
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> RequestBody
forall ctx. RequestInfo ctx -> RequestBody
ri_reqBody
    liftIO $ loadCacheVar (rb_postParams b)
{-# INLINE paramsPost #-}

-- | Get all request (POST + GET) params
params :: MonadIO m => ActionCtxT ctx m [(T.Text, T.Text)]
params :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
params =
  do
    g <- ActionCtxT ctx m [(Text, Text)]
forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
paramsGet
    p <- paramsPost
    return $ g ++ p
{-# INLINE params #-}

-- | Read a request parameter, searching query (GET) values before form (POST)
-- values. Use 'paramsPost' or 'paramsGet' when the source matters.
param :: (FromHttpApiData p, MonadIO m) => T.Text -> ActionCtxT ctx m (Maybe p)
param :: forall p (m :: * -> *) ctx.
(FromHttpApiData p, MonadIO m) =>
Text -> ActionCtxT ctx m (Maybe p)
param Text
k =
  do
    qp <- ActionCtxT ctx m [(Text, Text)]
forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
params
    return $ join $ fmap (either (const Nothing) Just . parseQueryParam) (lookup k qp)
{-# INLINE param #-}

-- | Like 'param', but outputs an error when a param is missing
param' :: (FromHttpApiData p, MonadIO m) => T.Text -> ActionCtxT ctx m p
param' :: forall p (m :: * -> *) ctx.
(FromHttpApiData p, MonadIO m) =>
Text -> ActionCtxT ctx m p
param' Text
k =
  do
    mParam <- Text -> ActionCtxT ctx m (Maybe p)
forall p (m :: * -> *) ctx.
(FromHttpApiData p, MonadIO m) =>
Text -> ActionCtxT ctx m (Maybe p)
param Text
k
    case mParam of
      Maybe p
Nothing ->
        do
          Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
status500
          Text -> ActionCtxT ctx m p
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
text ([Text] -> Text
T.concat [Text
"Missing parameter ", Text
k])
      Just p
val ->
        p -> ActionCtxT ctx m p
forall a. a -> ActionCtxT ctx m a
forall (m :: * -> *) a. Monad m => a -> m a
return p
val
{-# INLINE param' #-}

-- | Set a response status
setStatus :: MonadIO m => Status -> ActionCtxT ctx m ()
setStatus :: forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
s =
  (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseState -> ResponseState) -> ActionCtxT ctx m ())
-> (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ \ResponseState
rs -> ResponseState
rs {rs_status = s}
{-# INLINE setStatus #-}

-- | Set a response header. If the response header
-- is allowed to occur multiple times (as in RFC 2616), it will
-- be appended. Otherwise the previous value is overwritten.
-- See 'setMultiHeader'.
setHeader :: MonadIO m => T.Text -> T.Text -> ActionCtxT ctx m ()
setHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeader Text
k Text
v = HeaderName -> ByteString -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ByteString -> ActionCtxT ctx m ()
setRawHeader (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
k) (Text -> ByteString
T.encodeUtf8 Text
v)
{-# INLINE setHeader #-}

setRawHeader :: MonadIO m => CI.CI BS.ByteString -> BS.ByteString -> ActionCtxT ctx m ()
setRawHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ByteString -> ActionCtxT ctx m ()
setRawHeader HeaderName
k ByteString
v =
  case HeaderName -> HashMap HeaderName MultiHeader -> Maybe MultiHeader
forall k v. Hashable k => k -> HashMap k v -> Maybe v
HM.lookup HeaderName
k HashMap HeaderName MultiHeader
multiHeaderMap of
    Just MultiHeader
mhk ->
      MultiHeader -> ByteString -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> ByteString -> ActionCtxT ctx m ()
setRawMultiHeader MultiHeader
mhk ByteString
v
    Maybe MultiHeader
Nothing ->
      HeaderName -> ByteString -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ByteString -> ActionCtxT ctx m ()
setRawHeaderUnsafe HeaderName
k ByteString
v

-- | Set a response header that can occur multiple times. (eg: Cache-Control)
setMultiHeader :: MonadIO m => MultiHeader -> T.Text -> ActionCtxT ctx m ()
setMultiHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> Text -> ActionCtxT ctx m ()
setMultiHeader MultiHeader
k Text
v = MultiHeader -> ByteString -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> ByteString -> ActionCtxT ctx m ()
setRawMultiHeader MultiHeader
k (Text -> ByteString
T.encodeUtf8 Text
v)
{-# INLINE setMultiHeader #-}

-- | Set a response header that can occur multiple times. (eg: Cache-Control)
setRawMultiHeader :: MonadIO m => MultiHeader -> BS.ByteString -> ActionCtxT ctx m ()
setRawMultiHeader :: forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> ByteString -> ActionCtxT ctx m ()
setRawMultiHeader MultiHeader
k ByteString
v =
  (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseState -> ResponseState) -> ActionCtxT ctx m ())
-> (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ \ResponseState
rs ->
    ResponseState
rs
      { rs_multiResponseHeaders =
          HM.insertWith (++) k [v] (rs_multiResponseHeaders rs)
      }

-- | INTERNAL: Unsafely set a header (no checking if the header can occur multiple times)
setHeaderUnsafe :: MonadIO m => T.Text -> T.Text -> ActionCtxT ctx m ()
setHeaderUnsafe :: forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeaderUnsafe Text
k Text
v = HeaderName -> ByteString -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ByteString -> ActionCtxT ctx m ()
setRawHeaderUnsafe (ByteString -> HeaderName
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
k) (Text -> ByteString
T.encodeUtf8 Text
v)
{-# INLINE setHeaderUnsafe #-}

-- | INTERNAL: Unsafely set a header (no checking if the header can occur multiple times)
setRawHeaderUnsafe :: MonadIO m => CI.CI BS.ByteString -> BS.ByteString -> ActionCtxT ctx m ()
setRawHeaderUnsafe :: forall (m :: * -> *) ctx.
MonadIO m =>
HeaderName -> ByteString -> ActionCtxT ctx m ()
setRawHeaderUnsafe HeaderName
k ByteString
v =
  (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseState -> ResponseState) -> ActionCtxT ctx m ())
-> (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ \ResponseState
rs ->
    ResponseState
rs
      { rs_responseHeaders =
          HM.insert k v (rs_responseHeaders rs)
      }

-- | Abort the current action and jump the next one matching the route
jumpNext :: MonadIO m => ActionCtxT ctx m a
jumpNext :: forall (m :: * -> *) ctx a. MonadIO m => ActionCtxT ctx m a
jumpNext = ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionInterupt
ActionTryNext
{-# INLINE jumpNext #-}

-- | Redirect to a given url
redirect :: MonadIO m => T.Text -> ActionCtxT ctx m a
redirect :: forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
redirect = ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionInterupt -> ActionCtxT ctx m a)
-> (Text -> ActionInterupt) -> Text -> ActionCtxT ctx m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ActionInterupt
ActionRedirect
{-# INLINE redirect #-}

-- | Respond to the request by running a WAI application. This is
-- usefull in combination with wildcard routes. This can not be used
-- in combination with other request consuming combinators
-- like 'jsonBody', 'body', 'paramsPost', ...
respondApp :: Monad m => Wai.Application -> ActionCtxT ctx m a
respondApp :: forall (m :: * -> *) ctx a.
Monad m =>
Application -> ActionCtxT ctx m a
respondApp = ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionInterupt -> ActionCtxT ctx m a)
-> (Application -> ActionInterupt)
-> Application
-> ActionCtxT ctx m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Application -> ActionInterupt
ActionApplication (IO Application -> ActionInterupt)
-> (Application -> IO Application) -> Application -> ActionInterupt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> IO Application
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Respond to the request by running WAI middleware. This is
-- usefull in combination with wildcard routes. This can not be used
-- in combination with other request consuming combinators
-- like 'jsonBody', 'body', 'paramsPost', ...
respondMiddleware :: Monad m => Wai.Middleware -> ActionCtxT ctx m a
respondMiddleware :: forall (m :: * -> *) ctx a.
Monad m =>
Middleware -> ActionCtxT ctx m a
respondMiddleware = ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ActionInterupt -> ActionCtxT ctx m a)
-> (Middleware -> ActionInterupt)
-> Middleware
-> ActionCtxT ctx m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Middleware -> ActionInterupt
ActionMiddleware (IO Middleware -> ActionInterupt)
-> (Middleware -> IO Middleware) -> Middleware -> ActionInterupt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Middleware -> IO Middleware
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | If the Spock application is used as a middleware, you can use
-- this to pass request handling to the underlying application.
-- If Spock is not uses as a middleware, or there is no underlying application
-- this will result in 404 error.
middlewarePass :: MonadIO m => ActionCtxT ctx m a
middlewarePass :: forall (m :: * -> *) ctx a. MonadIO m => ActionCtxT ctx m a
middlewarePass = ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionInterupt
ActionMiddlewarePass
{-# INLINE middlewarePass #-}

-- | Modify the vault (useful for sharing data between middleware and app)
modifyVault :: MonadIO m => (V.Vault -> V.Vault) -> ActionCtxT ctx m ()
modifyVault :: forall (m :: * -> *) ctx.
MonadIO m =>
(Vault -> Vault) -> ActionCtxT ctx m ()
modifyVault Vault -> Vault
f =
  do
    vaultIf <- (RequestInfo ctx -> VaultIf) -> ActionCtxT ctx m VaultIf
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> VaultIf
forall ctx. RequestInfo ctx -> VaultIf
ri_vaultIf
    liftIO $ vi_modifyVault vaultIf f
{-# INLINE modifyVault #-}

-- | Query the vault
queryVault :: MonadIO m => V.Key a -> ActionCtxT ctx m (Maybe a)
queryVault :: forall (m :: * -> *) a ctx.
MonadIO m =>
Key a -> ActionCtxT ctx m (Maybe a)
queryVault Key a
k =
  do
    vaultIf <- (RequestInfo ctx -> VaultIf) -> ActionCtxT ctx m VaultIf
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> VaultIf
forall ctx. RequestInfo ctx -> VaultIf
ri_vaultIf
    liftIO $ vi_lookupKey vaultIf k
{-# INLINE queryVault #-}

-- | Use a custom WAI response generator as response body.
response :: MonadIO m => (Status -> ResponseHeaders -> Wai.Response) -> ActionCtxT ctx m a
response :: forall (m :: * -> *) ctx a.
MonadIO m =>
(Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
response Status -> [(HeaderName, ByteString)] -> Response
val =
  do
    (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((ResponseState -> ResponseState) -> ActionCtxT ctx m ())
-> (ResponseState -> ResponseState) -> ActionCtxT ctx m ()
forall a b. (a -> b) -> a -> b
$ \ResponseState
rs -> ResponseState
rs {rs_responseBody = ResponseBody val}
    ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionInterupt
ActionDone
{-# INLINE response #-}

-- | Send a 'ByteString' as response body. Provide your own "Content-Type"
bytes :: MonadIO m => BS.ByteString -> ActionCtxT ctx m a
bytes :: forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
bytes ByteString
val =
  ByteString -> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
lazyBytes (ByteString -> ActionCtxT ctx m a)
-> ByteString -> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
val
{-# INLINE bytes #-}

-- | Send a lazy 'ByteString' as response body. Provide your own "Content-Type"
lazyBytes :: MonadIO m => BSL.ByteString -> ActionCtxT ctx m a
lazyBytes :: forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
lazyBytes ByteString
val =
  (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
(Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
response ((Status -> [(HeaderName, ByteString)] -> Response)
 -> ActionCtxT ctx m a)
-> (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ \Status
status [(HeaderName, ByteString)]
headers -> Status -> [(HeaderName, ByteString)] -> ByteString -> Response
Wai.responseLBS Status
status [(HeaderName, ByteString)]
headers ByteString
val
{-# INLINE lazyBytes #-}

-- | Send text as a response body. Content-Type will be "text/plain"
text :: MonadIO m => T.Text -> ActionCtxT ctx m a
text :: forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
text Text
val =
  do
    Text -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeaderUnsafe Text
"Content-Type" Text
"text/plain; charset=utf-8"
    ByteString -> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
bytes (ByteString -> ActionCtxT ctx m a)
-> ByteString -> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
val
{-# INLINE text #-}

-- | Send a text as response body. Content-Type will be "text/html"
html :: MonadIO m => T.Text -> ActionCtxT ctx m a
html :: forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
html Text
val =
  do
    Text -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeaderUnsafe Text
"Content-Type" Text
"text/html; charset=utf-8"
    ByteString -> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
bytes (ByteString -> ActionCtxT ctx m a)
-> ByteString -> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 Text
val
{-# INLINE html #-}

-- | Send a file as response
file :: MonadIO m => T.Text -> FilePath -> ActionCtxT ctx m a
file :: forall (m :: * -> *) ctx a.
MonadIO m =>
Text -> String -> ActionCtxT ctx m a
file Text
contentType String
filePath =
  do
    Text -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeaderUnsafe Text
"Content-Type" Text
contentType
    (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
(Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
response ((Status -> [(HeaderName, ByteString)] -> Response)
 -> ActionCtxT ctx m a)
-> (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ \Status
status [(HeaderName, ByteString)]
headers -> Status
-> [(HeaderName, ByteString)]
-> String
-> Maybe FilePart
-> Response
Wai.responseFile Status
status [(HeaderName, ByteString)]
headers String
filePath Maybe FilePart
forall a. Maybe a
Nothing
{-# INLINE file #-}

-- | Send json as response. Content-Type will be "application/json"
json :: (A.ToJSON a, MonadIO m) => a -> ActionCtxT ctx m b
json :: forall a (m :: * -> *) ctx b.
(ToJSON a, MonadIO m) =>
a -> ActionCtxT ctx m b
json a
val =
  do
    Text -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> ActionCtxT ctx m ()
setHeaderUnsafe Text
"Content-Type" Text
"application/json; charset=utf-8"
    ByteString -> ActionCtxT ctx m b
forall (m :: * -> *) ctx a.
MonadIO m =>
ByteString -> ActionCtxT ctx m a
lazyBytes (ByteString -> ActionCtxT ctx m b)
-> ByteString -> ActionCtxT ctx m b
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
val
{-# INLINE json #-}

-- | Use a WAI streaming body to generate a response.
stream :: MonadIO m => Wai.StreamingBody -> ActionCtxT ctx m a
stream :: forall (m :: * -> *) ctx a.
MonadIO m =>
StreamingBody -> ActionCtxT ctx m a
stream StreamingBody
val =
  (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
(Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
response ((Status -> [(HeaderName, ByteString)] -> Response)
 -> ActionCtxT ctx m a)
-> (Status -> [(HeaderName, ByteString)] -> Response)
-> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ \Status
status [(HeaderName, ByteString)]
headers -> Status -> [(HeaderName, ByteString)] -> StreamingBody -> Response
Wai.responseStream Status
status [(HeaderName, ByteString)]
headers StreamingBody
val
{-# INLINE stream #-}

-- | Convenience Basic authentification
-- provide a title for the prompt and a function to validate
-- user and password. Usage example:
--
-- > get ("auth" <//> var <//> var) $ \user pass ->
-- >       let checker user' pass' =
-- >               unless (user == user' && pass == pass') $
-- >               do setStatus status401
-- >                  text "err"
-- >       in requireBasicAuth "Foo" checker $ \() -> text "ok"
requireBasicAuth :: MonadIO m => T.Text -> (T.Text -> T.Text -> ActionCtxT ctx m b) -> (b -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
requireBasicAuth :: forall (m :: * -> *) ctx b a.
MonadIO m =>
Text
-> (Text -> Text -> ActionCtxT ctx m b)
-> (b -> ActionCtxT ctx m a)
-> ActionCtxT ctx m a
requireBasicAuth Text
realmTitle Text -> Text -> ActionCtxT ctx m b
authFun b -> ActionCtxT ctx m a
cont =
  (Maybe (Text, Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
forall (m :: * -> *) ctx a.
MonadIO m =>
(Maybe (Text, Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
withBasicAuthData ((Maybe (Text, Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a)
-> (Maybe (Text, Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
forall a b. (a -> b) -> a -> b
$ \Maybe (Text, Text)
mAuthHeader ->
    case Maybe (Text, Text)
mAuthHeader of
      Maybe (Text, Text)
Nothing ->
        Maybe Text -> ActionCtxT ctx m a
forall {m :: * -> *} {ctx} {b}.
MonadIO m =>
Maybe Text -> ActionCtxT ctx m b
authFailed Maybe Text
forall a. Maybe a
Nothing
      Just (Text
user, Text
pass) ->
        Text -> Text -> ActionCtxT ctx m b
authFun Text
user Text
pass ActionCtxT ctx m b
-> (b -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
forall a b.
ActionCtxT ctx m a
-> (a -> ActionCtxT ctx m b) -> ActionCtxT ctx m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> ActionCtxT ctx m a
cont
  where
    authFailed :: Maybe Text -> ActionCtxT ctx m b
authFailed Maybe Text
mMore =
      do
        Status -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
status401
        MultiHeader -> Text -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> Text -> ActionCtxT ctx m ()
setMultiHeader MultiHeader
MultiHeaderWWWAuth (Text
"Basic realm=\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
realmTitle Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")
        Text -> ActionCtxT ctx m b
forall (m :: * -> *) ctx a. MonadIO m => Text -> ActionCtxT ctx m a
text (Text -> ActionCtxT ctx m b) -> Text -> ActionCtxT ctx m b
forall a b. (a -> b) -> a -> b
$ Text
"Authentication required. " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
mMore

-- | "Lower level" basic authentification handeling. Does not set any headers that will promt
-- browser users, only looks for an @Authorization@ header in the request and breaks it into
-- username and passwort component if present
withBasicAuthData :: MonadIO m => (Maybe (T.Text, T.Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
withBasicAuthData :: forall (m :: * -> *) ctx a.
MonadIO m =>
(Maybe (Text, Text) -> ActionCtxT ctx m a) -> ActionCtxT ctx m a
withBasicAuthData Maybe (Text, Text) -> ActionCtxT ctx m a
handler =
  do
    mAuthHeader <- Text -> ActionCtxT ctx m (Maybe Text)
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> ActionCtxT ctx m (Maybe Text)
header Text
"Authorization"
    case mAuthHeader of
      Maybe Text
Nothing ->
        Maybe (Text, Text) -> ActionCtxT ctx m a
handler Maybe (Text, Text)
forall a. Maybe a
Nothing
      Just Text
authHeader ->
        let (Text
_, Text
rawValue) =
              HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
" " Text
authHeader
            (Text
user, Text
rawPass) =
              (HasCallStack => Text -> Text -> (Text, Text)
Text -> Text -> (Text, Text)
T.breakOn Text
":" (Text -> (Text, Text)) -> (Text -> Text) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.decodeLenient (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.strip) Text
rawValue
            pass :: Text
pass = Int -> Text -> Text
T.drop Int
1 Text
rawPass
         in Maybe (Text, Text) -> ActionCtxT ctx m a
handler ((Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
user, Text
pass))

-- | Get the context of the current request
getContext :: MonadIO m => ActionCtxT ctx m ctx
getContext :: forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m ctx
getContext = (RequestInfo ctx -> ctx) -> ActionCtxT ctx m ctx
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> ctx
forall ctx. RequestInfo ctx -> ctx
ri_context
{-# INLINE getContext #-}

-- | Request ID, when structured logging has been enabled.
getRequestId :: MonadIO m => ActionCtxT ctx m (Maybe T.Text)
getRequestId :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m (Maybe Text)
getRequestId = (RequestInfo ctx -> Maybe Text) -> ActionCtxT ctx m (Maybe Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((RequestInfo ctx -> Maybe Text) -> ActionCtxT ctx m (Maybe Text))
-> (RequestInfo ctx -> Maybe Text) -> ActionCtxT ctx m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ ((RequestContext, LogEventType -> IO ()) -> Text)
-> Maybe (RequestContext, LogEventType -> IO ()) -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RequestContext -> Text
rc_requestId (RequestContext -> Text)
-> ((RequestContext, LogEventType -> IO ()) -> RequestContext)
-> (RequestContext, LogEventType -> IO ())
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RequestContext, LogEventType -> IO ()) -> RequestContext
forall a b. (a, b) -> a
fst) (Maybe (RequestContext, LogEventType -> IO ()) -> Maybe Text)
-> (RequestInfo ctx
    -> Maybe (RequestContext, LogEventType -> IO ()))
-> RequestInfo ctx
-> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RequestInfo ctx -> Maybe (RequestContext, LogEventType -> IO ())
forall ctx.
RequestInfo ctx -> Maybe (RequestContext, LogEventType -> IO ())
ri_requestLogger

-- | Emit a message with structured fields through the configured request
-- logger. With logging disabled this is a no-op. Fields are nested in JSON
-- under @fields@ so they cannot overwrite the request ID or other metadata.
logMessage :: MonadIO m => LogLevel -> T.Text -> [(T.Text, A.Value)] -> ActionCtxT ctx m ()
logMessage :: forall (m :: * -> *) ctx.
MonadIO m =>
LogLevel -> Text -> [(Text, Value)] -> ActionCtxT ctx m ()
logMessage LogLevel
level Text
message [(Text, Value)]
fields = do
  logger <- (RequestInfo ctx -> Maybe (RequestContext, LogEventType -> IO ()))
-> ActionCtxT ctx m (Maybe (RequestContext, LogEventType -> IO ()))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RequestInfo ctx -> Maybe (RequestContext, LogEventType -> IO ())
forall ctx.
RequestInfo ctx -> Maybe (RequestContext, LogEventType -> IO ())
ri_requestLogger
  liftIO $ forM_ logger $ \(RequestContext
_, LogEventType -> IO ()
emit) -> LogEventType -> IO ()
emit (LogLevel -> Text -> [(Text, Value)] -> LogEventType
MessageLog LogLevel
level Text
message [(Text, Value)]
fields)

-- | Run an Action in a different context
runInContext :: MonadIO m => ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext :: forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext ctx'
newCtx ActionCtxT ctx' m a
action =
  do
    currentEnv <- ActionCtxT ctx m (RequestInfo ctx)
forall r (m :: * -> *). MonadReader r m => m r
ask
    currentRespState <- ST.get
    (r, newRespState, _) <-
      lift $
        do
          let env =
                RequestInfo ctx
currentEnv
                  { ri_context = newCtx
                  }
          runRWST (runErrorT $ runActionCtxT action) env currentRespState
    ST.put newRespState
    case r of
      Left ActionInterupt
interupt ->
        ActionInterupt -> ActionCtxT ctx m a
forall a. ActionInterupt -> ActionCtxT ctx m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ActionInterupt
interupt
      Right a
d -> a -> ActionCtxT ctx m a
forall a. a -> ActionCtxT ctx m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
d
{-# INLINE runInContext #-}

-- | Set a cookie. The cookie value will be urlencoded.
setCookie :: MonadIO m => T.Text -> T.Text -> CookieSettings -> ActionCtxT ctx m ()
setCookie :: forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> CookieSettings -> ActionCtxT ctx m ()
setCookie Text
name Text
value CookieSettings
cs =
  do
    now <- IO UTCTime -> ActionCtxT ctx m UTCTime
forall a. IO a -> ActionCtxT ctx m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    setRawMultiHeader MultiHeaderSetCookie $
      generateCookieHeaderString name value cs now
{-# INLINE setCookie #-}

-- | Delete a cookie
deleteCookie :: MonadIO m => T.Text -> ActionCtxT ctx m ()
deleteCookie :: forall (m :: * -> *) ctx. MonadIO m => Text -> ActionCtxT ctx m ()
deleteCookie Text
name =
  Text -> Text -> CookieSettings -> ActionCtxT ctx m ()
forall (m :: * -> *) ctx.
MonadIO m =>
Text -> Text -> CookieSettings -> ActionCtxT ctx m ()
setCookie Text
name Text
T.empty CookieSettings
cs
  where
    cs :: CookieSettings
cs = CookieSettings
defaultCookieSettings {cs_EOL = CookieValidUntil epoch}
    epoch :: UTCTime
epoch = Day -> DiffTime -> UTCTime
UTCTime (Year -> Int -> Int -> Day
fromGregorian Year
1970 Int
1 Int
1) (Year -> DiffTime
secondsToDiffTime Year
0)
{-# INLINE deleteCookie #-}

-- | Read all cookies. The cookie value will already be urldecoded.
cookies :: MonadIO m => ActionCtxT ctx m [(T.Text, T.Text)]
cookies :: forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
cookies =
  do
    req <- ActionCtxT ctx m Request
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m Request
request
    return $
      maybe [] parseCookies $
        lookup "cookie" (Wai.requestHeaders req)
{-# INLINE cookies #-}

-- | Read a cookie. The cookie value will already be urldecoded. Note that it is
-- more efficient to use 'cookies' if you need do access many cookies during a request
-- handler.
cookie :: MonadIO m => T.Text -> ActionCtxT ctx m (Maybe T.Text)
cookie :: forall (m :: * -> *) ctx.
MonadIO m =>
Text -> ActionCtxT ctx m (Maybe Text)
cookie Text
name =
  do
    allCookies <- ActionCtxT ctx m [(Text, Text)]
forall (m :: * -> *) ctx.
MonadIO m =>
ActionCtxT ctx m [(Text, Text)]
cookies
    return $ lookup name allCookies
{-# INLINE cookie #-}