{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}

-- | Middleware for server push learning dependency based on Referer:.
module Network.Wai.Middleware.Push.Referer (
  -- * Middleware
    pushOnReferer
  -- * Making push promise
  , URLPath
  , MakePushPromise
  , defaultMakePushPromise
  -- * Settings
  , Settings
  , defaultSettings
  , makePushPromise
  , duration
  , keyLimit
  , valueLimit
  ) where

import Control.Monad (when, unless)
import Control.Reaper
import Data.ByteString (ByteString)
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

-- $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 :: IORef Bool
initialized = IO (IORef Bool) -> IORef Bool
forall a. IO a -> a
unsafePerformIO (IO (IORef Bool) -> IORef Bool) -> IO (IORef Bool) -> IORef Bool
forall a b. (a -> b) -> a -> b
$ Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
{-# NOINLINE initialized #-}

cacheReaper :: IORef (Maybe (Reaper Cache (URLPath,PushPromise)))
cacheReaper :: IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
cacheReaper = IO (IORef (Maybe (Reaper Cache (URLPath, PushPromise))))
-> IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
forall a. IO a -> a
unsafePerformIO (IO (IORef (Maybe (Reaper Cache (URLPath, PushPromise))))
 -> IORef (Maybe (Reaper Cache (URLPath, PushPromise))))
-> IO (IORef (Maybe (Reaper Cache (URLPath, PushPromise))))
-> IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
forall a b. (a -> b) -> a -> b
$ Maybe (Reaper Cache (URLPath, PushPromise))
-> IO (IORef (Maybe (Reaper Cache (URLPath, PushPromise))))
forall a. a -> IO (IORef a)
newIORef Maybe (Reaper Cache (URLPath, PushPromise))
forall a. Maybe a
Nothing
{-# NOINLINE cacheReaper #-}

-- | Settings for server push based on Referer:.
data Settings = Settings {
    Settings -> MakePushPromise
makePushPromise :: MakePushPromise -- ^ Default: 'defaultMakePushPromise'
  , Settings -> Int
duration :: Int -- ^ Duration (in micro seconds) to keep the learning information. The information completely cleared every this duration. Default: 30000000
  , 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 = $WSettings :: MakePushPromise -> Int -> Int -> Int -> Settings
Settings {
    makePushPromise :: MakePushPromise
makePushPromise = MakePushPromise
defaultMakePushPromise
  , duration :: Int
duration = 30000000
  , keyLimit :: Int
keyLimit = 20
  , valueLimit :: Int
valueLimit = 20
  }

tryInitialize :: Settings -> IO ()
tryInitialize :: Settings -> IO ()
tryInitialize Settings{..} = do
    Bool
isInitialized <- IORef Bool -> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Bool
initialized ((Bool -> (Bool, Bool)) -> IO Bool)
-> (Bool -> (Bool, Bool)) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \x :: Bool
x -> (Bool
True, Bool
x)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isInitialized (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Reaper Cache (URLPath, PushPromise)
reaper <- ReaperSettings Cache (URLPath, PushPromise)
-> IO (Reaper Cache (URLPath, PushPromise))
forall workload item.
ReaperSettings workload item -> IO (Reaper workload item)
mkReaper ReaperSettings Cache (URLPath, PushPromise)
settings
        IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
-> Maybe (Reaper Cache (URLPath, PushPromise)) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
cacheReaper (Reaper Cache (URLPath, PushPromise)
-> Maybe (Reaper Cache (URLPath, PushPromise))
forall a. a -> Maybe a
Just Reaper Cache (URLPath, PushPromise)
reaper)
  where
    emptyCache :: LimitMultiMap k v
emptyCache = Int -> Int -> LimitMultiMap k v
forall k v. Int -> Int -> LimitMultiMap k v
M.empty Int
keyLimit Int
valueLimit
    settings :: ReaperSettings Cache (URLPath,PushPromise)
    settings :: ReaperSettings Cache (URLPath, PushPromise)
settings = ReaperSettings [Any] Any
forall item. ReaperSettings [item] item
defaultReaperSettings {
        reaperAction :: Cache -> IO (Cache -> Cache)
reaperAction = \_ -> (Cache -> Cache) -> IO (Cache -> Cache)
forall (m :: * -> *) a. Monad m => a -> m a
return (\_ -> Cache
forall k v. LimitMultiMap k v
emptyCache)
      , reaperCons :: (URLPath, PushPromise) -> Cache -> Cache
reaperCons   = (URLPath, PushPromise) -> Cache -> Cache
forall k v.
(Ord k, Ord v) =>
(k, v) -> LimitMultiMap k v -> LimitMultiMap k v
M.insert
      , reaperNull :: Cache -> Bool
reaperNull   = Cache -> Bool
forall k t. LimitMultiMap k t -> Bool
M.isEmpty
      , reaperEmpty :: Cache
reaperEmpty  = Cache
forall k v. LimitMultiMap k v
emptyCache
      , reaperDelay :: Int
reaperDelay  = Int
duration
      }

-- | The middleware to push files based on Referer:.
--   Learning strategy is implemented in the first argument.
pushOnReferer :: Settings -> Middleware
pushOnReferer :: Settings -> Middleware
pushOnReferer settings :: Settings
settings@Settings{..} app :: Application
app req :: Request
req sendResponse :: Response -> IO ResponseReceived
sendResponse = do
    Settings -> IO ()
tryInitialize Settings
settings
    Maybe (Reaper Cache (URLPath, PushPromise))
mreaper <- IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
-> IO (Maybe (Reaper Cache (URLPath, PushPromise)))
forall a. IORef a -> IO a
readIORef IORef (Maybe (Reaper Cache (URLPath, PushPromise)))
cacheReaper
    case Maybe (Reaper Cache (URLPath, PushPromise))
mreaper of
        Nothing     -> Application
app Request
req Response -> IO ResponseReceived
sendResponse
        Just reaper :: Reaper Cache (URLPath, PushPromise)
reaper -> Application
app Request
req (Reaper Cache (URLPath, PushPromise)
-> Response -> IO ResponseReceived
push Reaper Cache (URLPath, PushPromise)
reaper)
  where
    push :: Reaper Cache (URLPath, PushPromise)
-> Response -> IO ResponseReceived
push reaper :: Reaper Cache (URLPath, PushPromise)
reaper res :: Response
res@(ResponseFile (Status 200 "OK") _ file :: FilePath
file Nothing) = do
        let !path :: URLPath
path = Request -> URLPath
rawPathInfo Request
req
        Cache
m <- Reaper Cache (URLPath, PushPromise) -> IO Cache
forall workload item. Reaper workload item -> IO workload
reaperRead Reaper Cache (URLPath, PushPromise)
reaper
        case URLPath -> Cache -> [PushPromise]
forall k v. Ord k => k -> LimitMultiMap k v -> [v]
M.lookup URLPath
path Cache
m of
            [] -> case Request -> Maybe URLPath
requestHeaderReferer Request
req of
                Nothing      -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just referer :: URLPath
referer -> do
                    (mauth :: Maybe URLPath
mauth,refPath :: URLPath
refPath) <- URLPath -> IO (Maybe URLPath, URLPath)
parseUrl URLPath
referer
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe URLPath -> Bool
forall a. Maybe a -> Bool
isNothing Maybe URLPath
mauth
                       Bool -> Bool -> Bool
|| Request -> Maybe URLPath
requestHeaderHost Request
req Maybe URLPath -> Maybe URLPath -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe URLPath
mauth) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (URLPath
path URLPath -> URLPath -> Bool
forall a. Eq a => a -> a -> Bool
/= URLPath
refPath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do -- just in case
                            let !path' :: URLPath
path' = URLPath -> URLPath
BS.copy URLPath
path
                                !refPath' :: URLPath
refPath' = URLPath -> URLPath
BS.copy URLPath
refPath
                            Maybe PushPromise
mpp <- MakePushPromise
makePushPromise URLPath
refPath' URLPath
path' FilePath
file
                            case Maybe PushPromise
mpp of
                                Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                                Just pp :: PushPromise
pp -> Reaper Cache (URLPath, PushPromise)
-> (URLPath, PushPromise) -> IO ()
forall workload item. Reaper workload item -> item -> IO ()
reaperAdd Reaper Cache (URLPath, PushPromise)
reaper (URLPath
refPath',PushPromise
pp)
            ps :: [PushPromise]
ps -> do
                let !h2d :: HTTP2Data
h2d = HTTP2Data
defaultHTTP2Data { http2dataPushPromise :: [PushPromise]
http2dataPushPromise = [PushPromise]
ps}
                Request -> Maybe HTTP2Data -> IO ()
setHTTP2Data Request
req (HTTP2Data -> Maybe HTTP2Data
forall a. a -> Maybe a
Just HTTP2Data
h2d)
        Response -> IO ResponseReceived
sendResponse Response
res
    push _ res :: Response
res = Response -> IO ResponseReceived
sendResponse Response
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 :: MakePushPromise
defaultMakePushPromise refPath :: URLPath
refPath path :: URLPath
path file :: FilePath
file
  | URLPath -> Bool
isHTML URLPath
refPath = 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
  | Bool
otherwise = Maybe PushPromise -> IO (Maybe PushPromise)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PushPromise
forall a. Maybe a
Nothing

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

isHTML :: URLPath -> Bool
isHTML :: URLPath -> Bool
isHTML p :: URLPath
p = ("/" URLPath -> URLPath -> Bool
`BS.isSuffixOf` URLPath
p)
        Bool -> Bool -> Bool
|| (".html" URLPath -> URLPath -> Bool
`BS.isSuffixOf` URLPath
p)
        Bool -> Bool -> Bool
|| (".htm" URLPath -> URLPath -> Bool
`BS.isSuffixOf` URLPath
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 :: URLPath -> IO (Maybe URLPath, URLPath)
parseUrl bs :: URLPath
bs@(PS fptr0 :: ForeignPtr Word8
fptr0 off :: Int
off len :: Int
len)
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, "")
  | Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, URLPath
bs)
  | Bool
otherwise = ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe URLPath, URLPath))
-> IO (Maybe URLPath, URLPath)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr0 ((Ptr Word8 -> IO (Maybe URLPath, URLPath))
 -> IO (Maybe URLPath, URLPath))
-> (Ptr Word8 -> IO (Maybe URLPath, URLPath))
-> IO (Maybe URLPath, URLPath)
forall a b. (a -> b) -> a -> b
$ \ptr0 :: Ptr Word8
ptr0 -> do
      let begptr :: Ptr b
begptr = Ptr Word8
ptr0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
          limptr :: Ptr b
limptr = Ptr Any
forall b. Ptr b
begptr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
      ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Maybe URLPath, URLPath)
