Bring back proper etag support

yesod-static/Yesod/Static.hs

@@ -7,19 +7,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 ---------------------------------------------------------
 --
--- Module        : Yesod.Static
--- Copyright     : Michael Snoyman
--- License       : BSD3
---
--- Maintainer    : Michael Snoyman <michael@snoyman.com>
--- Stability     : Unstable
--- Portability   : portable
---
-
 -- | Serve static files from a Yesod app.
 --
--- This is most useful for standalone testing. When running on a production
+-- This is great for developming your application, but also for a dead-simple deployment.
--- server (like Apache), just let the server do the static serving.
+-- Caching headers are automatically taken care of.
+--
+-- If you are running a proxy server (like Apache or Nginx),
+-- you may want to have that server do the static serving instead.
 --
 -- In fact, in an ideal setup you'll serve your static files from a separate
 -- domain name to save time on transmitting cookies. In that case, you may wish
@@ -61,24 +55,26 @@ import qualified Data.Serialize
 import Data.Text (Text, pack)
 import Data.Monoid (mempty)
 import qualified Data.Map as M
---import Data.IORef (readIORef, newIORef, writeIORef)
+import Data.IORef (readIORef, newIORef, writeIORef)
 import Network.Wai (pathInfo, rawPathInfo, responseLBS)
 import Data.Char (isLower, isDigit)
 import Data.List (foldl')
 import qualified Data.ByteString as S
 import Network.HTTP.Types (status301)
+import System.PosixCompat.Files (getFileStatus, modificationTime)
+import System.Posix.Types (EpochTime)
 
 import Network.Wai.Application.Static
     ( StaticSettings (..)
     , defaultWebAppSettings
-    , fileSystemLookupHash
     , staticApp
     , embeddedLookup
     , toEmbedded
-    -- , pathFromPieces
     , toFilePath
     , fromFilePath
     , FilePath
+    , ETagLookup
+    , webAppSettingsWithLookup
     )
 
 newtype Static = Static StaticSettings
@@ -86,15 +82,17 @@ newtype Static = Static StaticSettings
 -- | Default value of 'Static' for a given file folder.
 --
 -- Does not have index files or directory listings.
+-- Expects static files to *never* change
 static :: Prelude.FilePath -> IO Static
-static fp = do
+static dir = do
-  hashes <- mkHashMap fp
+    hashLookup <- cachedETagLookup dir
-  return $ Static defaultWebAppSettings{
+    return $ Static $ webAppSettingsWithLookup hashLookup
-    ssFolder = fileSystemLookupHash (getHash hashes) (toFilePath fp)
-  }
 
-getHash :: M.Map Prelude.FilePath S.ByteString -> FilePath -> Maybe (IO S.ByteString)
+-- | like static, but checks to see if the file has changed
-getHash m fp = fmap return $ M.lookup (fromFilePath fp) m
+staticDevel :: Prelude.FilePath -> IO Static
+staticDevel dir = do
+    hashLookup <- cachedETagLookupDevel dir
+    return $ Static $ webAppSettingsWithLookup hashLookup
 
 -- | Produces a 'Static' based on embedding file contents in the executable at
 -- compile time.
@@ -104,18 +102,6 @@ embed fp =
         { ssFolder = embeddedLookup (toEmbedded $(embedDir fp))
         })|]
 
-{-
-publicProduction :: String -> Prelude.FilePath -> IO Public
-publicProduction root fp = do
-  etags <- mkPublicProductionEtag fp
-  return $ public root fp etags
-
-publicDevel :: String -> Prelude.FilePath -> IO Public
-publicDevel root fp = do
-  etags <- mkPublicDevelEtag fp
-  return $ public root fp etags
-  -}
-
 
 -- | Manually construct a static route.
 -- The first argument is a sub-path to the file being served whereas the second argument is the key value pairs in the query string.
@@ -172,18 +158,19 @@ staticFiles dir = mkStaticFiles dir
 publicFiles :: Prelude.FilePath -> Q [Dec]
 publicFiles dir = mkStaticFiles' dir "StaticRoute" False
 
