{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Web.Spock
    ( -- * Launching Spock
      runSpock, runSpockNoBanner, spockAsApp
      -- * Spock's route definition monad
    , spock, SpockM, SpockCtxM
      -- * Defining routes
    , Path, root, Var, var, static, (<//>), wildcard
      -- * Rendering routes
    , renderRoute
      -- * 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 Web.Spock.Action
import Web.Spock.Core hiding
       ( hookRoute', hookAny'
       , get, post, getpost, head, put, delete, patch, hookRoute
       , hookRouteCustom, hookAny, hookAnyCustom
       , hookRouteAll, hookAnyAll
       )
import Web.Spock.Internal.Monad
import Web.Spock.Internal.SessionManager
import Web.Spock.Internal.Types
import Web.Spock.SessionActions
import qualified Web.Spock.Core as C

import Control.Applicative
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import Data.Pool
import Network.HTTP.Types.Status (status403)
import Prelude hiding (head)
import qualified Data.HVect as HV
import qualified Data.Text as T
import qualified Data.Vault.Lazy as V
import qualified Network.Wai as Wai


type SpockM conn sess st = SpockCtxM () conn sess st
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 :: SpockCfg conn sess st -> SpockM conn sess st () -> IO Middleware
spock SpockCfg conn sess st
spockCfg SpockM conn sess st ()
spockAppl =
    do Pool conn
connectionPool <-
           case PoolOrConn conn
poolOrConn of
             PoolOrConn conn
PCNoDatabase ->
                 IO ()
-> (() -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool ())
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool (() -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()) Int
5 NominalDiffTime
60 Int
5
             PCPool Pool conn
p ->
                 Pool conn -> IO (Pool conn)
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 IO conn
-> (conn -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool conn)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool (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)
                        (PoolCfg -> Int
pc_stripes PoolCfg
pc) (PoolCfg -> NominalDiffTime
pc_keepOpenTime PoolCfg
pc)
                        (PoolCfg -> Int
pc_resPerStripe PoolCfg
pc)
       WebState conn sess st
internalState <-
           Pool conn
-> SpockSessionManager conn sess st
-> st
-> SpockCfg conn sess st
-> WebState conn sess st
forall conn sess st.
Pool conn
-> SpockSessionManager conn sess st
-> st
-> SpockCfg conn sess st
-> WebState conn sess st
WebState
           (Pool conn
 -> SpockSessionManager conn sess st
 -> st
 -> SpockCfg conn sess st
 -> WebState conn sess st)
-> IO (Pool conn)
-> IO
     (SpockSessionManager conn sess st
      -> st -> SpockCfg conn sess st -> WebState conn sess st)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pool conn -> IO (Pool conn)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pool conn
connectionPool
           IO
  (SpockSessionManager conn sess st
   -> st -> SpockCfg conn sess st -> WebState conn sess st)
-> IO (SpockSessionManager conn sess st)
-> IO (st -> SpockCfg conn sess st -> WebState conn sess st)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (SessionCfg conn sess st
-> SessionIf (ActionCtxT () (WebStateM conn sess st))
-> IO (SpockSessionManager conn sess st)
forall (m :: * -> *) conn sess st.
MonadIO m =>
SessionCfg conn sess st
-> SessionIf m -> IO (SessionManager m conn sess st)
createSessionManager SessionCfg conn sess st
sessionCfg (SessionIf (ActionCtxT () (WebStateM conn sess st))
 -> IO (SpockSessionManager conn sess st))
-> SessionIf (ActionCtxT () (WebStateM conn sess st))
-> IO (SpockSessionManager conn sess st)
forall a b. (a -> b) -> a -> b
$
                   SessionIf :: forall (m :: * -> *).
(forall a. Key a -> m (Maybe a))
-> ((Vault -> Vault) -> m ())
-> (MultiHeader -> ByteString -> m ())
-> IO (Key SessionId)
-> SessionIf m
SessionIf
                   { si_queryVault :: forall a. Key a -> ActionCtxT () (WebStateM conn sess st) (Maybe a)
si_queryVault = forall a. Key a -> ActionCtxT () (WebStateM conn sess st) (Maybe a)
forall (m :: * -> *) a ctx.
MonadIO m =>
Key a -> ActionCtxT ctx m (Maybe a)
queryVault
                   , si_modifyVault :: (Vault -> Vault) -> ActionCtxT () (WebStateM conn sess st) ()
si_modifyVault = (Vault -> Vault) -> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) ctx.
MonadIO m =>
(Vault -> Vault) -> ActionCtxT ctx m ()
modifyVault
                   , si_setRawMultiHeader :: MultiHeader
-> ByteString -> ActionCtxT () (WebStateM conn sess st) ()
si_setRawMultiHeader = MultiHeader
-> ByteString -> ActionCtxT () (WebStateM conn sess st) ()
forall (m :: * -> *) ctx.
MonadIO m =>
MultiHeader -> ByteString -> ActionCtxT ctx m ()
setRawMultiHeader
                   , si_vaultKey :: IO (Key SessionId)
si_vaultKey = IO (Key SessionId)
forall a. IO (Key a)
V.newKey
                   }
               )
           IO (st -> SpockCfg conn sess st -> WebState conn sess st)
-> IO st -> IO (SpockCfg conn sess st -> WebState conn sess st)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> st -> IO st
forall (f :: * -> *) a. Applicative f => a -> f a
pure st
initialState
           IO (SpockCfg conn sess st -> WebState conn sess st)
-> IO (SpockCfg conn sess st) -> IO (WebState conn sess st)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SpockCfg conn sess st -> IO (SpockCfg conn sess st)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SpockCfg conn sess st
spockCfg
       let coreConfig :: SpockConfig
coreConfig =
               SpockConfig
defaultSpockConfig
               { sc_maxRequestSize :: Maybe Word64
sc_maxRequestSize = SpockCfg conn sess st -> Maybe Word64
forall conn sess st. SpockCfg conn sess st -> Maybe Word64
spc_maxRequestSize SpockCfg conn sess st
spockCfg
               , sc_errorHandler :: Status -> ActionCtxT () IO ()
sc_errorHandler = SpockCfg conn sess st -> Status -> ActionCtxT () IO ()
forall conn sess st.
SpockCfg conn sess st -> Status -> ActionCtxT () IO ()
spc_errorHandler SpockCfg conn sess st
spockCfg
               , sc_logError :: SessionId -> IO ()
sc_logError = SpockCfg conn sess st -> SessionId -> IO ()
forall conn sess st. SpockCfg conn sess st -> SessionId -> IO ()
spc_logError SpockCfg conn sess st
spockCfg
               }
       SpockConfig
-> (forall a. WebStateM conn sess st a -> IO a)
-> SpockM conn sess st ()
-> IO Middleware
forall (m :: * -> *).
MonadIO m =>
SpockConfig
-> (forall a. m a -> IO a) -> SpockT m () -> IO Middleware
spockConfigT SpockConfig
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)  (SpockM conn sess st () -> IO Middleware)
-> SpockM conn sess st () -> IO Middleware
forall a b. (a -> b) -> a -> b
$
           do Middleware -> SpockM conn sess st ()
forall (t :: * -> (* -> *) -> * -> *) (m :: * -> *) ctx.
(RouteM t, Monad m) =>
Middleware -> t ctx m ()
middleware (SpockSessionManager conn sess st -> Middleware
forall (m :: * -> *) conn sess st.
SessionManager m conn sess st -> Middleware
sm_middleware (SpockSessionManager conn sess st -> Middleware)
-> SpockSessionManager conn sess st -> Middleware
forall a b. (a -> b) -> a -> b
$ WebState conn sess st -> SpockSessionManager conn sess st
forall conn sess st.
WebState conn sess st -> SpockSessionManager conn sess st
web_sessionMgr WebState conn sess st
internalState)
              SpockM conn sess st ()
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 :: SpockActionCtx ctx conn sess st SessionId
getCsrfToken = ()
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> SpockActionCtx ctx 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
 -> SpockActionCtx ctx conn sess st SessionId)
