{-# 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 for URL path.
type URLPath = ByteString

-- | Making a push promise based on Referer:,
--   path to be pushed and file to be pushed.
--   If the middleware should push this file in the next time when
--   the page of Referer: is accessed,
--   this function should return 'Just'.
--   If 'Nothing' is returned,
--   the middleware learns nothing.
type MakePushPromise = URLPath  -- ^ path in referer  (key: /index.html)
                    -> URLPath  -- ^ path to be pushed (value: /style.css)
                    -> FilePath -- ^ file to be pushed (file_path/style.css)
                    -> IO (Maybe PushPromise)

-- | Learn if the file to be pushed is CSS (.css) or JavaScript (.js) file.
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

-- | Settings for server push based on Referer:.
data Settings = Settings {
    Settings -> MakePushPromise
makePushPromise :: MakePushPromise -- ^ Default: 'defaultMakePushPromise'
  , Settings -> Int
duration :: Int -- ^ Deprecated
  , Settings -> Int
keyLimit :: Int -- ^ Max number of keys (e.g. index.html) in the learning information. Default: 20
  , Settings -> Int
valueLimit :: Int -- ^ Max number of values (e.g. style.css) in the learning information. Default: 20
  }

-- | Default settings.
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
  }