module Network.HTTP.Server.Mini.Parser where

import Control.Monad.Trans.Maybe
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS

import Network.HTTP.Server.Mini.Types


readRequest :: Monad m => Int -> (Int -> m ByteString) -> m (Maybe Request)
readRequest maxsize recv = runMaybeT $ do
  bs <- MaybeT $ readUntilTerminator maxsize recv []
  hoistMaybe (parseRequest bs)

parseRequest :: ByteString -> Maybe Request
parseRequest = _

readUntilTerminator :: Monad m => Int -> (Int -> m ByteString) -> [ByteString] -> m (Maybe ByteString)
readUntilTerminator 0 _ _ = return Nothing
readUntilTerminator maxsize recv toprevprefix = do
  text <- recv maxsize
  if BS.length text == 0
    then return Nothing
    else goFind toprevprefix text
  where
    goFind revprefix text =
      case findTerminator text of
        NoTerm -> readUntilTerminator (maxsize - BS.length text) recv (text : revprefix)
        IncompleteTerm haveCR
          | maxsize == BS.length text -> return Nothing
          | otherwise -> do
              text2 <- recv (maxsize - BS.length text)
              text2' <- case BS.length text2 of
                1 -> (text2 <>) <$> recv (maxsize - BS.length text - 1)  -- premature concat but rare
                _ -> return text2  -- also for length 0 (i.e. EOF)!
              -- now text2' has length at least 2 if available before EOF
              case (haveCR, BS.length text2') of
                (_, 0) -> return Nothing
                (False, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.concat (reverse revprefix)))
                (False, n) | n >= 2, text2' `BS.index` 0 == 13, text2' `BS.index` 0 == 10 ->
                  return (Just (BS.concat (reverse revprefix)))
                (True, _) | text2' `BS.index` 0 == 10 -> return (Just (BS.init (BS.concat (reverse revprefix))))
                (_, 1) -> return Nothing  -- second recv returned EOF and no terminator found before that
                _ -> goFind (text : revprefix) text2'
        FoundTerm i -> return (Just (BS.concat (reverse (BS.take i text : revprefix))))

data FoundTerminator
  = NoTerm
  | IncompleteTerm {-# UNPACK #-} !Bool
      -- ^ Bool indicates "have CR".
      -- If False, then LF at end of segment, requires LF or CRLF at start of next.
      -- If True, then LF CR at end of segment, requires LF at start of next.
  | FoundTerm Int  -- ^ Index right after the first [CR]LF sequence in the terminator
  deriving (Show)

findTerminator :: ByteString -> FoundTerminator
findTerminator bs =
  -- We're looking for [CR] LF [CR] LF. Look for the first LF, and see if it's
  -- followed by CRLF or LF.
  go (BS.elemIndices 10 bs)
  where
    len = BS.length bs

    go [] = NoTerm
    go (i:is)
      | i == len - 1 = IncompleteTerm False
      | i == len - 2 =
          case bs `BS.index` (i+1) of
            10 -> FoundTerm (i+1)
            13 -> IncompleteTerm True
            _ -> NoTerm
      -- now certainly two bytes after this LF
      | otherwise =
          case bs `BS.index` (i+1) of
            10 -> FoundTerm (i+1)
            -- [i+2] is read twice if this check fails, but LF CR (!=LF) will be very rare so it's fine
            13 | bs `BS.index` (i+2) == 10 -> FoundTerm (i+1)
            _ -> go is