[Snap Framework] snap-core branch, master, updated. 89603be2092fc10b46138f55fc59e337364d972c

noreply at snapframework.com noreply at snapframework.com
Wed Apr 21 18:27:42 CDT 2010


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  89603be2092fc10b46138f55fc59e337364d972c (commit)
      from  b48633ae04a00dc8fac44f5267f0a7fb0d9ad19c (commit)


Summary of changes:
 src/Snap/Util/FileServe.hs |   49 ++++++++++++++++++++++++++++++-------------
 1 files changed, 34 insertions(+), 15 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 89603be2092fc10b46138f55fc59e337364d972c
Author: Mighty Byte <mightybyte at gmail.com>
Date:   Wed Apr 21 19:27:22 2010 -0400

    Added fileServeSingle.

diff --git a/src/Snap/Util/FileServe.hs b/src/Snap/Util/FileServe.hs
index 5d93877..d702be2 100644
--- a/src/Snap/Util/FileServe.hs
+++ b/src/Snap/Util/FileServe.hs
@@ -5,6 +5,8 @@ module Snap.Util.FileServe
 (
   fileServe
 , fileServe'
+, fileServeSingle
+, fileServeSingle'
 , defaultMimeTypes
 , MimeMap
 ) where
@@ -175,26 +177,12 @@ fileServe' :: MimeMap           -- ^ MIME type mapping
 fileServe' mm root = do
     req <- getRequest
     let pInfo = S.unpack $ rqPathInfo req
-    let mbIfModified = (getHeader "if-modified-since" req >>=
-                        parseHttpTime)
 
     fp <- resolvePath pInfo
 
-    -- check modification time and bug out early if the file is not modified.
-    mt <- liftIO $ liftM clock2time $ getModificationTime fp
-    maybe (return ()) (chkModificationTime mt) mbIfModified
-
-    -- get the mime type for the file. We know this is a file, otherwise we
-    -- would've failed earlier.
     let fn   = takeFileName fp
     let mime = fileType mm fn
-
-    sz <- liftIO $ liftM (fromEnum . fileSize) $ getFileStatus fp
-
-    modifyResponse $ setHeader "Last-Modified" (formatHttpTime mt)
-                   . setContentType mime
-                   . setContentLength sz
-                   . setResponseBody (enumFile fp)
+    fileServeSingle' mime fp
 
   where
     --------------------------------------------------------------------------
@@ -213,6 +201,37 @@ fileServe' mm root = do
 
         return f
 
+
+------------------------------------------------------------------------------
+-- | Serves a single file specified by a full or relative path.  The
+-- path restrictions on fileServe don't apply to this function since
+-- the path is not being supplied by the user.
+fileServeSingle :: FilePath          -- ^ path to file
+                -> Snap ()
+fileServeSingle fp =
+    fileServeSingle' (fileType defaultMimeTypes (takeFileName fp)) fp
+
+
+------------------------------------------------------------------------------
+-- | Same as 'fileServeSingle', with control over the MIME mapping used.
+fileServeSingle' :: ByteString        -- ^ MIME type mapping
+                 -> FilePath          -- ^ path to file
+                 -> Snap ()
+fileServeSingle' mime fp = do
+    req <- getRequest
+    let mbIfModified = (getHeader "if-modified-since" req >>=
+                        parseHttpTime)
+    -- check modification time and bug out early if the file is not modified.
+    mt <- liftIO $ liftM clock2time $ getModificationTime fp
+    maybe (return ()) (chkModificationTime mt) mbIfModified
+
+    sz <- liftIO $ liftM (fromEnum . fileSize) $ getFileStatus fp
+
+    modifyResponse $ setHeader "Last-Modified" (formatHttpTime mt)
+                   . setContentType mime
+                   . setContentLength sz
+                   . setResponseBody (enumFile fp)
+  where
     --------------------------------------------------------------------------
     chkModificationTime mt lt = when (mt <= lt) notModified
 
-----------------------------------------------------------------------


hooks/post-receive
-- 
snap-core


More information about the Snap mailing list