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