-> ActionCtxT () (WebStateM conn sess st) SessionId
-> SpockActionCtx ctx 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)
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 :: SpockActionCtx ctx conn sess st (Maybe SessionId)
getClientCsrfToken =
    do SpockCfg conn sess st
cfg <- ActionCtxT ctx (WebStateM conn sess st) (SpockCfg conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))
getSpockCfg
       Maybe SessionId
mHeader <- SessionId -> SpockActionCtx ctx conn sess st (Maybe SessionId)
forall (m :: * -> *) ctx.
MonadIO m =>
SessionId -> ActionCtxT ctx m (Maybe SessionId)
header (SpockCfg conn sess st -> SessionId
forall conn sess st. SpockCfg conn sess st -> SessionId
spc_csrfHeaderName SpockCfg conn sess st
cfg)
       Maybe SessionId
mParam <- SessionId -> SpockActionCtx ctx conn sess st (Maybe SessionId)
forall p (m :: * -> *) ctx.
(FromHttpApiData p, MonadIO m) =>
SessionId -> ActionCtxT ctx m (Maybe p)
param (SpockCfg conn sess st -> SessionId
forall conn sess st. SpockCfg conn sess st -> SessionId
spc_csrfPostName SpockCfg conn sess st
cfg)
       Maybe SessionId
