module Web.Spock.Simple
(
spock, SpockM, SpockAction
, spockT, SpockT, ActionT
, spockApp
, SpockRoute, (<#>)
, subcomponent
, get, post, head, put, delete, patch, hookRoute, hookAny
, Http.StdMethod (..)
, middleware
, spockMiddleware
, SafeAction (..)
, safeActionPath
, module Web.Spock.Shared
)
where
import Web.Spock.Shared
import Web.Spock.Internal.CoreAction
import Web.Spock.Internal.Types
import Web.Spock.Internal.Wrapper
import qualified Web.Spock.Internal.Wire as W
import qualified Web.Spock.Internal.Core as C
import Control.Applicative
import Control.Monad.Trans
import Data.Monoid
import Data.String
import Network.HTTP.Types.Method
import Prelude hiding (head)
import Web.Routing.TextRouting
import qualified Data.Text as T
import qualified Network.HTTP.Types as Http
import qualified Network.Wai as Wai
import qualified Network.Wai.Handler.Warp as Warp
type SpockM conn sess st a = SpockT (WebStateM conn sess st) a
newtype SpockT m a
= SpockT { runSpockT :: C.SpockAllT (TextRouter (ActionT m) ()) m a
} deriving (Monad, Functor, Applicative, MonadIO)
instance MonadTrans SpockT where
lift = SpockT . lift
newtype SpockRoute
= SpockRoute { _unSpockRoute :: T.Text }
deriving (Eq, Ord, Show, Read, IsString)
spock :: Int -> SessionCfg sess -> PoolOrConn conn -> st -> SpockM conn sess st () -> IO ()
spock port sessCfg poolOrConn initSt spockAppl =
spockAll TextRouter port sessCfg poolOrConn initSt (runSpockT spockAppl')
where
spockAppl' =
do hookSafeActions
spockAppl
spockT :: (MonadIO m)
=> Warp.Port
-> (forall a. m a -> IO a)
-> SpockT m ()
-> IO ()
spockT port liftFun (SpockT app) =
C.spockAllT TextRouter port liftFun app
spockApp :: (MonadIO m) => (forall a. m a -> IO a) -> SpockT m () -> IO Wai.Application
spockApp liftFun (SpockT app) =
W.buildApp TextRouter liftFun app
spockMiddleware :: (MonadIO m) => (forall a. m a -> IO a) -> SpockT m () -> IO Wai.Middleware
spockMiddleware liftFun (SpockT app) =
W.buildMiddleware TextRouter liftFun app
(<#>) :: SpockRoute -> SpockRoute -> SpockRoute
(SpockRoute t) <#> (SpockRoute t') = SpockRoute $ combineRoute t t'
get :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
get = hookRoute GET
post :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
post = hookRoute POST
head :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
head = hookRoute HEAD
put :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
put = hookRoute PUT
delete :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
delete = hookRoute DELETE
patch :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()
patch = hookRoute PATCH
hookRoute :: Monad m => StdMethod -> SpockRoute -> ActionT m () -> SpockT m ()
hookRoute m (SpockRoute path) action = SpockT $ C.hookRoute m (TextRouterPath path) (TAction action)
hookAny :: Monad m => StdMethod -> ([T.Text] -> ActionT m ()) -> SpockT m ()
hookAny m action = SpockT $ C.hookAny m action
subcomponent :: Monad m => SpockRoute -> SpockT m () -> SpockT m ()
subcomponent (SpockRoute p) (SpockT subapp) = SpockT $ C.subcomponent (TextRouterPath p) subapp
middleware :: Monad m => Wai.Middleware -> SpockT m ()
middleware = SpockT . C.middleware
safeActionPath :: forall conn sess st a.
( SafeAction conn sess st a
, HasSpock(SpockAction conn sess st)
, SpockConn (SpockAction conn sess st) ~ conn
, SpockSession (SpockAction conn sess st) ~ sess
, SpockState (SpockAction conn sess st) ~ st)
=> a
-> SpockAction conn sess st T.Text
safeActionPath safeAction =
do mgr <- getSessMgr
hash <- (sm_addSafeAction mgr) (PackedSafeAction safeAction)
return $ "/h/" <> hash
hookSafeActions :: forall conn sess st.
( HasSpock (SpockAction conn sess st)
, SpockConn (SpockAction conn sess st) ~ conn
, SpockSession (SpockAction conn sess st) ~ sess
, SpockState (SpockAction conn sess st) ~ st)
=> SpockM conn sess st ()
hookSafeActions =
do get "/h/:spock-csurf-protection" run
post "/h/:spock-csurf-protection" run
where
run =
do Just h <- param "spock-csurf-protection"
mgr <- getSessMgr
mAction <- (sm_lookupSafeAction mgr) h
case mAction of
Nothing ->
do setStatus Http.status404
text "File not found"
Just p@(PackedSafeAction action) ->
do runSafeAction action
(sm_removeSafeAction mgr) p