@@ -1,8 +1,11 @@
11{-# LANGUAGE BangPatterns, OverloadedStrings #-}
22
3+-- | Middleware for server push learning dependency based on Referer:.
34module Network.Wai.Middleware.Push.Referer (
45 pushOnReferer
6+ , MakePushPromise
57 , defaultMakePushPromise
8+ , URLPath
69 ) where
710
811import Control.Monad (when)
@@ -28,6 +31,19 @@ import System.IO.Unsafe (unsafePerformIO)
2831-- $setup
2932-- >>> :set -XOverloadedStrings
3033
34+-- | Making a push promise based on Referer:,
35+-- path to be pushed and file to be pushed.
36+-- If the middleware should push this file in the next time when
37+-- the page of Referer: is accessed,
38+-- this function should return 'Just'.
39+-- If 'Nothing' is returned,
40+-- the middleware learns nothing.
41+type MakePushPromise = URLPath -- ^ path in referer
42+ -> URLPath -- ^ path to be pushed
43+ -> FilePath -- ^ file to be pushed
44+ -> IO (Maybe PushPromise)
45+
46+-- | Type for URL path.
3147type URLPath = ByteString
3248
3349type Cache = Map URLPath (Set PushPromise)
@@ -45,6 +61,7 @@ settings = defaultReaperSettings {
4561 , reaperCons = insert
4662 , reaperNull = M.null
4763 , reaperEmpty = emptyCache
64+-- , reaperDelay = 30000000 -- FIXME hard-coding
4865 }
4966
5067insert :: (URLPath,PushPromise) -> Cache -> Cache
@@ -53,8 +70,10 @@ insert (path,pp) m = M.alter ins path m
5370 ins Nothing = Just $ S.singleton pp
5471 ins (Just set) = Just $ S.insert pp set
5572
56−pushOnReferer :: (URLPath -> URLPath -> FilePath -> IO (Maybe PushPromise))
57− -> Middleware
73+-- | The middleware to push files based on Referer:.
74+-- Learning strategy is implemented in the first argument.
75+-- Learning information is kept for 30 seconds.
76+pushOnReferer :: MakePushPromise -> Middleware
5877pushOnReferer func app req sendResponse = app req $ \res -> do
5978 let !path = rawPathInfo req
6079 m <- reaperRead cacheReaper
@@ -78,10 +97,9 @@ pushOnReferer func app req sendResponse = app req $ \res -> do
7897 setHTTP2Data req (Just h2d)
7998 sendResponse res
8099
81−defaultMakePushPromise :: URLPath -- ^ path in referer
82− -> URLPath -- ^ path to be pushed
83− -> FilePath -- ^ file to be pushed
84− -> IO (Maybe PushPromise)
100+-- | Learn if the file to be pushed is CSS (.css) or JavaScript (.js) file
101+-- AND the Referer: ends with \"/\" or \".html\" or \".htm\".
102+defaultMakePushPromise :: MakePushPromise
85103defaultMakePushPromise refPath path file
86104 | isHTML refPath = case getCT path of
87105 Nothing -> return Nothing