{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Build an application with typed routes, sessions, and a database pool.
--
-- = Reading requests and sending responses
--
-- Request and response helpers are reexported from "Web.Spock.Action" in the
-- @Spock-core@ package. Follow that module link for the complete action API:
--
-- * 'param' and 'param'': parse query or form parameters. Values captured by
--   'var' in a route are passed directly to its handler instead.
-- * 'paramsGet', 'paramsPost', and 'params': list request parameters.
-- * 'jsonBody', 'jsonBody'', and 'body': read JSON or raw request bytes.
-- * 'header', 'rawHeader', and 'cookies': inspect request metadata.
-- * 'filesMulti': read uploaded files, including repeated upload fields.
-- * 'setStatus' and 'setHeader': prepare response metadata before sending it.
-- * 'text', 'html', 'json', 'file', and 'lazyBytes': send a response and finish
--   the current action.
--
-- The <https://www.spock.li/reference/ API reference> links the current
-- versions of Spock, Spock-core, the typed API packages, and session adapters.
module Web.Spock
  ( -- * Launching Spock
    runSpock,
    runSpockNoBanner,
    spockAsApp,

    -- * Spock's route definition monad
    spock,
    SpockM,
    SpockCtxM,

    -- * Defining routes
    Path,
    root,
    Var,
    AltVar (..),
    var,
    static,
    trailingSlash,
    (<//>),
    (<.>),
    wildcard,

    -- * Rendering routes
    renderRoute,
    renderRouteWith,
    renderRouteEncoded,
    renderRouteEncodedWith,

    -- * Hooking routes
    prehook,
    RouteSpec,
    get,
    post,
    getpost,
    head,
    put,
    delete,
    patch,
    hookRoute,
    hookRouteCustom,
    hookAny,
    hookAnyCustom,
    hookRouteAll,
    hookAnyAll,
    C.StdMethod (..),

    -- * Adding Wai.Middleware
    middleware,

    -- * Actions
    SpockAction,
    SpockActionCtx,
    module Web.Spock.Action,
    HasSpock (..),
    SessionManager,
    module Web.Spock.SessionActions,
    getCsrfToken,
    getClientCsrfToken,
    csrfCheck,

    -- * Accessing internals
    WebStateM,
    WebStateT,
    WebState,
    getSpockHeart,
    runSpockIO,
    getSpockPool,
  )
where

import Control.Applicative
import Control.Exception (throwIO)
import Control.Monad (when)
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import qualified Data.HVect as HV
import Data.Pool
import qualified Data.Text as T
import qualified Data.Vault.Lazy as V
import Network.HTTP.Types.Status (status403)
import qualified Network.Wai as Wai
import Web.Spock.Action
import Web.Spock.Core hiding
  ( delete,
    get,
    getpost,
    head,
    hookAny,
    hookAny',
    hookAnyAll,
    hookAnyCustom,
    hookRoute,
    hookRoute',
    hookRouteAll,
    hookRouteCustom,
    patch,
    post,
    put,
  )
import qualified Web.Spock.Core as C
import Web.Spock.Internal.Monad
import Web.Spock.Internal.SessionManager
import Web.Spock.Internal.Types
import Web.Spock.Routing
import Web.Spock.SessionActions
import Prelude hiding (head)

-- | Register routes and middleware when the application starts. The handler
-- passed to a route runs later, once per matching request, in 'SpockAction'.
--
-- @conn@ is a database connection, @sess@ is one visitor's session value, and
-- @st@ is application-wide state. The final result parameter is usually @()@.
-- This is 'SpockCtxM' with an empty request context. Use 'SpockCtxM' inside a
-- 'prehook' that supplies a typed context.
type SpockM conn sess st = SpockCtxM () conn sess st

-- | Route registration with handlers that receive context @ctx@. A 'prehook'
-- produces this context per request; 'getContext' reads it in the handler.
-- Context belongs to the selected request and hook scope, while @st@ is shared
-- by the entire application and @sess@ belongs to a visitor's session.
--
-- The underlying monad is 'WebStateM': @lift helper@ runs a shared-state or
-- database helper during registration. Inside a handler, the same expression
-- runs it for that request. Use @liftIO@ for an ordinary IO operation.
type SpockCtxM ctx conn sess st = SpockCtxT ctx (WebStateM conn sess st)

-- | Create a spock application using a given db storageLayer and an initial state.
-- Spock works with database libraries that already implement connection pooling and
-- with those that don't come with it out of the box. For more see the 'PoolOrConn' type.
-- Use @runSpock@ to run the app or @spockAsApp@ to create a @Wai.Application@
spock :: forall conn sess st. SpockCfg conn sess st -> SpockM conn sess st () -> IO Wai.Middleware
spock :: forall conn sess st.
SpockCfg conn sess st -> SpockM conn sess st () -> IO Middleware
spock SpockCfg conn sess st
spockCfg SpockM conn sess st ()
spockAppl =
  do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (SessionCfg conn sess st -> SessionMode
forall conn a st. SessionCfg conn a st -> SessionMode
sc_sessionMode SessionCfg conn sess st
sessionCfg SessionMode -> SessionMode -> Bool
forall a. Eq a => a -> a -> Bool
== SessionMode
SessionsDisabled Bool -> Bool -> Bool
&& SpockCfg conn sess st -> Bool
forall conn sess st. SpockCfg conn sess st -> Bool
spc_csrfProtection SpockCfg conn sess st
spockCfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      SessionError -> IO ()
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO SessionError
CsrfRequiresSessions
    connectionPool <-
      case PoolOrConn conn
poolOrConn of
        PoolOrConn conn
PCNoDatabase ->
          PoolConfig () -> IO (Pool ())
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig () -> IO (Pool ())) -> PoolConfig () -> IO (Pool ())
forall a b. (a -> b) -> a -> b
$ Maybe Int -> PoolConfig () -> PoolConfig ()
forall a. Maybe Int -> PoolConfig a -> PoolConfig a
setNumStripes (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
5) (PoolConfig () -> PoolConfig ()) -> PoolConfig () -> PoolConfig ()
forall a b. (a -> b) -> a -> b
$ IO () -> (() -> IO ()) -> Double -> Int -> PoolConfig ()
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Double
60 Int
25
        PCPool Pool conn
p ->
          Pool conn -> IO (Pool conn)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Pool conn
p
        PCConn ConnBuilder conn
cb ->
          let pc :: PoolCfg
pc = ConnBuilder conn -> PoolCfg
forall a. ConnBuilder a -> PoolCfg
cb_poolConfiguration ConnBuilder conn
cb
           in PoolConfig conn -> IO (Pool conn)
forall a. PoolConfig a -> IO (Pool a)
newPool (PoolConfig conn -> IO (Pool conn))
-> PoolConfig conn -> IO (Pool conn)
forall a b. (a -> b) -> a -> b
$
                Maybe Int -> PoolConfig conn -> PoolConfig conn
forall a. Maybe Int -> PoolConfig a -> PoolConfig a
setNumStripes (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ PoolCfg -> Int
pc_stripes PoolCfg
pc) (PoolConfig conn -> PoolConfig conn)
-> PoolConfig conn -> PoolConfig conn
forall a b. (a -> b) -> a -> b
$
                  IO conn -> (conn -> IO ()) -> Double -> Int -> PoolConfig conn
forall a. IO a -> (a -> IO ()) -> Double -> Int -> PoolConfig a
defaultPoolConfig
                    (ConnBuilder conn -> IO conn
forall a. ConnBuilder a -> IO a
cb_createConn ConnBuilder conn
cb)
                    (ConnBuilder conn -> conn -> IO ()
forall a. ConnBuilder a -> a -> IO ()
cb_destroyConn ConnBuilder conn
cb)
                    (NominalDiffTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Double) -> NominalDiffTime -> Double
forall a b. (a -> b) -> a -> b
$ PoolCfg -> NominalDiffTime
pc_keepOpenTime PoolCfg
pc)
                    (PoolCfg -> Int
pc_stripes PoolCfg
pc Int -> Int -> Int
forall a. Num a => a -> a -> a
* PoolCfg -> Int
pc_resPerStripe PoolCfg
pc)
    internalState <-
      WebState connectionPool
        <$> ( createSessionManager sessionCfg $
                SessionIf
                  { si_queryVault = queryVault,
                    si_modifyVault = modifyVault,
                    si_setRawMultiHeader = setRawMultiHeader,
                    si_vaultKey = V.newKey
                  }
            )
        <*> pure initialState
        <*> pure spockCfg
    let coreConfig =
          SpockConfig
defaultSpockConfig
            { sc_maxRequestSize = spc_maxRequestSize spockCfg,
              sc_errorHandler = spc_errorHandler spockCfg,
              sc_logError = spc_logError spockCfg,
              sc_logging = spc_logging spockCfg,
              sc_slashPolicy = spc_slashPolicy spockCfg
            }
    spockConfigT coreConfig (\WebStateM conn sess st a
m -> ResourceT IO a -> IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO a -> IO a) -> ResourceT IO a -> IO a
forall a b. (a -> b) -> a -> b
$ ReaderT (WebState conn sess st) (ResourceT IO) a
-> WebState conn sess st -> ResourceT IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WebStateM conn sess st a
-> ReaderT (WebState conn sess st) (ResourceT IO) a
forall conn sess st (m :: * -> *) a.
WebStateT conn sess st m a -> ReaderT (WebState conn sess st) m a
runWebStateT WebStateM conn sess st a
m) WebState conn sess st
internalState) $
      do
        middleware (sm_middleware $ web_sessionMgr internalState)
        spockAppl
  where
    sessionCfg :: SessionCfg conn sess st
