{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
module XStatic (
XStaticFile (..),
xstaticApp,
xstaticMiddleware,
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
data XStaticFile = XStaticFile
{ XStaticFile -> ByteString
xfPath :: ByteString
, XStaticFile -> ByteString
xfContent :: ByteString
, XStaticFile -> ByteString
xfETag :: ByteString
, XStaticFile -> ByteString
xfType :: ByteString
}
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")
]
)
)
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
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"