Spock 0.7.9.0 → 0.7.10.0

raw patch · 15 files changed

+301/−109 lines, 15 filesdep +list-tdep +stm-containersdep ~aesondep ~basedep ~monad-controlPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: list-t, stm-containers

Dependency ranges changed: aeson, base, monad-control, reroute, stm

API changes (from Hackage documentation)

Files

• Spock.cabal +21/−5
• src/Web/Spock.hs +10/−0
• src/Web/Spock/Internal/Core.hs +1/−1
• src/Web/Spock/Internal/Monad.hs +1/−1
• src/Web/Spock/Internal/SessionManager.hs +70/−57
• src/Web/Spock/Internal/SessionVault.hs +57/−0
• src/Web/Spock/Internal/Types.hs +38/−24
• src/Web/Spock/Internal/Wire.hs +5/−1
• src/Web/Spock/Safe.hs +13/−5
• src/Web/Spock/Shared.hs +17/−3
• src/Web/Spock/Simple.hs +10/−3
• test/Web/Spock/FrameworkSpecHelper.hs +10/−7
• test/Web/Spock/Internal/SessionVaultSpec.hs +44/−0
• test/Web/Spock/SafeSpec.hs +1/−0
• test/Web/Spock/SimpleSpec.hs +3/−2

@@ -1,7 +1,17 @@ name:                Spock-version:             0.7.9.0+version:             0.7.10.0 synopsis:            Another Haskell web framework for rapid development-description:         This toolbox provides everything you need to get a quick start into web hacking with haskell: fast routing, middleware, json, sessions, cookies, database helper, csrf-protection+description:         This toolbox provides everything you need to get a quick start into web hacking with haskell:+                     .+                     * fast routing+                     * middleware+                     * json+                     * sessions+                     * cookies+                     * database helper+                     * csrf-protection+                     .+                     A tutorial is available at <http://www.spock.li/tutorial/ spock.li> Homepage:            http://www.spock.li Bug-reports:         https://github.com/agrafix/Spock/issues license:             BSD3@@ -17,7 +27,9 @@ library   hs-source-dirs:      src   exposed-modules:+                       Web.Spock,                        Web.Spock.Internal.Util,+                       Web.Spock.Internal.SessionVault,                        Web.Spock.Safe,                        Web.Spock.Shared,                        Web.Spock.Simple@@ -29,7 +41,7 @@                        Web.Spock.Internal.Types,                        Web.Spock.Internal.Wire   build-depends:-                       aeson >= 0.6.2.1,+                       aeson >= 0.7,                        base >= 4 && < 5,                        base64-bytestring >=1.0,                        bytestring >=0.10,@@ -38,15 +50,17 @@                        directory >=1.2,                        hashable >=1.2,                        http-types >=0.8,-                       monad-control >=0.3,+                       list-t >=0.4,+                       monad-control >=1.0,                        mtl >=2.1,                        old-locale >=1.0,                        path-pieces >=0.1.4,                        random >=1.0,-                       reroute >=0.2.2.1,+                       reroute >=0.2.3,                        resource-pool >=0.2,                        resourcet >= 0.4,                        stm >=2.4,+                       stm-containers >=0.2,                        text >= 0.11.3.1,                        time >=1.4,                        transformers >=0.3,@@ -65,6 +79,7 @@   other-modules:                        Web.Spock.FrameworkSpecHelper,                        Web.Spock.Internal.UtilSpec,+                       Web.Spock.Internal.SessionVaultSpec,                        Web.Spock.SafeSpec,                        Web.Spock.SimpleSpec   build-depends:@@ -73,6 +88,7 @@                        hspec-wai >= 0.6,                        http-types,                        Spock,+                       stm,                        reroute,                        text,                        wai

@@ -0,0 +1,10 @@+{- |+This module reexports type safe routing aproach which should be the default for all Spock applications. To learn more about+the routing, read the corresponding blog post available at <http://www.spock.li/2015/04/19/type-safe_routing.html>+-}+module Web.Spock+    ( module Web.Spock.Safe+    )+where++import Web.Spock.Safe

@@ -61,7 +61,7 @@                , web_sessionMgr = sessionMgr                , web_state = initialState                }-       spockAllT regIf (\m -> runResourceT $ runReaderT (runWebStateM m) internalState) $+       spockAllT regIf (\m -> runResourceT $ runReaderT (runWebStateT m) internalState) $                do defs                   middleware (sm_middleware sessionMgr) 

@@ -43,7 +43,7 @@  -- | Run an action inside of Spocks core monad. This allows you to use runQuery and getState runSpockIO :: WebState conn sess st -> WebStateM conn sess st a -> IO a-runSpockIO st (WebStateM action) =+runSpockIO st (WebStateT action) =     runResourceT $     runReaderT action st 

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts, OverloadedStrings, DoAndIfThenElse, RankNTypes #-} module Web.Spock.Internal.SessionManager-    ( createSessionManager+    ( createSessionManager, withSessionManager     , SessionId, Session(..), SessionManager(..)     ) where@@ -9,13 +9,14 @@ import Web.Spock.Internal.Types import Web.Spock.Internal.CoreAction import Web.Spock.Internal.Util+import qualified Web.Spock.Internal.SessionVault as SV  import Control.Arrow (first) import Control.Concurrent import Control.Concurrent.STM+import Control.Exception import Control.Monad import Control.Monad.Trans-import Data.List (foldl') import Data.Time #if MIN_VERSION_time(1,5,0) #else@@ -33,12 +34,20 @@ import qualified Data.Vault.Lazy as V import qualified Network.Wai as Wai +withSessionManager :: SessionCfg sess -> (SessionManager conn sess st -> IO a) -> IO a+withSessionManager sessCfg =+    bracket (createSessionManager sessCfg) sm_closeSessionManager+ createSessionManager :: SessionCfg sess -> IO (SessionManager conn sess st) createSessionManager cfg =     do oldSess <- loadSessions-       cacheHM <- atomically $ newTVar oldSess+       cacheHM <-+           atomically $+           do mapV <- SV.newSessionVault+              forM_ oldSess $ \v -> SV.storeSession v mapV+              return mapV        vaultKey <- V.newKey-       _ <- forkIO (forever (housekeepSessions cacheHM storeSessions))+       housekeepThread <- forkIO (forever (housekeepSessions cfg cacheHM storeSessions))        return           SessionManager           { sm_getSessionId = getSessionIdImpl vaultKey cacheHM@@ -50,52 +59,59 @@           , sm_addSafeAction = addSafeActionImpl vaultKey cacheHM           , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM           , sm_removeSafeAction = removeSafeActionImpl vaultKey cacheHM+          , sm_closeSessionManager = killThread housekeepThread           }     where       (loadSessions, storeSessions) =           case sc_persistCfg cfg of             Nothing ->-                ( return HM.empty+                ( return []                 , const $ return ()                 )             Just spc ->                 ( do sessions <- spc_load spc-                     return $ foldl' genSession HM.empty sessions+                     return (map genSession sessions)                 , spc_store spc . map mkSerializable . HM.elems                 )       mkSerializable sess =           (sess_id sess, sess_validUntil sess, sess_data sess)-      genSession hm (sid, validUntil, theData) =-          let s =-                  Session-                  { sess_id = sid-                  , sess_validUntil = validUntil-                  , sess_data = theData-                  , sess_safeActions = SafeActionStore HM.empty HM.empty-                  }-          in HM.insert sid s hm+      genSession (sid, validUntil, theData) =+          Session+          { sess_id = sid+          , sess_validUntil = validUntil+          , sess_data = theData+          , sess_safeActions = SafeActionStore HM.empty HM.empty+          }  getSessionIdImpl :: V.Key SessionId-                 -> UserSessions conn sess st+                 -> SV.SessionVault (Session conn sess st)                  -> SpockAction conn sess st SessionId getSessionIdImpl vK sessionRef =     do sess <- readSessionBase vK sessionRef        return $ sess_id sess  modifySessionBase :: V.Key SessionId-                  -> UserSessions conn sess st-                  -> (Session conn sess st -> Session conn sess st)-                  -> SpockAction conn sess st ()+                  -> SV.SessionVault (Session conn sess st)+                  -> (Session conn sess st -> (Session conn sess st, a))+                  -> SpockAction conn sess st a modifySessionBase vK sessionRef modFun =     do req <- request        case V.lookup vK (Wai.vault req) of          Nothing ->              error "(3) Internal Spock Session Error. Please report this bug!"          Just sid ->-             liftIO $ atomically $ modifyTVar' sessionRef (HM.adjust modFun sid)+             liftIO $ atomically $+             do mSession <- SV.loadSession sid sessionRef+                case mSession of+                  Nothing ->+                      fail "Internal Spock Session Error: Unknown SessionId"+                  Just session ->+                      do let (sessionNew, result) = modFun session+                         SV.storeSession sessionNew sessionRef+                         return result  readSessionBase :: V.Key SessionId-                -> UserSessions conn sess st+                -> SV.SessionVault (Session conn sess st)                 -> SpockAction conn sess st (Session conn sess st) readSessionBase vK sessionRef =     do req <- request@@ -103,15 +119,15 @@          Nothing ->              error "(1) Internal Spock Session Error. Please report this bug!"          Just sid ->-             do sessions <- liftIO $ atomically $ readTVar sessionRef-                case HM.lookup sid sessions of+             do mSession <- liftIO $ atomically $ SV.loadSession sid sessionRef+                case mSession of                   Nothing ->                       error "(2) Internal Spock Session Error. Please report this bug!"                   Just session ->                       return session  addSafeActionImpl :: V.Key SessionId-                  -> UserSessions conn sess st+                  -> SV.SessionVault (Session conn sess st)                   -> PackedSafeAction conn sess st                   -> SpockAction conn sess st SafeActionHash addSafeActionImpl vaultKey sessionMapVar safeAction =@@ -126,11 +142,11 @@                         { sas_forward = HM.insert safeActionHash safeAction (sas_forward sas)                         , sas_reverse = HM.insert safeAction safeActionHash (sas_reverse sas)                         }-                modifySessionBase vaultKey sessionMapVar (\s -> s { sess_safeActions = f (sess_safeActions s) })+                modifySessionBase vaultKey sessionMapVar (\s -> (s { sess_safeActions = f (sess_safeActions s) }, ()))                 return safeActionHash  lookupSafeActionImpl :: V.Key SessionId-                     -> UserSessions conn sess st+                     -> SV.SessionVault (Session conn sess st)                      -> SafeActionHash                      -> SpockAction conn sess st (Maybe (PackedSafeAction conn sess st)) lookupSafeActionImpl vaultKey sessionMapVar hash =@@ -138,11 +154,11 @@        return $ HM.lookup hash (sas_forward (sess_safeActions base))  removeSafeActionImpl :: V.Key SessionId-                     -> UserSessions conn sess st+                     -> SV.SessionVault (Session conn sess st)                      -> PackedSafeAction conn sess st                      -> SpockAction conn sess st () removeSafeActionImpl vaultKey sessionMapVar action =-    modifySessionBase vaultKey sessionMapVar (\s -> s { sess_safeActions = f (sess_safeActions s ) })+    modifySessionBase vaultKey sessionMapVar (\s -> (s { sess_safeActions = f (sess_safeActions s ) }, ()))     where       f sas =           sas@@ -154,31 +170,32 @@           }  readSessionImpl :: V.Key SessionId-                -> UserSessions conn sess st+                -> SV.SessionVault (Session conn sess st)                 -> SpockAction conn sess st sess readSessionImpl vK sessionRef =     do base <- readSessionBase vK sessionRef        return (sess_data base)  writeSessionImpl :: V.Key SessionId-                 -> UserSessions conn sess st+                 -> SV.SessionVault (Session conn sess st)                  -> sess                  -> SpockAction conn sess st () writeSessionImpl vK sessionRef value =-    modifySessionImpl vK sessionRef (const value)+    modifySessionImpl vK sessionRef (const (value, ()))  modifySessionImpl :: V.Key SessionId-                  -> UserSessions conn sess st-                  -> (sess -> sess)-                  -> SpockAction conn sess st ()+                  -> SV.SessionVault (Session conn sess st)+                  -> (sess -> (sess, a))+                  -> SpockAction conn sess st a modifySessionImpl vK sessionRef f =     do let modFun session =-                        session { sess_data = f (sess_data session) }+               let (sessData', out) = f (sess_data session)+               in (session { sess_data = sessData' }, out)        modifySessionBase vK sessionRef modFun  sessionMiddleware :: SessionCfg sess                   -> V.Key SessionId-                  -> UserSessions conn sess st+                  -> SV.SessionVault (Session conn sess st)                   -> Wai.Middleware sessionMiddleware cfg vK sessionRef app req respond =     case getCookieFromReq (sc_cookieName cfg) of@@ -227,22 +244,22 @@              withSess True newSess  newSessionImpl :: SessionCfg sess-               -> UserSessions conn sess st+               -> SV.SessionVault (Session conn sess st)                -> sess                -> IO (Session conn sess st) newSessionImpl sessCfg sessionRef content =     do sess <- createSession sessCfg content-       atomically $ modifyTVar' sessionRef (HM.insert (sess_id sess) sess)+       atomically $ SV.storeSession sess sessionRef        return $! sess  loadSessionImpl :: SessionCfg sess-                -> UserSessions conn sess st+                -> SV.SessionVault (Session conn sess st)                 -> SessionId                 -> IO (Maybe (Session conn sess st)) loadSessionImpl sessCfg sessionRef sid =-    do sessHM <- atomically $ readTVar sessionRef+    do mSess <- atomically $ SV.loadSession sid sessionRef        now <- getCurrentTime-       case HM.lookup sid sessHM of+       case mSess of          Just sess ->              do sessWithPossibleExpansion <-                     if sc_sessionExpandTTL sessCfg@@ -251,7 +268,7 @@                                     { sess_validUntil =                                           addUTCTime (sc_sessionTTL sessCfg) now                                     }-                            atomically $ modifyTVar' sessionRef (HM.insert sid expandedSession)+                            atomically $ SV.storeSession expandedSession sessionRef                             return expandedSession                     else return sess                 if sess_validUntil sessWithPossibleExpansion > now@@ -261,33 +278,29 @@          Nothing ->              return Nothing -deleteSessionImpl :: UserSessions conn sess st+deleteSessionImpl :: SV.SessionVault (Session conn sess st)                   -> SessionId                   -> IO () deleteSessionImpl sessionRef sid =-    do atomically $ modifyTVar' sessionRef (HM.delete sid)-       return ()+    atomically $ SV.deleteSession sid sessionRef -clearAllSessionsImpl :: UserSessions conn sess st+clearAllSessionsImpl :: SV.SessionVault (Session conn sess st)                      -> SpockAction conn sess st () clearAllSessionsImpl sessionRef =-    liftIO $ atomically $ modifyTVar' sessionRef (const HM.empty)+    liftIO $ atomically $ SV.filterSessions (const False) sessionRef -housekeepSessions :: UserSessions conn sess st+housekeepSessions :: SessionCfg sess+                  -> SV.SessionVault (Session conn sess st)                   -> (HM.HashMap SessionId (Session conn sess st) -> IO ())                   -> IO ()-housekeepSessions sessionRef storeSessions =+housekeepSessions cfg sessionRef storeSessions =     do now <- getCurrentTime        newStatus <-            atomically $-           do modifyTVar' sessionRef (killOld now)-              readTVar sessionRef-       storeSessions newStatus-       threadDelay (1000 * 1000 * 60) -- 60 seconds-    where-      filterOld now (_, sess) = sess_validUntil sess > now-      killOld now hm =-          HM.fromList $ filter (filterOld now) $ HM.toList hm+           do SV.filterSessions (\sess -> sess_validUntil sess > now) sessionRef+              SV.toList sessionRef+       storeSessions (HM.fromList $ map (\v -> (SV.getSessionKey v, v)) newStatus)+       threadDelay (1000 * 1000 * (round $ sc_housekeepingInterval cfg))  createSession :: SessionCfg sess -> sess -> IO (Session conn sess st) createSession sessCfg content =

