{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Middleware.Push.Referer.Types (
URLPath
, MakePushPromise
, defaultMakePushPromise
, Settings(..)
, defaultSettings
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Network.Wai.Handler.Warp (PushPromise(..), defaultPushPromise)
type URLPath = ByteString
type MakePushPromise = URLPath
-> URLPath
-> FilePath
-> IO (Maybe PushPromise)
defaultMakePushPromise :: MakePushPromise
defaultMakePushPromise :: MakePushPromise
defaultMakePushPromise refPath :: URLPath
refPath path :: URLPath
path file :: FilePath
file = case URLPath -> Maybe URLPath
getCT URLPath
path of
Nothing -> Maybe PushPromise -> IO (Maybe PushPromise)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PushPromise
forall a. Maybe a
Nothing
Just ct :: URLPath
ct -> do
let pp :: PushPromise
pp = PushPromise
defaultPushPromise {
promisedPath :: URLPath
promisedPath = URLPath
path
, promisedFile :: FilePath
promisedFile = FilePath
file
, promisedResponseHeaders :: ResponseHeaders
promisedResponseHeaders = [("content-type", URLPath
ct)
,("x-http2-push", URLPath
refPath)]
}
Maybe PushPromise -> IO (Maybe PushPromise)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PushPromise -> IO (Maybe PushPromise))
-> Maybe PushPromise -> IO (Maybe PushPromise)
forall a b. (a -> b) -> a -> b
$ PushPromise -> Maybe PushPromise
forall a. a -> Maybe a
Just PushPromise
pp
getCT :: URLPath -> Maybe ByteString
getCT :: URLPath -> Maybe URLPath
getCT p :: URLPath
p
| ".js" URLPath -> URLPath -> Bool
`BS.isSuffixOf` URLPath
p = URLPath -> Maybe URLPath
forall a. a -> Maybe a
Just "application/javascript"
| ".css" URLPath -> URLPath -> Bool
`BS.isSuffixOf` URLPath
p = URLPath -> Maybe URLPath
forall a. a -> Maybe a
Just "text/css"
| Bool
otherwise = Maybe URLPath
forall a. Maybe a
Nothing
data Settings = Settings {
Settings -> MakePushPromise
makePushPromise :: MakePushPromise
, Settings -> Int
duration :: Int
, Settings -> Int
keyLimit :: Int
, Settings -> Int
valueLimit :: Int
}
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = $WSettings :: MakePushPromise -> Int -> Int -> Int -> Settings
Settings {
makePushPromise :: MakePushPromise
makePushPromise = MakePushPromise
defaultMakePushPromise
, duration :: Int
duration = 0
, keyLimit :: Int
keyLimit = 20
, valueLimit :: Int
valueLimit = 20
}