<commit_before>{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances, RankNTypes #-}

module Happstack.Server.Internal.Types
    (Request(..), Response(..), RqBody(..), Input(..), HeaderPair(..),
     takeRequestBody, readInputsBody,
     rqURL, mkHeaders,
     getHeader, getHeaderBS, getHeaderUnsafe,
     hasHeader, hasHeaderBS, hasHeaderUnsafe,
     setHeader, setHeaderBS, setHeaderUnsafe,
     addHeader, addHeaderBS, addHeaderUnsafe,
     setRsCode, -- setCookie, setCookies,
     LogAccess, logMAccess, Conf(..), nullConf, result, resultBS,
     redirect, -- redirect_, redirect', redirect'_,
     isHTTP1_0, isHTTP1_1,
     RsFlags(..), nullRsFlags, contentLength, chunked, noContentLength,
     HttpVersion(..), Length(..), Method(..), Headers, continueHTTP,
     Host, ContentType(..),
     readDec', fromReadS, readM, FromReqURI(..)
    ) where

import Control.Monad.Error (Error(strMsg))
import Control.Monad.Trans (MonadIO(liftIO))
import qualified Control.Concurrent.Thread.Group as TG
import Control.Concurrent.MVar
import qualified Data.Map as M
import Data.Data (Data)
import Data.String (fromString)
import Data.Time.Format (FormatTime(..))
import Data.Typeable(Typeable)
import qualified Data.ByteString.Char8 as P
import Data.ByteString.Char8 (ByteString,pack)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy.UTF8  as LU (fromString)
import Data.Int   (Int8, Int16, Int32, Int64)
import Data.Maybe
import Data.List
import Data.Word  (Word, Word8, Word16, Word32, Word64)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import Happstack.Server.SURI
import Data.Char (toLower)
import Happstack.Server.Internal.RFC822Headers ( ContentType(..) )
import Happstack.Server.Internal.Cookie
import Happstack.Server.Internal.LogFormat (formatRequestCombined)
import Numeric (readDec, readSigned)
import System.Log.Logger (Priority(..), logM)
import Text.Show.Functions ()

-- | HTTP version
data HttpVersion = HttpVersion Int Int
             deriving(Read,Eq)

instance Show HttpVersion where
  show (HttpVersion x y) = (show x) ++ "." ++ (show y)

-- | 'True' if 'Request' is HTTP version @1.1@
isHTTP1_1 :: Request -> Bool
isHTTP1_1 rq =
    case rqVersion rq of
      HttpVersion 1 1 -> True
      _               -> False

-- | 'True' if 'Request' is HTTP version @1.0@
isHTTP1_0 :: Request -> Bool
isHTTP1_0 rq =
    case rqVersion rq of
      HttpVersion 1 0 -> True
      _               -> False

-- | Should the connection be used for further messages after this.
-- | isHTTP1_0 && hasKeepAlive || isHTTP1_1 && hasNotConnectionClose
continueHTTP :: Request -> Response -> Bool
continueHTTP rq res =
    (isHTTP1_0 rq && checkHeaderBS connectionC keepaliveC rq   && rsfLength (rsFlags res) == ContentLength) ||
    (isHTTP1_1 rq && not (checkHeaderBS connectionC closeC rq) && rsfLength (rsFlags res) /= NoContentLength)

-- | function to log access requests (see also: 'logMAccess')
-- type LogAccess time =
--    (   String  -- ^ host
--     -> String  -- ^ user
--     -> time    -- ^ time
--     -> String  -- ^ requestLine
--     -> Int     -- ^ responseCode
--     -> Integer -- ^ size
--     -> String  -- ^ referer
--     -> String  -- ^ userAgent
--     -> IO ())
type LogAccess time =
    (   String
     -> String
     -> time
     -> String
     -> Int
     -> Integer
     -> String
     -> String
     -> IO ())<commit_msg>Use keep-alive for 1xx, 204 no content and 304 not modified responses<commit_after>{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances, RankNTypes #-}

module Happstack.Server.Internal.Types
    (Request(..), Response(..), RqBody(..), Input(..), HeaderPair(..),
     takeRequestBody, readInputsBody,
     rqURL, mkHeaders,
     getHeader, getHeaderBS, getHeaderUnsafe,
     hasHeader, hasHeaderBS, hasHeaderUnsafe,
     setHeader, setHeaderBS, setHeaderUnsafe,
     addHeader, addHeaderBS, addHeaderUnsafe,
     setRsCode, -- setCookie, setCookies,
     LogAccess, logMAccess, Conf(..), nullConf, result, resultBS,
     redirect, -- redirect_, redirect', redirect'_,
     isHTTP1_0, isHTTP1_1,
     RsFlags(..), nullRsFlags, contentLength, chunked, noContentLength,
     HttpVersion(..), Length(..), Method(..), Headers, continueHTTP,
     Host, ContentType(..),
     readDec', fromReadS, readM, FromReqURI(..)
    ) where

import Control.Monad.Error (Error(strMsg))
import Control.Monad.Trans (MonadIO(liftIO))
import qualified Control.Concurrent.Thread.Group as TG
import Control.Concurrent.MVar
import qualified Data.Map as M
import Data.Data (Data)
import Data.String (fromString)
import Data.Time.Format (FormatTime(..))
import Data.Typeable(Typeable)
import qualified Data.ByteString.Char8 as P
import Data.ByteString.Char8 (ByteString,pack)
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.ByteString.Lazy.UTF8  as LU (fromString)
import Data.Int   (Int8, Int16, Int32, Int64)
import Data.Maybe
import Data.List
import Data.Word  (Word, Word8, Word16, Word32, Word64)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as Lazy
import Happstack.Server.SURI
import Data.Char (toLower)
import Happstack.Server.Internal.RFC822Headers ( ContentType(..) )
import Happstack.Server.Internal.Cookie
import Happstack.Server.Internal.LogFormat (formatRequestCombined)
import Numeric (readDec, readSigned)
import System.Log.Logger (Priority(..), logM)
import Text.Show.Functions ()

-- | HTTP version
data HttpVersion = HttpVersion Int Int
             deriving(Read,Eq)

instance Show HttpVersion where
  show (HttpVersion x y) = (show x) ++ "." ++ (show y)

-- | 'True' if 'Request' is HTTP version @1.1@
isHTTP1_1 :: Request -> Bool
isHTTP1_1 rq =
    case rqVersion rq of
      HttpVersion 1 1 -> True
      _               -> False

-- | 'True' if 'Request' is HTTP version @1.0@
isHTTP1_0 :: Request -> Bool
isHTTP1_0 rq =
    case rqVersion rq of
      HttpVersion 1 0 -> True
      _               -> False

-- | Should the connection be used for further messages after this.
-- isHTTP1_0 && hasKeepAlive || isHTTP1_1 && hasNotConnectionClose
--
-- In addition to this rule All 1xx (informational), 204 (no content),
-- and 304 (not modified) responses MUST NOT include a message-body
-- and therefore are eligible for connection keep-alive.
continueHTTP :: Request -> Response -> Bool
continueHTTP rq rs =
    (isHTTP1_0 rq && checkHeaderBS connectionC keepaliveC rq   &&
       (rsfLength (rsFlags rs) == ContentLength || isNoMessageBodyResponse rs)) ||
    (isHTTP1_1 rq && not (checkHeaderBS connectionC closeC rq) &&
       (rsfLength (rsFlags rs) /= NoContentLength || isNoMessageBodyResponse rs))
  where
    isNoMessageBodyCode code = (code >= 100 && code <= 199) || code == 204 || code == 304
    isNoMessageBodyResponse rs = isNoMessageBodyCode (rsCode rs) && L.null (rsBody rs)

-- | function to log access requests (see also: 'logMAccess')
-- type LogAccess time =
--    (   String  -- ^ host
--     -> String  -- ^ user
--     -> time    -- ^ time
--     -> String  -- ^ requestLine
--     -> Int     -- ^ responseCode
--     -> Integer -- ^ size
--     -> String  -- ^ referer
--     -> String  -- ^ userAgent
--     -> IO ())
type LogAccess time =
    (   String
     -> String
     -> time
     -> String
     -> Int
     -> Integer
     -> String
     -> String
     -> IO ())
{'fraction_non_alphanumeric': 0.12234689739083413, 'fraction_numerical': 0.016763552791672298, 'mean_word_length': 3.149186763881099, 'pattern_counts': {'":': 0, '<': 4, '<?xml version=': 0, '>': 52, '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': '510933', 'n_tokens_mistral': 2373, 'n_tokens_neox': 2292, 'n_words': 668}