diff --git a/Spock.cabal b/Spock.cabal --- a/Spock.cabal +++ b/Spock.cabal @@ -1,21 +1,23 @@ name: Spock -version: 0.7.1.0 +version: 0.7.2.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: routing, middleware, json, blaze, sessions, cookies, database helper, csrf-protection, global state +description: This toolbox provides everything you need to get a quick start into web hacking with haskell: fast routing, middleware, json, blaze, sessions, cookies, database helper, csrf-protection Homepage: https://github.com/agrafix/Spock Bug-reports: https://github.com/agrafix/Spock/issues license: BSD3 -author: Alexander Thiemann -maintainer: mail@agrafix.net +author: Alexander Thiemann +maintainer: Alexander Thiemann copyright: (c) 2013 - 2014 Alexander Thiemann category: Web build-type: Simple cabal-version: >=1.8 +tested-with: GHC==7.6.3, GHC==7.8.3 library hs-source-dirs: src exposed-modules: Web.Spock.Simple, - Web.Spock.Safe + Web.Spock.Safe, + Web.Spock.Shared other-modules: Web.Spock.Internal.SessionManager, Web.Spock.Internal.Monad, Web.Spock.Internal.Types, @@ -31,7 +33,6 @@ blaze-html ==0.7.*, bytestring ==0.10.*, case-insensitive >=1.1 && <1.3, - conduit >= 1.0 && <1.3, containers ==0.5.*, digestive-functors ==0.7.*, directory ==1.2.*, @@ -42,11 +43,9 @@ old-locale ==1.*, path-pieces >=0.1.4, random ==1.*, - regex-compat ==0.95.*, - reroute >=0.2 && <0.3, + reroute >=0.2.1 && <0.3, resource-pool ==0.2.*, resourcet >= 0.4 && <1.2, - safe >=0.3, stm ==2.4.*, text >= 0.11.3.1 && <1.3, time >=1.4 && <1.6, @@ -54,11 +53,9 @@ transformers-base ==0.4.*, unordered-containers ==0.2.*, vault ==0.3.*, - vector ==0.10.*, wai >=3.0 && <4.0, wai-extra >=3.0 && <4.0, - warp >=3.0 && <4.0, - xsd ==0.4.* + warp >=3.0 && <4.0 ghc-options: -Wall -fno-warn-orphans test-suite spocktests diff --git a/src/Web/Spock/Internal/Core.hs b/src/Web/Spock/Internal/Core.hs --- a/src/Web/Spock/Internal/Core.hs +++ b/src/Web/Spock/Internal/Core.hs @@ -8,6 +8,7 @@ , spockAllT , middleware , hookRoute + , hookAny , subcomponent ) where diff --git a/src/Web/Spock/Internal/CoreAction.hs b/src/Web/Spock/Internal/CoreAction.hs --- a/src/Web/Spock/Internal/CoreAction.hs +++ b/src/Web/Spock/Internal/CoreAction.hs @@ -6,7 +6,7 @@ , UploadedFile (..) , request, header, cookie, body, jsonBody, jsonBody' , files, params, param, param', setStatus, setHeader, redirect - , jumpNext + , jumpNext, middlewarePass, modifyVault, queryVault , setCookie, setCookie' , bytes, lazyBytes, text, html, file, json, blaze , requireBasicAuth @@ -37,6 +37,7 @@ import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Vault.Lazy as V import qualified Network.Wai as Wai -- | Get the original Wai Request object @@ -145,6 +146,25 @@ redirect :: MonadIO m => T.Text -> ActionT m a redirect = throwError . ActionRedirect +-- | If the Spock application is used as a middleware, you can use +-- this to pass request handeling to the underlying application. +-- If Spock is not uses as a middleware, or there is no underlying application +-- this will result in 404 error. +middlewarePass :: MonadIO m => ActionT m a +middlewarePass = throwError ActionMiddlewarePass + +-- | Modify the vault (useful for sharing data between middleware and app) +modifyVault :: MonadIO m => (V.Vault -> V.Vault) -> ActionT m () +modifyVault f = + do vaultIf <- asks ri_vaultIf + liftIO $ (vi_modifyVault vaultIf) f + +-- | 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 + -- | Set a cookie living for a given number of seconds setCookie :: MonadIO m => T.Text -> T.Text -> NominalDiffTime -> ActionT m () setCookie name value validSeconds = @@ -184,7 +204,7 @@ do setHeader "Content-Type" "text/plain" bytes $ T.encodeUtf8 val --- | Send a text as response body. Content-Type will be "text/plain" +-- | Send a text as response body. Content-Type will be "text/html" html :: MonadIO m => T.Text -> ActionT m a html val = do setHeader "Content-Type" "text/html" diff --git a/src/Web/Spock/Internal/Monad.hs b/src/Web/Spock/Internal/Monad.hs --- a/src/Web/Spock/Internal/Monad.hs +++ b/src/Web/Spock/Internal/Monad.hs @@ -6,16 +6,9 @@ import Web.Spock.Internal.Types -import Control.Monad import Control.Monad.Reader import Control.Monad.Trans.Resource import Data.Pool -import Data.Time.Clock ( UTCTime(..) ) -import Web.PathPieces -import qualified Data.ByteString.Lazy as BSL -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Text.XML.XSD.DateTime as XSD webM :: MonadTrans t => WebStateM conn sess st a -> t (WebStateM conn sess st) a webM = lift @@ -57,13 +50,3 @@ getSessMgrImpl :: (WebStateM conn sess st) (SessionManager conn sess st) getSessMgrImpl = asks web_sessionMgr - -instance PathPiece BSL.ByteString where - fromPathPiece = - Just . BSL.fromStrict . T.encodeUtf8 - toPathPiece = - T.decodeUtf8 . BSL.toStrict - -instance PathPiece UTCTime where - fromPathPiece p = join $ fmap XSD.toUTCTime $ XSD.dateTime p - toPathPiece = T.pack . show . XSD.fromUTCTime diff --git a/src/Web/Spock/Internal/SessionManager.hs b/src/Web/Spock/Internal/SessionManager.hs --- a/src/Web/Spock/Internal/SessionManager.hs +++ b/src/Web/Spock/Internal/SessionManager.hs @@ -34,7 +34,8 @@ vaultKey <- V.newKey _ <- forkIO (forever (housekeepSessions cacheHM)) return $ SessionManager - { sm_readSession = readSessionImpl vaultKey cacheHM + { sm_getSessionId = getSessionIdImpl vaultKey cacheHM + , sm_readSession = readSessionImpl vaultKey cacheHM , sm_writeSession = writeSessionImpl vaultKey cacheHM , sm_modifySession = modifySessionImpl vaultKey cacheHM , sm_clearAllSessions = clearAllSessionsImpl cacheHM @@ -43,6 +44,13 @@ , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM , sm_removeSafeAction = removeSafeActionImpl vaultKey cacheHM } + +getSessionIdImpl :: V.Key SessionId + -> UserSessions 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 diff --git a/src/Web/Spock/Internal/Types.hs b/src/Web/Spock/Internal/Types.hs --- a/src/Web/Spock/Internal/Types.hs +++ b/src/Web/Spock/Internal/Types.hs @@ -133,7 +133,8 @@ data SessionManager conn sess st = SessionManager - { sm_readSession :: SpockAction conn sess st sess + { 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_clearAllSessions :: SpockAction conn sess st () diff --git a/src/Web/Spock/Internal/Wire.hs b/src/Web/Spock/Internal/Wire.hs --- a/src/Web/Spock/Internal/Wire.hs +++ b/src/Web/Spock/Internal/Wire.hs @@ -9,6 +9,7 @@ module Web.Spock.Internal.Wire where import Control.Applicative +import Control.Concurrent.STM import Control.Exception import Control.Monad.RWS.Strict import Control.Monad.Error @@ -31,6 +32,7 @@ import qualified Data.HashMap.Strict as HM import qualified Data.Text as T import qualified Data.Text.Encoding as T +import qualified Data.Vault.Lazy as V import qualified Network.Wai as Wai import qualified Network.Wai.Parse as P @@ -44,12 +46,19 @@ , uf_tempLocation :: FilePath } +data VaultIf + = VaultIf + { vi_modifyVault :: (V.Vault -> V.Vault) -> IO () + , vi_lookupKey :: forall a. V.Key a -> IO (Maybe a) + } + data RequestInfo = RequestInfo { ri_request :: Wai.Request , ri_params :: HM.HashMap CaptureVar T.Text , ri_queryParams :: [(T.Text, T.Text)] , ri_files :: HM.HashMap T.Text UploadedFile + , ri_vaultIf :: VaultIf } data ResponseBody @@ -70,6 +79,7 @@ | ActionTryNext | ActionError String | ActionDone + | ActionMiddlewarePass deriving (Show) instance Error ActionInterupt where @@ -131,11 +141,24 @@ -> SpockAllT r m () -> IO Wai.Application buildApp registryIf registryLift spockActions = + do mw <- buildMiddleware registryIf registryLift spockActions + return (mw fallbackApp) + where + fallbackApp :: Wai.Application + fallbackApp _ respond = + respond $ notFound + +buildMiddleware :: forall m r. (MonadIO m, AbstractRouter r, RouteAppliedAction r ~ ActionT m ()) + => r + -> (forall a. m a -> IO a) + -> SpockAllT r m () + -> IO (Wai.Application -> Wai.Application) +buildMiddleware registryIf registryLift spockActions = do (_, getMatchingRoutes, middlewares) <- registryLift $ runRegistry registryIf spockActions let spockMiddleware = foldl (.) id middlewares - app :: Wai.Application - app req respond = + app :: Wai.Application -> Wai.Application + app coreApp req respond = case parseMethod $ Wai.requestMethod req of Left _ -> respond invalidReq @@ -143,7 +166,13 @@ runResourceT $ withInternalState $ \st -> do (bodyParams, bodyFiles) <- P.parseRequestBody (P.tempFileBackEnd st) req - let uploadedFiles = + 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) + } + uploadedFiles = HM.fromList $ map (\(k, fileInfo) -> ( T.decodeUtf8 k @@ -157,34 +186,43 @@ queryParams = postParams ++ getParams resp = errorResponse status200 "" allActions = getMatchingRoutes stdMethod (Wai.pathInfo req) - applyAction :: [(ParamMap, ActionT m ())] -> m ResponseState + applyAction :: [(ParamMap, ActionT m ())] -> m (Maybe ResponseState) applyAction [] = - return $ errorResponse status404 "404 - File not found" + return $ Just $ errorResponse status404 "404 - File not found" applyAction ((captures, selectedAction) : xs) = - do let env = RequestInfo req captures queryParams uploadedFiles + do let env = RequestInfo req captures queryParams uploadedFiles vaultIf (r, respState, _) <- runRWST (runErrorT $ runActionT $ selectedAction) env resp case r of Left (ActionRedirect loc) -> - return $ ResponseState (rs_responseHeaders respState) + return $ Just $ ResponseState (rs_responseHeaders respState) status302 (ResponseRedirect loc) Left ActionTryNext -> applyAction xs Left (ActionError errorMsg) -> do liftIO $ putStrLn $ "Spock Error while handeling " ++ show (Wai.pathInfo req) ++ ": " ++ errorMsg - return serverError + return $ Just serverError Left ActionDone -> - return respState + return $ Just respState + Left ActionMiddlewarePass -> + return Nothing Right () -> - return respState - respState <- + return $ Just respState + mRespState <- liftIO $ (registryLift $ applyAction allActions) `catch` \(e :: SomeException) -> do putStrLn $ "Spock Error while handeling " ++ show (Wai.pathInfo req) ++ ": " ++ show e - return serverError - forM_ (HM.elems uploadedFiles) $ \uploadedFile -> - do stillThere <- doesFileExist (uf_tempLocation uploadedFile) - when stillThere $ liftIO $ removeFile (uf_tempLocation uploadedFile) - liftIO $ respond $ respStateToResponse respState - return $ spockMiddleware $ app + return $ Just serverError + case mRespState of + Just respState -> + do forM_ (HM.elems uploadedFiles) $ \uploadedFile -> + do stillThere <- doesFileExist (uf_tempLocation uploadedFile) + when stillThere $ liftIO $ removeFile (uf_tempLocation uploadedFile) + liftIO $ respond $ respStateToResponse respState + Nothing -> + liftIO $ + do newVault <- atomically $ readTVar vaultVar + let req' = req { Wai.vault = V.union newVault (Wai.vault req) } + coreApp req' respond + return $ spockMiddleware . app diff --git a/src/Web/Spock/Safe.hs b/src/Web/Spock/Safe.hs --- a/src/Web/Spock/Safe.hs +++ b/src/Web/Spock/Safe.hs @@ -18,40 +18,22 @@ , renderRoute -- * Hooking routes , subcomponent - , get, post, head, put, delete, patch, hookRoute + , get, post, head, put, delete, patch, hookRoute, hookAny , Http.StdMethod (..) - -- * Handeling requests - , request, header, cookie, body, jsonBody, jsonBody', files, UploadedFile (..) - , params, param, param' - -- * Sending responses - , setStatus, setHeader, redirect, jumpNext, setCookie, setCookie', bytes, lazyBytes - , text, html, file, json, blaze - -- * Adding middleware + -- * Adding Wai.Middleware , middleware - -- * Database - , PoolOrConn (..), ConnBuilder (..), PoolCfg (..) - -- * Accessing Database and State - , HasSpock (runQuery, getState), SpockConn, SpockState, SpockSession - -- * Sessions - , SessionCfg (..) - , readSession, writeSession, modifySession, clearAllSessions - -- * Basic HTTP-Auth - , requireBasicAuth + -- * Using Spock as middleware + , spockMiddleware -- * Safe actions , SafeAction (..) , safeActionPath - -- * Digestive Functors - , runForm - -- * Internals for extending Spock - , getSpockHeart, runSpockIO, WebStateM, WebState + , module Web.Spock.Shared ) where +import Web.Spock.Shared import Web.Spock.Internal.CoreAction -import Web.Spock.Internal.Digestive -import Web.Spock.Internal.Monad -import Web.Spock.Internal.SessionManager import Web.Spock.Internal.Types import Web.Spock.Internal.Wrapper import qualified Web.Spock.Internal.Wire as W @@ -103,6 +85,11 @@ spockApp liftFun (SpockT app) = W.buildApp SafeRouter liftFun app +-- | Convert a Spock-App to a wai-middleware +spockMiddleware :: (MonadIO m) => (forall a. m a -> IO a) -> SpockT m () -> IO Wai.Middleware +spockMiddleware liftFun (SpockT app) = + W.buildMiddleware SafeRouter liftFun app + -- | Specify an action that will be run when the HTTP verb 'GET' and the given route match get :: MonadIO m => Path xs -> HVectElim xs (ActionT m ()) -> SpockT m () get = hookRoute GET @@ -131,6 +118,11 @@ hookRoute :: Monad m => StdMethod -> Path xs -> HVectElim xs (ActionT m ()) -> SpockT m () hookRoute m path action = SpockT $ C.hookRoute m (SafeRouterPath path) (HVectElim' action) +-- | 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 :: Monad m => StdMethod -> ([T.Text] -> ActionT m ()) -> SpockT m () +hookAny m action = SpockT $ C.hookAny m action + -- | Define a subcomponent. Usage example: -- -- > subcomponent "site" $ @@ -147,33 +139,6 @@ -- | Hook wai middleware into Spock middleware :: Monad m => Wai.Middleware -> SpockT m () middleware = SpockT . C.middleware - - --- | Write to the current session. Note that all data is stored on the server. --- The user only reciedes a sessionId to be identified. -writeSession :: sess -> SpockAction conn sess st () -writeSession d = - do mgr <- getSessMgr - (sm_writeSession mgr) d - --- | Modify the stored session -modifySession :: (sess -> sess) -> SpockAction conn sess st () -modifySession f = - do mgr <- getSessMgr - (sm_modifySession mgr) f - --- | Read the stored session -readSession :: SpockAction conn sess st sess -readSession = - do mgr <- getSessMgr - sm_readSession mgr - --- | Globally delete all existing sessions. This is useful for example if you want --- to require all users to relogin -clearAllSessions :: SpockAction conn sess st () -clearAllSessions = - do mgr <- getSessMgr - sm_clearAllSessions mgr -- | Wire up a safe action: Safe actions are actions that are protected from -- csrf attacks. Here's a usage example: diff --git a/src/Web/Spock/Shared.hs b/src/Web/Spock/Shared.hs new file mode 100644 --- /dev/null +++ b/src/Web/Spock/Shared.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +module Web.Spock.Shared + (-- * Handeling requests + request, header, cookie, body, jsonBody, jsonBody', files, UploadedFile (..) + , params, param, param' + -- * Sending responses + , setStatus, setHeader, redirect, jumpNext, setCookie, setCookie', bytes, lazyBytes + , text, html, file, json, blaze + -- * Middleware helpers + , middlewarePass, modifyVault, queryVault + -- * Database + , PoolOrConn (..), ConnBuilder (..), PoolCfg (..) + -- * Accessing Database and State + , HasSpock (runQuery, getState), SpockConn, SpockState, SpockSession + -- * Basic HTTP-Auth + , requireBasicAuth + -- * Sessions + , SessionCfg (..), SessionId + , getSessionId, readSession, writeSession, modifySession, clearAllSessions + -- * Digestive Functors + , runForm + -- * Internals for extending Spock + , getSpockHeart, runSpockIO, WebStateM, WebState + ) +where + +import Web.Spock.Internal.Monad +import Web.Spock.Internal.Digestive +import Web.Spock.Internal.SessionManager +import Web.Spock.Internal.Types +import Web.Spock.Internal.CoreAction + +-- | Get the current users sessionId. Note that this ID should only be +-- shown to it's owner as otherwise sessions can be hijacked. +getSessionId :: SpockAction conn sess st SessionId +getSessionId = + getSessMgr >>= sm_getSessionId + +-- | Write to the current session. Note that all data is stored on the server. +-- The user only reciedes a sessionId to be identified. +writeSession :: sess -> SpockAction conn sess st () +writeSession d = + do mgr <- getSessMgr + (sm_writeSession mgr) d + +-- | Modify the stored session +modifySession :: (sess -> sess) -> SpockAction conn sess st () +modifySession f = + do mgr <- getSessMgr + (sm_modifySession mgr) f + +-- | Read the stored session +readSession :: SpockAction conn sess st sess +readSession = + do mgr <- getSessMgr + sm_readSession mgr + +-- | Globally delete all existing sessions. This is useful for example if you want +-- to require all users to relogin +clearAllSessions :: SpockAction conn sess st () +clearAllSessions = + do mgr <- getSessMgr + sm_clearAllSessions mgr diff --git a/src/Web/Spock/Simple.hs b/src/Web/Spock/Simple.hs --- a/src/Web/Spock/Simple.hs +++ b/src/Web/Spock/Simple.hs @@ -15,40 +15,21 @@ , SpockRoute, (<#>) -- * Hooking routes , subcomponent - , get, post, head, put, delete, patch, hookRoute + , get, post, head, put, delete, patch, hookRoute, hookAny , Http.StdMethod (..) - -- * Handeling requests - , request, header, cookie, body, jsonBody, jsonBody', files, UploadedFile (..) - , params, param, param' - -- * Sending responses - , setStatus, setHeader, redirect, jumpNext, setCookie, setCookie', bytes, lazyBytes - , text, html, file, json, blaze - -- * Adding middleware + -- * Adding Wai.Middleware , middleware - -- * Database - , PoolOrConn (..), ConnBuilder (..), PoolCfg (..) - -- * Accessing Database and State - , HasSpock (runQuery, getState), SpockConn, SpockState, SpockSession - -- * Sessions - , SessionCfg (..) - , readSession, writeSession, modifySession, clearAllSessions - -- * Basic HTTP-Auth - , requireBasicAuth + -- * Using Spock as middleware + , spockMiddleware -- * Safe actions , SafeAction (..) , safeActionPath - -- * Digestive Functors - , runForm - -- * Internals for extending Spock - , getSpockHeart, runSpockIO, WebStateM, WebState + , module Web.Spock.Shared ) where - +import Web.Spock.Shared import Web.Spock.Internal.CoreAction -import Web.Spock.Internal.Digestive -import Web.Spock.Internal.Monad -import Web.Spock.Internal.SessionManager import Web.Spock.Internal.Types import Web.Spock.Internal.Wrapper import qualified Web.Spock.Internal.Wire as W @@ -104,6 +85,11 @@ spockApp liftFun (SpockT app) = W.buildApp TextRouter liftFun app +-- | Convert a Spock-App to a wai-middleware +spockMiddleware :: (MonadIO m) => (forall a. m a -> IO a) -> SpockT m () -> IO Wai.Middleware +spockMiddleware liftFun (SpockT app) = + W.buildMiddleware TextRouter liftFun app + -- | Combine two route components safely -- "/foo" <#> "/bar" ===> "/foo/bar" -- "foo" <#> "bar" ===> "/foo/bar" @@ -139,6 +125,11 @@ hookRoute :: Monad m => StdMethod -> SpockRoute -> ActionT m () -> SpockT m () hookRoute m (SpockRoute path) action = SpockT $ C.hookRoute m (TextRouterPath path) (TAction action) +-- | 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 :: Monad m => StdMethod -> ([T.Text] -> ActionT m ()) -> SpockT m () +hookAny m action = SpockT $ C.hookAny m action + -- | Define a subcomponent. Usage example: -- -- > subcomponent "/site" $ @@ -155,32 +146,6 @@ -- | Hook wai middleware into Spock middleware :: Monad m => Wai.Middleware -> SpockT m () middleware = SpockT . C.middleware - --- | Write to the current session. Note that all data is stored on the server. --- The user only reciedes a sessionId to be identified. -writeSession :: sess -> SpockAction conn sess st () -writeSession d = - do mgr <- getSessMgr - (sm_writeSession mgr) d - --- | Modify the stored session -modifySession :: (sess -> sess) -> SpockAction conn sess st () -modifySession f = - do mgr <- getSessMgr - (sm_modifySession mgr) f - --- | Read the stored session -readSession :: SpockAction conn sess st sess -readSession = - do mgr <- getSessMgr - sm_readSession mgr - --- | Globally delete all existing sessions. This is useful for example if you want --- to require all users to relogin -clearAllSessions :: SpockAction conn sess st () -clearAllSessions = - do mgr <- getSessMgr - sm_clearAllSessions mgr -- | Wire up a safe action: Safe actions are actions that are protected from -- csrf attacks. Here's a usage example: diff --git a/test/Web/Spock/FrameworkSpecHelper.hs b/test/Web/Spock/FrameworkSpecHelper.hs --- a/test/Web/Spock/FrameworkSpecHelper.hs +++ b/test/Web/Spock/FrameworkSpecHelper.hs @@ -30,6 +30,8 @@ it "works with subcomponents" $ 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 } where verbTest verb verbVerbose = (verb "/verb-test") diff --git a/test/Web/Spock/SafeSpec.hs b/test/Web/Spock/SafeSpec.hs --- a/test/Web/Spock/SafeSpec.hs +++ b/test/Web/Spock/SafeSpec.hs @@ -25,6 +25,7 @@ do get "foo" $ text "foo" subcomponent "/subcomponent2" $ do get "bar" $ text "bar" + hookAny GET $ text . T.intercalate "/" spec :: Spec spec = describe "SafeRouting" $ frameworkSpec (spockApp id app) diff --git a/test/Web/Spock/SimpleSpec.hs b/test/Web/Spock/SimpleSpec.hs --- a/test/Web/Spock/SimpleSpec.hs +++ b/test/Web/Spock/SimpleSpec.hs @@ -26,6 +26,7 @@ do get "foo" $ text "foo" subcomponent "/subcomponent2" $ do get "bar" $ text "bar" + hookAny GET $ text . T.intercalate "/" spec :: Spec spec = describe "SimpleRouting" $ frameworkSpec (spockApp id app)