-mkHashMap :: Prelude.FilePath -> IO (M.Map Prelude.FilePath S8.ByteString)
+
+mkHashMap :: Prelude.FilePath -> IO (M.Map FilePath S8.ByteString)
 mkHashMap dir = do
     fs <- getFileListPieces dir
     hashAlist fs >>= return . M.fromList
   where
-    hashAlist :: [[String]] -> IO [(Prelude.FilePath, S8.ByteString)]
+    hashAlist :: [[String]] -> IO [(FilePath, S8.ByteString)]
     hashAlist fs = mapM hashPair fs
       where
-        hashPair :: [String] -> IO (Prelude.FilePath, S8.ByteString)
+        hashPair :: [String] -> IO (FilePath, S8.ByteString)
         hashPair pieces = do let file = pathFromRawPieces dir pieces
                              h <- base64md5File file
-                             return (file, S8.pack h)
+                             return (toFilePath file, S8.pack h)
 
 pathFromRawPieces :: Prelude.FilePath -> [String] -> Prelude.FilePath
 pathFromRawPieces =
@@ -191,28 +178,27 @@ pathFromRawPieces =
   where
     append a b = a ++ '/' : b
 
-{-
+cachedETagLookupDevel :: Prelude.FilePath -> IO ETagLookup
-mkPublicDevelEtag :: Prelude.FilePath -> IO StaticSettings
+cachedETagLookupDevel dir = do
-mkPublicDevelEtag dir = do
     etags <- mkHashMap dir
-    mtimeVar <- newIORef (M.empty :: M.Map Prelude.FilePath System.Time.ClockTime)
+    mtimeVar <- newIORef (M.empty :: M.Map FilePath EpochTime)
-    return $ ETag $ \f ->
+    return $ \f ->
       case M.lookup f etags of
         Nothing -> return Nothing
         Just checksum -> do
-          newt <- getModificationTime f
+          fs <- getFileStatus $ fromFilePath f
+          let newt = modificationTime fs
           mtimes <- readIORef mtimeVar
           oldt <- case M.lookup f mtimes of
             Nothing -> writeIORef mtimeVar (M.insert f newt mtimes) >> return newt
-            Just ot -> return ot
+            Just oldt -> return oldt
           return $ if newt /= oldt then Nothing else Just checksum
 
 
-mkPublicProductionEtag :: Prelude.FilePath -> IO StaticSettings
+cachedETagLookup :: Prelude.FilePath -> IO ETagLookup
-mkPublicProductionEtag dir = do
+cachedETagLookup dir = do
     etags <- mkHashMap dir
-    return $ ETag $ \f -> return . M.lookup f $ etags
+    return $ (\f -> return $ M.lookup f etags)
--}
 
 mkStaticFiles :: Prelude.FilePath -> Q [Dec]
 mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True

yesod-static/yesod-static.cabal

@@ -3,7 +3,7 @@ version:         0.3.0
 license:         BSD3
 license-file:    LICENSE
 author:          Michael Snoyman <michael@snoyman.com>
-maintainer:      Michael Snoyman <michael@snoyman.com>
+maintainer:      Michael Snoyman <michael@snoyman.com>, Greg Weber <greg@gregweber.info>
 synopsis:        Static file serving subsite for Yesod Web Framework.
 category:        Web, Yesod
 stability:       Stable
@@ -27,11 +27,12 @@ library
                    , template-haskell
                    , directory                 >= 1.0      && < 1.2
                    , transformers              >= 0.2      && < 0.3
-                   , wai-app-static            >= 0.3.1    && < 0.4
+                   , wai-app-static            >= 0.3.2    && < 0.4
                    , wai                       >= 0.4      && < 0.5
                    , text                      >= 0.5      && < 1.0
                    , file-embed                >= 0.0.4.1  && < 0.5
                    , http-types                >= 0.6.5    && < 0.7
+                   , unix-compat               >= 0.2      && < 0.3
     exposed-modules: Yesod.Static
     ghc-options:     -Wall