Spock 0.4.3.3 → 0.4.3.4
raw patch · 5 files changed
+89/−84 lines, 5 files
Files
- Spock.cabal +1/−1
- Web/Spock/Monad.hs +1/−14
- Web/Spock/SafeActions.hs +15/−4
- Web/Spock/SessionManager.hs +37/−44
- Web/Spock/Types.hs +35/−21
Spock.cabal view
@@ -1,5 +1,5 @@ name: Spock-version: 0.4.3.3+version: 0.4.3.4 synopsis: Another Haskell web toolkit based on scotty description: This toolbox provides everything you need to get a quick start into web hacking with haskell: sessions, cookies, database helper, csrf-protection, global state and the power of scotty Homepage: https://github.com/agrafix/Spock
Web/Spock/Monad.hs view
@@ -21,19 +21,6 @@ webM :: MonadTrans t => WebStateM conn sess st a -> t (WebStateM conn sess st) a webM = lift -class HasSpock m where- type SpockConn m :: *- type SpockState m :: *- type SpockSession m :: *- -- | Give you access to a database connectin from the connection pool. The connection is- -- released back to the pool once the function terminates.- runQuery :: (SpockConn m -> IO a) -> m a- -- | Read the application's state. If you wish to have mutable state, you could- -- use a 'TVar' from the STM packge.- getState :: m (SpockState m)- -- | Get the session manager- getSessMgr :: m (SessionManager (SpockSession m))- instance MonadTrans t => HasSpock (t (WebStateM conn sess st)) where type SpockConn (t (WebStateM conn sess st)) = conn type SpockState (t (WebStateM conn sess st)) = st@@ -75,7 +62,7 @@ runResourceT $ runReaderT action st -getSessMgrImpl :: (WebStateM conn sess st) (SessionManager sess)+getSessMgrImpl :: (WebStateM conn sess st) (SessionManager conn sess st) getSessMgrImpl = asks web_sessionMgr instance Parsable BSL.ByteString where
Web/Spock/SafeActions.hs view
@@ -1,10 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} module Web.Spock.SafeActions where import Web.Scotty.Trans import Web.Spock.Types-import Web.Spock.Monad import qualified Data.Text as T @@ -25,7 +27,12 @@ -- -- Note that safeActions currently only support GET and POST requests. ---safeActionPath :: SafeAction a+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 =@@ -33,12 +40,16 @@ hash <- (sm_addSafeAction mgr) (PackedSafeAction safeAction) return $ T.concat [ "/h/", hash ] -hookSafeActions :: SpockM conn sess st ()+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 :: SpockAction conn sess st () run = do h <- param "spock-csurf-protection" mgr <- getSessMgr
Web/Spock/SessionManager.hs view
@@ -24,7 +24,7 @@ import qualified Network.Wai as Wai import qualified Network.Wai.Util as Wai -createSessionManager :: SessionCfg a -> IO (SessionManager a)+createSessionManager :: SessionCfg sess -> IO (SessionManager conn sess st) createSessionManager cfg = do cacheHM <- atomically $ newTVar HM.empty vaultKey <- V.newKey@@ -37,11 +37,10 @@ , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM } -modifySessionBase :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions a- -> (Session a -> Session a)- -> ActionT e m ()+modifySessionBase :: V.Key SessionId+ -> UserSessions conn sess st+ -> (Session conn sess st -> Session conn sess st)+ -> SpockAction conn sess st () modifySessionBase vK sessionRef modFun = do req <- request case V.lookup vK (Wai.vault req) of@@ -50,10 +49,9 @@ Just sid -> liftIO $ atomically $ modifyTVar sessionRef (HM.adjust modFun sid) -readSessionBase :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions a- -> ActionT e m (Session a)+readSessionBase :: V.Key SessionId+ -> UserSessions conn sess st+ -> SpockAction conn sess st (Session conn sess st) readSessionBase vK sessionRef = do req <- request case V.lookup vK (Wai.vault req) of@@ -67,11 +65,10 @@ Just session -> return session -addSafeActionImpl :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions sess- -> PackedSafeAction- -> ActionT e m SafeActionHash+addSafeActionImpl :: V.Key SessionId+ -> UserSessions conn sess st+ -> PackedSafeAction conn sess st+ -> SpockAction conn sess st SafeActionHash addSafeActionImpl vaultKey cacheHM safeAction = do base <- readSessionBase vaultKey cacheHM case HM.lookup safeAction (sas_reverse (sess_safeActions base)) of@@ -87,44 +84,40 @@ modifySessionBase vaultKey cacheHM (\s -> s { sess_safeActions = f (sess_safeActions s) }) return safeActionHash -lookupSafeActionImpl :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions sess+lookupSafeActionImpl :: V.Key SessionId+ -> UserSessions conn sess st -> SafeActionHash- -> ActionT e m (Maybe PackedSafeAction)+ -> SpockAction conn sess st (Maybe (PackedSafeAction conn sess st)) lookupSafeActionImpl vaultKey cacheHM hash = do base <- readSessionBase vaultKey cacheHM return $ HM.lookup hash (sas_forward (sess_safeActions base)) -readSessionImpl :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions a- -> ActionT e m a+readSessionImpl :: V.Key SessionId+ -> UserSessions conn sess st+ -> SpockAction conn sess st sess readSessionImpl vK sessionRef = do base <- readSessionBase vK sessionRef return (sess_data base) -writeSessionImpl :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions a- -> a- -> ActionT e m ()+writeSessionImpl :: V.Key SessionId+ -> UserSessions conn sess st+ -> sess+ -> SpockAction conn sess st () writeSessionImpl vK sessionRef value = modifySessionImpl vK sessionRef (const value) -modifySessionImpl :: (SpockError e, MonadIO m)- => V.Key SessionId- -> UserSessions a- -> (a -> a)- -> ActionT e m ()+modifySessionImpl :: V.Key SessionId+ -> UserSessions conn sess st+ -> (sess -> sess)+ -> SpockAction conn sess st () modifySessionImpl vK sessionRef f = do let modFun session = session { sess_data = f (sess_data session) } modifySessionBase vK sessionRef modFun -sessionMiddleware :: SessionCfg a+sessionMiddleware :: SessionCfg sess -> V.Key SessionId- -> UserSessions a+ -> UserSessions conn sess st -> Wai.Middleware sessionMiddleware cfg vK sessionRef app req = case getCookieFromReq (sc_cookieName cfg) req of@@ -152,19 +145,19 @@ do newSess <- newSessionImpl cfg sessionRef defVal withSess True newSess -newSessionImpl :: SessionCfg a- -> UserSessions a- -> a- -> IO (Session a)+newSessionImpl :: SessionCfg sess+ -> UserSessions conn sess st+ -> sess+ -> IO (Session conn sess st) newSessionImpl sessCfg sessionRef content = do sess <- createSession sessCfg content atomically $ modifyTVar sessionRef (\hm -> HM.insert (sess_id sess) sess hm) return sess -loadSessionImpl :: SessionCfg a- -> UserSessions a+loadSessionImpl :: SessionCfg sess+ -> UserSessions conn sess st -> SessionId- -> IO (Maybe (Session a))+ -> IO (Maybe (Session conn sess st)) loadSessionImpl sessCfg sessionRef sid = do sessHM <- atomically $ readTVar sessionRef now <- getCurrentTime@@ -177,14 +170,14 @@ Nothing -> return Nothing -deleteSessionImpl :: UserSessions a+deleteSessionImpl :: UserSessions conn sess st -> SessionId -> IO () deleteSessionImpl sessionRef sid = do atomically $ modifyTVar sessionRef (\hm -> HM.delete sid hm) return () -createSession :: SessionCfg a -> a -> IO (Session a)+createSession :: SessionCfg sess -> sess -> IO (Session conn sess st) createSession sessCfg content = do sid <- randomHash (sc_sessionIdEntropy sessCfg) now <- getCurrentTime
Web/Spock/Types.hs view
@@ -28,11 +28,11 @@ -- | Spock is supercharged Scotty, that's why the 'SpockM' is built on the -- ScottyT monad. Insive the SpockM monad, you may define routes and middleware.-type SpockM conn sess st a = ScottyT Text (WebStateM conn sess st) a+type SpockM conn sess st = ScottyT Text (WebStateM conn sess st) -- | The SpockAction is the monad of all route-actions. You have access -- to the database, session and state of your application.-type SpockAction conn sess st a = ActionT Text (WebStateM conn sess st) a+type SpockAction conn sess st = ActionT Text (WebStateM conn sess st) -- | If Spock should take care of connection pooling, you need to configure -- it depending on what you need.@@ -74,28 +74,41 @@ data WebState conn sess st = WebState { web_dbConn :: ConnectionPool conn- , web_sessionMgr :: SessionManager sess+ , web_sessionMgr :: SessionManager conn sess st , web_state :: st } +class HasSpock m where+ type SpockConn m :: *+ type SpockState m :: *+ type SpockSession m :: *+ -- | Give you access to a database connectin from the connection pool. The connection is+ -- released back to the pool once the function terminates.+ runQuery :: (SpockConn m -> IO a) -> m a+ -- | Read the application's state. If you wish to have mutable state, you could+ -- use a 'TVar' from the STM packge.+ getState :: m (SpockState m)+ -- | Get the session manager+ getSessMgr :: m (SessionManager (SpockConn m) (SpockSession m) (SpockState m))+ -- | SafeActions are actions that need to be protected from csrf attacks-class (Hashable a, Eq a, Typeable a) => SafeAction a where+class (Hashable a, Eq a, Typeable a) => SafeAction conn sess st a where runSafeAction :: a -> SpockAction conn sess st () -data PackedSafeAction- = forall a. (SafeAction a) => PackedSafeAction { unpackSafeAction :: a }+data PackedSafeAction conn sess st+ = forall a. (SafeAction conn sess st a) => PackedSafeAction { unpackSafeAction :: a } -instance Hashable PackedSafeAction where+instance Hashable (PackedSafeAction conn sess st) where hashWithSalt i (PackedSafeAction a) = hashWithSalt i a -instance Eq PackedSafeAction where+instance Eq (PackedSafeAction conn sess st) where (PackedSafeAction a) == (PackedSafeAction b) = cast a == Just b -data SafeActionStore+data SafeActionStore conn sess st = SafeActionStore- { sas_forward :: HM.HashMap SafeActionHash PackedSafeAction- , sas_reverse :: HM.HashMap PackedSafeAction SafeActionHash+ { sas_forward :: HM.HashMap SafeActionHash (PackedSafeAction conn sess st)+ , sas_reverse :: HM.HashMap (PackedSafeAction conn sess st) SafeActionHash } type SafeActionHash = T.Text@@ -112,21 +125,22 @@ restoreM = WebStateM . restoreM . unWStM type SessionId = T.Text-data Session a+data Session conn sess st = Session { sess_id :: SessionId , sess_validUntil :: UTCTime- , sess_data :: a- , sess_safeActions :: SafeActionStore+ , sess_data :: sess+ , sess_safeActions :: SafeActionStore conn sess st }-type UserSessions a = TVar (HM.HashMap SessionId (Session a))+type UserSessions conn sess st =+ TVar (HM.HashMap SessionId (Session conn sess st)) -data SessionManager a+data SessionManager conn sess st = SessionManager- { sm_readSession :: (SpockError e, MonadIO m) => ActionT e m a- , sm_writeSession :: (SpockError e, MonadIO m) => a -> ActionT e m ()- , sm_modifySession :: (SpockError e, MonadIO m) => (a -> a) -> ActionT e m ()+ { sm_readSession :: SpockAction conn sess st sess+ , sm_writeSession :: sess -> SpockAction conn sess st ()+ , sm_modifySession :: (sess -> sess) -> SpockAction conn sess st () , sm_middleware :: Middleware- , sm_addSafeAction :: (SpockError e, MonadIO m) => PackedSafeAction -> ActionT e m SafeActionHash- , sm_lookupSafeAction :: (SpockError e, MonadIO m) => SafeActionHash -> ActionT e m (Maybe PackedSafeAction)+ , sm_addSafeAction :: (PackedSafeAction conn sess st) -> SpockAction conn sess st SafeActionHash+ , sm_lookupSafeAction :: SafeActionHash -> SpockAction conn sess st (Maybe (PackedSafeAction conn sess st)) }