-> SpockActionCtx ctx conn sess st (Maybe SessionId)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SessionId
mHeader Maybe SessionId -> Maybe SessionId -> Maybe SessionId
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SessionId
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 :: SpockActionCtx ctx conn sess st ()
csrfCheck =
    do SessionId
csrf <- SpockActionCtx ctx conn sess st SessionId
forall ctx conn sess st. SpockActionCtx ctx conn sess st SessionId
getCsrfToken
       Maybe SessionId
clientCsrf <- SpockActionCtx ctx conn sess st (Maybe SessionId)
forall ctx conn sess st.
SpockActionCtx ctx conn sess st (Maybe SessionId)
getClientCsrfToken
       case Maybe SessionId
clientCsrf of
         Maybe SessionId
Nothing -> SpockActionCtx ctx 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 -> () -> SpockActionCtx ctx conn sess st ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
           | Bool
otherwise -> SpockActionCtx ctx 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 RouteSpec xs ps ctx conn sess st =
    Path xs ps -> HV.HVectElim xs (SpockActionCtx ctx conn sess st ()) -> SpockCtxM 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 xs ps ctx conn sess st
hookRoute :: StdMethod -> RouteSpec xs ps ctx conn sess st
hookRoute = SpockMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec xs ps ctx conn sess st
hookRoute' (SpockMethod -> RouteSpec xs ps ctx conn sess st)
-> (StdMethod -> SpockMethod)
-> StdMethod
-> RouteSpec xs ps ctx conn sess st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpMethod -> SpockMethod
MethodStandard (HttpMethod -> SpockMethod)
-> (StdMethod -> HttpMethod) -> StdMethod -> SpockMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> HttpMethod
HttpMethod

-- | Specify an action that will be run regardless of the HTTP verb
hookRouteAll :: HV.HasRep xs => RouteSpec xs ps ctx conn sess st
hookRouteAll :: RouteSpec xs ps ctx conn sess st
hookRouteAll = SpockMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec 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 xs ps ctx conn sess st
get :: RouteSpec xs ps ctx conn sess st
get = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
post :: RouteSpec xs ps ctx conn sess st
post = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
getpost :: RouteSpec xs ps ctx conn sess st
getpost Path xs ps
r HVectElim xs (SpockActionCtx ctx conn sess st ())
a = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec xs ps ctx conn sess st
hookRoute StdMethod
POST Path xs ps
r HVectElim xs (SpockActionCtx ctx conn sess st ())
a SpockCtxT ctx (WebStateM conn sess st) ()
-> SpockCtxT ctx (WebStateM conn sess st) ()
-> SpockCtxT ctx (WebStateM conn sess st) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
head :: RouteSpec xs ps ctx conn sess st
head = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
put :: RouteSpec xs ps ctx conn sess st
put = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
delete :: RouteSpec xs ps ctx conn sess st
delete = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
patch :: RouteSpec xs ps ctx conn sess st
patch = StdMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
StdMethod -> RouteSpec 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 xs ps ctx conn sess st
hookRouteCustom :: SessionId -> RouteSpec xs ps ctx conn sess st
hookRouteCustom = SpockMethod -> RouteSpec xs ps ctx conn sess st
forall (xs :: [*]) (ps :: PathState) ctx conn sess st.
HasRep xs =>
SpockMethod -> RouteSpec xs ps ctx conn sess st
hookRoute' (SpockMethod -> RouteSpec xs ps ctx conn sess st)
-> (SessionId -> SpockMethod)
-> SessionId
-> RouteSpec xs ps ctx conn sess st
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId -> SpockMethod
MethodCustom

-- | 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 ()) -> SpockCtxM ctx conn sess st ()

hookAny :: StdMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAny = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall ctx conn sess st.
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAny' (SpockMethod
 -> ([SessionId] -> SpockActionCtx ctx conn sess st ())
 -> SpockCtxM ctx conn sess st ())
-> (StdMethod -> SpockMethod)
-> StdMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpMethod -> SpockMethod
MethodStandard (HttpMethod -> SpockMethod)
-> (StdMethod -> HttpMethod) -> StdMethod -> SpockMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> HttpMethod
HttpMethod

-- | 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 ()) -> SpockCtxM ctx conn sess st ()
hookAnyAll :: ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAnyAll = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall ctx conn sess st.
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM 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 ()) -> SpockCtxM ctx conn sess st ()

hookAnyCustom :: SessionId
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAnyCustom = SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall ctx conn sess st.
SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAny' (SpockMethod
 -> ([SessionId] -> SpockActionCtx ctx conn sess st ())
 -> SpockCtxM ctx conn sess st ())
