{-# LANGUAGE CPP, OverloadedStrings #-}
module Network.Wai.Middleware.Static
(
static, staticPolicy, unsafeStaticPolicy
, static', staticPolicy', unsafeStaticPolicy'
, staticWithOptions, staticPolicyWithOptions, unsafeStaticPolicyWithOptions
,
Options, cacheContainer, mimeTypes, defaultOptions
,
CachingStrategy(..), FileMeta(..), initCaching, CacheContainer
,
Policy, (<|>), (>->), policy, predicate
, addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only
,
tryPolicy
,
getMimeType
) where
import Caching.ExpiringCacheMap.HashECM (newECMIO, lookupECM, CacheSettings(..), consistentDuration)
import Control.Monad
import qualified Crypto.Hash.SHA1 as SHA1
import qualified Data.ByteString.Base16 as Base16
import qualified Data.List as L
#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif
import Data.Time
import Data.Time.Clock.POSIX
import Network.HTTP.Types
import Network.Mime (MimeType, defaultMimeLookup)
import Network.Wai
import System.Directory (doesFileExist, getModificationTime)
#if !(MIN_VERSION_time(1,5,0))
import System.Locale
#endif
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified System.FilePath as FP
newtype Policy = Policy { Policy -> FilePath -> Maybe FilePath
tryPolicy :: String -> Maybe FilePath
}
data Options = Options { Options -> CacheContainer
cacheContainer :: CacheContainer
, Options -> FilePath -> Method
mimeTypes :: FilePath -> MimeType
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options { cacheContainer :: CacheContainer
cacheContainer = CacheContainer
CacheContainerEmpty, mimeTypes :: FilePath -> Method
mimeTypes = FilePath -> Method
getMimeType }
data CachingStrategy
= NoCaching
| PublicStaticCaching
| CustomCaching (FileMeta -> RequestHeaders)
instance Semigroup Policy where
Policy
p1 <> :: Policy -> Policy -> Policy
<> Policy
p2 = (FilePath -> Maybe FilePath) -> Policy
policy (Maybe FilePath
-> (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe FilePath
forall a. Maybe a
Nothing (Policy -> FilePath -> Maybe FilePath
tryPolicy Policy
p2) (Maybe FilePath -> Maybe FilePath)
-> (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Policy -> FilePath -> Maybe FilePath
tryPolicy Policy
p1)
instance Monoid Policy where
mempty :: Policy
mempty = (FilePath -> Maybe FilePath) -> Policy
policy FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just
mappend :: Policy -> Policy -> Policy
mappend = Policy -> Policy -> Policy
forall a. Semigroup a => a -> a -> a
(<>)
policy :: (String -> Maybe String) -> Policy
policy :: (FilePath -> Maybe FilePath) -> Policy
policy = (FilePath -> Maybe FilePath) -> Policy
Policy
predicate :: (String -> Bool) -> Policy
predicate :: (FilePath -> Bool) -> Policy
predicate FilePath -> Bool
p = (FilePath -> Maybe FilePath) -> Policy
policy (\FilePath
s -> if FilePath -> Bool
p FilePath
s then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
s else Maybe FilePath
forall a. Maybe a
Nothing)
infixr 5 >->
(>->) :: Policy -> Policy -> Policy
>-> :: Policy -> Policy -> Policy
(>->) = Policy -> Policy -> Policy
forall a. Semigroup a => a -> a -> a
(<>)
infixr 4 <|>
(<|>) :: Policy -> Policy -> Policy
Policy
p1 <|> :: Policy -> Policy -> Policy
<|> Policy
p2 = (FilePath -> Maybe FilePath) -> Policy
policy (\FilePath
s -> Maybe FilePath
-> (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Policy -> FilePath -> Maybe FilePath
tryPolicy Policy
p2 FilePath
s) FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Policy -> FilePath -> Maybe FilePath
tryPolicy Policy
p1 FilePath
s))
addBase :: String -> Policy
addBase :: FilePath -> Policy
addBase FilePath
b = (FilePath -> Maybe FilePath) -> Policy
policy (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (FilePath -> FilePath) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
b FilePath -> FilePath -> FilePath
FP.</>))
addSlash :: Policy
addSlash :: Policy
addSlash = (FilePath -> Maybe FilePath) -> Policy
policy FilePath -> Maybe FilePath
slashOpt
where slashOpt :: FilePath -> Maybe FilePath
slashOpt s :: FilePath
s@(Char
'/':FilePath
_) = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
s
slashOpt FilePath
s = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
s)
hasSuffix :: String -> Policy
hasSuffix :: FilePath -> Policy
hasSuffix = (FilePath -> Bool) -> Policy
predicate ((FilePath -> Bool) -> Policy)
-> (FilePath -> FilePath -> Bool) -> FilePath -> Policy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isSuffixOf
hasPrefix :: String -> Policy
hasPrefix :: FilePath -> Policy
hasPrefix = (FilePath -> Bool) -> Policy
predicate ((FilePath -> Bool) -> Policy)
-> (FilePath -> FilePath -> Bool) -> FilePath -> Policy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isPrefixOf
contains :: String -> Policy
contains :: FilePath -> Policy
contains = (FilePath -> Bool) -> Policy
predicate ((FilePath -> Bool) -> Policy)
-> (FilePath -> FilePath -> Bool) -> FilePath -> Policy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isInfixOf
noDots :: Policy
noDots :: Policy
noDots = (FilePath -> Bool) -> Policy
predicate (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
L.isInfixOf FilePath
"..")
isNotAbsolute :: Policy
isNotAbsolute :: Policy
isNotAbsolute = (FilePath -> Bool) -> Policy
predicate ((FilePath -> Bool) -> Policy) -> (FilePath -> Bool) -> Policy
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
FP.isAbsolute
only :: [(String, String)] -> Policy
only :: [(FilePath, FilePath)] -> Policy
only [(FilePath, FilePath)]
al = (FilePath -> Maybe FilePath) -> Policy
policy ((FilePath -> [(FilePath, FilePath)] -> Maybe FilePath)
-> [(FilePath, FilePath)] -> FilePath -> Maybe FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [(FilePath, FilePath)] -> Maybe FilePath
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(FilePath, FilePath)]
al)
static :: Middleware
static :: Middleware
static = Policy -> Middleware
staticPolicy Policy
forall a. Monoid a => a
mempty
{-# DEPRECATED static'
[ "Use 'staticWithOptions' instead. "
, "This function will be removed in the next major release."
] #-}
static' :: CacheContainer -> Middleware
static' :: CacheContainer -> Middleware
static' CacheContainer
cc = CacheContainer -> Policy -> Middleware
staticPolicy' CacheContainer
cc Policy
forall a. Monoid a => a
mempty
staticWithOptions :: Options -> Middleware
staticWithOptions :: Options -> Middleware
staticWithOptions Options
options = Options -> Policy -> Middleware
staticPolicyWithOptions Options
options Policy
forall a. Monoid a => a
mempty
staticPolicy :: Policy -> Middleware
staticPolicy :: Policy -> Middleware
staticPolicy = CacheContainer -> Policy -> Middleware
staticPolicy' (Options -> CacheContainer
cacheContainer Options
defaultOptions)
{-# DEPRECATED staticPolicy'
[ "Use 'staticPolicyWithOptions' instead. "
, "This function will be removed in the next major release."
] #-}
staticPolicy' :: CacheContainer -> Policy -> Middleware
staticPolicy' :: CacheContainer -> Policy -> Middleware
staticPolicy' CacheContainer
cc Policy
p = CacheContainer -> Policy -> Middleware
unsafeStaticPolicy' CacheContainer
cc (Policy -> Middleware) -> Policy -> Middleware
forall a b. (a -> b) -> a -> b
$ Policy
noDots Policy -> Policy -> Policy
>-> Policy
isNotAbsolute Policy -> Policy -> Policy
>-> Policy
p
staticPolicyWithOptions :: Options -> Policy -> Middleware
staticPolicyWithOptions :: Options -> Policy -> Middleware
staticPolicyWithOptions Options
options Policy
p = Options -> Policy -> Middleware
unsafeStaticPolicyWithOptions Options
options (Policy -> Middleware) -> Policy -> Middleware
forall a b. (a -> b) -> a -> b
$ Policy
noDots Policy -> Policy -> Policy
>-> Policy
isNotAbsolute Policy -> Policy -> Policy
>-> Policy
p
unsafeStaticPolicy :: Policy -> Middleware
unsafeStaticPolicy :: Policy -> Middleware
unsafeStaticPolicy = CacheContainer -> Policy -> Middleware
unsafeStaticPolicy' (Options -> CacheContainer
cacheContainer Options
defaultOptions)
{-# DEPRECATED unsafeStaticPolicy'
[ "Use 'unsafeStaticPolicyWithOptions' instead. "
, "This function will be removed in the next major release."
] #-}
unsafeStaticPolicy' :: CacheContainer -> Policy -> Middleware
unsafeStaticPolicy' :: CacheContainer -> Policy -> Middleware
unsafeStaticPolicy' CacheContainer
cc = Options -> Policy -> Middleware
unsafeStaticPolicyWithOptions (Options
defaultOptions { cacheContainer :: CacheContainer
cacheContainer = CacheContainer
cc })
unsafeStaticPolicyWithOptions :: Options -> Policy -> Middleware
unsafeStaticPolicyWithOptions :: Options -> Policy -> Middleware
unsafeStaticPolicyWithOptions Options
options Policy
p Application
app Request
req Response -> IO ResponseReceived
callback =
IO ResponseReceived
-> (FilePath -> IO ResponseReceived)
-> Maybe FilePath
-> IO ResponseReceived
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ResponseReceived
serveUpstream FilePath -> IO ResponseReceived
tryStaticFile Maybe FilePath
mCandidateFile
where
serveUpstream :: IO ResponseReceived
serveUpstream :: IO ResponseReceived
serveUpstream = Application
app Request
req Response -> IO ResponseReceived
callback
tryStaticFile :: FilePath -> IO ResponseReceived
tryStaticFile :: FilePath -> IO ResponseReceived
tryStaticFile FilePath
fp = do
Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
fp
if Bool
exists
then case Options -> CacheContainer
cacheContainer Options
options of
CacheContainer
CacheContainerEmpty ->
FilePath -> [(HeaderName, Method)] -> IO ResponseReceived
sendFile FilePath
fp []
CacheContainer FilePath -> IO FileMeta
_ CachingStrategy
NoCaching ->
FilePath -> [(HeaderName, Method)] -> IO ResponseReceived
sendFile FilePath
fp []
CacheContainer FilePath -> IO FileMeta
getFileMeta CachingStrategy
strategy ->
do FileMeta
fileMeta <- FilePath -> IO FileMeta
getFileMeta FilePath
fp
if FileMeta -> Maybe Method -> Maybe Method -> Bool
checkNotModified FileMeta
fileMeta (HeaderName -> Maybe Method
readHeader HeaderName
"If-Modified-Since") (HeaderName -> Maybe Method
readHeader HeaderName
"If-None-Match")
then FileMeta -> CachingStrategy -> IO ResponseReceived
sendNotModified FileMeta
fileMeta CachingStrategy
strategy
else FilePath -> [(HeaderName, Method)] -> IO ResponseReceived
sendFile FilePath
fp (FileMeta -> CachingStrategy -> [(HeaderName, Method)]
computeHeaders FileMeta
fileMeta CachingStrategy
strategy)
else IO ResponseReceived
serveUpstream
mCandidateFile :: Maybe FilePath
mCandidateFile :: Maybe FilePath
mCandidateFile =
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
isHeadOrGet Maybe () -> Maybe FilePath -> Maybe FilePath
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(Policy -> FilePath -> Maybe FilePath
tryPolicy Policy
p (FilePath -> Maybe FilePath) -> FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack (Text -> FilePath) -> Text -> FilePath
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"/" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Request -> [Text]
pathInfo Request
req)
where
method :: Method
method :: Method
method = Request -> Method
requestMethod Request
req
isHeadOrGet :: Bool
isHeadOrGet :: Bool
isHeadOrGet = Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
methodHead Bool -> Bool -> Bool
|| Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
methodGet
readHeader :: HeaderName -> Maybe Method
readHeader HeaderName
header =
HeaderName -> [(HeaderName, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header ([(HeaderName, Method)] -> Maybe Method)
-> [(HeaderName, Method)] -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Request -> [(HeaderName, Method)]
requestHeaders Request
req
checkNotModified :: FileMeta -> Maybe Method -> Maybe Method -> Bool
checkNotModified FileMeta
fm Maybe Method
modSince Maybe Method
etag =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Method -> Maybe Method
forall a. a -> Maybe a
Just (FileMeta -> Method
fm_lastModified FileMeta
fm) Maybe Method -> Maybe Method -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Method
modSince
, Method -> Maybe Method
forall a. a -> Maybe a
Just (FileMeta -> Method
fm_etag FileMeta
fm) Maybe Method -> Maybe Method -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Method
etag
]
computeHeaders :: FileMeta -> CachingStrategy -> [(HeaderName, Method)]
computeHeaders FileMeta
fm CachingStrategy
cs =
case CachingStrategy
cs of
CachingStrategy
NoCaching -> []
CachingStrategy
PublicStaticCaching ->
[ (HeaderName
"Cache-Control", Method
"no-transform,public,max-age=300,s-maxage=900")
, (HeaderName
"Last-Modified", FileMeta -> Method
fm_lastModified FileMeta
fm)
, (HeaderName
"ETag", FileMeta -> Method
fm_etag FileMeta
fm)
, (HeaderName
"Vary", Method
"Accept-Encoding")
]
CustomCaching FileMeta -> [(HeaderName, Method)]
f -> FileMeta -> [(HeaderName, Method)]
f FileMeta
fm
sendNotModified :: FileMeta -> CachingStrategy -> IO ResponseReceived
sendNotModified FileMeta
fm CachingStrategy
cs =
do let cacheHeaders :: [(HeaderName, Method)]
cacheHeaders = FileMeta -> CachingStrategy -> [(HeaderName, Method)]
computeHeaders FileMeta
fm CachingStrategy
cs
Response -> IO ResponseReceived
callback (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status -> [(HeaderName, Method)] -> ByteString -> Response
responseLBS Status
status304 [(HeaderName, Method)]
cacheHeaders ByteString
BSL.empty
sendFile :: FilePath -> [(HeaderName, Method)] -> IO ResponseReceived
sendFile FilePath
fp [(HeaderName, Method)]
extraHeaders =
do let basicHeaders :: [(HeaderName, Method)]
basicHeaders =
[ (HeaderName
"Content-Type", Options -> FilePath -> Method
mimeTypes Options
options FilePath
fp)
]
headers :: [(HeaderName, Method)]
headers =
[(HeaderName, Method)]
basicHeaders [(HeaderName, Method)]
-> [(HeaderName, Method)] -> [(HeaderName, Method)]
forall a. [a] -> [a] -> [a]
++ [(HeaderName, Method)]
extraHeaders
Response -> IO ResponseReceived
callback (Response -> IO ResponseReceived)
-> Response -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Status
-> [(HeaderName, Method)] -> FilePath -> Maybe FilePart -> Response
responseFile Status
status200 [(HeaderName, Method)]
headers FilePath
fp Maybe FilePart
forall a. Maybe a
Nothing
data CacheContainer
= CacheContainerEmpty
| CacheContainer (FilePath -> IO FileMeta) CachingStrategy
data FileMeta
= FileMeta
{ FileMeta -> Method
fm_lastModified :: !BS.ByteString
, FileMeta -> Method
fm_etag :: !BS.ByteString
, FileMeta -> FilePath
fm_fileName :: FilePath
} deriving (Int -> FileMeta -> FilePath -> FilePath
[FileMeta] -> FilePath -> FilePath
FileMeta -> FilePath
(Int -> FileMeta -> FilePath -> FilePath)
-> (FileMeta -> FilePath)
-> ([FileMeta] -> FilePath -> FilePath)
-> Show FileMeta
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FileMeta -> FilePath -> FilePath
showsPrec :: Int -> FileMeta -> FilePath -> FilePath
$cshow :: FileMeta -> FilePath
show :: FileMeta -> FilePath
$cshowList :: [FileMeta] -> FilePath -> FilePath
showList :: [FileMeta] -> FilePath -> FilePath
Show, FileMeta -> FileMeta -> Bool
(FileMeta -> FileMeta -> Bool)
-> (FileMeta -> FileMeta -> Bool) -> Eq FileMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileMeta -> FileMeta -> Bool
== :: FileMeta -> FileMeta -> Bool
$c/= :: FileMeta -> FileMeta -> Bool
/= :: FileMeta -> FileMeta -> Bool
Eq)
initCaching :: CachingStrategy -> IO CacheContainer
initCaching :: CachingStrategy -> IO CacheContainer
initCaching CachingStrategy
cs =
do let cacheAccess :: Maybe s -> FilePath -> IO (Int, (Maybe s, FileMeta))
cacheAccess =
Int
-> (Maybe s -> FilePath -> IO (Maybe s, FileMeta))
-> Maybe s
-> FilePath
-> IO (Int, (Maybe s, FileMeta))
forall (m :: * -> *) k s v.
(Monad m, Eq k, Hashable k) =>
Int
-> (Maybe s -> k -> m (Maybe s, v))
-> Maybe s
-> k
-> m (Int, (Maybe s, v))
consistentDuration Int
100 ((Maybe s -> FilePath -> IO (Maybe s, FileMeta))
-> Maybe s -> FilePath -> IO (Int, (Maybe s, FileMeta)))
-> (Maybe s -> FilePath -> IO (Maybe s, FileMeta))
-> Maybe s
-> FilePath
-> IO (Int, (Maybe s, FileMeta))
forall a b. (a -> b) -> a -> b
$ \Maybe s
state FilePath
fp ->
do FileMeta
fileMeta <- FilePath -> IO FileMeta
computeFileMeta FilePath
fp
(Maybe s, FileMeta) -> IO (Maybe s, FileMeta)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe s, FileMeta) -> IO (Maybe s, FileMeta))
-> (Maybe s, FileMeta) -> IO (Maybe s, FileMeta)
forall a b. (a -> b) -> a -> b
$! (Maybe s
state, FileMeta
fileMeta)
cacheTick :: IO Int
cacheTick =
do POSIXTime
time <- IO POSIXTime
getPOSIXTime
Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (POSIXTime -> Int
forall b. Integral b => POSIXTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime
time POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
100))
cacheFreq :: ECMIncr
cacheFreq = ECMIncr
1
cacheLRU :: CacheSettings
cacheLRU =
Int -> Int -> Int -> CacheSettings
CacheWithLRUList Int
100 Int
100 Int
200
ECM IO MVar Any HashMap FilePath FileMeta
filecache <- (Maybe Any -> FilePath -> IO (Int, (Maybe Any, FileMeta)))
-> IO Int
-> ECMIncr
-> CacheSettings
-> IO (ECM IO MVar Any HashMap FilePath FileMeta)
forall k s v.
(Eq k, Hashable k) =>
(Maybe s -> k -> IO (Int, (Maybe s, v)))
-> IO Int
-> ECMIncr
-> CacheSettings
-> IO (ECM IO MVar s HashMap k v)
newECMIO Maybe Any -> FilePath -> IO (Int, (Maybe Any, FileMeta))
forall {s}. Maybe s -> FilePath -> IO (Int, (Maybe s, FileMeta))
cacheAccess IO Int
cacheTick ECMIncr
cacheFreq CacheSettings
cacheLRU
CacheContainer -> IO CacheContainer
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> IO FileMeta) -> CachingStrategy -> CacheContainer
CacheContainer (ECM IO MVar Any HashMap FilePath FileMeta
-> FilePath -> IO FileMeta
forall (m :: * -> *) k (mv :: * -> *) s v.
(Monad m, Eq k, Hashable k) =>
ECM m mv s HashMap k v -> k -> m v
lookupECM ECM IO MVar Any HashMap FilePath FileMeta
filecache) CachingStrategy
cs)
computeFileMeta :: FilePath -> IO FileMeta
computeFileMeta :: FilePath -> IO FileMeta
computeFileMeta FilePath
fp =
do UTCTime
mtime <- FilePath -> IO UTCTime
getModificationTime FilePath
fp
ByteString
ct <- FilePath -> IO ByteString
BSL.readFile FilePath
fp
FileMeta -> IO FileMeta
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileMeta -> IO FileMeta) -> FileMeta -> IO FileMeta
forall a b. (a -> b) -> a -> b
$ FileMeta
{ fm_lastModified :: Method
fm_lastModified =
FilePath -> Method
BSC.pack (FilePath -> Method) -> FilePath -> Method
forall a b. (a -> b) -> a -> b
$ TimeLocale -> FilePath -> UTCTime -> FilePath
forall t. FormatTime t => TimeLocale -> FilePath -> t -> FilePath
formatTime TimeLocale
defaultTimeLocale FilePath
"%a, %d-%b-%Y %X %Z" UTCTime
mtime
, fm_etag :: Method
fm_etag = Method -> Method
Base16.encode (ByteString -> Method
SHA1.hashlazy ByteString
ct)
, fm_fileName :: FilePath
fm_fileName = FilePath
fp
}
getMimeType :: FilePath -> MimeType
getMimeType :: FilePath -> Method
getMimeType = Text -> Method
defaultMimeLookup (Text -> Method) -> (FilePath -> Text) -> FilePath -> Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack