    {-# LANGUAGE ScopedTypeVariables, ScopedTypeVariables, TupleSections #-}

    module Happstack.Server.Internal.Handler
        ( request
        , parseResponse
        , putRequest
        ) where

    import qualified Paths_happstack_server as Paths
    import qualified Data.Version as DV
    import Control.Applicative (pure)
    import Control.Concurrent (newMVar, newEmptyMVar, tryTakeMVar)
    import Control.Exception.Extensible as E
    import Control.Monad
    import Data.List(elemIndex)
    import Data.Char(toLower)
    import Data.Maybe ( fromMaybe, fromJust, isJust, isNothing )
    import Data.Time      (UTCTime)
    import Prelude hiding (last)
    import qualified Data.ByteString.Char8 as P
    import qualified Data.ByteString.Char8 as B
    import qualified Data.ByteString.Lazy.Char8 as L
    import           Data.ByteString.Lazy.Internal (ByteString(Chunk, Empty))
    import qualified Data.ByteString.Lazy.Char8 as LC
    import qualified Data.Map as M
    import Data.Int (Int64)
    import Happstack.Server.Internal.Cookie
    import Happstack.Server.Internal.Clock
    import Happstack.Server.Internal.Types
    import Happstack.Server.Internal.Multipart
    import Happstack.Server.Internal.RFC822Headers
    import Happstack.Server.Internal.MessageWrap
    import Happstack.Server.SURI(SURI(..),path,query)
    import Happstack.Server.SURI.ParseURI
    import Happstack.Server.Internal.TimeoutIO (TimeoutIO(..))
    import Happstack.Server.Internal.Monads (failResponse)
    import qualified Happstack.Server.Internal.TimeoutManager as TM
    import Numeric
    import System.Directory (removeFile)
    import System.IO
    import System.IO.Error (isDoesNotExistError)

    request :: TimeoutIO -> Maybe (LogAccess UTCTime) -> Host -> (Request -> IO Response) -> IO ()
    request :: TimeoutIO
    -> Maybe (LogAccess UTCTime)
    -> Host
    -> (Request -> IO Response)
    -> IO ()
    request TimeoutIO
    timeoutIO Maybe (LogAccess UTCTime)
    mlog Host
    host Request -> IO Response
    handler =
        TimeoutIO
    -> Maybe (LogAccess UTCTime)
    -> Host
    -> (Request -> IO Response)
    -> ByteString
    -> IO ()
    rloop TimeoutIO
    timeoutIO Maybe (LogAccess UTCTime)
    mlog Host
    host Request -> IO Response
    handler (ByteString -> IO ()) -> IO ByteString -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TimeoutIO -> IO ByteString
    toGetContents TimeoutIO
    timeoutIO

    required :: String -> Maybe a -> Either String a
    required :: forall a. String -> Maybe a -> Either String a
    required String
    err Maybe a
    Nothing  = String -> Either String a
    forall a b. a -> Either a b
    Left String
    err
    required String
    _   (Just a
    a) = a -> Either String a
    forall a b. b -> Either a b
    Right a
    a

    rloop :: TimeoutIO
             -> Maybe (LogAccess UTCTime)
             -> Host
             -> (Request -> IO Response)
             -> L.ByteString
             -> IO ()
    rloop :: TimeoutIO
    -> Maybe (LogAccess UTCTime)
    -> Host
    -> (Request -> IO Response)
    -> ByteString
    -> IO ()
    rloop TimeoutIO
    timeoutIO Maybe (LogAccess UTCTime)
    mlog Host
    host Request -> IO Response
    handler ByteString
    inputStr
        | ByteString -> Bool
    L.null ByteString
    inputStr = () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        | Bool
    otherwise
        = (IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          do let parseRequest :: Either
      String
      (Method, SURI, [(String, Cookie)], HttpVersion, Headers,
       ByteString, ByteString)
    parseRequest
                     = do
                          (topStr, restStr) <- String
    -> Maybe (ByteString, ByteString)
    -> Either String (ByteString, ByteString)
    forall a. String -> Maybe a -> Either String a
    required String
    "failed to separate request" (Maybe (ByteString, ByteString)
     -> Either String (ByteString, ByteString))
    -> Maybe (ByteString, ByteString)
    -> Either String (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe (ByteString, ByteString)
    splitAtEmptyLine ByteString
    inputStr
                          (rql, headerStr)  <- required "failed to separate headers/body" $ splitAtCRLF topStr
                          let (m,u,v) = requestLine rql
                          headers' <- case parseHeaders "host" (L.unpack headerStr) of
                            Maybe [Header]
    Nothing -> String -> Either String [Header]
    forall a b. a -> Either a b
    Left String
    "failed to parse host header"
                            Just [Header]
    x -> [Header] -> Either String [Header]
    forall a b. b -> Either a b
    Right [Header]
    x
                          let headers = [Header] -> Headers
    mkHeaders [Header]
    headers'
                          let contentLen = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    0 (Maybe Int -> Int) -> Maybe Int -> Int
    forall a b. (a -> b) -> a -> b
    $ ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, ByteString) -> Int
    forall a b. (a, b) -> a
    fst (ByteString -> Maybe (Int, ByteString)
    P.readInt (ByteString -> Maybe (Int, ByteString))
    -> Maybe ByteString -> Maybe (Int, ByteString)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< ByteString -> Headers -> Maybe ByteString
    forall r. HasHeaders r => ByteString -> r -> Maybe ByteString
    getHeaderUnsafe ByteString
    contentlengthC Headers
    headers)
                          (body, nextRequest) <- case () of
                              () | Int
    contentLen Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0               -> String -> Either String (ByteString, ByteString)
    forall a b. a -> Either a b
    Left String
    "negative content-length"
                                 | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe ByteString -> Bool) -> Maybe ByteString -> Bool
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Headers -> Maybe ByteString
    forall r. HasHeaders r => ByteString -> r -> Maybe ByteString
    getHeaderBS ByteString
    transferEncodingC Headers
    headers ->
                                     (ByteString, ByteString) -> Either String (ByteString, ByteString)
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ByteString, ByteString)
     -> Either String (ByteString, ByteString))
    -> (ByteString, ByteString)
    -> Either String (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> (ByteString, ByteString)
    consumeChunks ByteString
    restStr
                                 | Bool
    otherwise                       -> (ByteString, ByteString) -> Either String (ByteString, ByteString)
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    contentLen) ByteString
    restStr)
                          let cookies = [ (Cookie -> String
    cookieName Cookie
    c, Cookie
    c) | [Cookie]
    cl <- [[Cookie]] -> Maybe [[Cookie]] -> [[Cookie]]
    forall a. a -> Maybe a -> a
    fromMaybe [] ((ByteString -> [[Cookie]]) -> Maybe ByteString -> Maybe [[Cookie]]
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ByteString -> [[Cookie]]
    forall (m :: * -> *). MonadFail m => ByteString -> m [Cookie]
    getCookies (String -> Headers -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    "Cookie" Headers
    headers)), Cookie
    c <- [Cookie]
    cl ] -- Ugle
                          return (m, u, cookies, v, headers, body, nextRequest)

             case Either
      String
      (Method, SURI, [(String, Cookie)], HttpVersion, Headers,
       ByteString, ByteString)
    parseRequest of
               Left String
    err -> String -> IO (IO ())
    forall a. HasCallStack => String -> a
    error (String -> IO (IO ())) -> String -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ String
    "failed to parse HTTP request: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err
               Right (Method
    m, SURI
    u, [(String, Cookie)]
    cookies, HttpVersion
    v, Headers
    headers, ByteString
    body, ByteString
    nextRequest)
                  -> IO () -> IO (IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (IO () -> IO (IO ())) -> IO () -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $
                      do bodyRef        <- RqBody -> IO (MVar RqBody)
    forall a. a -> IO (MVar a)
    newMVar (ByteString -> RqBody
    Body ByteString
    body)
                         bodyInputRef   <- newEmptyMVar
                         let req = Bool
    -> Method
    -> [String]
    -> String
    -> String
    -> [(String, Input)]
    -> MVar [(String, Input)]
    -> [(String, Cookie)]
    -> HttpVersion
    -> Headers
    -> MVar RqBody
    -> Host
    -> Request
    Request (TimeoutIO -> Bool
    toSecure TimeoutIO
    timeoutIO) Method
    m (String -> [String]
    pathEls (SURI -> String
    path SURI
    u)) (SURI -> String
    path SURI
    u) (SURI -> String
    query SURI
    u)
                                      (SURI -> [(String, Input)]
    queryInput SURI
    u) MVar [(String, Input)]
    bodyInputRef [(String, Cookie)]
    cookies HttpVersion
    v Headers
    headers MVar RqBody
    bodyRef Host
    host

                         let ioseq m b
    act = m b
    act m b -> (b -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \b
    x -> b
    x b -> m b -> m b
    forall a b. a -> b -> b
    `seq` b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    x

                         (res, handlerKilled) <- ((, False) `liftM` ioseq (handler req))
                             `E.catches` [ Handler $ \(EscapeHTTP
    e::EscapeHTTP)      -> EscapeHTTP -> IO (Response, Bool)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO EscapeHTTP
    e -- need to handle this higher up
                                         , Handler $ \(SomeException
    e::E.SomeException) -> (Response, Bool) -> IO (Response, Bool)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> Response
    failResponse (SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e), SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e Maybe AsyncException -> Maybe AsyncException -> Bool
    forall a. Eq a => a -> a -> Bool
    == AsyncException -> Maybe AsyncException
    forall a. a -> Maybe a
    Just AsyncException
    ThreadKilled)
                                         ]

                         case mlog of
                           Maybe (LogAccess UTCTime)
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                           (Just LogAccess UTCTime
    logger) ->
                               do time <- IO UTCTime
    getApproximateUTCTime
                                  let host'        = Host -> String
    forall a b. (a, b) -> a
    fst Host
    host
                                      user         = String
    "-"
                                      requestLn    = [String] -> String
    unwords [Method -> String
    forall a. Show a => a -> String
    show (Method -> String) -> Method -> String
    forall a b. (a -> b) -> a -> b
    $ Request -> Method
    rqMethod Request
    req, Request -> String
    rqUri Request
    req, HttpVersion -> String
    forall a. Show a => a -> String
    show (HttpVersion -> String) -> HttpVersion -> String
    forall a b. (a -> b) -> a -> b
    $ Request -> HttpVersion
    rqVersion Request
    req]
                                      responseCode = Response -> Int
    rsCode Response
    res
                                      size         = Integer -> (ByteString -> Integer) -> Maybe ByteString -> Integer
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (-Integer
    1) (String -> Integer
    forall a. (Num a, Eq a) => String -> a
    readDec' (String -> Integer)
    -> (ByteString -> String) -> ByteString -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> String
    B.unpack) (String -> Response -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    "Content-Length" Response
    res) -- -1 indicates unknown size
                                      referer      = ByteString -> String
    B.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ByteString
    B.pack String
    "") (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> Request -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    "Referer" Request
    req
                                      userAgent    = ByteString -> String
    B.unpack (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe (String -> ByteString
    B.pack String
    "") (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String -> Request -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    "User-Agent" Request
    req
                                  logger host' user time requestLn responseCode size referer userAgent

                         -- withNoPush sock $ putAugmentedResult thandle sock req res
                         putAugmentedResult timeoutIO req res
                         -- clean up tmp files
                         cleanupTempFiles req
                         -- do not continue if handler was killed
                         when (not handlerKilled && continueHTTP req res) $
                             rloop timeoutIO mlog host handler nextRequest) IO () -> (EscapeHTTP -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` (TimeoutIO -> EscapeHTTP -> IO ()
    escapeHttpHandler TimeoutIO
    timeoutIO)

    escapeHttpHandler :: TimeoutIO
                      -> EscapeHTTP
                      -> IO ()
    escapeHttpHandler :: TimeoutIO -> EscapeHTTP -> IO ()
    escapeHttpHandler TimeoutIO
    tio (EscapeHTTP TimeoutIO -> IO ()
    f) = TimeoutIO -> IO ()
    f TimeoutIO
    tio

    -- NOTE: if someone took the inputs and never put them back, then they are responsible for the cleanup
    cleanupTempFiles :: Request -> IO ()
    cleanupTempFiles :: Request -> IO ()
    cleanupTempFiles Request
    req =
        do mInputs <- MVar [(String, Input)] -> IO (Maybe [(String, Input)])
    forall a. MVar a -> IO (Maybe a)
    tryTakeMVar (Request -> MVar [(String, Input)]
    rqInputsBody Request
    req)
           case mInputs of
             Maybe [(String, Input)]
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
             (Just [(String, Input)]
    inputs) -> ((String, Input) -> IO ()) -> [(String, Input)] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (String, Input) -> IO ()
    deleteTmpFile [(String, Input)]
    inputs
        where
          deleteTmpFile :: (String, Input) -> IO ()
          deleteTmpFile :: (String, Input) -> IO ()
    deleteTmpFile (String
    _, Input
    input) =
              case Input -> Either String ByteString
    inputValue Input
    input of
                (Left String
    fp) -> (IOError -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
    E.catchJust (Bool -> Maybe ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IOError -> Bool
    isDoesNotExistError) (String -> IO ()
    removeFile String
    fp)  (IO () -> () -> IO ()
    forall a b. a -> b -> a
    const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
                Either String ByteString
    _         -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Unserializes the bytestring into a response.  If there is an
    -- error it will return @Left msg@.
    parseResponse :: L.ByteString -> Either String Response
    parseResponse :: ByteString -> Either String Response
    parseResponse ByteString
    inputStr =
        do (topStr,restStr) <- String
    -> Maybe (ByteString, ByteString)
    -> Either String (ByteString, ByteString)
    forall a. String -> Maybe a -> Either String a
    required String
    "failed to separate response" (Maybe (ByteString, ByteString)
     -> Either String (ByteString, ByteString))
    -> Maybe (ByteString, ByteString)
    -> Either String (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $
                               ByteString -> Maybe (ByteString, ByteString)
    splitAtEmptyLine ByteString
    inputStr
           (rsl,headerStr) <- required "failed to separate headers/body" $
                              splitAtCRLF topStr
           let (_,code) = responseLine rsl
           headers' <- case parseHeaders "host" (L.unpack headerStr) of
             Maybe [Header]
    Nothing -> String -> Either String [Header]
    forall a b. a -> Either a b
    Left String
    "failed to parse host header"
             Just [Header]
    x -> [Header] -> Either String [Header]
    forall a b. b -> Either a b
    Right [Header]
    x
           let headers = [Header] -> Headers
    mkHeaders [Header]
    headers'
           let mbCL = ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Int, ByteString) -> Int
    forall a b. (a, b) -> a
    fst (ByteString -> Maybe (Int, ByteString)
    B.readInt (ByteString -> Maybe (Int, ByteString))
    -> Maybe ByteString -> Maybe (Int, ByteString)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> Headers -> Maybe ByteString
    forall r. HasHeaders r => String -> r -> Maybe ByteString
    getHeader String
    "content-length" Headers
    headers)
           (body,_) <-
               maybe (if (isNothing $ getHeader "transfer-encoding" headers)
                           then  return (restStr,L.pack "")
                           else  return $ consumeChunks restStr)
                     (\Int
    cl->(ByteString, ByteString) -> Either String (ByteString, ByteString)
    forall a. a -> Either String a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    cl) ByteString
    restStr))
                     mbCL
           return $ Response {rsCode=code,rsHeaders=headers,rsBody=body,rsFlags=RsFlags ContentLength,rsValidator=Nothing}

    -- http://www.w3.org/Protocols/rfc2616/rfc2616-sec3.html
    -- note this does NOT handle extenions
    consumeChunks::L.ByteString->(L.ByteString,L.ByteString)
    consumeChunks :: ByteString -> (ByteString, ByteString)
    consumeChunks ByteString
    str = let ([(Int64, ByteString)]
    parts,ByteString
    tr,ByteString
    rest) = ByteString -> ([(Int64, ByteString)], ByteString, ByteString)
    consumeChunksImpl ByteString
    str in ([ByteString] -> ByteString
    L.concat ([ByteString] -> ByteString)
    -> ([(Int64, ByteString)] -> [ByteString])
    -> [(Int64, ByteString)]
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString
    tr]) ([ByteString] -> [ByteString])
    -> ([(Int64, ByteString)] -> [ByteString])
    -> [(Int64, ByteString)]
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .((Int64, ByteString) -> ByteString)
    -> [(Int64, ByteString)] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int64, ByteString) -> ByteString
    forall a b. (a, b) -> b
    snd ([(Int64, ByteString)] -> ByteString)
    -> [(Int64, ByteString)] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [(Int64, ByteString)]
    parts,ByteString
    rest)

    consumeChunksImpl :: L.ByteString -> ([(Int64, L.ByteString)], L.ByteString, L.ByteString)
    consumeChunksImpl :: ByteString -> ([(Int64, ByteString)], ByteString, ByteString)
    consumeChunksImpl ByteString
    str
        | ByteString -> Bool
    L.null ByteString
    str = ([],ByteString
    L.empty,ByteString
    str)
        | Int64
    chunkLen Int64 -> Int64 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int64
    0 = let (ByteString
    last,ByteString
    rest') = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt Int64
    lenLine1 ByteString
    str
                              (ByteString
    tr',ByteString
    rest'') = ByteString -> (ByteString, ByteString)
    getTrailer ByteString
    rest'
                          in ([(Int64
    0,ByteString
    last)],ByteString
    tr',ByteString
    rest'')
        | Bool
    otherwise = ((Int64
    chunkLen,ByteString
    part)(Int64, ByteString)
    -> [(Int64, ByteString)] -> [(Int64, ByteString)]
    forall a. a -> [a] -> [a]
    :[(Int64, ByteString)]
    crest,ByteString
    tr,ByteString
    rest2)
        where
          line1 :: ByteString
    line1 = [ByteString] -> ByteString
    forall a. HasCallStack => [a] -> a
    head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    lazylines ByteString
    str
          lenLine1 :: Int64
    lenLine1 = (ByteString -> Int64
    L.length ByteString
    line1) Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    1 -- endchar
          chunkLen :: Int64
    chunkLen = ((Int64, String) -> Int64
    forall a b. (a, b) -> a
    fst ((Int64, String) -> Int64) -> (Int64, String) -> Int64
    forall a b. (a -> b) -> a -> b
    $ [(Int64, String)] -> (Int64, String)
    forall a. HasCallStack => [a] -> a
    head ([(Int64, String)] -> (Int64, String))
    -> [(Int64, String)] -> (Int64, String)
    forall a b. (a -> b) -> a -> b
    $ ReadS Int64
    forall a. (Eq a, Num a) => ReadS a
    readHex ReadS Int64 -> ReadS Int64
    forall a b. (a -> b) -> a -> b
    $ ByteString -> String
    L.unpack ByteString
    line1)
          len :: Int64
    len = Int64
    chunkLen Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    lenLine1 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + Int64
    2
          (ByteString
    part,ByteString
    rest) = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt Int64
    len ByteString
    str
          ([(Int64, ByteString)]
    crest,ByteString
    tr,ByteString
    rest2) = ByteString -> ([(Int64, ByteString)], ByteString, ByteString)
    consumeChunksImpl ByteString
    rest
          getTrailer :: ByteString -> (ByteString, ByteString)
    getTrailer ByteString
    s = Int64 -> ByteString -> (ByteString, ByteString)
    L.splitAt Int64
    index ByteString
    s
              where index :: Int64
    index | ByteString
    crlfLC ByteString -> ByteString -> Bool
    `L.isPrefixOf` ByteString
    s = Int64
    2
                          | Bool
    otherwise = let iscrlf :: [Bool]
    iscrlf = (Char -> Char -> Bool) -> ByteString -> ByteString -> [Bool]
    forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
    L.zipWith (\Char
    a Char
    b -> Char
    a Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\r' Bool -> Bool -> Bool
    && Char
    b Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '\n') ByteString
    s (ByteString -> [Bool])
    -> (ByteString -> ByteString) -> ByteString -> [Bool]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    L.tail (ByteString -> [Bool]) -> ByteString -> [Bool]
    forall a b. (a -> b) -> a -> b
    $ ByteString
    s
                                            Just Int
    i = Bool -> [Bool] -> Maybe Int
    forall a. Eq a => a -> [a] -> Maybe Int
    elemIndex Bool
    True ([Bool] -> Maybe Int) -> [Bool] -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Bool -> Bool) -> [Bool] -> [Bool] -> [Bool]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Bool -> Bool -> Bool
    (&&) [Bool]
    iscrlf ([Bool] -> [Bool]
    forall a. HasCallStack => [a] -> [a]
    tail ([Bool] -> [Bool]
    forall a. HasCallStack => [a] -> [a]
    tail [Bool]
    iscrlf))
                                        in Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Int64) -> Int -> Int64
    forall a b. (a -> b) -> a -> b
    $ Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4

    crlfLC :: L.ByteString
    crlfLC :: ByteString
    crlfLC = String -> ByteString
    L.pack String
    "\r\n"

    -- Properly lazy version of 'lines' for lazy bytestrings
    lazylines           :: L.ByteString -> [L.ByteString]
    lazylines :: ByteString -> [ByteString]
    lazylines ByteString
    s
        | ByteString -> Bool
    L.null ByteString
    s  = []
        | Bool
    otherwise =
            let (ByteString
    l,ByteString
    s') = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    L.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Char
    '\n') ByteString
    s
            in ByteString
    l ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : if ByteString -> Bool
    L.null ByteString
    s' then []
                                else ByteString -> [ByteString]
    lazylines (HasCallStack => ByteString -> ByteString
    ByteString -> ByteString
    L.tail ByteString
    s')

    requestLine :: L.ByteString -> (Method, SURI, HttpVersion)
    requestLine :: ByteString -> (Method, SURI, HttpVersion)
    requestLine ByteString
    l = case ByteString -> [ByteString]
    P.words (([ByteString] -> ByteString
    P.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    L.toChunks) ByteString
    l) of
                      [ByteString
    rq,ByteString
    uri,ByteString
    ver] -> (ByteString -> Method
    method ByteString
    rq, URI -> SURI
    SURI (URI -> SURI) -> URI -> SURI
    forall a b. (a -> b) -> a -> b
    $ ByteString -> URI
    parseURIRef ByteString
    uri, ByteString -> HttpVersion
    version ByteString
    ver)
                      [ByteString
    rq,ByteString
    uri] -> (ByteString -> Method
    method ByteString
    rq, URI -> SURI
    SURI (URI -> SURI) -> URI -> SURI
    forall a b. (a -> b) -> a -> b
    $ ByteString -> URI
    parseURIRef ByteString
    uri,Int -> Int -> HttpVersion
    HttpVersion Int
    0 Int
    9)
                      [ByteString]
    x -> String -> (Method, SURI, HttpVersion)
    forall a. HasCallStack => String -> a
    error (String -> (Method, SURI, HttpVersion))
    -> String -> (Method, SURI, HttpVersion)
    forall a b. (a -> b) -> a -> b
    $ String
    "requestLine cannot handle input:  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ([ByteString] -> String
    forall a. Show a => a -> String
    show [ByteString]
    x)

    responseLine :: L.ByteString -> (B.ByteString, Int)
    responseLine :: ByteString -> (ByteString, Int)
    responseLine ByteString
    l = case ByteString -> [ByteString]
    B.words (([ByteString] -> ByteString
    B.concat ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    L.toChunks) ByteString
    l) of
                       (ByteString
    v:ByteString
    c:[ByteString]
    _) -> ByteString -> HttpVersion
    version ByteString
    v HttpVersion -> (ByteString, Int) -> (ByteString, Int)
    forall a b. a -> b -> b
    `seq` (ByteString
    v,(Int, ByteString) -> Int
    forall a b. (a, b) -> a
    fst (Maybe (Int, ByteString) -> (Int, ByteString)
    forall a. HasCallStack => Maybe a -> a
    fromJust (ByteString -> Maybe (Int, ByteString)
    B.readInt ByteString
    c)))
                       [ByteString]
    x -> String -> (ByteString, Int)
    forall a. HasCallStack => String -> a
    error (String -> (ByteString, Int)) -> String -> (ByteString, Int)
    forall a b. (a -> b) -> a -> b
    $ String
    "responseLine cannot handle input: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ([ByteString] -> String
    forall a. Show a => a -> String
    show [ByteString]
    x)

    method :: B.ByteString -> Method
    method :: ByteString -> Method
    method ByteString
    r = Maybe Method -> Method
    fj (Maybe Method -> Method) -> Maybe Method -> Method
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [(ByteString, Method)] -> Maybe Method
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup ByteString
    r [(ByteString, Method)]
    mtable
        where fj :: Maybe Method -> Method
    fj (Just Method
    x) = Method
    x
              fj Maybe Method
    Nothing  = ByteString -> Method
    EXTENSION ByteString
    r
              mtable :: [(ByteString, Method)]
    mtable = [ (String -> ByteString
    P.pack String
    "GET",     Method
    GET)
                       , (String -> ByteString
    P.pack String
    "HEAD",    Method
    HEAD)
                       , (String -> ByteString
    P.pack String
    "POST",    Method
    POST)
                       , (String -> ByteString
    P.pack String
    "PUT",     Method
    PUT)
                       , (String -> ByteString
    P.pack String
    "DELETE",  Method
    DELETE)
                       , (String -> ByteString
    P.pack String
    "TRACE",   Method
    TRACE)
                       , (String -> ByteString
    P.pack String
    "OPTIONS", Method
    OPTIONS)
                       , (String -> ByteString
    P.pack String
    "CONNECT", Method
    CONNECT)
                       , (String -> ByteString
    P.pack String
    "PATCH",   Method
    PATCH)
                       ]

    -- Result side

    staticHeaders :: Headers
    staticHeaders :: Headers
    staticHeaders =
        ((ByteString, ByteString) -> Headers -> Headers)
    -> Headers -> [(ByteString, ByteString)] -> Headers
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr ((ByteString -> ByteString -> Headers -> Headers)
    -> (ByteString, ByteString) -> Headers -> Headers
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry ByteString -> ByteString -> Headers -> Headers
    forall r. HasHeaders r => ByteString -> ByteString -> r -> r
    setHeaderBS) ([Header] -> Headers
    mkHeaders [])
        [ (ByteString
    serverC, ByteString
    happstackC) ]

    -- FIXME: we should not be controlling the response headers in mysterious ways in this low level code
    -- headers should be set by application code and the core http engine should be very lean.
    putAugmentedResult :: TimeoutIO -> Request -> Response -> IO ()
    putAugmentedResult :: TimeoutIO -> Request -> Response -> IO ()
    putAugmentedResult TimeoutIO
    timeoutIO Request
    req Response
    res = do
        case Response
    res of
            -- standard bytestring response
            Response {} -> do
                let isChunked :: Bool
    isChunked = RsFlags -> Length
    rsfLength (Response -> RsFlags
    rsFlags Response
    res) Length -> Length -> Bool
    forall a. Eq a => a -> a -> Bool
    == Length
    TransferEncodingChunked Bool -> Bool -> Bool
    && Request -> Bool
    isHTTP1_1 Request
    req
                Maybe Integer -> Bool -> IO ()
    sendTop (if Bool
    isChunked then Maybe Integer
    forall a. Maybe a
    Nothing else (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just (Int64 -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int64
    L.length (Response -> ByteString
    rsBody Response
    res))))) Bool
    isChunked
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Request -> Method
    rqMethod Request
    req Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Method
    HEAD)
                         (let body :: ByteString
    body = if Bool
    isChunked
                                     then ByteString -> ByteString
    chunk (Response -> ByteString
    rsBody Response
    res)
                                     else Response -> ByteString
    rsBody Response
    res
                          in TimeoutIO -> ByteString -> IO ()
    toPutLazy TimeoutIO
    timeoutIO ByteString
    body)
            -- zero-copy sendfile response
            -- the handle *should* be closed by the garbage collector

            SendFile {} -> do
                let infp :: String
    infp = Response -> String
    sfFilePath Response
    res
                    off :: Integer
    off = Response -> Integer
    sfOffset Response
    res
                    count :: Integer
    count = Response -> Integer
    sfCount Response
    res
                Maybe Integer -> Bool -> IO ()
    sendTop (Integer -> Maybe Integer
    forall a. a -> Maybe a
    Just Integer
    count) Bool
    False
                Handle -> IO ()
    TM.tickle (TimeoutIO -> Handle
    toHandle TimeoutIO
    timeoutIO)
                TimeoutIO -> String -> Integer -> Integer -> IO ()
    toSendFile TimeoutIO
    timeoutIO String
    infp Integer
    off Integer
    count

        where ph :: HeaderPair -> [ByteString]
    ph (HeaderPair ByteString
    k [ByteString]
    vs) = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ByteString
    v -> [ByteString] -> ByteString
    P.concat [ByteString
    k, ByteString
    fsepC, ByteString
    v, ByteString
    crlfC]) [ByteString]
    vs
              sendTop :: Maybe Integer -> Bool -> IO ()
    sendTop Maybe Integer
    cl Bool
    isChunked = do
                  allHeaders <- Request -> Response -> Maybe Integer -> Bool -> IO Headers
    augmentHeaders Request
    req Response
    res Maybe Integer
    cl Bool
    isChunked
                  toPut timeoutIO $ B.concat $ concat
                     [ (pversion $ rqVersion req)          -- Print HTTP version
                     , [responseMessage $ rsCode res]      -- Print responseCode
                     , concatMap ph (M.elems allHeaders)   -- Print all headers
                     , [crlfC]
                     ]
                  TM.tickle (toHandle timeoutIO)
              chunk :: L.ByteString -> L.ByteString
              chunk :: ByteString -> ByteString
    chunk ByteString
    Empty        = String -> ByteString
    LC.pack String
    "0\r\n\r\n"
              chunk (Chunk ByteString
    c ByteString
    cs) = ByteString -> ByteString -> ByteString
    Chunk (String -> ByteString
    B.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Integral a => a -> String -> String
    showHex (ByteString -> Int
    B.length ByteString
    c) String
    "\r\n") (ByteString -> ByteString -> ByteString
    Chunk ByteString
    c (ByteString -> ByteString -> ByteString
    Chunk (String -> ByteString
    B.pack String
    "\r\n") (ByteString -> ByteString
    chunk ByteString
    cs)))

    augmentHeaders :: Request -> Response -> Maybe Integer -> Bool -> IO Headers
    augmentHeaders :: Request -> Response -> Maybe Integer -> Bool -> IO Headers
    augmentHeaders Request
    req Response
    res Maybe Integer
    mcl Bool
    isChunked = do
        -- TODO: Hoist static headers to the toplevel.
        raw <- IO ByteString
    getApproximateTime
        let stdHeaders = Headers
    staticHeaders Headers -> Headers -> Headers
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    `M.union`
              [(ByteString, HeaderPair)] -> Headers
    forall k a. Ord k => [(k, a)] -> Map k a
    M.fromList ( [ (ByteString
    dateCLower,       ByteString -> [ByteString] -> HeaderPair
    HeaderPair ByteString
    dateC [ByteString
    raw])
                           , (ByteString
    connectionCLower, ByteString -> [ByteString] -> HeaderPair
    HeaderPair ByteString
    connectionC [if Request -> Response -> Bool
    continueHTTP Request
    req Response
    res then ByteString
    keepAliveC else ByteString
    closeC])
                           ] [(ByteString, HeaderPair)]
    -> [(ByteString, HeaderPair)] -> [(ByteString, HeaderPair)]
    forall a. [a] -> [a] -> [a]
    ++ case RsFlags -> Length
    rsfLength (Response -> RsFlags
    rsFlags Response
    res) of
                                  Length
    NoContentLength -> []
                                  Length
    ContentLength | Bool -> Bool
    not (String -> Response -> Bool
    forall r. HasHeaders r => String -> r -> Bool
    hasHeader String
    "Content-Length" Response
    res) ->
                                                    case Maybe Integer
    mcl of
                                                      (Just Integer
    cl) -> [(ByteString
    contentlengthC, ByteString -> [ByteString] -> HeaderPair
    HeaderPair ByteString
    contentLengthC [String -> ByteString
    P.pack (Integer -> String
    forall a. Show a => a -> String
    show Integer
    cl)])]
                                                      Maybe Integer
    _ -> []
                                                | Bool
    otherwise -> []
                                  Length
    TransferEncodingChunked
                                      -- we check 'chunked' because we might not use this mode if the client is http 1.0
                                      | Bool
    isChunked -> [(ByteString
    transferEncodingC, ByteString -> [ByteString] -> HeaderPair
    HeaderPair ByteString
    transferEncodingC [ByteString
    chunkedC])]
                                      | Bool
    otherwise -> []

                         )
        return (rsHeaders res `M.union` stdHeaders) -- 'union' prefers 'headers res' when duplicate keys are encountered.

    -- | Serializes the request to the given handle
    putRequest :: Handle -> Request -> IO ()
    putRequest :: Handle -> Request -> IO ()
    putRequest Handle
    h Request
    rq = do
        let put :: ByteString -> IO ()
    put = Handle -> ByteString -> IO ()
    B.hPut Handle
    h
            ph :: HeaderPair -> [ByteString]
    ph (HeaderPair ByteString
    k [ByteString]
    vs) = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ByteString
    v -> [ByteString] -> ByteString
    B.concat [ByteString
    k, ByteString
    fsepC, ByteString
    v, ByteString
    crlfC]) [ByteString]
    vs
            sp :: [ByteString]
    sp = [String -> ByteString
    B.pack String
    " "]
        (ByteString -> IO ()) -> [ByteString] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ByteString -> IO ()
    put ([ByteString] -> IO ()) -> [ByteString] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [[ByteString]] -> [ByteString]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [[String -> ByteString
    B.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Method -> String
    forall a. Show a => a -> String
    show (Method -> String) -> Method -> String
    forall a b. (a -> b) -> a -> b
    $ Request -> Method
    rqMethod Request
    rq],[ByteString]
    sp
          ,[String -> ByteString
    B.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> String
    rqURL Request
    rq],[ByteString]
    sp
          ,(HttpVersion -> [ByteString]
    pversion (HttpVersion -> [ByteString]) -> HttpVersion -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Request -> HttpVersion
    rqVersion Request
    rq), [ByteString
    crlfC]
          ,(HeaderPair -> [ByteString]) -> [HeaderPair] -> [ByteString]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap HeaderPair -> [ByteString]
    ph (Headers -> [HeaderPair]
    forall k a. Map k a -> [a]
    M.elems (Headers -> [HeaderPair]) -> Headers -> [HeaderPair]
    forall a b. (a -> b) -> a -> b
    $ Request -> Headers
    rqHeaders Request
    rq)
          ,[ByteString
    crlfC]
          ]
        mBody <- Request -> IO (Maybe RqBody)
    forall (m :: * -> *). MonadIO m => Request -> m (Maybe RqBody)
    takeRequestBody Request
    rq -- tryTakeMVar (rqBody rq)
        L.hPut h (maybe L.empty unBody mBody) -- FIXME: should this actually be an error if the body is null?
        hFlush h

    -- HttpVersion

    pversion :: HttpVersion -> [B.ByteString]
    pversion :: HttpVersion -> [ByteString]
    pversion (HttpVersion Int
    1 Int
    1) = [ByteString
    http11]
    pversion (HttpVersion Int
    1 Int
    0) = [ByteString
    http10]
    pversion (HttpVersion Int
    x Int
    y) = [String -> ByteString
    P.pack String
    "HTTP/", String -> ByteString
    P.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    x), String -> ByteString
    P.pack String
    ".", String -> ByteString
    P.pack (Int -> String
    forall a. Show a => a -> String
    show Int
    y)]

    version :: B.ByteString -> HttpVersion
    version :: ByteString -> HttpVersion
    version ByteString
    x | ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    http09 = Int -> Int -> HttpVersion
    HttpVersion Int
    0 Int
    9
              | ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    http10 = Int -> Int -> HttpVersion
    HttpVersion Int
    1 Int
    0
              | ByteString
    x ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    http11 = Int -> Int -> HttpVersion
    HttpVersion Int
    1 Int
    1
              | Bool
    otherwise   = String -> HttpVersion
    forall a. HasCallStack => String -> a
    error String
    "Invalid HTTP version"

    http09 :: B.ByteString
    http09 :: ByteString
    http09 = String -> ByteString
    P.pack String
    "HTTP/0.9"
    http10 :: B.ByteString
    http10 :: ByteString
    http10 = String -> ByteString
    P.pack String
    "HTTP/1.0"
    http11 :: B.ByteString
    http11 :: ByteString
    http11 = String -> ByteString
    P.pack String
    "HTTP/1.1"

    -- * ByteString Constants

    connectionC :: B.ByteString
    connectionC :: ByteString
    connectionC      = String -> ByteString
    P.pack String
    "Connection"
    connectionCLower :: B.ByteString
    connectionCLower :: ByteString
    connectionCLower = (Char -> Char) -> ByteString -> ByteString
    P.map Char -> Char
    toLower ByteString
    connectionC
    closeC :: B.ByteString
    closeC :: ByteString
    closeC           = String -> ByteString
    P.pack String
    "close"
    keepAliveC :: B.ByteString
    keepAliveC :: ByteString
    keepAliveC       = String -> ByteString
    P.pack String
    "Keep-Alive"
    crlfC :: B.ByteString
    crlfC :: ByteString
    crlfC            = String -> ByteString
    P.pack String
    "\r\n"
    fsepC :: B.ByteString
    fsepC :: ByteString
    fsepC            = String -> ByteString
    P.pack String
    ": "
    -- contentTypeC :: B.ByteString
    -- contentTypeC     = P.pack "Content-Type"
    contentLengthC :: B.ByteString
    contentLengthC :: ByteString
    contentLengthC   = String -> ByteString
    P.pack String
    "Content-Length"
    contentlengthC :: B.ByteString
    contentlengthC :: ByteString
    contentlengthC   = String -> ByteString
    P.pack String
    "content-length"
    dateC :: B.ByteString
    dateC :: ByteString
    dateC            = String -> ByteString
    P.pack String
    "Date"
    dateCLower :: B.ByteString
    dateCLower :: ByteString
    dateCLower       = (Char -> Char) -> ByteString -> ByteString
    P.map Char -> Char
    toLower ByteString
    dateC
    serverC :: B.ByteString
    serverC :: ByteString
    serverC          = String -> ByteString
    P.pack String
    "Server"
    happstackC :: B.ByteString
    happstackC :: ByteString
    happstackC           = String -> ByteString
    P.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ String
    "Happstack/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    DV.showVersion Version
    Paths.version
    -- textHtmlC :: B.ByteString
    -- textHtmlC        = P.pack "text/html; charset=utf-8"
    transferEncodingC :: B.ByteString
    transferEncodingC :: ByteString
    transferEncodingC = String -> ByteString
    P.pack String
    "Transfer-Encoding"
    chunkedC :: B.ByteString
    chunkedC :: ByteString
    chunkedC = String -> ByteString
    P.pack String
    "chunked"

    -- Response code names

    responseMessage :: (Num t, Show t, Eq t) => t -> B.ByteString
    responseMessage :: forall t. (Num t, Show t, Eq t) => t -> ByteString
    responseMessage t
    100 = String -> ByteString
    P.pack String
    " 100 Continue\r\n"
    responseMessage t
    101 = String -> ByteString
    P.pack String
    " 101 Switching Protocols\r\n"
    responseMessage t
    200 = String -> ByteString
    P.pack String
    " 200 OK\r\n"
    responseMessage t
    201 = String -> ByteString
    P.pack String
    " 201 Created\r\n"
    responseMessage t
    202 = String -> ByteString
    P.pack String
    " 202 Accepted\r\n"
    responseMessage t
    203 = String -> ByteString
    P.pack String
    " 203 Non-Authoritative Information\r\n"
    responseMessage t
    204 = String -> ByteString
    P.pack String
    " 204 No Content\r\n"
    responseMessage t
    205 = String -> ByteString
    P.pack String
    " 205 Reset Content\r\n"
    responseMessage t
    206 = String -> ByteString
    P.pack String
    " 206 Partial Content\r\n"
    responseMessage t
    300 = String -> ByteString
    P.pack String
    " 300 Multiple Choices\r\n"
    responseMessage t
    301 = String -> ByteString
    P.pack String
    " 301 Moved Permanently\r\n"
    responseMessage t
    302 = String -> ByteString
    P.pack String
    " 302 Found\r\n"
    responseMessage t
    303 = String -> ByteString
    P.pack String
    " 303 See Other\r\n"
    responseMessage t
    304 = String -> ByteString
    P.pack String
    " 304 Not Modified\r\n"
    responseMessage t
    305 = String -> ByteString
    P.pack String
    " 305 Use Proxy\r\n"
    responseMessage t
    307 = String -> ByteString
    P.pack String
    " 307 Temporary Redirect\r\n"
    responseMessage t
    400 = String -> ByteString
    P.pack String
    " 400 Bad Request\r\n"
    responseMessage t
    401 = String -> ByteString
    P.pack String
    " 401 Unauthorized\r\n"
    responseMessage t
    402 = String -> ByteString
    P.pack String
    " 402 Payment Required\r\n"
    responseMessage t
    403 = String -> ByteString
    P.pack String
    " 403 Forbidden\r\n"
    responseMessage t
    404 = String -> ByteString
    P.pack String
    " 404 Not Found\r\n"
    responseMessage t
    405 = String -> ByteString
    P.pack String
    " 405 Method Not Allowed\r\n"
    responseMessage t
    406 = String -> ByteString
    P.pack String
    " 406 Not Acceptable\r\n"
    responseMessage t
    407 = String -> ByteString
    P.pack String
    " 407 Proxy Authentication Required\r\n"
    responseMessage t
    408 = String -> ByteString
    P.pack String
    " 408 Request Time-out\r\n"
    responseMessage t
    409 = String -> ByteString
    P.pack String
    " 409 Conflict\r\n"
    responseMessage t
    410 = String -> ByteString
    P.pack String
    " 410 Gone\r\n"
    responseMessage t
    411 = String -> ByteString
    P.pack String
    " 411 Length Required\r\n"
    responseMessage t
    412 = String -> ByteString
    P.pack String
    " 412 Precondition Failed\r\n"
    responseMessage t
    413 = String -> ByteString
    P.pack String
    " 413 Request Entity Too Large\r\n"
    responseMessage t
    414 = String -> ByteString
    P.pack String
    " 414 Request-URI Too Large\r\n"
    responseMessage t
    415 = String -> ByteString
    P.pack String
    " 415 Unsupported Media Type\r\n"
    responseMessage t
    416 = String -> ByteString
    P.pack String
    " 416 Requested range not satisfiable\r\n"
    responseMessage t
    417 = String -> ByteString
    P.pack String
    " 417 Expectation Failed\r\n"
    responseMessage t
    500 = String -> ByteString
    P.pack String
    " 500 Internal Server Error\r\n"
    responseMessage t
    501 = String -> ByteString
    P.pack String
    " 501 Not Implemented\r\n"
    responseMessage t
    502 = String -> ByteString
    P.pack String
    " 502 Bad Gateway\r\n"
    responseMessage t
    503 = String -> ByteString
    P.pack String
    " 503 Service Unavailable\r\n"
    responseMessage t
    504 = String -> ByteString
    P.pack String
    " 504 Gateway Time-out\r\n"
    responseMessage t
    505 = String -> ByteString
    P.pack String
    " 505 HTTP Version not supported\r\n"
    responseMessage t
    x   = String -> ByteString
    P.pack (String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ t -> String
    forall a. Show a => a -> String
    show t
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " \r\n")