{-# 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 :: ByteString -> IO (Maybe ByteString, URLPath)
parseUrl :: URLPath -> IO (Maybe URLPath, URLPath)
parseUrl bs :: URLPath
bs@(PS ForeignPtr Word8
fptr0 Int
off Int
len)
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, URLPath
"")
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall a. a -> IO a
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
$ \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' ForeignPtr Word8
fptr0 Ptr Word8
ptr0 Ptr Word8
begptr Ptr Word8
limptr 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` Int
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, URLPath
"")
else do
let authptr :: Ptr b
authptr = Ptr Word8
colonptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
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 Word8
ptr Int
len
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, URLPath
"")
| 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` Int
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
forall a. Maybe a
Nothing, URLPath
"")
else do
let auth :: URLPath
auth = Ptr Word8 -> Ptr Any -> Ptr Word8 -> URLPath
forall {b} {b} {a}. Ptr b -> Ptr b -> 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 Word8
ptr Int
len 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} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
limptr
(Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall a. a -> IO a
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} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
questionptr
(Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe URLPath
mauth, URLPath
path)
bs :: Ptr b -> Ptr b -> Ptr a -> URLPath
bs Ptr b
p0 Ptr b
p1 Ptr a
p2 = URLPath
path
where
off :: Int
off = Ptr b
p1 Ptr b -> Ptr b -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
p0
siz :: Int
siz = Ptr a
p2 Ptr a -> Ptr b -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr b
p1
path :: URLPath
path = ForeignPtr Word8 -> Int -> Int -> URLPath
PS ForeignPtr Word8
fptr0 Int
off Int
siz