    {-# LANGUAGE BangPatterns #-}

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

    import Control.Arrow (first)
    import qualified Data.ByteString.Char8 as C8
    import Data.IORef
    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.Internal (Request(..))
    import System.IO.Unsafe (unsafePerformIO)
    import qualified System.TimeManager as T

    import Network.Wai.Handler.Warp.HTTP2.Types
    import Network.Wai.Handler.Warp.Imports
    import Network.Wai.Handler.Warp.Request (getFileInfoKey, pauseTimeoutKey, getClientCertificateKey)
    import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)
    import Network.Wai.Handler.Warp.Types

    type ToReq = (TokenHeaderList,ValueTable) -> Maybe Int -> IO ByteString -> T.Handle -> Transport -> IO Request

    ----------------------------------------------------------------

    http30 :: H.HttpVersion
    http30 :: HttpVersion
    http30 = Int -> Int -> HttpVersion
    H.HttpVersion 3 0

    toRequest :: InternalInfo -> S.Settings -> SockAddr -> ToReq
    toRequest :: InternalInfo -> Settings -> SockAddr -> ToReq
    toRequest ii :: InternalInfo
    ii settings :: Settings
    settings addr :: SockAddr
    addr ht :: (TokenHeaderList, ValueTable)
    ht bodylen :: Maybe Int
    bodylen body :: IO ByteString
    body th :: Handle
    th transport :: Transport
    transport = do
        IORef (Maybe HTTP2Data)
    ref <- Maybe HTTP2Data -> IO (IORef (Maybe HTTP2Data))
    forall a. a -> IO (IORef a)
    newIORef Maybe HTTP2Data
    forall a. Maybe a
    Nothing
        InternalInfo
    -> Settings -> SockAddr -> IORef (Maybe HTTP2Data) -> ToReq
    toRequest' InternalInfo
    ii Settings
    settings SockAddr
    addr IORef (Maybe HTTP2Data)
    ref (TokenHeaderList, ValueTable)
    ht Maybe Int
    bodylen IO ByteString
    body Handle
    th Transport
    transport

    toRequest' :: InternalInfo -> S.Settings -> SockAddr
               -> IORef (Maybe HTTP2Data)
               -> ToReq
    toRequest' :: InternalInfo
    -> Settings -> SockAddr -> IORef (Maybe HTTP2Data) -> ToReq
    toRequest' ii :: InternalInfo
    ii settings :: Settings
    settings addr :: SockAddr
    addr ref :: IORef (Maybe HTTP2Data)
    ref (reqths :: TokenHeaderList
    reqths,reqvt :: ValueTable
    reqvt) bodylen :: Maybe Int
    bodylen body :: IO ByteString
    body th :: Handle
    th transport :: Transport
    transport = Request -> IO Request
    forall (m :: * -> *) a. Monad m => a -> m a
    return Request
    req
      where
        !req :: Request
    req = Request :: ByteString
    -> HttpVersion
    -> ByteString
    -> ByteString
    -> RequestHeaders
    -> Bool
    -> SockAddr
    -> [Text]
    -> Query
    -> IO ByteString
    -> Vault
    -> RequestBodyLength
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Maybe ByteString
    -> Request
    Request {
            requestMethod :: ByteString
    requestMethod = ByteString
    colonMethod
          , httpVersion :: HttpVersion
    httpVersion = if Transport -> Bool
    isTransportQUIC Transport
    transport then HttpVersion
    http30 else HttpVersion
    H.http20
          , rawPathInfo :: ByteString
    rawPathInfo = ByteString
    rawPath
          , pathInfo :: [Text]
    pathInfo = ByteString -> [Text]
    H.decodePathSegments ByteString
    path
          , rawQueryString :: ByteString
    rawQueryString = ByteString
    query
          , queryString :: Query
    queryString = ByteString -> Query
    H.parseQuery ByteString
    query
          , requestHeaders :: RequestHeaders
    requestHeaders = RequestHeaders
    headers
          , isSecure :: Bool
    isSecure = Transport -> Bool
    isTransportSecure Transport
    transport
          , remoteHost :: SockAddr
    remoteHost = SockAddr
    addr
          , requestBody :: IO ByteString
    requestBody = IO ByteString
    body
          , vault :: Vault
    vault = Vault
    vaultValue
          , requestBodyLength :: RequestBodyLength
    requestBodyLength = RequestBodyLength
    -> (Int -> RequestBodyLength) -> Maybe Int -> RequestBodyLength
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe RequestBodyLength
    ChunkedBody (Word64 -> RequestBodyLength
    KnownLength (Word64 -> RequestBodyLength)
    -> (Int -> Word64) -> Int -> RequestBodyLength
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Word64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) Maybe Int
    bodylen
          , requestHeaderHost :: Maybe ByteString
    requestHeaderHost      = Maybe ByteString
    mHost Maybe ByteString -> Maybe ByteString -> Maybe ByteString
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe ByteString
    mAuth
          , requestHeaderRange :: Maybe ByteString
    requestHeaderRange     = Maybe ByteString
    mRange
          , requestHeaderReferer :: Maybe ByteString
    requestHeaderReferer   = Maybe ByteString
    mReferer
          , requestHeaderUserAgent :: Maybe ByteString
    requestHeaderUserAgent = Maybe ByteString
    mUserAgent
          }
        headers :: RequestHeaders
    headers = (TokenHeader -> (CI ByteString, ByteString))
    -> TokenHeaderList -> RequestHeaders
    forall a b. (a -> b) -> [a] -> [b]
    map ((Token -> CI ByteString)
    -> TokenHeader -> (CI ByteString, ByteString)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first Token -> CI ByteString
    tokenKey) TokenHeaderList
    ths
          where
            ths :: TokenHeaderList
    ths = case Maybe ByteString
    mHost of
                Just _  -> TokenHeaderList
    reqths
                Nothing -> case Maybe ByteString
    mAuth of
                  Just auth :: ByteString
    auth -> (Token
    tokenHost, ByteString
    auth) TokenHeader -> TokenHeaderList -> TokenHeaderList
    forall a. a -> [a] -> [a]
    : TokenHeaderList
    reqths
                  _         -> TokenHeaderList
    reqths
        !mPath :: Maybe ByteString
    mPath = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenPath ValueTable
    reqvt -- SHOULD
        !colonMethod :: ByteString
    colonMethod = Maybe ByteString -> ByteString
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenMethod ValueTable
    reqvt -- MUST
        !mAuth :: Maybe ByteString
    mAuth = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenAuthority ValueTable
    reqvt -- SHOULD
        !mHost :: Maybe ByteString
    mHost = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenHost ValueTable
    reqvt
        !mRange :: Maybe ByteString
    mRange = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenRange ValueTable
    reqvt
        !mReferer :: Maybe ByteString
    mReferer = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenReferer ValueTable
    reqvt
        !mUserAgent :: Maybe ByteString
    mUserAgent = Token -> ValueTable -> Maybe ByteString
    getHeaderValue Token
    tokenUserAgent ValueTable
    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 :: ByteString
    unparsedPath,query :: ByteString
    query) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    C8.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    =='?') (ByteString -> (ByteString, ByteString))
    -> ByteString -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ Maybe ByteString -> ByteString
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe ByteString
    mPath Maybe ByteString -> Maybe ByteString -> Maybe ByteString
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe ByteString
    mAuth)
        !path :: ByteString
    path = ByteString -> ByteString
    H.extractPath ByteString
    unparsedPath
        !rawPath :: ByteString
    rawPath = if Settings -> Bool
    S.settingsNoParsePath Settings
    settings then ByteString
    unparsedPath else ByteString
    path
        -- fixme: pauseTimeout. th is not available here.
        !vaultValue :: Vault
    vaultValue = Key (FilePath -> IO FileInfo)
    -> (FilePath -> IO FileInfo) -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (FilePath -> IO FileInfo)
    getFileInfoKey (InternalInfo -> FilePath -> IO FileInfo
    getFileInfo InternalInfo
    ii)
                    (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (IO (Maybe HTTP2Data))
    -> IO (Maybe HTTP2Data) -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (IO (Maybe HTTP2Data))
    getHTTP2DataKey (IORef (Maybe HTTP2Data) -> IO (Maybe HTTP2Data)
    forall a. IORef a -> IO a
    readIORef IORef (Maybe HTTP2Data)
    ref)
                    (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (Maybe HTTP2Data -> IO ())
    -> (Maybe HTTP2Data -> IO ()) -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (Maybe HTTP2Data -> IO ())
    setHTTP2DataKey (IORef (Maybe HTTP2Data) -> Maybe HTTP2Data -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef (Maybe HTTP2Data)
    ref)
                    (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    -> ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    -> Vault
    -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    modifyHTTP2DataKey (IORef (Maybe HTTP2Data)
    -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef' IORef (Maybe HTTP2Data)
    ref)
                    (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (IO ()) -> IO () -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (IO ())
    pauseTimeoutKey (Handle -> IO ()
    T.pause Handle
    th)
                    (Vault -> Vault) -> Vault -> Vault
    forall a b. (a -> b) -> a -> b
    $ Key (Maybe CertificateChain)
    -> Maybe CertificateChain -> Vault -> Vault
    forall a. Key a -> a -> Vault -> Vault
    Vault.insert Key (Maybe CertificateChain)
    getClientCertificateKey (Transport -> Maybe CertificateChain
    getTransportClientCertificate Transport
    transport)
                      Vault
    Vault.empty

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

    -- | 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 :: Request -> IO (Maybe HTTP2Data)
    getHTTP2Data req :: Request
    req = case Key (IO (Maybe HTTP2Data)) -> Vault -> Maybe (IO (Maybe HTTP2Data))
    forall a. Key a -> Vault -> Maybe a
    Vault.lookup Key (IO (Maybe HTTP2Data))
    getHTTP2DataKey (Request -> Vault
    vault Request
    req) of
      Nothing     -> Maybe HTTP2Data -> IO (Maybe HTTP2Data)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe HTTP2Data
    forall a. Maybe a
    Nothing
      Just getter :: IO (Maybe HTTP2Data)
    getter -> IO (Maybe HTTP2Data)
    getter

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

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

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

    -- | 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 :: Request -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
    modifyHTTP2Data req :: Request
    req func :: Maybe HTTP2Data -> Maybe HTTP2Data
    func = case Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    -> Vault -> Maybe ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    forall a. Key a -> Vault -> Maybe a
    Vault.lookup Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ())
    modifyHTTP2DataKey (Request -> Vault
    vault Request
    req) of
      Nothing     -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      Just modify :: (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
    modify -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()
    modify Maybe HTTP2Data -> Maybe HTTP2Data
    func