<commit_before>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Network.Wai.Handler.Warp.Request (
    recvRequest
  , headerLines
  ) where

import Control.Applicative
import qualified Control.Concurrent as Conc (yield)
import Control.Exception.Lifted (throwIO)
import Control.Monad.IO.Class (liftIO)
import Data.Array ((!))
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as SU
import qualified Data.CaseInsensitive as CI
import Data.Conduit
import qualified Data.IORef as I
import Data.Monoid (mempty)
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr)
import Network.Wai
import Network.Wai.Handler.Warp.Conduit
import Network.Wai.Handler.Warp.Header
import Network.Wai.Handler.Warp.ReadInt
import Network.Wai.Handler.Warp.RequestHeader
import qualified Network.Wai.Handler.Warp.Timeout as Timeout
import Network.Wai.Handler.Warp.Types
import Network.Wai.Internal
import Prelude hiding (lines)

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

-- FIXME come up with good values here
maxTotalHeaderLength :: Int
maxTotalHeaderLength = 50 * 1024

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

-- | Receiving a HTTP request from 'Connection' and parsing its header
--   to create 'Request'.
recvRequest :: Connection
            -> InternalInfo
            -> SockAddr -- ^ Peer's address.
            -> Source IO ByteString -- ^ Where HTTP request comes from.
            -> IO (Request
                  ,IndexedHeader
                  ,IO (ResumableSource IO ByteString)) -- ^
            -- 'Request' passed to 'Application',
            -- 'IndexedHeader' of HTTP request for internal use, and
            -- leftover source (i.e. body and other HTTP reqeusts in HTTP pipelining).

recvRequest conn ii addr src0 = do
    (src, hdrlines) <- src0 $$+ headerLines
    (method, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
    let idxhdr = indexRequestHeader hdr
        expect = idxhdr ! idxExpect
        cl = idxhdr ! idxContentLength
        te = idxhdr ! idxTransferEncoding
    liftIO $ handleExpect conn httpversion expect
    (rbody, bodyLength, getSource) <- bodyAndSource src cl te
    let req = Request {
            requestMethod     = method
          , httpVersion       = httpversion
          , pathInfo          = H.decodePathSegments path
          , rawPathInfo       = path
          , rawQueryString    = query
          , queryString       = H.parseQuery query
          , requestHeaders    = hdr
          , isSecure          = False
          , remoteHost        = addr
          , requestBody       = timeoutBody th rbody
          , vault             = mempty
          , requestBodyLength = bodyLength
          }
    return (req, idxhdr, getSource)
  where
    th = threadHandle ii<commit_msg>adding requestHeaderHost. (#190).<commit_after>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}

module Network.Wai.Handler.Warp.Request (
    recvRequest
  , headerLines
  ) where

import Control.Applicative
import qualified Control.Concurrent as Conc (yield)
import Control.Exception.Lifted (throwIO)
import Control.Monad.IO.Class (liftIO)
import Data.Array ((!))
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Unsafe as SU
import qualified Data.CaseInsensitive as CI
import Data.Conduit
import qualified Data.IORef as I
import Data.Monoid (mempty)
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr)
import Network.Wai
import Network.Wai.Handler.Warp.Conduit
import Network.Wai.Handler.Warp.Header
import Network.Wai.Handler.Warp.ReadInt
import Network.Wai.Handler.Warp.RequestHeader
import qualified Network.Wai.Handler.Warp.Timeout as Timeout
import Network.Wai.Handler.Warp.Types
import Network.Wai.Internal
import Prelude hiding (lines)

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

-- FIXME come up with good values here
maxTotalHeaderLength :: Int
maxTotalHeaderLength = 50 * 1024

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

-- | Receiving a HTTP request from 'Connection' and parsing its header
--   to create 'Request'.
recvRequest :: Connection
            -> InternalInfo
            -> SockAddr -- ^ Peer's address.
            -> Source IO ByteString -- ^ Where HTTP request comes from.
            -> IO (Request
                  ,IndexedHeader
                  ,IO (ResumableSource IO ByteString)) -- ^
            -- 'Request' passed to 'Application',
            -- 'IndexedHeader' of HTTP request for internal use, and
            -- leftover source (i.e. body and other HTTP reqeusts in HTTP pipelining).

recvRequest conn ii addr src0 = do
    (src, hdrlines) <- src0 $$+ headerLines
    (method, path, query, httpversion, hdr) <- parseHeaderLines hdrlines
    let idxhdr = indexRequestHeader hdr
        expect = idxhdr ! idxExpect
        cl = idxhdr ! idxContentLength
        te = idxhdr ! idxTransferEncoding
    liftIO $ handleExpect conn httpversion expect
    (rbody, bodyLength, getSource) <- bodyAndSource src cl te
    let req = Request {
            requestMethod     = method
          , httpVersion       = httpversion
          , pathInfo          = H.decodePathSegments path
          , rawPathInfo       = path
          , rawQueryString    = query
          , queryString       = H.parseQuery query
          , requestHeaders    = hdr
          , isSecure          = False
          , remoteHost        = addr
          , requestBody       = timeoutBody th rbody
          , vault             = mempty
          , requestBodyLength = bodyLength
          , requestHeaderHost = idxhdr ! idxHost
          }
    return (req, idxhdr, getSource)
  where
    th = threadHandle ii
{'fraction_non_alphanumeric': 0.119544914246901, 'fraction_numerical': 0.003226354219731703, 'mean_word_length': 2.1547937868237814, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2753178', 'n_tokens_mistral': 1595, 'n_tokens_neox': 1549, 'n_words': 478}