Spock 0.7.8.0 → 0.7.9.0
raw patch · 11 files changed
+90/−77 lines, 11 filesdep ~hspecdep ~hspec-waidep ~reroutePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: hspec, hspec-wai, reroute
API changes (from Hackage documentation)
+ Web.Spock.Safe: type Var a = Path ((:) * a ([] *))
- Web.Spock.Safe: renderRoute :: Path as -> HVect as -> Text
+ Web.Spock.Safe: renderRoute :: HasRep as => Path as -> HVectElim as Text
Files
- Spock.cabal +5/−4
- src/Web/Spock/Internal/Core.hs +1/−2
- src/Web/Spock/Internal/CoreAction.hs +3/−3
- src/Web/Spock/Internal/Monad.hs +4/−5
- src/Web/Spock/Internal/SessionManager.hs +16/−17
- src/Web/Spock/Internal/Util.hs +3/−5
- src/Web/Spock/Internal/Wire.hs +7/−8
- src/Web/Spock/Safe.hs +15/−11
- src/Web/Spock/Shared.hs +7/−11
- src/Web/Spock/Simple.hs +7/−8
- test/Web/Spock/SafeSpec.hs +22/−3
Spock.cabal view
@@ -1,8 +1,8 @@ name: Spock-version: 0.7.8.0+version: 0.7.9.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-Homepage: https://github.com/agrafix/Spock+Homepage: http://www.spock.li Bug-reports: https://github.com/agrafix/Spock/issues license: BSD3 license-file: LICENSE@@ -69,10 +69,11 @@ Web.Spock.SimpleSpec build-depends: base,- hspec,- hspec-wai,+ hspec >= 2.0,+ hspec-wai >= 0.6, http-types, Spock,+ reroute, text, wai
src/Web/Spock/Internal/Core.hs view
@@ -72,5 +72,4 @@ -> (forall a. m a -> IO a) -> SpockAllT r m () -> IO Wai.Middleware-spockAllT registryIf liftSpock routeDefs =- buildMiddleware registryIf liftSpock routeDefs+spockAllT = buildMiddleware
src/Web/Spock/Internal/CoreAction.hs view
@@ -125,7 +125,7 @@ params = do p <- asks ri_params qp <- asks ri_queryParams- return (qp ++ (map (\(k, v) -> (unCaptureVar k, v)) $ HM.toList p))+ return (qp ++ map (first unCaptureVar) (HM.toList p)) {-# INLINE params #-} -- | Read a request param. Spock looks in route captures first, then in POST variables and at last in GET variables@@ -195,14 +195,14 @@ modifyVault :: MonadIO m => (V.Vault -> V.Vault) -> ActionT m () modifyVault f = do vaultIf <- asks ri_vaultIf- liftIO $ (vi_modifyVault vaultIf) f+ liftIO $ vi_modifyVault vaultIf f {-# INLINE modifyVault #-} -- | Query the vault queryVault :: MonadIO m => V.Key a -> ActionT m (Maybe a) queryVault k = do vaultIf <- asks ri_vaultIf- liftIO $ (vi_lookupKey vaultIf) k+ liftIO $ vi_lookupKey vaultIf k {-# INLINE queryVault #-} -- | Set a cookie living for a given number of seconds
src/Web/Spock/Internal/Monad.hs view
@@ -1,7 +1,6 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-} module Web.Spock.Internal.Monad where import Web.Spock.Internal.Types@@ -18,8 +17,8 @@ type SpockState (t (WebStateM conn sess st)) = st type SpockSession (t (WebStateM conn sess st)) = sess runQuery a = webM $ runQueryImpl a- getState = webM $ getStateImpl- getSessMgr = webM $ getSessMgrImpl+ getState = webM getStateImpl+ getSessMgr = webM getSessMgrImpl instance HasSpock (WebStateM conn sess st) where type SpockConn (WebStateM conn sess st) = conn@@ -32,7 +31,7 @@ runQueryImpl :: (conn -> IO a) -> WebStateM conn sess st a runQueryImpl query = do pool <- asks web_dbConn- liftIO (withResource pool $ query)+ liftIO (withResource pool query) getStateImpl :: WebStateM conn sess st st getStateImpl = asks web_state
src/Web/Spock/Internal/SessionManager.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts, DeriveGeneric, OverloadedStrings, DoAndIfThenElse, RankNTypes #-}+{-# LANGUAGE FlexibleContexts, OverloadedStrings, DoAndIfThenElse, RankNTypes #-} module Web.Spock.Internal.SessionManager ( createSessionManager , SessionId, Session(..), SessionManager(..)@@ -39,17 +39,18 @@ cacheHM <- atomically $ newTVar oldSess vaultKey <- V.newKey _ <- forkIO (forever (housekeepSessions cacheHM storeSessions))- return $ SessionManager- { sm_getSessionId = getSessionIdImpl vaultKey cacheHM- , sm_readSession = readSessionImpl vaultKey cacheHM- , sm_writeSession = writeSessionImpl vaultKey cacheHM- , sm_modifySession = modifySessionImpl vaultKey cacheHM- , sm_clearAllSessions = clearAllSessionsImpl cacheHM- , sm_middleware = sessionMiddleware cfg vaultKey cacheHM- , sm_addSafeAction = addSafeActionImpl vaultKey cacheHM- , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM- , sm_removeSafeAction = removeSafeActionImpl vaultKey cacheHM- }+ return+ SessionManager+ { sm_getSessionId = getSessionIdImpl vaultKey cacheHM+ , sm_readSession = readSessionImpl vaultKey cacheHM+ , sm_writeSession = writeSessionImpl vaultKey cacheHM+ , sm_modifySession = modifySessionImpl vaultKey cacheHM+ , sm_clearAllSessions = clearAllSessionsImpl cacheHM+ , sm_middleware = sessionMiddleware cfg vaultKey cacheHM+ , sm_addSafeAction = addSafeActionImpl vaultKey cacheHM+ , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM+ , sm_removeSafeAction = removeSafeActionImpl vaultKey cacheHM+ } where (loadSessions, storeSessions) = case sc_persistCfg cfg of@@ -60,8 +61,7 @@ Just spc -> ( do sessions <- spc_load spc return $ foldl' genSession HM.empty sessions- , \hm ->- spc_store spc $ map mkSerializable $ HM.elems hm+ , spc_store spc . map mkSerializable . HM.elems ) mkSerializable sess = (sess_id sess, sess_validUntil sess, sess_data sess)@@ -254,7 +254,7 @@ atomically $ modifyTVar' sessionRef (HM.insert sid expandedSession) return expandedSession else return sess- if (sess_validUntil sessWithPossibleExpansion) > now+ if sess_validUntil sessWithPossibleExpansion > now then return $ Just sessWithPossibleExpansion else do deleteSessionImpl sessionRef sid return Nothing@@ -285,8 +285,7 @@ storeSessions newStatus threadDelay (1000 * 1000 * 60) -- 60 seconds where- filterOld now (_, sess) =- (sess_validUntil sess) > now+ filterOld now (_, sess) = sess_validUntil sess > now killOld now hm = HM.fromList $ filter (filterOld now) $ HM.toList hm
src/Web/Spock/Internal/Util.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Web.Spock.Internal.Util where +import Data.Maybe import Network.HTTP.Types import Network.Wai.Internal import qualified Data.Text as T@@ -16,7 +17,7 @@ mimeMapping :: HM.HashMap T.Text ClientPreferredFormat mimeMapping =- HM.fromList $+ HM.fromList [ ("application/json", PrefJSON) , ("text/javascript", PrefJSON) , ("text/json", PrefJSON)@@ -33,10 +34,7 @@ let (mimeTypeStr, _) = T.breakOn ";" t mimeTypes = map (T.toLower . T.strip) $ T.splitOn "," mimeTypeStr firstMatch [] = PrefUnknown- firstMatch (x:xs) =- case HM.lookup x mimeMapping of- Just pref -> pref- Nothing -> firstMatch xs+ firstMatch (x:xs) = fromMaybe (firstMatch xs) (HM.lookup x mimeMapping) in firstMatch mimeTypes
src/Web/Spock/Internal/Wire.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -9,6 +8,7 @@ {-# LANGUAGE TypeOperators #-} module Web.Spock.Internal.Wire where +import Control.Arrow ((***)) import Control.Applicative import Control.Concurrent.STM import Control.Exception@@ -142,8 +142,7 @@ mw fallbackApp where fallbackApp :: Wai.Application- fallbackApp _ respond =- respond $ notFound+ fallbackApp _ respond = respond notFound makeActionEnvironment :: InternalState -> Wai.Request -> IO (ParamMap -> RequestInfo, TVar V.Vault, IO ()) makeActionEnvironment st req =@@ -151,8 +150,8 @@ vaultVar <- liftIO $ newTVarIO (Wai.vault req) let vaultIf = VaultIf- { vi_modifyVault = \modF -> atomically $ modifyTVar' vaultVar modF- , vi_lookupKey = \k -> V.lookup k <$> (atomically $ readTVar vaultVar)+ { vi_modifyVault = atomically . modifyTVar' vaultVar+ , vi_lookupKey = \k -> V.lookup k <$> atomically (readTVar vaultVar) } uploadedFiles = HM.fromList $@@ -162,7 +161,7 @@ ) ) bodyFiles postParams =- map (\(k, v) -> (T.decodeUtf8 k, T.decodeUtf8 v)) bodyParams+ map (T.decodeUtf8 *** T.decodeUtf8) bodyParams getParams = map (\(k, mV) -> (T.decodeUtf8 k, T.decodeUtf8 $ fromMaybe BS.empty mV)) $ Wai.queryString req queryParams = postParams ++ getParams@@ -195,7 +194,7 @@ do let env = mkEnv captures defResp = errorResponse status200 "" (r, respState, _) <-- runRWST (runErrorT $ runActionT $ selectedAction) env defResp+ runRWST (runErrorT $ runActionT selectedAction) env defResp case r of Left (ActionRedirect loc) -> return $ Just $ ResponseState (rs_responseHeaders respState) status302 $ ResponseBody $@@ -220,7 +219,7 @@ handleRequest registryLift allActions st coreApp req respond = do (mkEnv, vaultVar, cleanUp) <- makeActionEnvironment st req mRespState <-- (registryLift $ applyAction req mkEnv allActions)+ registryLift (applyAction req mkEnv allActions) `catch` \(e :: SomeException) -> do putStrLn $ "Spock Error while handling " ++ show (Wai.pathInfo req) ++ ": " ++ show e return $ Just serverError
src/Web/Spock/Safe.hs view
@@ -1,18 +1,17 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} module Web.Spock.Safe ( -- * Spock's route definition monad spock, SpockM , spockT, SpockT -- * Defining routes- , Path, root, var, static, (<//>)+ , Path, root, Var, var, static, (<//>) -- * Rendering routes , renderRoute -- * Hooking routes@@ -39,7 +38,8 @@ import Data.HVect import Network.HTTP.Types.Method import Prelude hiding (head)-import Web.Routing.SafeRouting+import Web.Routing.SafeRouting hiding (renderRoute)+import qualified Web.Routing.SafeRouting as SR import qualified Data.Text as T import qualified Network.HTTP.Types as Http import qualified Network.Wai as Wai@@ -150,7 +150,7 @@ -> SpockAction conn sess st T.Text safeActionPath safeAction = do mgr <- getSessMgr- hash <- (sm_addSafeAction mgr) (PackedSafeAction safeAction)+ hash <- sm_addSafeAction mgr (PackedSafeAction safeAction) return $ "/h/" <> hash hookSafeActions :: forall conn sess st.@@ -165,15 +165,19 @@ where run h = do mgr <- getSessMgr- mAction <- (sm_lookupSafeAction mgr) h+ 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+ sm_removeSafeAction mgr p -- | Combine two path components (<//>) :: Path as -> Path bs -> Path (Append as bs) (<//>) = (</>)++-- | Render a route applying path pieces+renderRoute :: HasRep as => Path as -> HVectElim as T.Text+renderRoute route = hVectCurry (T.cons '/' . SR.renderRoute route)
@@ -1,12 +1,10 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} module Web.Spock.Shared (-- * Helpers for running Spock runSpock, spockAsApp@@ -71,13 +69,13 @@ writeSession :: sess -> SpockAction conn sess st () writeSession d = do mgr <- getSessMgr- (sm_writeSession mgr) d+ sm_writeSession mgr d -- | Modify the stored session modifySession :: (sess -> sess) -> SpockAction conn sess st () modifySession f = do mgr <- getSessMgr- (sm_modifySession mgr) f+ sm_modifySession mgr f -- | Read the stored session readSession :: SpockAction conn sess st sess@@ -102,7 +100,5 @@ then do str <- readFile fp return (read str) else return []- , spc_store =- \theData ->- writeFile fp (show theData)+ , spc_store = writeFile fp . show }
src/Web/Spock/Simple.hs view
@@ -1,11 +1,10 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DoAndIfThenElse #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} module Web.Spock.Simple ( -- * Spock's route definition monad spock, SpockM@@ -167,7 +166,7 @@ -> SpockAction conn sess st T.Text safeActionPath safeAction = do mgr <- getSessMgr- hash <- (sm_addSafeAction mgr) (PackedSafeAction safeAction)+ hash <- sm_addSafeAction mgr (PackedSafeAction safeAction) return $ "/h/" <> hash hookSafeActions :: forall conn sess st.@@ -183,11 +182,11 @@ run = do Just h <- param "spock-csurf-protection" mgr <- getSessMgr- mAction <- (sm_lookupSafeAction mgr) h+ 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+ sm_removeSafeAction mgr p
test/Web/Spock/SafeSpec.hs view
@@ -20,13 +20,13 @@ get "test-slash" $ text "ok" get "/test-noslash" $ text "ok" get ("param-test" <//> var) $ \(i :: 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@@ -34,5 +34,24 @@ x -> text (T.pack (show x)) hookAny GET $ text . T.intercalate "/" +routeRenderingSpec :: Spec+routeRenderingSpec =+ describe "Route Rendering" $+ do it "should work with argument-less routes" $+ do renderRoute "foo" `shouldBe` "/foo"+ renderRoute "/foo" `shouldBe` "/foo"+ renderRoute "/foo/" `shouldBe` "/foo"+ renderRoute ("foo" <//> "bar") `shouldBe` "/foo/bar"+ it "should work with routes with args" $+ do let r1 = var :: Var Int+ renderRoute r1 1 `shouldBe` "/1"+ let r2 = "blog" <//> (var :: Var Int)+ renderRoute r2 2 `shouldBe` "/blog/2"+ let r3 = "blog" <//> (var :: Var Int) <//> (var :: Var T.Text)+ renderRoute r3 2 "BIIM" `shouldBe` "/blog/2/BIIM"+ spec :: Spec-spec = describe "SafeRouting" $ frameworkSpec (spockAsApp $ spockT id app)+spec =+ describe "SafeRouting" $+ do frameworkSpec (spockAsApp $ spockT id app)+ routeRenderingSpec