parseUrl' ForeignPtr Word8
fptr0 Ptr Word8
ptr0 Ptr Word8
forall b. Ptr b
begptr Ptr Word8
forall b. Ptr b
limptr Int
len

parseUrl' :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int
          -> IO (Maybe ByteString, URLPath)
parseUrl' :: ForeignPtr Word8
-> Ptr Word8
-> Ptr Word8
-> Ptr Word8
-> Int
-> IO (Maybe URLPath, URLPath)
parseUrl' fptr0 :: ForeignPtr Word8
fptr0 ptr0 :: Ptr Word8
ptr0 begptr :: Ptr Word8
begptr limptr :: Ptr Word8
limptr len0 :: Int
len0 = do
      Word8
w0 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
begptr
      if Word8
w0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash then do
          Word8
w1 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek (Ptr Word8 -> IO Word8) -> Ptr Word8 -> IO Word8
forall a b. (a -> b) -> a -> b
$ Ptr Word8
begptr Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1
          if Word8
w1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash  then
              Ptr Word8 -> Int -> IO (Maybe URLPath, URLPath)
doubleSlashed Ptr Word8
begptr Int
len0
            else
              Ptr Word8 -> Int -> Maybe URLPath -> IO (Maybe URLPath, URLPath)
slashed Ptr Word8
begptr Int
len0 Maybe URLPath
forall a. Maybe a
Nothing
        else do
          Ptr Word8
