Spock 0.7.5.2 → 0.7.6.0

raw patch · 12 files changed

+264/−151 lines, 12 filesdep −blaze-htmldep −digestive-functorsdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: blaze-html, digestive-functors

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• LICENSE +30/−0
• Spock.cabal +13/−6
• examples/simple/Main.hs +12/−0
• src/Web/Spock/Internal/CoreAction.hs +22/−11
• src/Web/Spock/Internal/Digestive.hs +0/−36
• src/Web/Spock/Internal/SessionManager.hs +37/−5
• src/Web/Spock/Internal/Types.hs +7/−0
• src/Web/Spock/Internal/Wire.hs +103/−72
• src/Web/Spock/Safe.hs +8/−5
• src/Web/Spock/Shared.hs +21/−5
• src/Web/Spock/Simple.hs +9/−9
• test/Web/Spock/SafeSpec.hs +2/−2

@@ -0,0 +1,30 @@+Copyright (c) 2013 - 2014, Alexander Thiemann <mail@agrafix.net>++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Alexander Thiemann <mail@agrafix.net> nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -1,10 +1,11 @@ name:                Spock-version:             0.7.5.2+version:             0.7.6.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, blaze, 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 Homepage:            https://github.com/agrafix/Spock Bug-reports:         https://github.com/agrafix/Spock/issues license:             BSD3+license-file:        LICENSE author:              Alexander Thiemann <mail@athiemann.net> maintainer:          Alexander Thiemann <mail@athiemann.net> copyright:           (c) 2013 - 2014 Alexander Thiemann@@ -23,7 +24,6 @@   other-modules:                        Web.Spock.Internal.Core,                        Web.Spock.Internal.CoreAction,-                       Web.Spock.Internal.Digestive,                        Web.Spock.Internal.Monad,                        Web.Spock.Internal.SessionManager,                        Web.Spock.Internal.Types,@@ -32,11 +32,9 @@                        aeson >= 0.6.2.1,                        base >= 4 && < 5,                        base64-bytestring >=1.0,-                       blaze-html >=0.7,                        bytestring >=0.10,                        case-insensitive >=1.1,                        containers >=0.5,-                       digestive-functors >=0.7,                        directory >=1.2,                        hashable >=1.2,                        http-types >=0.8,@@ -58,7 +56,7 @@                        wai >=3.0,                        wai-extra >=3.0,                        warp >=3.0-  ghc-options: -Wall -fno-warn-orphans+  ghc-options: -auto-all -Wall -fno-warn-orphans  test-suite spocktests   type:                exitcode-stdio-1.0@@ -79,6 +77,15 @@                        wai    ghc-options: -Wall -fno-warn-orphans++benchmark spock-simple-example+  type:                exitcode-stdio-1.0+  ghc-options:         -auto-all -Wall -O2+  hs-source-dirs:      examples/simple+  main-is:             Main.hs+  build-depends:+    base,+    Spock  source-repository head   type:     git

@@ -0,0 +1,12 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Web.Spock.Safe++main :: IO ()+main =+    runSpock 8080 $ spockT id $+    do get "foo" $+           text "bar"+       get ("hello" <//> var) $ \name ->+           text name

@@ -8,14 +8,14 @@     , files, params, param, param', setStatus, setHeader, redirect     , jumpNext, middlewarePass, modifyVault, queryVault     , setCookie, setCookie'-    , bytes, lazyBytes, text, html, file, json, blaze+    , bytes, lazyBytes, text, html, file, json     , requireBasicAuth     , preferredFormat, ClientPreferredFormat(..)     ) where -import Web.Spock.Internal.Wire import Web.Spock.Internal.Util+import Web.Spock.Internal.Wire  import Control.Arrow (first) import Control.Monad@@ -27,8 +27,6 @@ import Network.HTTP.Types.Status import Prelude hiding (head) import System.Locale-import Text.Blaze.Html (Html)-import Text.Blaze.Html.Renderer.Utf8 (renderHtml) import Web.PathPieces import Web.Routing.AbstractRouter import qualified Data.Aeson as A@@ -82,12 +80,14 @@                   then return chunks                   else parseAll (chunks `BS.append` bs)        parseAll BS.empty+{-# INLINE body #-}  -- | Parse the request body as json jsonBody :: (MonadIO m, A.FromJSON a) => ActionT m (Maybe a) jsonBody =     do b <- body        return $ A.decodeStrict b+{-# INLINE jsonBody #-}  -- | Parse the request body as json and fails with 500 status code on error jsonBody' :: (MonadIO m, A.FromJSON a) => ActionT m a@@ -99,11 +99,13 @@                 text (T.pack $ "Failed to parse json: " ++ err)          Right val ->              return val+{-# INLINE jsonBody' #-}  -- | Get uploaded files files :: MonadIO m => ActionT m (HM.HashMap T.Text UploadedFile) files =     asks ri_files+{-# INLINE files #-}  -- | Get all request params params :: MonadIO m => ActionT m [(T.Text, T.Text)]@@ -143,19 +145,27 @@ setStatus :: MonadIO m => Status -> ActionT m () setStatus s =     modify $ \rs -> rs { rs_status = s }+{-# INLINE setStatus #-}  -- | Set a response header. Overwrites already defined headers setHeader :: MonadIO m => T.Text -> T.Text -> ActionT m () setHeader k v =-    modify $ \rs -> rs { rs_responseHeaders = ((k, v) : filter ((/= k) . fst) (rs_responseHeaders rs)) }+    modify $ \rs ->+        rs+        { rs_responseHeaders =+              HM.insert (CI.mk $ T.encodeUtf8 k) (T.encodeUtf8 v) (rs_responseHeaders rs)+        }+{-# INLINE setHeader #-}  -- | Abort the current action and jump the next one matching the route jumpNext :: MonadIO m => ActionT m a jumpNext = throwError ActionTryNext+{-# INLINE jumpNext #-}  -- | Redirect to a given url redirect :: MonadIO m => T.Text -> ActionT m a redirect = throwError . ActionRedirect+{-# INLINE redirect #-}  -- | If the Spock application is used as a middleware, you can use -- this to pass request handeling to the underlying application.@@ -163,6 +173,7 @@ -- this will result in 404 error. middlewarePass :: MonadIO m => ActionT m a middlewarePass = throwError ActionMiddlewarePass+{-# INLINE middlewarePass #-}  -- | Modify the vault (useful for sharing data between middleware and app) modifyVault :: MonadIO m => (V.Vault -> V.Vault) -> ActionT m ()@@ -202,24 +213,28 @@ bytes :: MonadIO m => BS.ByteString -> ActionT m a bytes val =     lazyBytes $ BSL.fromStrict val+{-# INLINE bytes #-}  -- | Send a lazy 'ByteString' as response body. Provide your own "Content-Type" lazyBytes :: MonadIO m => BSL.ByteString -> ActionT m a lazyBytes val =     do modify $ \rs -> rs { rs_responseBody = ResponseLBS val }        throwError ActionDone+{-# INLINE lazyBytes #-}  -- | Send text as a response body. Content-Type will be "text/plain" text :: MonadIO m => T.Text -> ActionT m a text val =     do setHeader "Content-Type" "text/plain; charset=utf-8"        bytes $ T.encodeUtf8 val+{-# INLINE text #-}  -- | 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; charset=utf-8"        bytes $ T.encodeUtf8 val+{-# INLINE html #-}  -- | Send a file as response file :: MonadIO m => T.Text -> FilePath -> ActionT m a@@ -227,18 +242,14 @@      do setHeader "Content-Type" contentType         modify $ \rs -> rs { rs_responseBody = ResponseFile filePath }         throwError ActionDone+{-# INLINE file #-}  -- | Send json as response. Content-Type will be "application/json" json :: (A.ToJSON a, MonadIO m) => a -> ActionT m b json val =     do setHeader "Content-Type" "application/json; charset=utf-8"        lazyBytes $ A.encode val---- | Send blaze html as response. Content-Type will be "text/html"-blaze :: MonadIO m => Html -> ActionT m a-blaze val =-    do setHeader "Content-Type" "text/html; charset=utf-8"-       lazyBytes $ renderHtml val+{-# INLINE json #-}  -- | Basic authentification -- provide a title for the prompt and a function to validate

@@ -1,36 +0,0 @@-{-# LANGUAGE DoAndIfThenElse #-}-module Web.Spock.Internal.Digestive-    ( runForm )-where--import Web.Spock.Internal.CoreAction--import Control.Applicative-import Control.Monad.Trans-import Network.HTTP.Types-import Network.Wai-import Text.Digestive.Form-import Text.Digestive.Types-import Text.Digestive.View-import qualified Data.HashMap.Strict as HM-import qualified Data.Text as T---- | Run a digestive functors form-runForm :: (Functor m, MonadIO m)-        => T.Text -- ^ form name-        -> Form v (ActionT m) a-        -> ActionT m (View v, Maybe a)-runForm formName form =-    do httpMethod <- requestMethod <$> request-       if httpMethod == methodGet-       then do f <- getForm formName form-               return (f, Nothing)-       else postForm formName form (const $ return localEnv)-    where-      localEnv path =-          do let name = fromPath $ path-                 applyParam f =-                     map (f . snd) . filter ((== name) . fst)-             vars <- (applyParam (TextInput)) <$> params-             sentFiles <- (applyParam (FileInput . T.unpack . uf_name) . HM.toList) <$> files-             return (vars ++ sentFiles)

@@ -14,6 +14,7 @@ import Control.Concurrent.STM import Control.Monad import Control.Monad.Trans+import Data.List (foldl') import Data.Time import System.Locale import System.Random@@ -30,9 +31,10 @@  createSessionManager :: SessionCfg sess -> IO (SessionManager conn sess st) createSessionManager cfg =-    do cacheHM <- atomically $ newTVar HM.empty+    do oldSess <- loadSessions+       cacheHM <- atomically $ newTVar oldSess        vaultKey <- V.newKey-       _ <- forkIO (forever (housekeepSessions cacheHM))+       _ <- forkIO (forever (housekeepSessions cacheHM storeSessions))        return $ SessionManager                   { sm_getSessionId = getSessionIdImpl vaultKey cacheHM                   , sm_readSession = readSessionImpl vaultKey cacheHM@@ -44,6 +46,30 @@                   , sm_lookupSafeAction = lookupSafeActionImpl vaultKey cacheHM                   , sm_removeSafeAction = removeSafeActionImpl vaultKey cacheHM                   }+    where+      (loadSessions, storeSessions) =+          case sc_persistCfg cfg of+            Nothing ->+                ( return HM.empty+                , const $ return ()+                )+            Just spc ->+                ( do sessions <- spc_load spc+                     return $ foldl' genSession HM.empty sessions+                , \hm ->+                    spc_store spc $ map mkSerializable $ HM.elems hm+                )+      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  getSessionIdImpl :: V.Key SessionId                  -> UserSessions conn sess st@@ -232,10 +258,16 @@ clearAllSessionsImpl sessionRef =     liftIO $ atomically $ modifyTVar' sessionRef (const HM.empty) -housekeepSessions :: UserSessions conn sess st -> IO ()-housekeepSessions sessionRef =+housekeepSessions :: UserSessions conn sess st+                  -> (HM.HashMap SessionId (Session conn sess st) -> IO ())+                  -> IO ()+housekeepSessions sessionRef storeSessions =     do now <- getCurrentTime-       atomically $ modifyTVar' sessionRef (killOld now)+       newStatus <-+           atomically $+           do modifyTVar' sessionRef (killOld now)+              readTVar sessionRef+       storeSessions newStatus        threadDelay (1000 * 1000 * 60) -- 60 seconds     where       filterOld now (_, sess) =

@@ -62,6 +62,13 @@    , sc_sessionTTL :: NominalDiffTime    , sc_sessionIdEntropy :: Int    , sc_emptySession :: a+   , sc_persistCfg :: Maybe (SessionPersistCfg a)+   }++data SessionPersistCfg a+   = SessionPersistCfg+   { spc_load :: IO [(SessionId, UTCTime, a)]+   , spc_store :: [(SessionId, UTCTime, a)] -> IO ()    }  data WebState conn sess st

@@ -6,6 +6,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} module Web.Spock.Internal.Wire where  import Control.Applicative@@ -41,9 +42,9 @@  data UploadedFile    = UploadedFile-   { uf_name :: T.Text-   , uf_contentType :: T.Text-   , uf_tempLocation :: FilePath+   { uf_name :: !T.Text+   , uf_contentType :: !T.Text+   , uf_tempLocation :: !FilePath    }  data VaultIf@@ -64,18 +65,18 @@ data ResponseBody    = ResponseFile FilePath    | ResponseLBS BSL.ByteString-   | ResponseRedirect T.Text+   | ResponseRedirect !T.Text    deriving (Show, Eq)  data ResponseState    = ResponseState-   { rs_responseHeaders :: [(T.Text, T.Text)]-   , rs_status :: Status-   , rs_responseBody :: ResponseBody+   { rs_responseHeaders :: !(HM.HashMap (CI.CI BS.ByteString) BS.ByteString)+   , rs_status :: !Status+   , rs_responseBody :: !ResponseBody    } deriving (Show, Eq)  data ActionInterupt-    = ActionRedirect T.Text+    = ActionRedirect !T.Text     | ActionTryNext     | ActionError String     | ActionDone@@ -103,12 +104,14 @@       ResponseRedirect target ->           Wai.responseLBS status302 (("Location", T.encodeUtf8 target) : waiHeaders) BSL.empty     where-      waiHeaders = map (\(k, v) -> (CI.mk $ T.encodeUtf8 k, T.encodeUtf8 v)) headers+      waiHeaders =+          HM.toList headers  errorResponse :: Status -> BSL.ByteString -> ResponseState errorResponse s e =     ResponseState-    { rs_responseHeaders = [("Content-Type", "text/html")]+    { rs_responseHeaders =+          HM.singleton "Content-Type" "text/html"     , rs_status = s     , rs_responseBody =         ResponseLBS $@@ -144,6 +147,93 @@       fallbackApp _ respond =           respond $ notFound +makeActionEnvironment :: InternalState -> Wai.Request -> IO (ParamMap -> RequestInfo, TVar V.Vault, IO ())+makeActionEnvironment st req =+    do (bodyParams, bodyFiles) <- P.parseRequestBody (P.tempFileBackEnd st) req+       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+                          , UploadedFile (T.decodeUtf8 $ P.fileName fileInfo) (T.decodeUtf8 $ P.fileContentType fileInfo) (P.fileContent fileInfo)+                          )+                     ) bodyFiles+           postParams =+               map (\(k, v) -> (T.decodeUtf8 k, T.decodeUtf8 v)) bodyParams+           getParams =+               map (\(k, mV) -> (T.decodeUtf8 k, T.decodeUtf8 $ fromMaybe BS.empty mV)) $ Wai.queryString req+           queryParams = postParams ++ getParams+       return ( \params ->+                    RequestInfo+                    { ri_request = req+                    , ri_params = params+                    , ri_queryParams = queryParams+                    , ri_files = uploadedFiles+                    , ri_vaultIf = vaultIf+                    }+              , vaultVar+              , removeUploadedFiles uploadedFiles+              )++removeUploadedFiles :: HM.HashMap k UploadedFile -> IO ()+removeUploadedFiles uploadedFiles =+    forM_ (HM.elems uploadedFiles) $ \uploadedFile ->+    do stillThere <- doesFileExist (uf_tempLocation uploadedFile)+       when stillThere $ liftIO $ removeFile (uf_tempLocation uploadedFile)++applyAction :: MonadIO m+            => Wai.Request+            -> (ParamMap -> RequestInfo)+            -> [(ParamMap, ActionT m ())]+            -> m (Maybe ResponseState)+applyAction _ _ [] =+    return $ Just $ errorResponse status404 "404 - File not found"+applyAction req mkEnv ((captures, selectedAction) : xs) =+    do let env = mkEnv captures+           defResp = errorResponse status200 ""+       (r, respState, _) <-+           runRWST (runErrorT $ runActionT $ selectedAction) env defResp+       case r of+         Left (ActionRedirect loc) ->+             return $ Just $ ResponseState (rs_responseHeaders respState) status302 (ResponseRedirect loc)+         Left ActionTryNext ->+             applyAction req mkEnv xs+         Left (ActionError errorMsg) ->+             do liftIO $ putStrLn $ "Spock Error while handeling "+                             ++ show (Wai.pathInfo req) ++ ": " ++ errorMsg+                return $ Just serverError+         Left ActionDone ->+             return $ Just respState+         Left ActionMiddlewarePass ->+             return Nothing+         Right () ->+             return $ Just respState++handleRequest :: MonadIO m => (forall a. m a -> IO a)+              -> [(ParamMap, ActionT m ())]+              -> InternalState+              -> Wai.Application -> Wai.Application+handleRequest registryLift allActions st coreApp req respond =+    do (mkEnv, vaultVar, cleanUp) <- makeActionEnvironment st req+       mRespState <-+           (registryLift $ applyAction req mkEnv allActions)+           `catch` \(e :: SomeException) ->+              do putStrLn $ "Spock Error while handeling " ++ show (Wai.pathInfo req) ++ ": " ++ show e+                 return $ Just serverError+       cleanUp+       case mRespState of+         Just respState ->+             respond $ respStateToResponse respState+         Nothing ->+             do newVault <- atomically $ readTVar vaultVar+                let req' = req { Wai.vault = V.union newVault (Wai.vault req) }+                coreApp req' respond+ buildMiddleware :: forall m r. (MonadIO m, AbstractRouter r, RouteAppliedAction r ~ ActionT m ())          => r          -> (forall a. m a -> IO a)@@ -159,66 +249,7 @@               Left _ ->                   respond invalidReq               Right stdMethod ->-                  runResourceT $-                  withInternalState $ \st ->-                      do (bodyParams, bodyFiles) <- P.parseRequestBody (P.tempFileBackEnd st) req-                         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-                                            , UploadedFile (T.decodeUtf8 $ P.fileName fileInfo) (T.decodeUtf8 $ P.fileContentType fileInfo) (P.fileContent fileInfo)-                                            )-                                       ) bodyFiles-                             postParams =-                                 map (\(k, v) -> (T.decodeUtf8 k, T.decodeUtf8 v)) bodyParams-                             getParams =-                                 map (\(k, mV) -> (T.decodeUtf8 k, T.decodeUtf8 $ fromMaybe BS.empty mV)) $ Wai.queryString req-                             queryParams = postParams ++ getParams-                             resp = errorResponse status200 ""-                             allActions = getMatchingRoutes stdMethod (Wai.pathInfo req)-                             applyAction :: [(ParamMap, ActionT m ())] -> m (Maybe ResponseState)-                             applyAction [] =-                                 return $ Just $ errorResponse status404 "404 - File not found"-                             applyAction ((captures, selectedAction) : xs) =-                                       do let env = RequestInfo req captures queryParams uploadedFiles vaultIf-                                          (r, respState, _) <--                                              runRWST (runErrorT $ runActionT $ selectedAction) env resp-                                          case r of-                                            Left (ActionRedirect loc) ->-                                                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 $ Just serverError-                                            Left ActionDone ->-                                                return $ Just respState-                                            Left ActionMiddlewarePass ->-                                                return Nothing-                                            Right () ->-                                                return $ Just respState-                         mRespState <--                             liftIO $ (registryLift $ applyAction allActions)-                                        `catch` \(e :: SomeException) ->-                                            do putStrLn $ "Spock Error while handeling " ++ show (Wai.pathInfo req) ++ ": " ++ show e-                                               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+                  do let allActions = getMatchingRoutes stdMethod (Wai.pathInfo req)+                     runResourceT $ withInternalState $ \st ->+                         handleRequest registryLift allActions st coreApp req respond        return $ spockMiddleware . app