sessionCfg = SpockCfg conn sess st -> SessionCfg conn sess st
forall conn sess st.
SpockCfg conn sess st -> SessionCfg conn sess st
spc_sessionCfg SpockCfg conn sess st
spockCfg
    poolOrConn :: PoolOrConn conn
poolOrConn = SpockCfg conn sess st -> PoolOrConn conn
forall conn sess st. SpockCfg conn sess st -> PoolOrConn conn
spc_database SpockCfg conn sess st
spockCfg
    initialState :: st
initialState = SpockCfg conn sess st -> st
forall conn sess st. SpockCfg conn sess st -> st
spc_initialState SpockCfg conn sess st
spockCfg

-- | Get the CSRF token for the current user. This token must be sent on all non
-- GET requests via a post parameter or HTTP-Header if 'spc_csrfProtection' is turned on.
-- See configuration 'SpockCfg' documentation for more information
getCsrfToken :: SpockActionCtx ctx conn sess st T.Text
getCsrfToken :: forall ctx conn sess st. SpockActionCtx ctx conn sess st SessionId
getCsrfToken = ()
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> ActionCtxT ctx (WebStateM conn sess st) SessionId
forall (m :: * -> *) ctx' a ctx.
MonadIO m =>
ctx' -> ActionCtxT ctx' m a -> ActionCtxT ctx m a
runInContext () (ActionCtxT () (WebStateM conn sess st) SessionId
 -> ActionCtxT ctx (WebStateM conn sess st) SessionId)
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> ActionCtxT ctx (WebStateM conn sess st) SessionId
forall a b. (a -> b) -> a -> b
$ SessionManager
  (ActionCtxT () (WebStateM conn sess st)) conn sess st
