    {-# LANGUAGE CPP, OverloadedStrings #-}
    -- | Serve static files, subject to a policy that can filter or
    --   modify incoming URIs. The flow is:
    --
    --   incoming request URI ==> policies ==> exists? ==> respond
    --
    --   If any of the polices fail, or the file doesn't
    --   exist, then the middleware gives up and calls the inner application.
    --   If the file is found, the middleware chooses a content type based
    --   on the file extension and returns the file contents as the response.
    module Network.Wai.Middleware.Static
        ( -- * Middlewares
          static, staticPolicy, unsafeStaticPolicy
        , static', staticPolicy', unsafeStaticPolicy'
        , staticWithOptions, staticPolicyWithOptions, unsafeStaticPolicyWithOptions
        , -- * Options
          Options, cacheContainer, mimeTypes, defaultOptions
        , -- * Cache Control
          CachingStrategy(..), FileMeta(..), initCaching, CacheContainer
        , -- * Policies
          Policy, (<|>), (>->), policy, predicate
        , addBase, addSlash, contains, hasPrefix, hasSuffix, noDots, isNotAbsolute, only
        , -- * Utilities
          tryPolicy
        , -- * MIME types
          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,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)
    -- import Crypto.Hash.Algorithms
    -- import Crypto.Hash
    -- import Data.ByteArray.Encoding
    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

    -- | Take an incoming URI and optionally modify or filter it.
    --   The result will be treated as a filepath.
    newtype Policy = Policy { Policy -> FilePath -> Maybe FilePath
    tryPolicy :: String -> Maybe FilePath -- ^ Run a policy
                            }

    -- | Options for 'staticWithOptions' 'Middleware'.
    --
    -- Options can be set using record syntax on 'defaultOptions' with the fields below.
    data Options = Options { Options -> CacheContainer
    cacheContainer :: CacheContainer -- ^ Cache container to use
                           , Options -> FilePath -> Method
    mimeTypes :: FilePath -> MimeType -- ^ Compute MimeType from file name
                           }

    -- | Default options.
    --
    -- @
    -- 'Options'
    -- { 'cacheContainer' = 'CacheContainerEmpty' -- no caching
    -- , 'mimeTypes'      = 'getMimeType'         -- use 'defaultMimeLookup' from 'Network.Mime'
    -- }
    -- @
    defaultOptions :: Options
    defaultOptions :: Options
    defaultOptions = Options { cacheContainer :: CacheContainer
    cacheContainer = CacheContainer
    CacheContainerEmpty, mimeTypes :: FilePath -> Method
    mimeTypes = FilePath -> Method
    getMimeType }

    -- | A cache strategy which should be used to
    -- serve content matching a policy. Meta information is cached for a maxium of
    -- 100 seconds before being recomputed.
    data CachingStrategy
       -- | Do not send any caching headers
       = NoCaching
       -- | Send common caching headers for public (non dynamic) static files
       | PublicStaticCaching
       -- | Compute caching headers using the user specified function.
       -- See <http://www.mobify.com/blog/beginners-guide-to-http-cache-headers/> for a detailed guide
       | CustomCaching (FileMeta -> RequestHeaders)

    -- | Note:
    --   '(<>)' == @>->@ (policy sequencing)
    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)

    -- | Note:
    --   'mempty' == @policy Just@ (the always accepting policy)
    --   'mappend' == @>->@ (policy sequencing)
    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
    (<>)

    -- | Lift a function into a 'Policy'
    policy :: (String -> Maybe String) -> Policy
    policy :: (FilePath -> Maybe FilePath) -> Policy
    policy = (FilePath -> Maybe FilePath) -> Policy
    Policy

    -- | Lift a predicate into a '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)

    -- | Sequence two policies. They are run from left to right. (Note: this is `mappend`)
    infixr 5 >->
    (>->) :: Policy -> Policy -> Policy
    >-> :: Policy -> Policy -> Policy
    (>->) = Policy -> Policy -> Policy
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Choose between two policies. If the first fails, run the second.
    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))

    -- | Add a base path to the URI
    --
    -- > staticPolicy (addBase "/home/user/files")
    --
    -- GET \"foo\/bar\" looks for \"\/home\/user\/files\/foo\/bar\"
    --
    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.</>))

    -- | Add an initial slash to to the URI, if not already present.
    --
    -- > staticPolicy addSlash
    --
    -- GET \"foo\/bar\" looks for \"\/foo\/bar\"
    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)

    -- | Accept only URIs with given suffix
    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

    -- | Accept only URIs with given prefix
    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

    -- | Accept only URIs containing given string
    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

    -- | Reject URIs containing \"..\"
    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
    "..")

    -- | Reject URIs that are absolute paths
    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

    -- | Use URI as the key to an association list, rejecting those not found.
    -- The policy result is the matching value.
    --
    -- > staticPolicy (only [("foo/bar", "/home/user/files/bar")])
    --
    -- GET \"foo\/bar\" looks for \"\/home\/user\/files\/bar\"
    -- GET \"baz\/bar\" doesn't match anything
    --
    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)

    -- | Serve static files out of the application root (current directory).
    -- If file is found, it is streamed to the client and no further middleware is run. Disables caching.
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    static :: Middleware
    static :: Middleware
    static = Policy -> Middleware
    staticPolicy Policy
    forall a. Monoid a => a
    mempty

    -- | Serve static files out of the application root (current directory).
    -- If file is found, it is streamed to the client and no further middleware is run. Allows a 'CachingStrategy'.
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    {-# 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

    -- | Serve static files out of the application root (current directory).
    -- If file is found, it is streamed to the client and no further middleware is run. Takes 'Options'.
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    staticWithOptions :: Options -> Middleware
    staticWithOptions :: Options -> Middleware
    staticWithOptions Options
    options = Options -> Policy -> Middleware
    staticPolicyWithOptions Options
    options Policy
    forall a. Monoid a => a
    mempty

    -- | Serve static files subject to a 'Policy'. Disables caching.
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    staticPolicy :: Policy -> Middleware
    staticPolicy :: Policy -> Middleware
    staticPolicy = CacheContainer -> Policy -> Middleware
    staticPolicy' (Options -> CacheContainer
    cacheContainer Options
    defaultOptions)

    -- | Serve static files subject to a 'Policy' using a specified 'CachingStrategy'
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    {-# 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

    -- | Serve static files subject to a 'Policy' using specified 'Options'
    --
    -- Note: for security reasons, this uses the 'noDots' and 'isNotAbsolute' policy by default.
    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

    -- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this
    -- has no policies enabled by default and is hence insecure. Disables caching.
    unsafeStaticPolicy :: Policy -> Middleware
    unsafeStaticPolicy :: Policy -> Middleware
    unsafeStaticPolicy = CacheContainer -> Policy -> Middleware
    unsafeStaticPolicy' (Options -> CacheContainer
    cacheContainer Options
    defaultOptions)

    -- | Serve static files subject to a 'Policy'. Unlike 'static' and 'staticPolicy', this
    -- has no policies enabled by default, and is hence insecure. Also allows to set a 'CachingStrategy'.
    {-# 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 = cc })

    -- | Serve static files subject to a 'Policy'. Unlike 'staticWithOptions' and 'staticPolicyWithOptions',
    -- this has no policies enabled by default and is hence insecure. Takes 'Options'.
    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
              exists <- FilePath -> IO Bool
    doesFileExist FilePath
    fp
              if exists
                      then case cacheContainer 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 <- FilePath -> IO FileMeta
    getFileMeta FilePath
    fp
                                    if checkNotModified fileMeta (readHeader "If-Modified-Since") (readHeader "If-None-Match")
                                    then sendNotModified fileMeta strategy
                                    else sendFile fp (computeHeaders fileMeta strategy)
                      else 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

    -- | Container caching file meta information. Create using 'initCaching'
    data CacheContainer
        = CacheContainerEmpty
        | CacheContainer (FilePath -> IO FileMeta) CachingStrategy

    -- | Meta information about a file to calculate cache headers
    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)

    -- | Initialize caching. This should only be done once per application launch.
    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 <- FilePath -> IO FileMeta
    computeFileMeta FilePath
    fp
                          return $! (state, fileMeta)
               cacheTick :: IO Int
    cacheTick =
                   do time <- IO POSIXTime
    getPOSIXTime
                      return (round (time * 100))
               cacheFreq :: ECMIncr
    cacheFreq = ECMIncr
    1
               cacheLRU :: CacheSettings
    cacheLRU =
                   Int -> Int -> Int -> CacheSettings
    CacheWithLRUList Int
    100 Int
    100 Int
    200
           filecache <- (Maybe (ZonkAny 0)
     -> FilePath -> IO (Int, (Maybe (ZonkAny 0), FileMeta)))
    -> IO Int
    -> ECMIncr
    -> CacheSettings
    -> IO (ECM IO MVar (ZonkAny 0) 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 (ZonkAny 0)
    -> FilePath -> IO (Int, (Maybe (ZonkAny 0), FileMeta))
    forall {s}. Maybe s -> FilePath -> IO (Int, (Maybe s, FileMeta))
    cacheAccess IO Int
    cacheTick ECMIncr
    cacheFreq CacheSettings
    cacheLRU
           return (CacheContainer (lookupECM filecache) cs)

    computeFileMeta :: FilePath -> IO FileMeta
    computeFileMeta :: FilePath -> IO FileMeta
    computeFileMeta FilePath
    fp =
        do mtime <- FilePath -> IO UTCTime
    getModificationTime FilePath
    fp
           ct <- BSL.readFile fp
           return $ FileMeta
                    { fm_lastModified =
                          BSC.pack $ formatTime defaultTimeLocale "%a, %d-%b-%Y %X %Z" mtime
                    , fm_etag = Base16.encode (SHA1.hashlazy ct)
                    , fm_fileName = fp
                    }

    -- | Guess MIME type from file extension
    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