{-# LANGUAGE OverloadedStrings, CPP #-}
{-# LANGUAGE BangPatterns #-}

module Network.Wai.Handler.Warp.HTTP2.Request (
    mkRequest
  , MkReq
  , getHTTP2Data
  , setHTTP2Data
  , modifyHTTP2Data
  ) where

import Control.Applicative ((<|>))
import Control.Arrow (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import qualified Data.Vault.Lazy as Vault
import Network.HPACK
import Network.HPACK.Token
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr)
import Network.Wai
import Network.Wai.Handler.Warp.HTTP2.Types
import Network.Wai.Handler.Warp.HashMap (hashByteString)
import Network.Wai.Handler.Warp.IORef
import Network.Wai.Handler.Warp.Request (pauseTimeoutKey, getFileInfoKey)
import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)
import qualified Network.Wai.Handler.Warp.Timeout as Timeout
import Network.Wai.Handler.Warp.Types
import Network.Wai.Internal (Request(..))
import System.IO.Unsafe (unsafePerformIO)

type MkReq = (TokenHeaderList,ValueTable) -> (Maybe Int,IO ByteString) -> IO (Request,InternalInfo)

mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq
mkRequest ii1 settings addr (reqths,reqvt) (bodylen,body) = do
    ref <- newIORef Nothing
    mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body)

mkRequest' :: InternalInfo1 -> S.Settings -> SockAddr
           -> IORef (Maybe HTTP2Data)
           -> MkReq
mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body) = return (req,ii)
  where
    !req = Request {
        requestMethod = colonMethod
      , httpVersion = http2ver
      , rawPathInfo = rawPath
      , pathInfo = H.decodePathSegments path
      , rawQueryString = query
      , queryString = H.parseQuery query
      , requestHeaders = headers
      , isSecure = True
      , remoteHost = addr
      , requestBody = body
      , vault = vaultValue
      , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen
      , requestHeaderHost      = mHost <|> mAuth
      , requestHeaderRange     = mRange
      , requestHeaderReferer   = mReferer
      , requestHeaderUserAgent = mUserAgent
      }
    headers = map (first tokenKey) ths
      where
        ths = case mHost of
            Just _  -> reqths
            Nothing -> case mAuth of
              Just auth -> (tokenHost, auth) : reqths
              _         -> reqths
    !mPath = getHeaderValue tokenPath reqvt -- SHOULD
    !colonMethod = fromJust $ getHeaderValue tokenMethod reqvt -- MUST
    !mAuth = getHeaderValue tokenAuthority reqvt -- SHOULD
    !mHost = getHeaderValue tokenHost reqvt
    !mRange = getHeaderValue tokenRange reqvt
    !mReferer = getHeaderValue tokenReferer reqvt
    !mUserAgent = getHeaderValue tokenUserAgent reqvt
    -- CONNECT request will have ":path" omitted, use ":authority" as unparsed
    -- path instead so that it will have consistent behavior compare to HTTP 1.0
    (unparsedPath,query) = B8.break (=='?') $ fromJust (mPath <|> mAuth)
    !path = H.extractPath unparsedPath
    !rawPath = if S.settingsNoParsePath settings then unparsedPath else path
    !h = hashByteString rawPath
    !ii = toInternalInfo ii1 h
    !th = threadHandle ii
    !vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
                $ Vault.insert getFileInfoKey (getFileInfo ii)
                $ Vault.insert getHTTP2DataKey (readIORef ref)
                $ Vault.insert setHTTP2DataKey (writeIORef ref)
                $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref)
                  Vault.empty

getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data))
getHTTP2DataKey = unsafePerformIO Vault.newKey
{-# NOINLINE getHTTP2Data #-}

-- | Getting 'HTTP2Data' through vault of the request.
--   Warp uses this to receive 'HTTP2Data' from 'Middleware'.
--
--   Since: 3.2.7
getHTTP2Data :: Request -> IO (Maybe HTTP2Data)
getHTTP2Data req = case Vault.lookup getHTTP2DataKey (vault req) of
  Nothing     -> return Nothing
  Just getter -> getter

setHTTP2DataKey :: Vault.Key (Maybe HTTP2Data -> IO ())
setHTTP2DataKey = unsafePerformIO Vault.newKey
{-# NOINLINE setHTTP2Data #-}

-- | Setting 'HTTP2Data' through vault of the request.
--   'Application' or 'Middleware' should use this.
--
--   Since: 3.2.7
setHTTP2Data :: Request -> Maybe HTTP2Data -> IO ()
setHTTP2Data req mh2d = case Vault.lookup setHTTP2DataKey (vault req) of
  Nothing     -> return ()
  Just setter -> setter mh2d

modifyHTTP2DataKey :: Vault.Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
modifyHTTP2DataKey = unsafePerformIO Vault.newKey
{-# NOINLINE modifyHTTP2Data #-}

-- | Modifying 'HTTP2Data' through vault of the request.
--   'Application' or 'Middleware' should use this.
--
--   Since: 3.2.8
modifyHTTP2Data :: Request -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
modifyHTTP2Data req func = case Vault.lookup modifyHTTP2DataKey (vault req) of
  Nothing     -> return ()
  Just modify -> modify func