-> ActionCtxT () (WebStateM conn sess st) SessionId
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> m SessionId
sm_getCsrfToken (SessionManager
   (ActionCtxT () (WebStateM conn sess st)) conn sess st
 -> ActionCtxT () (WebStateM conn sess st) SessionId)
-> ActionCtxT
     ()
     (WebStateM conn sess st)
     (SessionManager
        (ActionCtxT () (WebStateM conn sess st)) conn sess st)
-> ActionCtxT () (WebStateM conn sess st) SessionId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ActionCtxT
  ()
  (WebStateM conn sess st)
  (SessionManager
     (ActionCtxT () (WebStateM conn sess st)) conn sess st)
ActionCtxT
  ()
  (WebStateM conn sess st)
  (SpockSessionManager
     (SpockConn (ActionCtxT () (WebStateM conn sess st)))
     (SpockSession (ActionCtxT () (WebStateM conn sess st)))
     (SpockState (ActionCtxT () (WebStateM conn sess st))))
forall (m :: * -> *).
HasSpock m =>
m (SpockSessionManager
     (SpockConn m) (SpockSession m) (SpockState m))
getSessMgr
{-# INLINE getCsrfToken #-}

-- | Get the CSRF token sent by the client. You should not need to call this
-- manually if 'spc_csrfProtection' is turned on.
getClientCsrfToken :: SpockActionCtx ctx conn sess st (Maybe T.Text)
getClientCsrfToken :: forall ctx conn sess st.
SpockActionCtx ctx conn sess st (Maybe SessionId)
getClientCsrfToken =
  do
    cfg <- ActionCtxT ctx (WebStateM conn sess st) (SpockCfg conn sess st)
ActionCtxT
  ctx
  (WebStateM conn sess st)
  (SpockCfg
     (SpockConn (ActionCtxT ctx (WebStateM conn sess st)))
     (SpockSession (ActionCtxT ctx (WebStateM conn sess st)))
     (SpockState (ActionCtxT ctx (WebStateM conn sess st))))
forall (m :: * -> *).
HasSpock m =>
m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))
getSpockCfg
    mHeader <- header (spc_csrfHeaderName cfg)
    mParam <- param (spc_csrfPostName cfg)
    pure (mHeader <|> mParam)
{-# INLINE getClientCsrfToken #-}

-- | Check that the client sent a valid CSRF token. You should not need to call this
-- manually in non GET requests if 'spc_csrfProtection' is turned on.
csrfCheck :: SpockActionCtx ctx conn sess st ()
csrfCheck :: forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheck =
  do
    csrf <- SpockActionCtx ctx conn sess st SessionId
forall ctx conn sess st. SpockActionCtx ctx conn sess st SessionId
getCsrfToken
    clientCsrf <- getClientCsrfToken
    case clientCsrf of
      Maybe SessionId
Nothing -> ActionCtxT ctx (WebStateM conn sess st) ()
forall {ctx} {b}. ActionCtxT ctx (WebStateM conn sess st) b
abort
      Just SessionId
csrfVal
        | SessionId
csrfVal SessionId -> SessionId -> Bool
forall a. Eq a => a -> a -> Bool
== SessionId
csrf -> () -> ActionCtxT ctx (WebStateM conn sess st) ()
forall a. a -> ActionCtxT ctx (WebStateM conn sess st) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise -> ActionCtxT ctx (WebStateM conn sess st) ()
forall {ctx} {b}. ActionCtxT ctx (WebStateM conn sess st) b
abort
  where
    abort :: ActionCtxT ctx (WebStateM conn sess st) b
abort =
      do
        Status -> ActionCtxT ctx (WebStateM conn sess st) ()
forall (m :: * -> *) ctx.
MonadIO m =>
Status -> ActionCtxT ctx m ()
setStatus Status
status403
        SessionId -> ActionCtxT ctx (WebStateM conn sess st) b
forall (m :: * -> *) ctx a.
MonadIO m =>
SessionId -> ActionCtxT ctx m a
text SessionId
"Broken/Missing CSRF Token"
{-# INLINE csrfCheck #-}

type RouteMonad t ctx conn sess st a =
  (Monad (t ctx (WebStateM conn sess st)), RouteM t) => t ctx (WebStateM conn sess st) a

type RouteSpec t xs ps ctx conn sess st =
  Path xs ps -> HV.HVectElim xs (SpockActionCtx ctx conn sess st ()) -> RouteMonad t ctx conn sess st ()

-- | Specify an action that will be run when a standard HTTP verb and the given route match
hookRoute :: HV.HasRep xs => StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
m = SpockMethod -> RouteSpec t xs ps ctx conn sess st
forall (t :: * -> (* -> *) -> * -> *) (xs :: [*]) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute' (HttpMethod -> SpockMethod
MethodStandard (HttpMethod -> SpockMethod)
-> (StdMethod -> HttpMethod) -> StdMethod -> SpockMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> HttpMethod
HttpMethod (StdMethod -> SpockMethod) -> StdMethod -> SpockMethod
forall a b. (a -> b) -> a -> b
$ StdMethod
m)

-- | Specify an action that will be run regardless of the HTTP verb
hookRouteAll :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
hookRouteAll :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
hookRouteAll = SpockMethod -> RouteSpec t xs ps ctx conn sess st
forall (t :: * -> (* -> *) -> * -> *) (xs :: [*]) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute' SpockMethod
MethodAny

-- | Specify an action that will be run when the HTTP verb 'GET' and the given route match
get :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
get :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
get = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
GET

-- | Specify an action that will be run when the HTTP verb 'POST' and the given route match
post :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
post :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
post = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
POST

-- | Specify an action that will be run when the HTTP verb 'GET'/'POST' and the given route match
getpost :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
getpost :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
getpost Path xs ps
r HVectElim xs (SpockActionCtx ctx conn sess st ())
a = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
POST Path xs ps
r HVectElim xs (SpockActionCtx ctx conn sess st ())
a t ctx (WebStateM conn sess st) ()
-> t ctx (WebStateM conn sess st) ()
-> t ctx (WebStateM conn sess st) ()
forall a b.
t ctx (WebStateM conn sess st) a
-> t ctx (WebStateM conn sess st) b
-> t ctx (WebStateM conn sess st) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
GET Path xs ps
r HVectElim xs (SpockActionCtx ctx conn sess st ())
a

-- | Specify an action that will be run when the HTTP verb 'HEAD' and the given route match
head :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
head :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
head = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
HEAD

-- | Specify an action that will be run when the HTTP verb 'PUT' and the given route match
put :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
put :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
put = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
PUT

-- | Specify an action that will be run when the HTTP verb 'DELETE' and the given route match
delete :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
delete :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
delete = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
DELETE

-- | Specify an action that will be run when the HTTP verb 'PATCH' and the given route match
patch :: HV.HasRep xs => RouteSpec t xs ps ctx conn sess st
patch :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
RouteSpec t xs ps ctx conn sess st
patch = StdMethod -> RouteSpec t xs ps ctx conn sess st
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute StdMethod
PATCH

-- | Specify an action that will be run when a custom HTTP verb and the given route match
hookRouteCustom :: HV.HasRep xs => T.Text -> RouteSpec t xs ps ctx conn sess st
hookRouteCustom :: forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
SessionId -> RouteSpec t xs ps ctx conn sess st
hookRouteCustom SessionId
t = SpockMethod -> RouteSpec t xs ps ctx conn sess st
forall (t :: * -> (* -> *) -> * -> *) (xs :: [*]) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute' (SessionId -> SpockMethod
MethodCustom SessionId
t)

