module Network.HTTP.Server.Mini (
  module Network.HTTP.Server.Mini,
  module Network.HTTP.Server.Mini.Types,
) where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import Data.List.NonEmpty qualified as NE
import Network.Socket
import Network.Socket.ByteString

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


-- | The request handler will run in a forkIO thread.
run :: Settings -> (Request -> IO Response) -> IO ()
run settings handler = do
  let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_NUMERICSERV, AI_PASSIVE]
                           , addrSocketType = Stream }
  addr <- NE.head <$> getAddrInfo (Just hints) Nothing (Just (show (setPort settings)))

  bracket (openSocket addr) close $ \sock -> do
    setSocketOption sock ReusePort 1
    bind sock (addrAddress addr)
    listen sock 64
    semaphore <- newTVarIO (setMaxParallelRequests settings)
    acceptLoop sock semaphore
  where
    -- Put the forever _outside_ the mask_ to unmask briefly between iterations
    -- (when it's safe because we have nothing ongoing).
    acceptLoop sock semaphore = forever $ mask_ $ do
      -- Because we're masked, if atomically exits with an async exception, it
      -- was while blocking so the transaction failed, so nothing happened, so
      -- no cleanup necessary.
      atomically $ do
        n <- readTVar semaphore
        when (n == 0) retry
        writeTVar semaphore $! n - 1
      let increment = atomically (modifyTVar' semaphore (+1))

      (conn, peer) <- accept sock `onException` increment
      let cleanup = close conn `finally` increment

      onException
        (do allowInterrupt  -- we're masked but we just blocked (in `accept` in FFI), so let exceptions through
            print peer
            -- Now either the forkIO succeeds (and the responsibility for
            -- closing and incrementing is passed to the thread) or it fails
            -- (and we retain both responsibilities).
            void $ forkIO $
              handleConnection settings conn handler `finally` cleanup)
        cleanup

-- | Will not close the connection, instead will just return, expecting the
-- caller to close the connection then.
handleConnection :: Settings -> Socket -> (Request -> IO Response) -> IO ()
handleConnection settings conn handler = do
  req <- readRequest (setMaxRequestSize settings) (recv conn)
  print req