<commit_before>{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) where

import Control.Exception.Lifted (throwIO)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as B (unpack)
import qualified Data.CaseInsensitive as CI
import qualified Network.HTTP.Types as H
import Network.Wai.Handler.Warp.Types
import Prelude hiding (lines)

-- $setup
-- >>> :set -XOverloadedStrings

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

parseHeaderLines :: [ByteString]
                 -> IO (H.Method
                       ,ByteString  --  Path
                       ,ByteString  --  Query
                       ,H.HttpVersion
                       ,H.RequestHeaders
                       )
parseHeaderLines [] = throwIO $ NotEnoughLines []
parseHeaderLines (firstLine:otherLines) = do
    (method, path', query, httpversion) <- parseRequestLine firstLine
    let path = parseRpath path'
        hdr = map parseHeader otherLines
    return (method, path, query, httpversion, hdr)

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

parseRequestLine :: ByteString
           -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
parseRequestLine s =
    case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of  -- ' '
        (method:query:http'') -> do
            let http' = S.concat http''
                (hfirst, hsecond) = S.splitAt 5 http'
            if hfirst == "HTTP/"
               then let (rpath, qstring) = S.breakByte 63 query  -- '?'
                        hv =
                            case hsecond of
                                "1.1" -> H.http11
                                _ -> H.http10
                    in return (method, rpath, qstring, hv)
               else throwIO NonHttp
        _ -> throwIO $ BadFirstLine $ B.unpack s

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

-- |
--
-- >>> parseRpath ""
-- "/"
-- >>> parseRpath "http://example.com/path"
-- "/path"
-- >>> parseRpath "http://example.com"
-- ""
-- >>> parseRpath "/path"
-- "/path"

-- FIXME: parseRpath "http://example.com" should be "/"?
parseRpath :: ByteString -> ByteString
parseRpath path
  | S.null path                   = "/"
  | "http://" `S.isPrefixOf` path = extractPath path
  | otherwise                     = path
  where
    extractPath = snd . S.breakByte 47 . S.drop 7 -- 47 is '/'.

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

-- |
--
-- >>> parseHeader "Content-Length:47"
-- ("Content-Length","47")
-- >>> parseHeader "Accept-Ranges: bytes"
-- ("Accept-Ranges","bytes")
-- >>> parseHeader "Host:  example.com:8080"
-- ("Host","example.com:8080")
<commit_msg>proper name.<commit_after>{-# LANGUAGE OverloadedStrings #-}

module Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) where

import Control.Exception.Lifted (throwIO)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as B (unpack)
import qualified Data.CaseInsensitive as CI
import qualified Network.HTTP.Types as H
import Network.Wai.Handler.Warp.Types
import Prelude hiding (lines)

-- $setup
-- >>> :set -XOverloadedStrings

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

parseHeaderLines :: [ByteString]
                 -> IO (H.Method
                       ,ByteString  --  Path
                       ,ByteString  --  Query
                       ,H.HttpVersion
                       ,H.RequestHeaders
                       )
parseHeaderLines [] = throwIO $ NotEnoughLines []
parseHeaderLines (firstLine:otherLines) = do
    (method, path', query, httpversion) <- parseRequestLine firstLine
    let path = parsePath path'
        hdr = map parseHeader otherLines
    return (method, path, query, httpversion, hdr)

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

parseRequestLine :: ByteString
           -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
parseRequestLine s =
    case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of  -- ' '
        (method:query:http'') -> do
            let http' = S.concat http''
                (hfirst, hsecond) = S.splitAt 5 http'
            if hfirst == "HTTP/"
               then let (rpath, qstring) = S.breakByte 63 query  -- '?'
                        hv =
                            case hsecond of
                                "1.1" -> H.http11
                                _ -> H.http10
                    in return (method, rpath, qstring, hv)
               else throwIO NonHttp
        _ -> throwIO $ BadFirstLine $ B.unpack s

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

-- |
--
-- >>> parsePath ""
-- "/"
-- >>> parsePath "http://example.com:8080/path"
-- "/path"
-- >>> parsePath "http://example.com"
-- ""
-- >>> parsePath "/path"
-- "/path"

-- FIXME: parsePath "http://example.com" should be "/"?
parsePath :: ByteString -> ByteString
parsePath path
  | S.null path                   = "/"
  | "http://" `S.isPrefixOf` path = extractPath path
  | otherwise                     = path
  where
    extractPath = snd . S.breakByte 47 . S.drop 7 -- 47 is '/'.

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

-- |
--
-- >>> parseHeader "Content-Length:47"
-- ("Content-Length","47")
-- >>> parseHeader "Accept-Ranges: bytes"
-- ("Accept-Ranges","bytes")
-- >>> parseHeader "Host:  example.com:8080"
-- ("Host","example.com:8080")

{'fraction_non_alphanumeric': 0.21807747489239598, 'fraction_numerical': 0.011836441893830704, 'mean_word_length': 1.4709791758972086, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 2, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6194087', 'n_tokens_mistral': 1562, 'n_tokens_neox': 1485, 'n_words': 379}