-- | Specify an action that will be run when a standard HTTP verb matches but no defined route matches.
-- The full path is passed as an argument
hookAny :: StdMethod -> ([T.Text] -> SpockActionCtx ctx conn sess st ()) -> RouteMonad t ctx conn sess st ()
hookAny :: forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
StdMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAny StdMethod
m = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAny' (HttpMethod -> SpockMethod
MethodStandard (HttpMethod -> SpockMethod)
-> (StdMethod -> HttpMethod) -> StdMethod -> SpockMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> HttpMethod
HttpMethod (StdMethod -> SpockMethod) -> StdMethod -> SpockMethod
forall a b. (a -> b) -> a -> b
$ StdMethod
m)

-- | Specify an action that will be run regardless of the HTTP verb and no defined route matches.
-- The full path is passed as an argument
hookAnyAll :: ([T.Text] -> SpockActionCtx ctx conn sess st ()) -> RouteMonad t ctx conn sess st ()
hookAnyAll :: forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAnyAll = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAny' SpockMethod
MethodAny

-- | Specify an action that will be run when a custom HTTP verb matches but no defined route matches.
-- The full path is passed as an argument
hookAnyCustom :: T.Text -> ([T.Text] -> SpockActionCtx ctx conn sess st ()) -> RouteMonad t ctx conn sess st ()
hookAnyCustom :: forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
SessionId
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAnyCustom SessionId
t = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAny' (SessionId -> SpockMethod
MethodCustom SessionId
t)

