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

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

    -- * file-embed re-export
    embedFile,
) where

import Data.Binary.Builder (Builder, fromByteString)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 (breakEnd, pack)
import Data.ByteString.Char8 qualified as BS8
import Data.FileEmbed (embedFile)
import Data.Map.Strict qualified as Map
import Data.Version (Version, showVersion)
import Network.HTTP.Types.Header (ResponseHeaders)
import Network.HTTP.Types.Status qualified as HTTP
import Network.Wai qualified

-- | A static file definition
data XStaticFile = XStaticFile
    { XStaticFile -> ByteString
name :: ByteString
    -- ^ The expected request filename. The name must not have any slash '/'.
    , XStaticFile -> ByteString
content :: ByteString
    -- ^ The file content gzip compressed.
    , XStaticFile -> Version
contentVersion :: Version
    -- ^ The file version for the etag header.
    , XStaticFile -> ByteString
contentType :: ByteString
    -- ^ The content type, e.g. `text/javascript` or `text/css`.
    }

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

 The request are served whenever the basename match, ignoring the parent directory or the query string.
-}
xstaticApp :: [XStaticFile] -> Network.Wai.Application
xstaticApp :: [XStaticFile] -> Application
xstaticApp [XStaticFile]
xs = \Request
req Response -> IO ResponseReceived
resp ->
    let (ByteString
_, ByteString
basename) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
breakEnd (forall a. Eq a => a -> a -> Bool
== Char
'/') (Request -> ByteString
Network.Wai.rawPathInfo Request
req)
     in Response -> IO ResponseReceived
resp forall a b. (a -> b) -> a -> b
$ case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ByteString
basename Map ByteString (Builder, ResponseHeaders)
files of
            Just (Builder
builder, ResponseHeaders
headers) ->
                let body :: Builder
body = case Request -> ByteString
Network.Wai.requestMethod Request
req of
                        ByteString
"HEAD" -> forall a. Monoid a => a
mempty
                        ByteString
_ -> Builder
builder
                 in Status -> ResponseHeaders -> Builder -> Response
Network.Wai.responseBuilder Status
HTTP.status200 ResponseHeaders
headers Builder
body
            Maybe (Builder, ResponseHeaders)
Nothing -> Status -> ResponseHeaders -> ByteString -> Response
Network.Wai.responseLBS Status
HTTP.status404 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
  where
    files :: Map.Map ByteString (Builder, ResponseHeaders)
    files :: Map ByteString (Builder, ResponseHeaders)
files = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map XStaticFile -> (ByteString, (Builder, ResponseHeaders))
toItem [XStaticFile]
xs

    toItem :: XStaticFile -> (ByteString, (Builder, ResponseHeaders))
    toItem :: XStaticFile -> (ByteString, (Builder, ResponseHeaders))
toItem XStaticFile
xf =
        ( XStaticFile -> ByteString
name XStaticFile
xf
        ,
            ( ByteString -> Builder
fromByteString forall a b. (a -> b) -> a -> b
$ XStaticFile -> ByteString
content XStaticFile
xf
            , (ByteString -> ResponseHeaders -> ResponseHeaders
addGzipHeader forall a b. (a -> b) -> a -> b
$ XStaticFile -> ByteString
content XStaticFile
xf)
                [ (HeaderName
"cache-control", ByteString
"public, max-age=604800")
                , (HeaderName
"content-length", String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
BS.length forall a b. (a -> b) -> a -> b
$ XStaticFile -> ByteString
content XStaticFile
xf)
                , (HeaderName
"content-type", XStaticFile -> ByteString
contentType XStaticFile
xf)
                , (HeaderName
"connection", ByteString
"keep-alive")
                , (HeaderName
"etag", Version -> ByteString
versionToEtag forall a b. (a -> b) -> a -> b
$ XStaticFile -> Version
contentVersion XStaticFile
xf)
                , (HeaderName
"keep-alive", ByteString
"timeout=5, max=100")
                ]
            )
        )

addGzipHeader :: ByteString -> ResponseHeaders -> ResponseHeaders
addGzipHeader :: ByteString -> ResponseHeaders -> ResponseHeaders
addGzipHeader ByteString
fileContent
    | ByteString -> Bool
isGzip ByteString
fileContent = ((HeaderName
"content-encoding", ByteString
"gzip") forall a. a -> [a] -> [a]
:)
    | Bool
otherwise = forall a. a -> a
id

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

versionToEtag :: Version -> ByteString
versionToEtag :: Version -> ByteString
versionToEtag = [ByteString] -> ByteString
BS8.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> [ByteString]
BS8.split Char
'.' forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion