xstatic-0.2.0: src/XStatic.hs

{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}

module XStatic (
    -- * xstatic api
    XStaticFile (..),
    xstaticApp,
    xstaticMiddleware,

    -- * helpers
    isGzip,
) where

import Data.Binary.Builder (Builder, fromByteString)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 (pack)
import Data.ByteString.Unsafe qualified as BS (unsafeDrop)
import Data.Map.Strict qualified as Map
import Network.HTTP.Types.Header (ResponseHeaders)
import Network.HTTP.Types.Status qualified as HTTP
import Network.Wai qualified

{- | A static file definition.

 Use the @xstatic-th@ or @file-embed@ library to embed a local file.
-}
data XStaticFile = XStaticFile
    { xfPath :: ByteString
    -- ^ The expected request path.
    , xfContent :: ByteString
    -- ^ The file content.
    , xfETag :: ByteString
    -- ^ The etag header value.
    , xfType :: ByteString
    -- ^ The content type, e.g. \"application\/javascript\" or \"text\/css\".
    }

{- | Create a wai application to serve 'XStaticFile'.

 The \"\/xstatic\/\" request path prefix is ignored.
-}
xstaticApp :: [XStaticFile] -> Network.Wai.Application
xstaticApp xs = \req resp -> do
    let basePath = Network.Wai.rawPathInfo req
        requestPath
            | "/xstatic/" `BS.isPrefixOf` basePath = BS.unsafeDrop 8 basePath
            | otherwise = basePath

    resp $ case Map.lookup requestPath files of
        Just (builder, headers) ->
            let body = case Network.Wai.requestMethod req of
                    "HEAD" -> mempty
                    _ -> builder
             in Network.Wai.responseBuilder HTTP.status200 headers body
        Nothing -> Network.Wai.responseLBS HTTP.status404 mempty mempty
  where
    files :: Map.Map ByteString (Builder, ResponseHeaders)
    files = Map.fromList $ map toItem xs

    toItem :: XStaticFile -> (ByteString, (Builder, ResponseHeaders))
    toItem xf =
        ( xfPath xf
        ,
            ( fromByteString $ xfContent xf
            , (addGzipHeader $ xfContent xf)
                [ ("cache-control", "public, max-age=604800")
                , ("content-length", pack . show . BS.length $ xfContent xf)
                , ("content-type", xfType xf)
                , ("connection", "keep-alive")
                , ("etag", xfETag xf)
                , ("keep-alive", "timeout=5, max=100")
                ]
            )
        )

-- | Serve 'XStaticFile' using 'xstaticApp' when the provided application returns a 404.
xstaticMiddleware :: [XStaticFile] -> Network.Wai.Middleware
xstaticMiddleware xs app req resp = app req handleAppResp
  where
    staticApp = xstaticApp xs
    handleAppResp appResp = case HTTP.statusCode (Network.Wai.responseStatus appResp) of
        404 -> staticApp req resp
        _ -> resp appResp

addGzipHeader :: ByteString -> ResponseHeaders -> ResponseHeaders
addGzipHeader fileContent
    | isGzip fileContent = (("content-encoding", "gzip") :)
    | otherwise = id

isGzip :: ByteString -> Bool
isGzip = BS.isPrefixOf "\x1f\x8b\x08" -- the gzip magic number for deflate