This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "snap-core".
The branch, master has been updated
via 5f88abb8db9d6012a0686141f8f686ee3b2c557e (commit)
via 29261490e7b8a2f7227705202a422a16a8e5e274 (commit)
from 9c386ea71d62e17d6f5e6cccd95cf9218f5b6935 (commit)
Summary of changes:
src/Snap/Util/FileServe.hs | 29 +++++++++++++++++++----------
test/suite/Snap/Util/FileServe/Tests.hs | 12 ++++++++----
2 files changed, 27 insertions(+), 14 deletions(-)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 5f88abb8db9d6012a0686141f8f686ee3b2c557e
Merge: 9c386ea 2926149
Author: Gregory Collins <[email protected]>
Date: Fri May 27 04:21:25 2011 -0700
Merge pull request #71 from jaspervdj/master
Add preServeHook to DirectoryConfig
commit 29261490e7b8a2f7227705202a422a16a8e5e274
Author: Jasper Van der Jeugt <[email protected]>
Date: Thu May 19 13:29:53 2011 +0200
Add preServeHook to DirectoryConfig
diff --git a/src/Snap/Util/FileServe.hs b/src/Snap/Util/FileServe.hs
index f0f4571..123f9ab 100644
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@ -221,7 +221,11 @@ data DirectoryConfig m = DirectoryConfig {
dynamicHandlers :: HandlerMap m,
-- | MIME type map to look up content types.
- mimeTypes :: MimeMap
+ mimeTypes :: MimeMap,
+
+ -- | Handler that is called before a file is served. It will only be
+ -- called when a file is actually found, not for generated index pages.
+ preServeHook :: FilePath -> m ()
}
@@ -328,13 +332,14 @@ defaultIndexGenerator mm styles d = do
------------------------------------------------------------------------------
-- | A very simple configuration for directory serving. This configuration
-- uses built-in MIME types from 'defaultMimeTypes', and has no index files,
--- index generator, or dynamic file handlers.
+-- index generator, dynamic file handlers, or 'preServeHook'.
simpleDirectoryConfig :: MonadSnap m => DirectoryConfig m
simpleDirectoryConfig = DirectoryConfig {
indexFiles = [],
indexGenerator = const pass,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
@@ -342,13 +347,15 @@ simpleDirectoryConfig = DirectoryConfig {
-- | A reasonable default configuration for directory serving. This
-- configuration uses built-in MIME types from 'defaultMimeTypes', serves
-- common index files @index.html@ and @index.htm@, but does not autogenerate
--- directory indexes, nor have any dynamic file handlers.
+-- directory indexes, nor have any dynamic file handlers. The 'preServeHook'
+-- will not do anything.
defaultDirectoryConfig :: MonadSnap m => DirectoryConfig m
defaultDirectoryConfig = DirectoryConfig {
indexFiles = ["index.html", "index.htm"],
indexGenerator = const pass,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
@@ -356,8 +363,8 @@ defaultDirectoryConfig = DirectoryConfig {
-- | A more elaborate configuration for file serving. This configuration
-- uses built-in MIME types from 'defaultMimeTypes', serves common index files
-- @index.html@ and @index.htm@, and autogenerates directory indexes with a
--- Snap-like feel. It still has no dynamic file handlers, which should be
--- added as needed.
+-- Snap-like feel. It still has no dynamic file handlers, nor 'preServeHook',
+-- which should be added as needed.
--
-- Files recognized as indexes include @index.html@, @index.htm@,
-- @default.html@, @default.htm@, @home.html@
@@ -366,7 +373,8 @@ fancyDirectoryConfig = DirectoryConfig {
indexFiles = ["index.html", "index.htm"],
indexGenerator = defaultIndexGenerator defaultMimeTypes snapIndexStyles,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
@@ -401,12 +409,13 @@ serveDirectoryWith cfg base = do
generate = indexGenerator cfg
mimes = mimeTypes cfg
dyns = dynamicHandlers cfg
+ pshook = preServeHook cfg
-- Serves a file if it exists; passes if not
serve f = do
liftIO (doesFileExist f) >>= flip unless pass
- let fname = takeFileName f
- let staticServe = do serveFileAs (fileType mimes fname)
+ let fname = takeFileName f
+ let staticServe f' = pshook f >> serveFileAs (fileType mimes fname) f'
lookupExt staticServe dyns fname f >> return True <|> return False
-- Serves a directory via indices if available. Returns True on success,
diff --git a/test/suite/Snap/Util/FileServe/Tests.hs
b/test/suite/Snap/Util/FileServe/Tests.hs
index 6ce0db1..1e138cf 100644
--- a/test/suite/Snap/Util/FileServe/Tests.hs
+++ b/test/suite/Snap/Util/FileServe/Tests.hs
@@ -224,7 +224,8 @@ testFsCfg = testCase "fileServe/Cfg" $ do
indexFiles = [],
indexGenerator = const pass,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
-- Named file in the root directory
@@ -266,7 +267,8 @@ testFsCfg = testCase "fileServe/Cfg" $ do
indexFiles = ["index.txt", "altindex.html"],
indexGenerator = const pass,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
-- Request for root directory with index
@@ -296,7 +298,8 @@ testFsCfg = testCase "fileServe/Cfg" $ do
indexFiles = ["index.txt", "altindex.html"],
indexGenerator = printName,
dynamicHandlers = Map.empty,
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
-- Request for root directory with index
@@ -318,7 +321,8 @@ testFsCfg = testCase "fileServe/Cfg" $ do
indexFiles = [],
indexGenerator = const pass,
dynamicHandlers = Map.fromList [ (".txt", printName) ],
- mimeTypes = defaultMimeTypes
+ mimeTypes = defaultMimeTypes,
+ preServeHook = const $ return ()
}
-- Request for file with dynamic handler
-----------------------------------------------------------------------
hooks/post-receive
--
snap-core
_______________________________________________
Snap mailing list
[email protected]
https://mailman-mail5.webfaction.com/listinfo/snap
