@@ -1,6 +1,14 @@
11{-# LANGUAGE ScopedTypeVariables #-}
22{-# LANGUAGE OverloadedStrings #-}
3−module Backend.Filesystem where
3+-- | Access files on the filesystem.
4+module WaiAppStatic.Storage.Filesystem
5+ ( -- * Types
6+ ETagLookup
7+ -- * Settings
8+ , defaultWebAppSettings
9+ , defaultFileServerSettings
10+ , webAppSettingsWithLookup
11+ ) where
412
513import WaiAppStatic.Types
614import Prelude hiding (FilePath)
@@ -11,20 +19,26 @@ import Data.List (foldl')
1119import Control.Monad (forM)
1220import Util
1321import Data.ByteString (ByteString)
14−import qualified Data.ByteString.Lazy as L
1522import Control.Exception (SomeException, try)
1623import qualified Network.Wai as W
1724import Listing
1825import Mime
1926import System.PosixCompat.Files (fileSize, getFileStatus, modificationTime)
2027import Data.Maybe (catMaybes)
28+import qualified Crypto.Conduit
29+import Data.Serialize (encode)
30+import Crypto.Hash.MD5 (MD5)
2131
32+-- | Construct a new path from a root and some @Pieces@.
2233pathFromPieces :: FilePath -> Pieces -> FilePath
2334pathFromPieces = foldl' (\fp p -> fp </> F.fromText (fromPiece p))
2435
25−defaultWebAppSettings :: StaticSettings
26−defaultWebAppSettings = StaticSettings
27− { ssLookupFile = webAppLookup hashFileIfExists "static"
36+-- | Settings optimized for a web application. Files will have aggressive
37+-- caching applied and hashes calculated, and indices and listings are disabled.
38+defaultWebAppSettings :: FilePath -- ^ root folder to serve from
39+ -> StaticSettings
40+defaultWebAppSettings root = StaticSettings
41+ { ssLookupFile = webAppLookup hashFileIfExists root
2842 , ssMkRedirect = defaultMkRedirect
2943 , ssGetMimeType = return . defaultMimeTypeByExt . fileName
3044 , ssMaxAge = MaxAgeForever
@@ -34,9 +48,12 @@ defaultWebAppSettings = StaticSettings
3448 , ssUseHash = True
3549 }
3650
37−defaultFileServerSettings :: StaticSettings
38−defaultFileServerSettings = StaticSettings
39− { ssLookupFile = fileSystemLookup "static"
51+-- | Settings optimized for a file server. More conservative caching will be
52+-- applied, and indices and listings are enabled.
53+defaultFileServerSettings :: FilePath -- ^ root folder to serve from
54+ -> StaticSettings
55+defaultFileServerSettings root = StaticSettings
56+ { ssLookupFile = fileSystemLookup (fmap Just . hashFile) root
4057 , ssMkRedirect = defaultMkRedirect
4158 , ssGetMimeType = return . defaultMimeTypeByExt . fileName
4259 , ssMaxAge = MaxAgeSeconds $ 60 * 60
@@ -46,16 +63,23 @@ defaultFileServerSettings = StaticSettings
4663 , ssUseHash = False
4764 }
4865
49−webAppSettingsWithLookup :: FilePath -> ETagLookup -> StaticSettings
66+-- | Same as @defaultWebAppSettings@, but additionally uses a specialized
67+-- @ETagLookup@ in place of the standard one. This can allow you to cache your
68+-- hash values, or even precompute them.
69+webAppSettingsWithLookup :: FilePath -- ^ root folder to serve from
70+ -> ETagLookup
71+ -> StaticSettings
5072webAppSettingsWithLookup dir etagLookup =
51− defaultWebAppSettings { ssLookupFile = webAppLookup etagLookup dir}
73+ (defaultWebAppSettings dir) { ssLookupFile = webAppLookup etagLookup dir}
5274
75+-- | Convenience wrapper for @fileHelper@.
5376fileHelperLR :: ETagLookup
5477 -> FilePath -- ^ file location
5578 -> Piece -- ^ file name
5679 -> IO LookupResult
5780fileHelperLR a b c = fmap (maybe LRNotFound LRFile) $ fileHelper a b c
5881
82+-- | Attempt to load up a @File@ from the given path.
5983fileHelper :: ETagLookup
6084 -> FilePath -- ^ file location
6185 -> Piece -- ^ file name
@@ -72,8 +96,12 @@ fileHelper hashFunc fp name = do
7296 , fileGetModified = Just $ modificationTime fs
7397 }
7498
75−type ETagLookup = (FilePath -> IO (Maybe ByteString))
99+-- | How to calculate etags. Can perform filesystem reads on each call, or use
100+-- some caching mechanism.
101+type ETagLookup = FilePath -> IO (Maybe ByteString)
76102
103+-- | More efficient than @fileSystemLookup@ as it only concerns itself with
104+-- finding files, not folders.
77105webAppLookup :: ETagLookup -> FilePath -> Pieces -> IO LookupResult
78106webAppLookup cachedLookupHash prefix pieces =
79107 fileHelperLR cachedLookupHash fp lastPiece
@@ -83,28 +111,17 @@ webAppLookup cachedLookupHash prefix pieces =
83111 | null pieces = unsafeToPiece ""
84112 | otherwise = last pieces
85113
86−defaultFileSystemHash :: ETagLookup
87−defaultFileSystemHash fp = fmap Just $ hashFile fp
88−
89−-- FIXME replace lazy IO with enumerators
90−-- FIXME let's use a dictionary to cache these values?
91114hashFile :: FilePath -> IO ByteString -- FIXME use crypto-conduit
92115hashFile fp = do
93− l <- L.readFile $ F.encodeString fp
94− return $ runHashL l
116+ h <- Crypto.Conduit.hashFile (F.encodeString fp)
117+ return $ encode (h :: MD5)
95118
96119hashFileIfExists :: ETagLookup
97120hashFileIfExists fp = do
98121 fe <- F.isFile fp
99122 if fe
100123 then return Nothing
101− else defaultFileSystemHash fp
102−
103−fileSystemLookup :: FilePath -> Pieces -> IO LookupResult
104−fileSystemLookup = fileSystemLookupHash defaultFileSystemHash
105−
106−filePathToPiece :: FilePath -> Piece
107−filePathToPiece = unsafeToPiece . either id id . F.toText
124+ else fmap Just $ hashFile fp
108125
109126isVisible :: FilePath -> Bool
110127isVisible =
@@ -114,9 +131,11 @@ isVisible =
114131 go "" = False
115132 go _ = True
116133
117−fileSystemLookupHash :: ETagLookup
118− -> FilePath -> Pieces -> IO LookupResult
119−fileSystemLookupHash hashFunc prefix pieces = do
134+-- | Get a proper @LookupResult@, checking if the path is a file or folder.
135+-- Compare with @webAppLookup@, which only deals with files.
136+fileSystemLookup :: ETagLookup
137+ -> FilePath -> Pieces -> IO LookupResult
138+fileSystemLookup hashFunc prefix pieces = do
120139 let fp = pathFromPieces prefix pieces
121140 fe <- F.isFile fp
122141 if fe