{-# 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
    { XStaticFile -> ByteString
xfPath :: ByteString
    -- ^ The expected request path.
    , XStaticFile -> ByteString
xfContent :: ByteString
    -- ^ The file content.
    , XStaticFile -> ByteString
xfETag :: ByteString
    -- ^ The etag header value.
    , XStaticFile -> ByteString
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 :: [XStaticFile] -> Application
xstaticApp [XStaticFile]
xs = \Request
req Response -> IO ResponseReceived
resp -> do
    let basePath :: ByteString
basePath = Request -> ByteString
Network.Wai.rawPathInfo Request
req
        requestPath :: ByteString
requestPath
            | ByteString
"/xstatic/" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
basePath = Int -> ByteString -> ByteString
BS.unsafeDrop Int
8 ByteString
basePath
            | Bool
otherwise = ByteString
basePath

    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
requestPath 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
xfPath XStaticFile
xf
        ,
            ( ByteString -> Builder
fromByteString forall a b. (a -> b) -> a -> b
$ XStaticFile -> ByteString
xfContent XStaticFile
xf
            , (ByteString -> ResponseHeaders -> ResponseHeaders
addGzipHeader forall a b. (a -> b) -> a -> b
$ XStaticFile -> ByteString
xfContent 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
xfContent XStaticFile
xf)
                , (HeaderName
"content-type", XStaticFile -> ByteString
xfType XStaticFile
xf)
                , (HeaderName
"connection", ByteString
"keep-alive")
                , (HeaderName
"etag", XStaticFile -> ByteString
xfETag XStaticFile
xf)
                , (HeaderName
"keep-alive", ByteString
"timeout=5, max=100")
                ]
            )
        )

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

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