@@ -0,0 +1,57 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+module Web.Spock.Internal.SessionVault where++import Web.Spock.Internal.Types++#if MIN_VERSION_base(4,8,0)+#else+import Control.Applicative+#endif+import Control.Concurrent.STM (STM)+import Control.Monad+import Data.Hashable+import qualified ListT as L+import qualified STMContainers.Map as STMMap+import qualified Data.Text as T++class (Eq (SessionKey s), Hashable (SessionKey s)) => IsSession s where+    type SessionKey s :: *+    getSessionKey :: s -> SessionKey s++instance IsSession (Session conn sess st) where+    type SessionKey (Session conn sess st) = T.Text+    getSessionKey = sess_id++newtype SessionVault s+    = SessionVault { unSessionVault :: STMMap.Map (SessionKey s) s }++-- | Create a new session vault+newSessionVault :: IsSession s => STM (SessionVault s)+newSessionVault = SessionVault <$> STMMap.new++-- | Load a session+loadSession :: IsSession s => SessionKey s -> SessionVault s -> STM (Maybe s)+loadSession key (SessionVault smap) = STMMap.lookup key smap++-- | Store a session, overwriting any previous values+storeSession :: IsSession s => s -> SessionVault s -> STM ()+storeSession v (SessionVault smap) = STMMap.insert v (getSessionKey v) smap++-- | Removea session+deleteSession :: IsSession s => SessionKey s -> SessionVault s -> STM ()+deleteSession k (SessionVault smap) = STMMap.delete k smap++-- | Get all sessions as list+toList :: IsSession s => SessionVault s -> STM [s]+toList =  liftM (map snd) . L.toList . STMMap.stream . unSessionVault++-- | Remove all sessions that do not match the predicate+filterSessions :: IsSession s => (s -> Bool) -> SessionVault s -> STM ()+filterSessions cond sv =+    do allVals <- toList sv+       let deleteKeys =+               map getSessionKey $+               filter (not . cond) allVals+       forM_ deleteKeys $ flip deleteSession sv

@@ -1,10 +1,12 @@-{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-} module Web.Spock.Internal.Types where  import Web.Spock.Internal.CoreAction@@ -14,7 +16,6 @@ #else import Control.Applicative #endif-import Control.Concurrent.STM import Control.Monad.Base import Control.Monad.Reader import Control.Monad.Trans.Control@@ -58,6 +59,19 @@    = PCPool (Pool a)    | PCConn (ConnBuilder a) +-- | Session configuration with reasonable defaults+defaultSessionCfg :: a -> SessionCfg a+defaultSessionCfg emptySession =+    SessionCfg+    { sc_cookieName = "spockcookie"+    , sc_sessionTTL = 3600+    , sc_sessionIdEntropy = 64+    , sc_sessionExpandTTL = True+    , sc_emptySession = emptySession+    , sc_persistCfg = Nothing+    , sc_housekeepingInterval = 60 * 10+    }+ -- | Configuration for the session manager data SessionCfg a    = SessionCfg@@ -73,6 +87,8 @@      -- ^ initial session for visitors    , sc_persistCfg :: Maybe (SessionPersistCfg a)      -- ^ persistence interface for sessions+   , sc_housekeepingInterval :: NominalDiffTime+     -- ^ how often should the session manager check for dangeling dead sessions    }  data SessionPersistCfg a@@ -124,25 +140,24 @@  type SafeActionHash = T.Text -newtype WebStateM conn sess st a = WebStateM { runWebStateM :: ReaderT (WebState conn sess st) (ResourceT IO) a }-    deriving (Monad, Functor, Applicative, MonadIO, MonadReader (WebState conn sess st))+newtype WebStateT conn sess st m a = WebStateT { runWebStateT :: ReaderT (WebState conn sess st) m a }+    deriving (Monad, Functor, Applicative, MonadIO, MonadReader (WebState conn sess st), MonadTrans) -instance MonadBase IO (WebStateM conn sess st) where-    liftBase = WebStateM . liftBase+instance MonadBase b m => MonadBase b (WebStateT conn sess st m) where+    liftBase = liftBaseDefault -#if MIN_VERSION_monad_control(1,0,0)-newtype WStM conn sess st a = WStM { unWStM :: StM (ReaderT (WebState conn sess st) (ResourceT IO)) a }-#endif+instance MonadTransControl (WebStateT conn sess st) where+    type StT (WebStateT conn sess st) a = a+    liftWith = defaultLiftWith WebStateT runWebStateT+    restoreT = defaultRestoreT WebStateT -instance MonadBaseControl IO (WebStateM conn sess st) where-#if MIN_VERSION_monad_control(1,0,0)-    type StM (WebStateM conn sess st) a = WStM conn sess st a-#else-    newtype StM (WebStateM conn sess st) a = WStM { unWStM :: StM (ReaderT (WebState conn sess st) (ResourceT IO)) a }-#endif-    liftBaseWith f = WebStateM . liftBaseWith $ \runInBase -> f $ liftM WStM . runInBase . runWebStateM-    restoreM = WebStateM . restoreM . unWStM+instance MonadBaseControl b m => MonadBaseControl b (WebStateT conn sess st m) where+    type StM (WebStateT conn sess st m) a = ComposeSt (WebStateT conn sess st) m a+    restoreM = defaultRestoreM+    liftBaseWith = defaultLiftBaseWith +type WebStateM conn sess st = WebStateT conn sess st (ResourceT IO)+ type SessionId = T.Text data Session conn sess st     = Session@@ -151,21 +166,20 @@     , sess_data :: !sess     , sess_safeActions :: !(SafeActionStore conn sess st)     }+ instance Show (Session conn sess st) where     show = show . sess_id -type UserSessions conn sess st =-    TVar (HM.HashMap SessionId (Session conn sess st))- data SessionManager conn sess st    = SessionManager    { sm_getSessionId :: SpockAction conn sess st SessionId    , sm_readSession :: SpockAction conn sess st sess    , sm_writeSession :: sess -> SpockAction conn sess st ()-   , sm_modifySession :: (sess -> sess) -> SpockAction conn sess st ()+   , sm_modifySession :: forall a. (sess -> (sess, a)) -> SpockAction conn sess st a    , sm_clearAllSessions :: SpockAction conn sess st ()    , sm_middleware :: Middleware    , sm_addSafeAction :: PackedSafeAction conn sess st -> SpockAction conn sess st SafeActionHash    , sm_lookupSafeAction :: SafeActionHash -> SpockAction conn sess st (Maybe (PackedSafeAction conn sess st))    , sm_removeSafeAction :: PackedSafeAction conn sess st -> SpockAction conn sess st ()+   , sm_closeSessionManager :: IO ()    }