@@ -8,11 +8,11 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds #-} module Web.Spock.Safe-    ( -- * Spock's core-      spock, SpockM, SpockAction-    , spockT, SpockT, ActionT+    ( -- * Spock's route definition monad+      spock, SpockM+    , spockT, SpockT      -- * Defining routes-    , Path, root, var, static, (</>)+    , Path, root, var, static, (<//>)      -- * Rendering routes     , renderRoute      -- * Hooking routes@@ -30,7 +30,6 @@   import Web.Spock.Shared-import Web.Spock.Internal.CoreAction import Web.Spock.Internal.Types import qualified Web.Spock.Internal.Core as C @@ -175,3 +174,7 @@                Just p@(PackedSafeAction action) ->                    do runSafeAction action                       (sm_removeSafeAction mgr) p++-- | Combine two path components+(<//>) :: Path as -> Path bs -> Path (Append as bs)+(<//>) = (</>)

@@ -10,6 +10,8 @@ module Web.Spock.Shared     (-- * Helpers for running Spock       runSpock, spockAsApp+     -- * Action types+    , SpockAction, ActionT      -- * Handeling requests     , request, header, cookie     , preferredFormat, ClientPreferredFormat(..)@@ -18,7 +20,7 @@     , params, param, param'      -- * Sending responses     , setStatus, setHeader, redirect, jumpNext, setCookie, setCookie', bytes, lazyBytes-    , text, html, file, json, blaze+    , text, html, file, json       -- * Middleware helpers     , middlewarePass, modifyVault, queryVault       -- * Database@@ -28,21 +30,20 @@       -- * Basic HTTP-Auth     , requireBasicAuth      -- * Sessions-    , SessionCfg (..), SessionId+    , SessionCfg (..), SessionPersistCfg(..), SessionId+    , readShowSessionPersist     , 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 import Control.Monad+import System.Directory import qualified Web.Spock.Internal.Wire as W import qualified Network.Wai as Wai import qualified Network.Wai.Handler.Warp as Warp@@ -90,3 +91,18 @@ clearAllSessions =     do mgr <- getSessMgr        sm_clearAllSessions mgr++-- | Simple session persisting configuration. DO NOT USE IN PRODUCTION+readShowSessionPersist :: (Read a, Show a) => FilePath -> SessionPersistCfg a+readShowSessionPersist fp =+    SessionPersistCfg+    { spc_load =+         do isThere <- doesFileExist fp+            if isThere+            then do str <- readFile fp+                    return (read str)+            else return []+    , spc_store =+         \theData ->+             writeFile fp (show theData)+    }

@@ -7,11 +7,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} module Web.Spock.Simple-    ( -- * Spock's core-      spock, SpockM, SpockAction-    , spockT, SpockT, ActionT+    ( -- * Spock's route definition monad+      spock, SpockM+    , spockT, SpockT      -- * Defining routes-    , SpockRoute, (<#>)+    , SpockRoute, (<//>)      -- * Hooking routes     , subcomponent     , get, post, head, put, delete, patch, hookRoute, hookAny@@ -76,11 +76,11 @@     C.spockAllT TextRouter liftFun app  -- | Combine two route components safely--- "/foo" <#> "/bar" ===> "/foo/bar"--- "foo" <#> "bar" ===> "/foo/bar"--- "foo <#> "/bar" ===> "/foo/bar"-(<#>) :: SpockRoute -> SpockRoute -> SpockRoute-(SpockRoute t) <#> (SpockRoute t') = SpockRoute $ combineRoute t t'+-- "/foo" <//> "/bar" ===> "/foo/bar"+-- "foo" <//> "bar" ===> "/foo/bar"+-- "foo <//> "/bar" ===> "/foo/bar"+(<//>) :: SpockRoute -> SpockRoute -> SpockRoute+(SpockRoute t) <//> (SpockRoute t') = SpockRoute $ combineRoute t t'  -- | Specify an action that will be run when the HTTP verb 'GET' and the given route match get :: MonadIO m => SpockRoute -> ActionT m () -> SpockT m ()

@@ -17,9 +17,9 @@        put "verb-test" $ text "PUT"        delete "verb-test" $ text "DELETE"        patch "verb-test" $ text "PATCH"-       get ("param-test" </> var) $ \(i :: Int) ->+       get ("param-test" <//> var) $ \(i :: Int) ->            text $ "int" <> (T.pack $ show i)-       get ("param-test" </> "static") $+       get ("param-test" <//> "static") $            text "static"        subcomponent "/subcomponent" $          do get "foo" $ text "foo"