{-# 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 (ZonkAny 2)
forall {b}. Ptr b
begptr Ptr (ZonkAny 2) -> 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
      w0 <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
begptr
      if w0 == _slash then do
          w1 <- peek $ begptr `plusPtr` 1
          if w1 == _slash  then
              doubleSlashed begptr len0
            else
              slashed begptr len0 Nothing
        else do
          colonptr <- memchr begptr _colon $ fromIntegral len0
          if colonptr == nullPtr then
              return (Nothing, "")
            else do
              let authptr = Ptr Word8
colonptr Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
1
              doubleSlashed authptr (limptr `minusPtr` 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
          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 pathptr == nullPtr then
              return (Nothing, "")
            else do
              let auth = Ptr Word8 -> Ptr (ZonkAny 0) -> Ptr Word8 -> URLPath
forall {b} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
bs Ptr Word8
ptr0 Ptr (ZonkAny 0)
forall {b}. Ptr b
ptr1 Ptr Word8
pathptr
              slashed pathptr (limptr `minusPtr` pathptr) (Just 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
        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 questionptr == nullPtr then do
            let 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
            return (mauth, path)
          else do
            let 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
            return (mauth, 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