-- | Specify an action that will be run when a HTTP verb matches but no defined route matches.
-- The full path is passed as an argument
hookAny' :: SpockMethod -> ([T.Text] -> SpockActionCtx ctx conn sess st ()) -> RouteMonad t ctx conn sess st ()
hookAny' :: forall ctx conn sess st (t :: * -> (* -> *) -> * -> *).
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> RouteMonad t ctx conn sess st ()
hookAny' SpockMethod
m [SessionId] -> SpockActionCtx ctx conn sess st ()
action =
  SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> t ctx (WebStateM conn sess st) ()
forall (t :: * -> (* -> *) -> * -> *) (m :: * -> *) ctx.
(RouteM t, Monad m) =>
SpockMethod -> ([SessionId] -> ActionCtxT ctx m ()) -> t ctx m ()
C.hookAny' SpockMethod
m (([SessionId] -> SpockActionCtx ctx conn sess st ())
 -> t ctx (WebStateM conn sess st) ())
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> t ctx (WebStateM conn sess st) ()
forall a b. (a -> b) -> a -> b
$ \[SessionId]
t -> SpockActionCtx ctx conn sess st ()
forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheckIfEnabled SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
forall a b.
ActionCtxT ctx (WebStateM conn sess st) a
-> ActionCtxT ctx (WebStateM conn sess st) b
-> ActionCtxT ctx (WebStateM conn sess st) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SessionId] -> SpockActionCtx ctx conn sess st ()
action [SessionId]
t

