{-# 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 :: 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