{-# 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 ByteString
refPath ByteString
path FilePath
file = case ByteString -> Maybe ByteString
getCT ByteString
path of
Maybe ByteString
Nothing -> Maybe PushPromise -> IO (Maybe PushPromise)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PushPromise
forall a. Maybe a
Nothing
Just ByteString
ct -> do
let pp :: PushPromise
pp = PushPromise
defaultPushPromise {
promisedPath = path
, promisedFile = file
, promisedResponseHeaders = [("content-type", ct)
,("x-http2-push", refPath)]
}
Maybe PushPromise -> IO (Maybe PushPromise)
forall a. a -> IO a
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 :: ByteString -> Maybe ByteString
getCT ByteString
p
| ByteString
".js" ByteString -> ByteString -> Bool
`BS.isSuffixOf` ByteString
p = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"application/javascript"
| ByteString
".css" ByteString -> ByteString -> Bool
`BS.isSuffixOf` ByteString
p = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"text/css"
| Bool
otherwise = Maybe ByteString
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 = Settings {
makePushPromise :: MakePushPromise
makePushPromise = MakePushPromise
defaultMakePushPromise
, duration :: Int
duration = Int
0
, keyLimit :: Int
keyLimit = Int
20
, valueLimit :: Int
valueLimit = Int
20
}