-- | Specify an action that will be run when a HTTP verb and the given route match
hookRoute' ::
  forall t xs ps ctx conn sess st.
  (HV.HasRep xs) =>
  SpockMethod ->
  RouteSpec t xs ps ctx conn sess st
hookRoute' :: forall (t :: * -> (* -> *) -> * -> *) (xs :: [*]) (ps :: PathState)
       ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec t xs ps ctx conn sess st
hookRoute' SpockMethod
m Path xs ps
path HVectElim xs (SpockActionCtx ctx conn sess st ())
action =
  let checkedAction :: HV.HVect xs -> SpockActionCtx ctx conn sess st ()
      checkedAction :: HVect xs -> SpockActionCtx ctx conn sess st ()
checkedAction HVect xs
args = SpockActionCtx ctx conn sess st ()
forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheckIfEnabled SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
forall a b.
ActionCtxT ctx (WebStateM conn sess st) a
-> ActionCtxT ctx (WebStateM conn sess st) b
-> ActionCtxT ctx (WebStateM conn sess st) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HVectElim xs (SpockActionCtx ctx conn sess st ())
-> HVect xs -> SpockActionCtx ctx conn sess st ()
forall (ts :: [*]) a. HVectElim ts a -> HVect ts -> a
HV.uncurry HVectElim xs (SpockActionCtx ctx conn sess st ())
action HVect xs
args
   in SpockMethod
-> Path xs ps
-> HVectElim xs (SpockActionCtx ctx conn sess st ())
-> t ctx (WebStateM conn sess st) ()
forall (xs :: [*]) (t :: * -> (* -> *) -> * -> *) (m :: * -> *)
       (ps :: PathState) ctx.
(HasRep xs, RouteM t, Monad m) =>
SpockMethod
-> Path xs ps -> HVectElim xs (ActionCtxT ctx m ()) -> t ctx m ()
C.hookRoute' SpockMethod
m Path xs ps
path ((HVect xs -> SpockActionCtx ctx conn sess st ())
-> HVectElim xs (SpockActionCtx ctx conn sess st ())
forall (ts :: [*]) a.
HasRep ts =>
(HVect ts -> a) -> HVectElim ts a
HV.curry HVect xs -> SpockActionCtx ctx conn sess st ()
checkedAction)

csrfCheckIfEnabled :: SpockActionCtx ctx conn sess st ()
csrfCheckIfEnabled :: forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheckIfEnabled =
  do
    method <- ActionCtxT ctx (WebStateM conn sess st) SpockMethod
forall (m :: * -> *) ctx. MonadIO m => ActionCtxT ctx m SpockMethod
reqMethod
    when (shouldCheckCsrf method) $
      do
        cfg <- getSpockCfg
        when (spc_csrfProtection cfg) csrfCheck

-- Check the request method, including when the route accepts every method.
shouldCheckCsrf :: SpockMethod -> Bool
shouldCheckCsrf :: SpockMethod -> Bool
shouldCheckCsrf SpockMethod
m =
  case SpockMethod
m of
    MethodStandard (HttpMethod StdMethod
GET) -> Bool
False
    MethodStandard (HttpMethod StdMethod
HEAD) -> Bool
False
    MethodStandard (HttpMethod StdMethod
OPTIONS) -> Bool
False
    SpockMethod
_ -> Bool
True