colonptr <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
begptr Word8
_colon (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len0
          if Ptr Word8
colonptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
nullPtr then
              (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, "")
            else do
              let !authptr :: Ptr b
authptr = Ptr Word8
colonptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 1
              Ptr Word8 -> Int -> IO (Maybe URLPath, URLPath)
doubleSlashed Ptr Word8
forall b. Ptr b
authptr (Ptr Word8
limptr Ptr Word8 -> Ptr Any -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Any
forall b. Ptr b
authptr)
  where
    -- // / ?
    doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe ByteString, URLPath)
    doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe URLPath, URLPath)
doubleSlashed ptr :: Ptr Word8
ptr len :: Int
len
      | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2  = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, "")
      | Bool
otherwise = do
          let ptr1 :: Ptr b
ptr1 = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` 2
          Ptr Word8
pathptr <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
forall b. Ptr b
ptr1 Word8
_slash (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
          if Ptr Word8
pathptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
nullPtr then
              (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, "")
            else do
              let !auth :: URLPath
auth = Ptr Word8 -> Ptr Any -> Ptr Word8 -> URLPath
forall b a a. Ptr b -> Ptr a -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr Any
forall b. Ptr b
ptr1 Ptr Word8
pathptr
              Ptr Word8 -> Int -> Maybe URLPath -> IO (Maybe URLPath, URLPath)
slashed Ptr Word8
pathptr (Ptr Word8
limptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
pathptr) (URLPath -> Maybe URLPath
forall a. a -> Maybe a
Just URLPath
auth)

    -- / ?
    slashed :: Ptr Word8 -> Int -> Maybe ByteString -> IO (Maybe ByteString, URLPath)
    slashed :: Ptr Word8 -> Int -> Maybe URLPath -> IO (Maybe URLPath, URLPath)
slashed ptr :: Ptr Word8
ptr len :: Int
len mauth :: Maybe URLPath
mauth = do
        Ptr Word8
questionptr <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
memchr Ptr Word8
ptr Word8
_question (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$ Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len
        if Ptr Word8
questionptr Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Word8
forall b. Ptr b
nullPtr then do
            let !path :: URLPath
path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> URLPath
forall b a a. Ptr b -> Ptr a -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
limptr
            (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
mauth, URLPath
path)
          else do
            let !path :: URLPath
path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> URLPath
forall b a a. Ptr b -> Ptr a -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
questionptr
            (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
mauth, URLPath
path)
    bs :: Ptr b -> Ptr a -> Ptr a -> URLPath
bs p0 :: Ptr b
p0 p1 :: Ptr a
p1 p2 :: Ptr a
p2 = URLPath
path
      where
        !off :: Int
off = Ptr a
p1 Ptr a -> Ptr b -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
p0
        !siz :: Int
siz = Ptr a
p2 Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
p1
        !path :: URLPath
path = ForeignPtr Word8 -> Int -> Int -> URLPath
PS ForeignPtr Word8
fptr0 Int
off Int
siz