-> (SessionId -> SpockMethod)
-> SessionId
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionId -> SpockMethod
MethodCustom

-- | 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 ()) -> SpockCtxM ctx conn sess st ()
hookAny' :: SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
hookAny' SpockMethod
m [SessionId] -> SpockActionCtx ctx conn sess st ()
action =
    SpockCtxT ctx (WebStateM conn sess st) (SpockCfg conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))
getSpockCfg SpockCtxT ctx (WebStateM conn sess st) (SpockCfg conn sess st)
-> (SpockCfg conn sess st -> SpockCtxM ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SpockCfg conn sess st
cfg ->
    SpockMethod
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx 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 ())
 -> SpockCtxM ctx conn sess st ())
-> ([SessionId] -> SpockActionCtx ctx conn sess st ())
-> SpockCtxM ctx conn sess st ()
forall a b. (a -> b) -> a -> b
$ \[SessionId]
t ->
    case SpockMethod
m of
      MethodStandard (HttpMethod StdMethod
stdMethod)
          | StdMethod -> Bool
shouldCheckCsrf StdMethod
stdMethod Bool -> Bool -> Bool
&& SpockCfg conn sess st -> Bool
forall conn sess st. SpockCfg conn sess st -> Bool
spc_csrfProtection SpockCfg conn sess st
cfg -> SpockActionCtx ctx conn sess st ()
forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheck SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [SessionId] -> SpockActionCtx ctx conn sess st ()
action [SessionId]
t
      SpockMethod
_ -> [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 xs ps ctx conn sess st.
    (HV.HasRep xs)
    => SpockMethod
    -> RouteSpec xs ps ctx conn sess st
hookRoute' :: SpockMethod -> RouteSpec xs ps ctx conn sess st
hookRoute' SpockMethod
m Path xs ps
path HVectElim xs (SpockActionCtx ctx conn sess st ())
action =
    do SpockCfg conn sess st
cfg <- SpockCtxT ctx (WebStateM conn sess st) (SpockCfg conn sess st)
forall (m :: * -> *).
HasSpock m =>
m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))
getSpockCfg
       HVectElim xs (SpockActionCtx ctx conn sess st ())
checkedAction <-
           case SpockMethod
m of
               MethodStandard (HttpMethod StdMethod
stdMethod)
                   | StdMethod -> Bool
shouldCheckCsrf StdMethod
stdMethod Bool -> Bool -> Bool
&& SpockCfg conn sess st -> Bool
forall conn sess st. SpockCfg conn sess st -> Bool
spc_csrfProtection SpockCfg conn sess st
cfg ->
                         do let unpackedAction :: HV.HVect xs -> SpockActionCtx ctx conn sess st ()
                                unpackedAction :: HVect xs -> SpockActionCtx ctx conn sess st ()
unpackedAction HVect xs
args =
                                    SpockActionCtx ctx conn sess st ()
forall ctx conn sess st. SpockActionCtx ctx conn sess st ()
csrfCheck SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
-> SpockActionCtx ctx conn sess st ()
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
                            HVectElim xs (SpockActionCtx ctx conn sess st ())
-> SpockCtxT
     ctx
     (WebStateM conn sess st)
     (HVectElim xs (SpockActionCtx ctx conn sess st ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HVectElim xs (SpockActionCtx ctx conn sess st ())
 -> SpockCtxT
      ctx
      (WebStateM conn sess st)
      (HVectElim xs (SpockActionCtx ctx conn sess st ())))
-> HVectElim xs (SpockActionCtx ctx conn sess st ())
-> SpockCtxT
     ctx
     (WebStateM conn sess st)
     (HVectElim xs (SpockActionCtx ctx conn sess st ()))
forall a b. (a -> b) -> a -> b
$ (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 ()
unpackedAction
               SpockMethod
_ -> HVectElim xs (SpockActionCtx ctx conn sess st ())
-> SpockCtxT
     ctx
     (WebStateM conn sess st)
     (HVectElim xs (SpockActionCtx ctx conn sess st ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure HVectElim xs (SpockActionCtx ctx conn sess st ())
action
       SpockMethod -> RouteSpec xs ps ctx 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 HVectElim xs (SpockActionCtx ctx conn sess st ())
checkedAction

shouldCheckCsrf :: StdMethod -> Bool
shouldCheckCsrf :: StdMethod -> Bool
shouldCheckCsrf StdMethod
m =
    case StdMethod
m of
      StdMethod
GET -> Bool
False
      StdMethod
HEAD -> Bool
False
      StdMethod
OPTIONS -> Bool
False
      StdMethod
_ -> Bool
True