<commit_before>{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{- |
Sometimes incoming requests don't stick to the
"no duplicate headers" invariant, for a number
of possible reasons (e.g. proxy servers blindly
adding headers), or your application (or other
middleware) blindly adds headers.

In those cases, you can use this 'Middleware'
to make sure that headers that /can/ be combined
/are/ combined. (e.g. applications might only
check the first \"Accept\" header and fail, while
there might be another one that would match)
-}
module Network.Wai.Middleware.CombineHeaders
    ( combineHeaders
    , defaultCombineSettings
    , CombineSettings (..)
    , HandleType (..)
    ) where

import qualified Data.ByteString as B
import qualified Data.List as L (foldl', reverse)
import qualified Data.Map.Strict as M
import Data.Word8 (_comma, _space, _tab)
import Network.HTTP.Types (Header, HeaderName, RequestHeaders)
import qualified Network.HTTP.Types.Header as H
import Network.Wai (Middleware, requestHeaders, mapResponseHeaders)
import Network.Wai.Header (dropWhileEnd)

-- | These settings define which headers should be combined
-- ('combineHeaderMap'), if the combining should happen on
-- incoming headers ('combineRequestHeaders') and if it
-- should happen on outgoing headers ('combineResponseHeaders').
--
-- Any header you put in the 'combineHeaderMap' *will* be
-- used to combine those headers with commas. There's no
-- check to see if it is a header that allows comma-separated
-- lists, so if you want to combine custom headers, go ahead.
--
-- (You can check the documentation of 'defaultCombineSettings'
-- to see which standard headers are specified to be able to be
-- combined)
--
-- @since 3.1.13.0
data CombineSettings = CombineSettings {
    combineHeaderMap :: M.Map HeaderName HandleType,
    -- ^ Which headers should be combined? And how? (cf. 'HandleType')
    combineRequestHeaders :: Bool,
    -- ^ Should request headers be combined?
    combineResponseHeaders :: Bool
    -- ^ Should response headers be combined?
} deriving (Eq, Show)

-- | Settings that combine request headers,
-- but don't touch response headers.
--
-- All types of headers that /can/ be combined
-- (as defined in the spec) /will/ be combined.
--
-- To be exact, this is the list:
--
-- * \"Accept\"
-- * \"Accept-CH\"
-- * \"Accept-Charset\"
-- * \"Accept-Encoding\"
-- * \"Accept-Language\"
-- * \"Accept-Post\"
-- * \"Access-Control-Allow-Headers\"
-- * \"Access-Control-Allow-Methods\"
-- * \"Access-Control-Expose-Headers\"
-- * \"Access-Control-Request-Headers\"
-- * \"Allow\"
-- * \"Alt-Svc\"
-- * \"Cache-Control\"
-- * \"Clear-Site-Data\"
-- * \"Connection\"
-- * \"Content-Encoding\"
-- * \"Content-Language\"
-- * \"Digest\"
-- * \"If-Match\"
-- * \"If-None-Match\"
-- * \"Link\"
-- * \"Permissions-Policy\"
-- * \"TE\"
-- * \"Timing-Allow-Origin\"
-- * \"Trailer\"
-- * \"Transfer-Encoding\"
-- * \"Upgrade\"
-- * \"Via\"
-- * \"Vary\"
-- * \"Want-Digest\"
--
-- @since 3.1.13.0
defaultCombineSettings :: CombineSettings
defaultCombineSettings = CombineSettings {
    combineHeaderMap = defaultHeaderMap,
    combineRequestHeaders = True,
    combineResponseHeaders = False
}

-- | This middleware will reorganize the incoming and/or outgoing
-- headers in such a way that it combines any duplicates of
-- headers that, on their own, can normally have more than one
-- value, and any other headers will stay untouched.
--
-- This middleware WILL change the global order of headers
-- (they will be put in alphabetical order), but keep the
-- order of the same type of header. I.e. if there are 3
-- \"Set-Cookie\" headers, the first one will still be first,
-- the second one will still be second, etc. But now they are
-- guaranteed to be next to each other.
--
-- N.B. This 'Middleware' assumes the headers it combines
-- are correctly formatted. If one of the to-be-combined
-- headers is malformed, the new combined header will also
-- (probably) be malformed.
--
-- @since 3.1.13.0
combineHeaders :: CombineSettings -> Middleware
combineHeaders CombineSettings{..} app req resFunc =
    app newReq $ resFunc . adjustRes<commit_msg>wai-extra: some more documentation of the 'defaultCombineSettings'<commit_after>{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{- |
Sometimes incoming requests don't stick to the
"no duplicate headers" invariant, for a number
of possible reasons (e.g. proxy servers blindly
adding headers), or your application (or other
middleware) blindly adds headers.

In those cases, you can use this 'Middleware'
to make sure that headers that /can/ be combined
/are/ combined. (e.g. applications might only
check the first \"Accept\" header and fail, while
there might be another one that would match)
-}
module Network.Wai.Middleware.CombineHeaders
    ( combineHeaders
    , defaultCombineSettings
    , CombineSettings (..)
    , HandleType (..)
    ) where

import qualified Data.ByteString as B
import qualified Data.List as L (foldl', reverse)
import qualified Data.Map.Strict as M
import Data.Word8 (_comma, _space, _tab)
import Network.HTTP.Types (Header, HeaderName, RequestHeaders)
import qualified Network.HTTP.Types.Header as H
import Network.Wai (Middleware, requestHeaders, mapResponseHeaders)
import Network.Wai.Header (dropWhileEnd)

-- | These settings define which headers should be combined
-- ('combineHeaderMap'), if the combining should happen on
-- incoming headers ('combineRequestHeaders') and if it
-- should happen on outgoing headers ('combineResponseHeaders').
--
-- Any header you put in the 'combineHeaderMap' *will* be
-- used to combine those headers with commas. There's no
-- check to see if it is a header that allows comma-separated
-- lists, so if you want to combine custom headers, go ahead.
--
-- (You can check the documentation of 'defaultCombineSettings'
-- to see which standard headers are specified to be able to be
-- combined)
--
-- @since 3.1.13.0
data CombineSettings = CombineSettings {
    combineHeaderMap :: M.Map HeaderName HandleType,
    -- ^ Which headers should be combined? And how? (cf. 'HandleType')
    combineRequestHeaders :: Bool,
    -- ^ Should request headers be combined?
    combineResponseHeaders :: Bool
    -- ^ Should response headers be combined?
} deriving (Eq, Show)

-- | Settings that combine request headers,
-- but don't touch response headers.
--
-- All types of headers that /can/ be combined
-- (as defined in the spec) /will/ be combined.
--
-- To be exact, this is the list:
--
-- * \"Accept\"
-- * \"Accept-CH\"
-- * \"Accept-Charset\"
-- * \"Accept-Encoding\"
-- * \"Accept-Language\"
-- * \"Accept-Post\"
-- * \"Access-Control-Allow-Headers\"
-- * \"Access-Control-Allow-Methods\"
-- * \"Access-Control-Expose-Headers\"
-- * \"Access-Control-Request-Headers\"
-- * \"Allow\"
-- * \"Alt-Svc\" @(KeepOnly \"clear\")@
-- * \"Cache-Control\"
-- * \"Clear-Site-Data\" @(KeepOnly \"*\")@
-- * \"Connection\"
-- * \"Content-Encoding\"
-- * \"Content-Language\"
-- * \"Digest\"
-- * \"If-Match\"
-- * \"If-None-Match\" @(KeepOnly \"*\")@
-- * \"Link\"
-- * \"Permissions-Policy\"
-- * \"TE\"
-- * \"Timing-Allow-Origin\" @(KeepOnly \"*\")@
-- * \"Trailer\"
-- * \"Transfer-Encoding\"
-- * \"Upgrade\"
-- * \"Via\"
-- * \"Vary\" @(KeepOnly \"*\")@
-- * \"Want-Digest\"
--
-- N.B. Any header name that has \"KeepOnly\" after it
-- will be combined like normal, unless one of the values
-- is the only mentioned (\"*\" most of the time), then
-- that value is used and all others are dropped.
--
-- @since 3.1.13.0
defaultCombineSettings :: CombineSettings
defaultCombineSettings = CombineSettings {
    combineHeaderMap = defaultHeaderMap,
    combineRequestHeaders = True,
    combineResponseHeaders = False
}

-- | This middleware will reorganize the incoming and/or outgoing
-- headers in such a way that it combines any duplicates of
-- headers that, on their own, can normally have more than one
-- value, and any other headers will stay untouched.
--
-- This middleware WILL change the global order of headers
-- (they will be put in alphabetical order), but keep the
-- order of the same type of header. I.e. if there are 3
-- \"Set-Cookie\" headers, the first one will still be first,
-- the second one will still be second, etc. But now they are
-- guaranteed to be next to each other.
--
-- N.B. This 'Middleware' assumes the headers it combines
-- are correctly formatted. If one of the to-be-combined
-- headers is malformed, the new combined header will also
-- (probably) be malformed.
--
-- @since 3.1.13.0
combineHeaders :: CombineSettings -> Middleware
combineHeaders CombineSettings{..} app req resFunc =
    app newReq $ resFunc . adjustRes
{'fraction_non_alphanumeric': 0.13793894881799404, 'fraction_numerical': 0.0039017672710580675, 'mean_word_length': 3.2223837209302326, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 6, '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': '1686159', 'n_tokens_mistral': 2545, 'n_tokens_neox': 2492, 'n_words': 966}