@@ -84,6 +84,10 @@     | ActionMiddlewarePass     deriving (Show) +instance Monoid ActionInterupt where+    mempty = ActionDone+    mappend _ a = a+ #if MIN_VERSION_mtl(2,2,0) type ErrorT = ExceptT runErrorT :: ExceptT e m a -> m (Either e a)@@ -96,7 +100,7 @@  newtype ActionT m a     = ActionT { runActionT :: ErrorT ActionInterupt (RWST RequestInfo () ResponseState m) a }-      deriving (Monad, Functor, Applicative, MonadIO, MonadReader RequestInfo, MonadState ResponseState, MonadError ActionInterupt)+      deriving (Monad, Functor, Applicative, Alternative, MonadIO, MonadReader RequestInfo, MonadState ResponseState, MonadError ActionInterupt)  instance MonadTrans ActionT where     lift = ActionT . lift . lift

@@ -6,6 +6,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}++{- |+This module implements the type safe routing aproach. It should be used by all new Spock powered applications. To learn more about+the routing, read the corresponding blog post available at <http://www.spock.li/2015/04/19/type-safe_routing.html>+-} module Web.Spock.Safe     ( -- * Spock's route definition monad       spock, SpockM@@ -16,7 +21,7 @@     , renderRoute      -- * Hooking routes     , subcomponent-    , get, post, head, put, delete, patch, hookRoute, hookAny+    , get, post, getpost, head, put, delete, patch, hookRoute, hookAny     , Http.StdMethod (..)       -- * Adding Wai.Middleware     , middleware@@ -82,6 +87,10 @@ post :: MonadIO m => Path xs -> HVectElim xs (ActionT m ()) -> SpockT m () post = hookRoute POST +-- | Specify an action that will be run when the HTTP verb 'GET'/'POST' and the given route match+getpost :: MonadIO m => Path xs -> HVectElim xs (ActionT m ()) -> SpockT m ()+getpost r a = hookRoute POST r a >> hookRoute GET r a+ -- | Specify an action that will be run when the HTTP verb 'HEAD' and the given route match head :: MonadIO m => Path xs -> HVectElim xs (ActionT m ()) -> SpockT m () head = hookRoute HEAD@@ -160,8 +169,7 @@                    , SpockState (SpockAction conn sess st) ~ st)                 => SpockM conn sess st () hookSafeActions =-    do get (static "h" </> var) run-       post (static "h" </> var) run+    getpost (static "h" </> var) run     where       run h =           do mgr <- getSessMgr@@ -179,5 +187,5 @@ (<//>) = (</>)  -- | Render a route applying path pieces-renderRoute :: HasRep as => Path as -> HVectElim as T.Text-renderRoute route = hVectCurry (T.cons '/' . SR.renderRoute route)+renderRoute :: Path as -> HVectElim as T.Text+renderRoute route = hVectCurryExpl (pathToRep route) (T.cons '/' . SR.renderRoute route)

@@ -28,9 +28,11 @@       -- * Basic HTTP-Auth     , requireBasicAuth      -- * Sessions-    , SessionCfg (..), SessionPersistCfg(..), SessionId-    , readShowSessionPersist-    , getSessionId, readSession, writeSession, modifySession, clearAllSessions+    , defaultSessionCfg, SessionCfg (..)+    , SessionPersistCfg(..), readShowSessionPersist+    , SessionId+    , getSessionId, readSession, writeSession+    , modifySession, modifySession', modifyReadSession, clearAllSessions      -- * Internals for extending Spock     , getSpockHeart, runSpockIO, WebStateM, WebState     )@@ -74,8 +76,20 @@ -- | Modify the stored session modifySession :: (sess -> sess) -> SpockAction conn sess st () modifySession f =+    modifySession' $ \sess -> (f sess, ())++-- | Modify the stored session and return a value+modifySession' :: (sess -> (sess, a)) -> SpockAction conn sess st a+modifySession' f =     do mgr <- getSessMgr        sm_modifySession mgr f++-- | Modify the stored session and return the new value after modification+modifyReadSession :: (sess -> sess) -> SpockAction conn sess st sess+modifyReadSession f =+    modifySession' $ \sess ->+        let x = f sess+        in (x, x)  -- | Read the stored session readSession :: SpockAction conn sess st sess

@@ -5,6 +5,10 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{- |+Since version 0.7 Spock features a new routing system that enables more type-safe code while still being relatively simple and lightweight.+You should consider using that (see "Web.Spock.Safe") instead of this module. This module is not yet deprecated, but this may happen anytime soon.+-} module Web.Spock.Simple     ( -- * Spock's route definition monad       spock, SpockM@@ -13,7 +17,7 @@     , SpockRoute, (<//>)      -- * Hooking routes     , subcomponent-    , get, post, head, put, delete, patch, hookRoute, hookAny+    , get, post, getpost, head, put, delete, patch, hookRoute, hookAny     , Http.StdMethod (..)      -- * Adding Wai.Middleware     , middleware@@ -97,6 +101,10 @@ post :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m () post = hookRoute POST +-- | Specify an action that will be run when the HTTP verb 'GET'/'POST' and the given route match+getpost :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()+getpost r a = hookRoute POST r a >> hookRoute GET r a+ -- | Specify an action that will be run when the HTTP verb 'HEAD' and the given route match head :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m () head = hookRoute HEAD@@ -176,8 +184,7 @@                    , SpockState (SpockAction conn sess st) ~ st)                 => SpockM conn sess st () hookSafeActions =-    do get ("h" <//> ":spock-csurf-protection") run-       post ("h" <//> ":spock-csurf-protection") run+    getpost ("h" <//> ":spock-csurf-protection") run     where       run =           do Just h <- param "spock-csurf-protection"

@@ -19,10 +19,12 @@             get "/" `shouldRespondWith` "root" { matchStatus = 200 }          it "routes different HTTP-verbs to different actions" $             do verbTest get "GET"-               verbTest (\p -> post p "") "POST"-               verbTest (\p -> put p "") "PUT"+               verbTest (`post` "") "POST"+               verbTest (`put` "") "PUT"                verbTest delete "DELETE"-               verbTest (\p -> patch p "") "PATCH"+               verbTest (`patch` "") "PATCH"+               verbTestGp get "GETPOST"+               verbTestGp (`post` "") "GETPOST"          it "can extract params from routes" $             get "/param-test/42" `shouldRespondWith` "int42" { matchStatus = 200 }          it "can handle multiple matching routes" $@@ -33,18 +35,19 @@             do get "/subcomponent/foo" `shouldRespondWith` "foo" { matchStatus = 200 }                get "/subcomponent/subcomponent2/bar" `shouldRespondWith` "bar" { matchStatus = 200 }          it "allows the definition of a fallback handler" $-            do get "/askldjas/aklsdj" `shouldRespondWith` "askldjas/aklsdj" { matchStatus = 200 }+            get "/askldjas/aklsdj" `shouldRespondWith` "askldjas/aklsdj" { matchStatus = 200 }          it "detected the preferred format" $-            do request "GET" "/preferred-format" [("Accept", "text/html,application/xml;q=0.9,image/webp,*/*;q=0.8")] "" `shouldRespondWith` "html" { matchStatus = 200 }+            request "GET" "/preferred-format" [("Accept", "text/html,application/xml;q=0.9,image/webp,*/*;q=0.8")] "" `shouldRespondWith` "html" { matchStatus = 200 }          it "/test-slash and test-noslash are the same thing" $             do get "/test-slash" `shouldRespondWith` "ok" { matchStatus = 200 }                get "test-slash" `shouldRespondWith` "ok" { matchStatus = 200 }                get "/test-noslash" `shouldRespondWith` "ok" { matchStatus = 200 }                get "test-noslash" `shouldRespondWith` "ok" { matchStatus = 200 }     where+      verbTestGp verb verbVerbose =+          verb "/verb-test-gp" `shouldRespondWith` (verbVerbose { matchStatus = 200 })       verbTest verb verbVerbose =-          (verb "/verb-test")-          `shouldRespondWith` (verbVerbose { matchStatus = 200 })+          verb "/verb-test" `shouldRespondWith` (verbVerbose { matchStatus = 200 })  actionSpec :: SpecWith Wai.Application actionSpec =

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}+module Web.Spock.Internal.SessionVaultSpec (spec) where++import Web.Spock.Internal.SessionVault++import Control.Concurrent.STM+import Test.Hspec++data DummySession+    = DummySession+      { ds_key :: Int+      , ds_value :: Int+      } deriving (Show, Eq)++instance IsSession DummySession where+    type SessionKey DummySession = Int+    getSessionKey = ds_key++spec :: Spec+spec =+     describe "SessionVault" $+     do it "insert works correctly" $+           do let sess = DummySession 1 1+              vault <- atomically newSessionVault+              atomically $ storeSession sess vault+              atomically (loadSession (ds_key sess) vault) `shouldReturn` Just sess+        it "update works correctly" $+           do let sess = DummySession 1 1+                  sess2 = DummySession 1 2+              vault <- atomically newSessionVault+              atomically $ storeSession sess vault+              atomically (loadSession (ds_key sess) vault) `shouldReturn` Just sess+              atomically $ storeSession sess2 vault+              atomically (loadSession (ds_key sess) vault) `shouldReturn` Just sess2+        it "filter and toList works correctly" $+           do let sess = DummySession 1 1+                  sess2 = DummySession 2 2+                  sess3 = DummySession 3 3+              vault <- atomically newSessionVault+              atomically $ mapM_ (`storeSession` vault) [sess, sess2, sess3]+              atomically (toList vault) `shouldReturn` [sess, sess2, sess3]+              atomically $ filterSessions (\s -> ds_value s > 2) vault+              atomically (toList vault) `shouldReturn` [sess3]

@@ -14,6 +14,7 @@     do get root $ text "root"        get "verb-test" $ text "GET"        post "verb-test" $ text "POST"+       getpost "verb-test-gp" $ text "GETPOST"        put "verb-test" $ text "PUT"        delete "verb-test" $ text "DELETE"        patch "verb-test" $ text "PATCH"

@@ -14,6 +14,7 @@     do get "/" $ text "root"        get "/verb-test" $ text "GET"        post "/verb-test" $ text "POST"+       getpost "/verb-test-gp" $ text "GETPOST"        put "/verb-test" $ text "PUT"        delete "/verb-test" $ text "DELETE"        patch "/verb-test" $ text "PATCH"@@ -21,13 +22,13 @@        get "/test-noslash" $ text "ok"        get "/param-test/:int" $            do Just (i :: Int) <- param "int"-              text $ "int" <> (T.pack $ show i)+              text $ "int" <> T.pack (show i)        get "/param-test/static" $            text "static"        subcomponent "/subcomponent" $          do get "foo" $ text "foo"             subcomponent "/subcomponent2" $-              do get "bar" $ text "bar"+              get "bar" $ text "bar"        get "/preferred-format" $          do fmt <- preferredFormat             case fmt of