More filesystem cleanup

wai-app-static/Network/Wai/Application/Static.hs

@@ -36,11 +36,7 @@ module Network.Wai.Application.Static
       -- ** Directory listings
     , Listing
     , defaultListing
-      -- ** Lookup functions
-    , fileSystemLookup
-    , fileSystemLookupHash
     {-
-    , embeddedLookup
       -- ** Embedded
     , Embedded
     , EmbeddedEntry (..)
@@ -79,7 +75,7 @@ import WaiAppStatic.Types
 import Mime
 import Listing
 import Util
-import Backend.Filesystem
+import WaiAppStatic.Storage.Filesystem
 
 data StaticResponse =
       -- | Just the etag hash or Nothing for no etag hash

wai-app-static/WaiAppStatic/Storage/Filesystem.hs

@@ -1,6 +1,14 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
-module Backend.Filesystem where
+-- | Access files on the filesystem.
+module WaiAppStatic.Storage.Filesystem
+    ( -- * Types
+      ETagLookup
+      -- * Settings
+    , defaultWebAppSettings
+    , defaultFileServerSettings
+    , webAppSettingsWithLookup
+    ) where
 
 import WaiAppStatic.Types
 import Prelude hiding (FilePath)
@@ -11,20 +19,26 @@ import Data.List (foldl')
 import Control.Monad (forM)
 import Util
 import Data.ByteString (ByteString)
-import qualified Data.ByteString.Lazy as L
 import Control.Exception (SomeException, try)
 import qualified Network.Wai as W
 import Listing
 import Mime
 import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
 import Data.Maybe (catMaybes)
+import qualified Crypto.Conduit
+import Data.Serialize (encode)
+import Crypto.Hash.MD5 (MD5)
 
+-- | Construct a new path from a root and some @Pieces@.
 pathFromPieces :: FilePath -> Pieces -> FilePath
 pathFromPieces = foldl' (\fp p -> fp </> F.fromText (fromPiece p))
 
-defaultWebAppSettings :: StaticSettings
-defaultWebAppSettings = StaticSettings
-    { ssLookupFile = webAppLookup hashFileIfExists "static"
+-- | Settings optimized for a web application. Files will have aggressive
+-- caching applied and hashes calculated, and indices and listings are disabled.
+defaultWebAppSettings :: FilePath -- ^ root folder to serve from
+                      -> StaticSettings
+defaultWebAppSettings root = StaticSettings
+    { ssLookupFile = webAppLookup hashFileIfExists root
     , ssMkRedirect  = defaultMkRedirect
     , ssGetMimeType = return . defaultMimeTypeByExt . fileName
     , ssMaxAge  = MaxAgeForever
@@ -34,9 +48,12 @@ defaultWebAppSettings = StaticSettings
     , ssUseHash = True
     }
 
-defaultFileServerSettings :: StaticSettings
-defaultFileServerSettings = StaticSettings
-    { ssLookupFile = fileSystemLookup "static"
+-- | Settings optimized for a file server. More conservative caching will be
+-- applied, and indices and listings are enabled.
+defaultFileServerSettings :: FilePath -- ^ root folder to serve from
+                          -> StaticSettings
+defaultFileServerSettings root = StaticSettings
+    { ssLookupFile = fileSystemLookup (fmap Just . hashFile) root
     , ssMkRedirect = defaultMkRedirect
     , ssGetMimeType = return . defaultMimeTypeByExt . fileName
     , ssMaxAge = MaxAgeSeconds $ 60 * 60
@@ -46,16 +63,23 @@ defaultFileServerSettings = StaticSettings
     , ssUseHash = False
     }
 
-webAppSettingsWithLookup :: FilePath -> ETagLookup -> StaticSettings
+-- | Same as @defaultWebAppSettings@, but additionally uses a specialized
+-- @ETagLookup@ in place of the standard one. This can allow you to cache your
+-- hash values, or even precompute them.
+webAppSettingsWithLookup :: FilePath -- ^ root folder to serve from
+                         -> ETagLookup
+                         -> StaticSettings
 webAppSettingsWithLookup dir etagLookup =
-  defaultWebAppSettings { ssLookupFile = webAppLookup etagLookup dir}
+  (defaultWebAppSettings dir) { ssLookupFile = webAppLookup etagLookup dir}
 
+-- | Convenience wrapper for @fileHelper@.
 fileHelperLR :: ETagLookup
              -> FilePath -- ^ file location
              -> Piece -- ^ file name
              -> IO LookupResult
 fileHelperLR a b c = fmap (maybe LRNotFound LRFile) $ fileHelper a b c
 
+-- | Attempt to load up a @File@ from the given path.
 fileHelper :: ETagLookup
            -> FilePath -- ^ file location
            -> Piece -- ^ file name
@@ -72,8 +96,12 @@ fileHelper hashFunc fp name = do
             , fileGetModified = Just $ modificationTime fs
             }
 
-type ETagLookup = (FilePath -> IO (Maybe ByteString))
+-- | How to calculate etags. Can perform filesystem reads on each call, or use
+-- some caching mechanism.
+type ETagLookup = FilePath -> IO (Maybe ByteString)
 
+-- | More efficient than @fileSystemLookup@ as it only concerns itself with
+-- finding files, not folders.
 webAppLookup :: ETagLookup -> FilePath -> Pieces -> IO LookupResult
 webAppLookup cachedLookupHash prefix pieces =
     fileHelperLR cachedLookupHash fp lastPiece
@@ -83,28 +111,17 @@ webAppLookup cachedLookupHash prefix pieces =
         | null pieces = unsafeToPiece ""
         | otherwise = last pieces
 
-defaultFileSystemHash :: ETagLookup
-defaultFileSystemHash fp = fmap Just $ hashFile fp
-
--- FIXME replace lazy IO with enumerators
--- FIXME let's use a dictionary to cache these values?
 hashFile :: FilePath -> IO ByteString -- FIXME use crypto-conduit
 hashFile fp = do
-    l <- L.readFile $ F.encodeString fp
-    return $ runHashL l
+    h <- Crypto.Conduit.hashFile (F.encodeString fp)
+    return $ encode (h :: MD5)
 
 hashFileIfExists :: ETagLookup
 hashFileIfExists fp = do
     fe <- F.isFile fp
     if fe
       then return Nothing
-      else defaultFileSystemHash fp
-
-fileSystemLookup :: FilePath -> Pieces -> IO LookupResult
-fileSystemLookup = fileSystemLookupHash defaultFileSystemHash
-
-filePathToPiece :: FilePath -> Piece
-filePathToPiece = unsafeToPiece . either id id . F.toText
+      else fmap Just $ hashFile fp
 
 isVisible :: FilePath -> Bool
 isVisible =
@@ -114,9 +131,11 @@ isVisible =
     go "" = False
     go _ = True
 
-fileSystemLookupHash :: ETagLookup
-                     -> FilePath -> Pieces -> IO LookupResult
-fileSystemLookupHash hashFunc prefix pieces = do
+-- | Get a proper @LookupResult@, checking if the path is a file or folder.
+-- Compare with @webAppLookup@, which only deals with files.
+fileSystemLookup :: ETagLookup
+                 -> FilePath -> Pieces -> IO LookupResult
+fileSystemLookup hashFunc prefix pieces = do
     let fp = pathFromPieces prefix pieces
     fe <- F.isFile fp
     if fe

wai-app-static/wai-app-static.cabal

@@ -43,14 +43,16 @@ library
                    , http-date
                    , blaze-html                >= 0.5      && < 0.6
                    , blaze-markup              >= 0.5.1    && < 0.6
+                   , crypto-conduit            >= 0.3.2    && < 0.4
+                   , cereal                    >= 0.3.5    && < 0.4
 
     exposed-modules: Network.Wai.Application.Static
                      WaiAppStatic.Types
+                     WaiAppStatic.Storage.Filesystem
     other-modules:   Listing
                      Mime
                      Util
-                     Backend.Filesystem
-    ghc-options:     -Wall
+    ghc-options:     -Wall -Werror
     extensions:     CPP
 
     if flag(print)