{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Monad.Trans.State.Strict
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Hedgehog
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import System.Exit

import Network.HTTP.Server.Mini.Internal.Parser
import Network.HTTP.Server.Mini.Types


randomSlicing :: Int -> Int -> Gen [Int]
randomSlicing n _ | n <= 0 = error "no slices"
randomSlicing 1 target = return [target]
randomSlicing numslice target = do
  n1 <- Gen.integral (Range.constant 1 (target - numslice))
  ns <- (n1:) <$> go (numslice - 1) (target - n1)
  if sum ns /= target || any (== 0) ns then error (show (ns, target)) else return ()
  Gen.shuffle ns
  where
    go 1 tg
      | tg <= 0 = error "impossible"
      | otherwise = return [tg]
    go ns tg
      | tg < ns = error "impossible"
      | tg == ns = return (replicate ns 1)
      | otherwise = do
          s <- Gen.integral (Range.constant 1 (min (tg - (ns-1)) (round (fromIntegral (3 * tg) / fromIntegral ns :: Double))))
          (s:) <$> go (ns-1) (tg - s)

randomTextSlicing :: ByteString -> Gen [ByteString]
randomTextSlicing str = do
  nfragments <- Gen.integral (Range.linear 1 10)
  lens <- randomSlicing nfragments (BS.length str)
  let slices [] _ = []
      slices (l:ls) r = let (pre, post) = BS.splitAt l r
                        in pre : slices ls post
  return (slices lens str)

readRequestSliced :: Int -> [ByteString] -> Maybe Request
readRequestSliced maxlen slices =
  evalState (readRequest maxlen (\_ -> state (\case x:xs -> (x, xs)
                                                    [] -> (BS.empty, []))))
            slices

prop_valid :: Property
prop_valid = property $ do
  crlf <- forAll (Gen.choice [pure "\r\n", pure "\n"])
  slices <- forAll (randomTextSlicing (requestText crlf))
  readRequestSliced 4096 slices === Just answer
  where
    requestText :: ByteString -> ByteString
    requestText crlf = BS.concat
      ["GET /path/x?q=1&a=2 HTTP/1.1", crlf
      ,"Host: tirclogv.example", crlf
      ,"Accept: */*", crlf
      ,crlf]

    answer = Request
      { reqMethod = "GET"
      , reqURI = "/path/x?q=1&a=2"
      , reqHeaders = [("host", "tirclogv.example"), ("accept", "*/*")]
      , reqPath = ["path", "x"]
      , reqQuery = [("q", "1"), ("a", "2")]
      }

tests :: IO Bool
tests = checkParallel $ Group "mini-http-server"
  [("valid", withTests 10000 prop_valid)
  ]

-- main :: IO ()
-- main = do
--   print $ evalState (readRequest 4096 (\_ -> state (\case x:xs -> (x, xs); [] -> (BS.empty, [])))) ["GET /path/x?q=1&a=2 HTTP/1.1\r\nHost: tirclogv.example\r\nAccept: */*\r\n", "\r", "\n"]

main :: IO ()
main = tests >>= \case
  True -> exitSuccess
  False -> exitFailure