{-# 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 :: ByteString -> IO (Maybe ByteString, ByteString)
parseUrl bs :: ByteString
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 ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, "")
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = (Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, ByteString
bs)
| Bool
otherwise = ForeignPtr Word8
-> (Ptr Word8 -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr0 ((Ptr Word8 -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString))
-> (Ptr Word8 -> IO (Maybe ByteString, ByteString))
-> IO (Maybe ByteString, ByteString)
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 ByteString, ByteString)
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 ByteString, ByteString)
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 ByteString, ByteString)
doubleSlashed Ptr Word8
begptr Int
len0
else
Ptr Word8
-> Int -> Maybe ByteString -> IO (Maybe ByteString, ByteString)
slashed Ptr Word8
begptr Int
len0 Maybe ByteString
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 ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
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 ByteString, ByteString)
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 ByteString, ByteString)
doubleSlashed ptr :: Ptr Word8
ptr len :: Int
len
| Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 2 = (Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
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 ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
forall a. Maybe a
Nothing, "")
else do
let auth :: ByteString
auth = Ptr Word8 -> Ptr Any -> Ptr Word8 -> ByteString
forall b a a. Ptr b -> Ptr a -> Ptr a -> ByteString
bs Ptr Word8
ptr0 Ptr Any
forall b. Ptr b
ptr1 Ptr Word8
pathptr
Ptr Word8
-> Int -> Maybe ByteString -> IO (Maybe ByteString, ByteString)
slashed Ptr Word8
pathptr (Ptr Word8
limptr Ptr Word8 -> Ptr Word8 -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr Word8
pathptr) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
auth)
slashed :: Ptr Word8 -> Int -> Maybe ByteString -> IO (Maybe ByteString, URLPath)
slashed :: Ptr Word8
-> Int -> Maybe ByteString -> IO (Maybe ByteString, ByteString)
slashed ptr :: Ptr Word8
ptr len :: Int
len mauth :: Maybe ByteString
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 :: ByteString
path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> ByteString
forall b a a. Ptr b -> Ptr a -> Ptr a -> ByteString
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
limptr
(Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
mauth, ByteString
path)
else do
let path :: ByteString
path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> ByteString
forall b a a. Ptr b -> Ptr a -> Ptr a -> ByteString
bs Ptr Word8
ptr0 Ptr Word8
ptr Ptr Word8
questionptr
(Maybe ByteString, ByteString) -> IO (Maybe ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString
mauth, ByteString
path)
bs :: Ptr b -> Ptr a -> Ptr a -> ByteString
bs p0 :: Ptr b
p0 p1 :: Ptr a
p1 p2 :: Ptr a
p2 = ByteString
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 :: ByteString
path = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fptr0 Int
off Int
siz