packages feed

wai-http2-extra 0.1.2 → 0.1.3

raw patch · 8 files changed

+337/−241 lines, 8 filesdep +psqueuesdep −auto-updatePVP ok

version bump matches the API change (PVP)

Dependencies added: psqueues

Dependencies removed: auto-update

API changes (from Hackage documentation)

Files

Network/Wai/Middleware/Push/Referer.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  -- | Middleware for server push learning dependency based on Referer:. module Network.Wai.Middleware.Push.Referer (@@ -10,227 +11,70 @@   , defaultMakePushPromise   -- * Settings   , Settings-  , defaultSettings+  , M.defaultSettings   , makePushPromise   , duration   , keyLimit   , valueLimit   ) where -import Control.Monad (when, unless)-import Control.Reaper-import Data.ByteString (ByteString)+import Control.Monad (when) import qualified Data.ByteString as BS-import Data.ByteString.Internal (ByteString(..), memchr)-import Data.IORef import Data.Maybe (isNothing)-import Data.Word (Word8)-import Data.Word8-import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)-import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)-import Foreign.Storable (peek) import Network.HTTP.Types (Status(..)) import Network.Wai import Network.Wai.Handler.Warp hiding (Settings, defaultSettings) import Network.Wai.Internal (Response(..))-import System.IO.Unsafe (unsafePerformIO) -import qualified Network.Wai.Middleware.Push.Referer.LimitMultiMap as M+import qualified Network.Wai.Middleware.Push.Referer.Manager as M+import Network.Wai.Middleware.Push.Referer.ParseURL+import Network.Wai.Middleware.Push.Referer.Types  -- $setup -- >>> :set -XOverloadedStrings --- | 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)---- | Type for URL path.-type URLPath = ByteString--type Cache = M.LimitMultiMap URLPath PushPromise--initialized :: IORef Bool-initialized = unsafePerformIO $ newIORef False-{-# NOINLINE initialized #-}--cacheReaper :: IORef (Maybe (Reaper Cache (URLPath,PushPromise)))-cacheReaper = unsafePerformIO $ newIORef Nothing-{-# NOINLINE cacheReaper #-}---- | Settings for server push based on Referer:.-data Settings = Settings {-    makePushPromise :: MakePushPromise -- ^ Default: 'defaultMakePushPromise'-  , duration :: Int -- ^ Duration (in micro seconds) to keep the learning information. The information completely cleared every this duration. Default: 30000000-  , keyLimit :: Int -- ^ Max number of keys (e.g. index.html) in the learning information. Default: 20-  , valueLimit :: Int -- ^ Max number of values (e.g. style.css) in the learning information. Default: 20-  }---- | Default settings.-defaultSettings :: Settings-defaultSettings = Settings {-    makePushPromise = defaultMakePushPromise-  , duration = 30000000-  , keyLimit = 20-  , valueLimit = 20-  }--tryInitialize :: Settings -> IO ()-tryInitialize Settings{..} = do-    isInitialized <- atomicModifyIORef' initialized $ \x -> (True, x)-    unless isInitialized $ do-        reaper <- mkReaper settings-        writeIORef cacheReaper (Just reaper)-  where-    emptyCache = M.empty keyLimit valueLimit-    settings :: ReaperSettings Cache (URLPath,PushPromise)-    settings = defaultReaperSettings {-        reaperAction = \_ -> return (\_ -> emptyCache)-      , reaperCons   = M.insert-      , reaperNull   = M.isEmpty-      , reaperEmpty  = emptyCache-      , reaperDelay  = duration-      }- -- | The middleware to push files based on Referer:. --   Learning strategy is implemented in the first argument. pushOnReferer :: Settings -> Middleware-pushOnReferer settings@Settings{..} app req sendResponse = do-    tryInitialize settings-    mreaper <- readIORef cacheReaper-    case mreaper of-        Nothing     -> app req sendResponse-        Just reaper -> app req (push reaper)+pushOnReferer settings app req sendResponse = do+    mgr <- M.getManager settings+    app req $ push mgr   where-    push reaper res@(ResponseFile (Status 200 "OK") _ file Nothing) = do-        let !path = rawPathInfo req-        m <- reaperRead reaper-        case M.lookup path m of-            [] -> case requestHeaderReferer req of-                Nothing      -> return ()-                Just referer -> do-                    (mauth,refPath) <- parseUrl referer-                    when (isNothing mauth-                       || requestHeaderHost req == mauth) $ do-                        when (path /= refPath) $ do -- just in case-                            let !path' = BS.copy path-                                !refPath' = BS.copy refPath-                            mpp <- makePushPromise refPath' path' file-                            case mpp of-                                Nothing -> return ()-                                Just pp -> reaperAdd reaper (refPath',pp)-            ps -> do-                let !h2d = defaultHTTP2Data { http2dataPushPromise = ps}-                setHTTP2Data req (Just h2d)-        sendResponse res+    path = rawPathInfo req+    push mgr res@(ResponseFile (Status 200 "OK") _ file Nothing)+      -- file:    /index.html+      -- path:    /+      -- referer:+      -- refPath:+      | isHTML path = do+            xs <- M.lookup path mgr+            case xs of+              [] -> return ()+              ps -> do+                  let h2d = defaultHTTP2Data { http2dataPushPromise = ps }+                  setHTTP2Data req $ Just h2d+            sendResponse res+      -- file:    /style.css+      -- path:    /style.css+      -- referer: /index.html+      -- refPath: /+      | otherwise = case requestHeaderReferer req of+          Nothing      -> sendResponse res+          Just referer -> do+              (mauth,refPath) <- parseUrl referer+              when ((isNothing mauth || requestHeaderHost req == mauth)+                  && path /= refPath+                  && isHTML refPath) $ do+                  let path' = BS.copy path+                      refPath' = BS.copy refPath+                  mpp <- makePushPromise settings refPath' path' file+                  case mpp of+                    Nothing -> return ()+                    Just pp -> M.insert refPath' pp mgr+              sendResponse res     push _ res = sendResponse res ---- | Learn if the file to be pushed is CSS (.css) or JavaScript (.js) file---   AND the Referer: ends with \"/\" or \".html\" or \".htm\".-defaultMakePushPromise :: MakePushPromise-defaultMakePushPromise refPath path file-  | isHTML refPath = case getCT path of-      Nothing -> return Nothing-      Just ct -> do-          let pp = defaultPushPromise {-                       promisedPath = path-                     , promisedFile = file-                     , promisedResponseHeaders = [("content-type", ct)-                                                 ,("x-http2-push", refPath)]-                     }-          return $ Just pp-  | otherwise = return Nothing--getCT :: URLPath -> Maybe ByteString-getCT p-  | ".js"  `BS.isSuffixOf` p = Just "application/javascript"-  | ".css" `BS.isSuffixOf` p = Just "text/css"-  | otherwise                = Nothing- isHTML :: URLPath -> Bool isHTML p = ("/" `BS.isSuffixOf` p)         || (".html" `BS.isSuffixOf` p)         || (".htm" `BS.isSuffixOf` p)---- |------ >>> parseUrl ""--- (Nothing,"")--- >>> parseUrl "/"--- (Nothing,"/")--- >>> parseUrl "ht"--- (Nothing,"")--- >>> parseUrl "http://example.com/foo/bar/"--- (Just "example.com","/foo/bar/")--- >>> parseUrl "https://www.example.com/path/to/dir/"--- (Just "www.example.com","/path/to/dir/")--- >>> parseUrl "http://www.example.com:8080/path/to/dir/"--- (Just "www.example.com:8080","/path/to/dir/")--- >>> parseUrl "//www.example.com:8080/path/to/dir/"--- (Just "www.example.com:8080","/path/to/dir/")--- >>> parseUrl "/path/to/dir/"--- (Nothing,"/path/to/dir/")--parseUrl :: ByteString -> IO (Maybe ByteString, URLPath)-parseUrl bs@(PS fptr0 off len)-  | len == 0 = return (Nothing, "")-  | len == 1 = return (Nothing, bs)-  | otherwise = withForeignPtr fptr0 $ \ptr0 -> do-      let begptr = ptr0 `plusPtr` off-          limptr = begptr `plusPtr` len-      parseUrl' fptr0 ptr0 begptr limptr len--parseUrl' :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int-          -> IO (Maybe ByteString, URLPath)-parseUrl' fptr0 ptr0 begptr limptr len0 = do-      w0 <- peek begptr-      if w0 == _slash then do-          w1 <- peek $ begptr `plusPtr` 1-          if w1 == _slash  then-              doubleSlashed begptr len0-            else-              slashed begptr len0 Nothing-        else do-          colonptr <- memchr begptr _colon $ fromIntegral len0-          if colonptr == nullPtr then-              return (Nothing, "")-            else do-              let !authptr = colonptr `plusPtr` 1-              doubleSlashed authptr (limptr `minusPtr` authptr)-  where-    -- // / ?-    doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe ByteString, URLPath)-    doubleSlashed ptr len-      | len < 2  = return (Nothing, "")-      | otherwise = do-          let ptr1 = ptr `plusPtr` 2-          pathptr <- memchr ptr1 _slash $ fromIntegral len-          if pathptr == nullPtr then-              return (Nothing, "")-            else do-              let !auth = bs ptr0 ptr1 pathptr-              slashed pathptr (limptr `minusPtr` pathptr) (Just auth)--    -- / ?-    slashed :: Ptr Word8 -> Int -> Maybe ByteString -> IO (Maybe ByteString, URLPath)-    slashed ptr len mauth = do-        questionptr <- memchr ptr _question $ fromIntegral len-        if questionptr == nullPtr then do-            let !path = bs ptr0 ptr limptr-            return (mauth, path)-          else do-            let !path = bs ptr0 ptr questionptr-            return (mauth, path)-    bs p0 p1 p2 = path-      where-        !off = p1 `minusPtr` p0-        !siz = p2 `minusPtr` p1-        !path = PS fptr0 off siz
+ Network/Wai/Middleware/Push/Referer/LRU.hs view
@@ -0,0 +1,64 @@+-- from https://jaspervdj.be/posts/2015-02-24-lru-cache.html+module Network.Wai.Middleware.Push.Referer.LRU (+    Cache(..)+  , Priority+  , empty+  , insert+  , lookup+  ) where++import Data.OrdPSQ (OrdPSQ)+import qualified Data.OrdPSQ as PSQ+import Data.Int (Int64)+import Prelude hiding (lookup)++import Network.Wai.Middleware.Push.Referer.Multi (Multi)+import qualified Network.Wai.Middleware.Push.Referer.Multi as M++type Priority = Int64++data Cache k v = Cache {+    cCapacity :: Int       -- ^ The maximum number of elements in the queue+  , cSize     :: Int       -- ^ The current number of elements in the queue+  , cValLimit :: Int+  , cTick     :: Priority  -- ^ The next logical time+  , cQueue    :: OrdPSQ k Priority (Multi v)+  } deriving (Eq, Show)++empty :: Int -> Int -> Cache k v+empty capacity valLimit+  | capacity < 1 = error "Cache.empty: capacity < 1"+  | otherwise    = Cache {+        cCapacity = capacity+      , cSize     = 0+      , cValLimit = valLimit+      , cTick     = 0+      , cQueue    = PSQ.empty+      }++trim :: Ord k => Cache k v -> Cache k v+trim c+  | cTick c == maxBound  = empty (cCapacity c) (cValLimit c)+  | cSize c > cCapacity c = c {+        cSize  = cSize c - 1+      , cQueue = PSQ.deleteMin (cQueue c)+      }+  | otherwise             = c++insert :: (Ord k, Ord v) => k -> v -> Cache k v -> Cache k v+insert k v c = case PSQ.alter lookupAndBump k (cQueue c) of+    (True,  q) -> trim $ c { cTick = cTick c + 1, cQueue = q, cSize = cSize c + 1}+    (False, q) -> trim $ c { cTick = cTick c + 1, cQueue = q }+  where+    lookupAndBump Nothing       = (True,  Just (cTick c, M.singleton (cValLimit c) v))+    lookupAndBump (Just (_, x)) = (False, Just (cTick c, M.insert v x))++lookup :: Ord k => k -> Cache k v -> (Cache k v, [v])+lookup k c = case PSQ.alter lookupAndBump k (cQueue c) of+    (Nothing, _) -> (c, [])+    (Just x, q)  -> let c' = trim $ c { cTick = cTick c + 1, cQueue = q }+                        xs = M.list x+                    in (c', xs)+  where+    lookupAndBump Nothing       = (Nothing, Nothing)+    lookupAndBump (Just (_, x)) = (Just x,  Just (cTick c, x))
− Network/Wai/Middleware/Push/Referer/LimitMultiMap.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE BangPatterns #-}--module Network.Wai.Middleware.Push.Referer.LimitMultiMap where--import Data.Map (Map)-import qualified Data.Map.Strict as M-import Data.Set (Set)-import qualified Data.Set as S--data LimitMultiMap k v = LimitMultiMap {-      limitKey :: !Int-    , limitVal :: !Int-    , multiMap :: !(Map k (Set v))-    } deriving (Eq, Show)--isEmpty :: LimitMultiMap k t -> Bool-isEmpty (LimitMultiMap _ _ m) = M.null m--empty :: Int -> Int -> LimitMultiMap k v-empty lk lv = LimitMultiMap lk lv M.empty--insert :: (Ord k, Ord v) => (k,v) -> LimitMultiMap k v -> LimitMultiMap k v-insert (k,v) (LimitMultiMap lk lv m)-  | siz <  lk = let !m' = M.alter  alt k m in LimitMultiMap lk lv m'-  | siz == lk = let !m' = M.adjust adj k m in LimitMultiMap lk lv m'-  | otherwise = error "insert"-  where-    siz = M.size m-    alt Nothing          = Just $ S.singleton v-    alt s@(Just set)-      | S.size set == lv = s-      | otherwise        = Just $ S.insert v set-    adj set-      | S.size set == lv = set-      | otherwise        = S.insert v set--lookup :: Ord k => k -> LimitMultiMap k v -> [v]-lookup k (LimitMultiMap _ _ m) = case M.lookup k m of-  Nothing  -> []-  Just set -> S.toList set
+ Network/Wai/Middleware/Push/Referer/Manager.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.Wai.Middleware.Push.Referer.Manager (+    MakePushPromise+  , defaultMakePushPromise+  , Settings(..)+  , defaultSettings+  , Manager+  , URLPath+  , getManager+  , Network.Wai.Middleware.Push.Referer.Manager.lookup+  , Network.Wai.Middleware.Push.Referer.Manager.insert+  ) where++import Control.Monad (unless)+import Data.IORef+import Network.Wai.Handler.Warp hiding (Settings, defaultSettings)+import System.IO.Unsafe (unsafePerformIO)++import Network.Wai.Middleware.Push.Referer.Types+import qualified Network.Wai.Middleware.Push.Referer.LRU as LRU++newtype Manager = Manager (IORef (LRU.Cache URLPath PushPromise))++getManager :: Settings -> IO Manager+getManager Settings{..} = do+    isInitialized <- atomicModifyIORef' lruInitialized $ \x -> (True, x)+    unless isInitialized $ do+        let cache = LRU.empty keyLimit valueLimit+            Manager ref = cacheManager+        writeIORef ref cache+    return cacheManager++lruInitialized :: IORef Bool+lruInitialized = unsafePerformIO $ newIORef False+{-# NOINLINE lruInitialized #-}++cacheManager :: Manager+cacheManager = Manager $ unsafePerformIO $ newIORef $ LRU.empty 0 0+{-# NOINLINE cacheManager #-}++lookup :: URLPath -> Manager -> IO [PushPromise]+lookup k (Manager ref) = atomicModifyIORef' ref $ LRU.lookup k++insert :: URLPath -> PushPromise -> Manager -> IO ()+insert k v (Manager ref) = atomicModifyIORef' ref $ \c -> (LRU.insert k v c, ())
+ Network/Wai/Middleware/Push/Referer/Multi.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE RecordWildCards #-}+module Network.Wai.Middleware.Push.Referer.Multi where++import Data.Set (Set)+import qualified Data.Set as Set++data Multi a = Multi {+    limit :: Int+  , list  :: [a]+  , check :: Set a+  } deriving (Eq, Show)++empty :: Int -> Multi a+empty n = Multi n [] Set.empty++singleton :: Int -> a -> Multi a+singleton n v = Multi n [v] $ Set.singleton v++insert :: Ord a => a -> Multi a -> Multi a+insert _ m@Multi{..}+  | Set.size check == limit           = m+insert v m@Multi{..}+  | Set.size check == Set.size check' = m+  | otherwise                         = Multi limit (v:list) check'+  where+    check' = Set.insert v check
+ Network/Wai/Middleware/Push/Referer/ParseURL.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.Wai.Middleware.Push.Referer.ParseURL (+    parseUrl+  ) where++import Data.ByteString (ByteString)+import Data.ByteString.Internal (ByteString(..), memchr)+import Data.Word8+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)+import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)+import Foreign.Storable (peek)++import Network.Wai.Middleware.Push.Referer.Types++-- |+--+-- >>> parseUrl ""+-- (Nothing,"")+-- >>> parseUrl "/"+-- (Nothing,"/")+-- >>> parseUrl "ht"+-- (Nothing,"")+-- >>> parseUrl "http://example.com/foo/bar/"+-- (Just "example.com","/foo/bar/")+-- >>> parseUrl "https://www.example.com/path/to/dir/"+-- (Just "www.example.com","/path/to/dir/")+-- >>> parseUrl "http://www.example.com:8080/path/to/dir/"+-- (Just "www.example.com:8080","/path/to/dir/")+-- >>> parseUrl "//www.example.com:8080/path/to/dir/"+-- (Just "www.example.com:8080","/path/to/dir/")+-- >>> parseUrl "/path/to/dir/"+-- (Nothing,"/path/to/dir/")++parseUrl :: ByteString -> IO (Maybe ByteString, URLPath)+parseUrl bs@(PS fptr0 off len)+  | len == 0 = return (Nothing, "")+  | len == 1 = return (Nothing, bs)+  | otherwise = withForeignPtr fptr0 $ \ptr0 -> do+      let begptr = ptr0 `plusPtr` off+          limptr = begptr `plusPtr` len+      parseUrl' fptr0 ptr0 begptr limptr len++parseUrl' :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int+          -> IO (Maybe ByteString, URLPath)+parseUrl' fptr0 ptr0 begptr limptr len0 = do+      w0 <- peek begptr+      if w0 == _slash then do+          w1 <- peek $ begptr `plusPtr` 1+          if w1 == _slash  then+              doubleSlashed begptr len0+            else+              slashed begptr len0 Nothing+        else do+          colonptr <- memchr begptr _colon $ fromIntegral len0+          if colonptr == nullPtr then+              return (Nothing, "")+            else do+              let authptr = colonptr `plusPtr` 1+              doubleSlashed authptr (limptr `minusPtr` authptr)+  where+    -- // / ?+    doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe ByteString, URLPath)+    doubleSlashed ptr len+      | len < 2  = return (Nothing, "")+      | otherwise = do+          let ptr1 = ptr `plusPtr` 2+          pathptr <- memchr ptr1 _slash $ fromIntegral len+          if pathptr == nullPtr then+              return (Nothing, "")+            else do+              let auth = bs ptr0 ptr1 pathptr+              slashed pathptr (limptr `minusPtr` pathptr) (Just auth)++    -- / ?+    slashed :: Ptr Word8 -> Int -> Maybe ByteString -> IO (Maybe ByteString, URLPath)+    slashed ptr len mauth = do+        questionptr <- memchr ptr _question $ fromIntegral len+        if questionptr == nullPtr then do+            let path = bs ptr0 ptr limptr+            return (mauth, path)+          else do+            let path = bs ptr0 ptr questionptr+            return (mauth, path)+    bs p0 p1 p2 = path+      where+        off = p1 `minusPtr` p0+        siz = p2 `minusPtr` p1+        path = PS fptr0 off siz
+ Network/Wai/Middleware/Push/Referer/Types.hs view
@@ -0,0 +1,63 @@+{-# 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 refPath path file = case getCT path of+  Nothing -> return Nothing+  Just ct -> do+      let pp = defaultPushPromise {+                   promisedPath = path+                 , promisedFile = file+                 , promisedResponseHeaders = [("content-type", ct)+                                             ,("x-http2-push", refPath)]+                 }+      return $ Just pp++getCT :: URLPath -> Maybe ByteString+getCT p+  | ".js"  `BS.isSuffixOf` p = Just "application/javascript"+  | ".css" `BS.isSuffixOf` p = Just "text/css"+  | otherwise                = Nothing++-- | Settings for server push based on Referer:.+data Settings = Settings {+    makePushPromise :: MakePushPromise -- ^ Default: 'defaultMakePushPromise'+  , duration :: Int -- ^ Deprecated+  , keyLimit :: Int -- ^ Max number of keys (e.g. index.html) in the learning information. Default: 20+  , valueLimit :: Int -- ^ Max number of values (e.g. style.css) in the learning information. Default: 20+  }++-- | Default settings.+defaultSettings :: Settings+defaultSettings = Settings {+    makePushPromise = defaultMakePushPromise+  , duration = 0+  , keyLimit = 20+  , valueLimit = 20+  }
wai-http2-extra.cabal view
@@ -1,5 +1,5 @@ Name:                wai-http2-extra-Version:             0.1.2+Version:             0.1.3 Synopsis:            WAI utilities for HTTP/2 License:             MIT License-file:        LICENSE@@ -14,15 +14,19 @@  Library   Build-Depends:     base                      >= 3        && < 5-                   , auto-update               >= 0.1.3    && < 0.2                    , bytestring                    , containers                    , http-types+                   , psqueues                    , wai                    , warp                    , word8   Exposed-modules:   Network.Wai.Middleware.Push.Referer-  Other-modules:     Network.Wai.Middleware.Push.Referer.LimitMultiMap+  Other-modules:     Network.Wai.Middleware.Push.Referer.LRU+                     Network.Wai.Middleware.Push.Referer.Manager+                     Network.Wai.Middleware.Push.Referer.Multi+                     Network.Wai.Middleware.Push.Referer.ParseURL+                     Network.Wai.Middleware.Push.Referer.Types   Ghc-Options:       -Wall   if impl(ghc >= 8)       default-extensions:  Strict StrictData