    {-# LANGUAGE BangPatterns        #-}
    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE DeriveDataTypeable  #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE RankNTypes          #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Snap.Internal.Http.Server.Session
      ( httpAcceptLoop
      , httpSession
      , snapToServerHandler
      , BadRequestException(..)
      , LengthRequiredException(..)
      , TerminateSessionException(..)
      ) where

    ------------------------------------------------------------------------------
    #if !MIN_VERSION_base(4,8,0)
    import           Control.Applicative                      ((<$>))
    #endif
    import           Control.Arrow                            (first, second)
    import           Control.Concurrent                       (MVar, newEmptyMVar, putMVar, readMVar)
    import           Control.Exception                        (AsyncException, Exception, Handler (..), SomeException (..))
    import qualified Control.Exception                        as E
    import           Control.Monad                            (join, unless, void, when, (>=>))
    import           Data.ByteString.Char8                    (ByteString)
    import qualified Data.ByteString.Char8                    as S
    import qualified Data.ByteString.Unsafe                   as S
    import qualified Data.CaseInsensitive                     as CI
    import           Data.Int                                 (Int64)
    import           Data.IORef                               (IORef, newIORef, readIORef, writeIORef)
    import           Data.List                                (foldl')
    import qualified Data.Map                                 as Map
    import           Data.Maybe                               (fromJust, fromMaybe, isNothing)
    #if !MIN_VERSION_base(4,8,0)
    import           Data.Monoid                              (mconcat)
    #endif
    import           Data.Monoid                              ((<>))
    import           Data.Time.Format                         (formatTime)
    import           Data.Typeable                            (Typeable)
    import           Data.Version                             (showVersion)
    import           Data.Word                                (Word64, Word8)
    import           Foreign.Marshal.Utils                    (copyBytes)
    import           Foreign.Ptr                              (Ptr, castPtr, plusPtr)
    import           Foreign.Storable                         (pokeByteOff)
    #if MIN_VERSION_time(1,5,0)
    import           Data.Time.Format                         (defaultTimeLocale)
    #else
    import           System.Locale                            (defaultTimeLocale)
    #endif
    ------------------------------------------------------------------------------
    import           Data.ByteString.Builder                  (Builder, byteString, char8, stringUtf8)
    import           Data.ByteString.Builder.Extra            (flush)
    import           Data.ByteString.Builder.Internal         (Buffer, defaultChunkSize, newBuffer)
    import           Data.ByteString.Builder.Prim             (FixedPrim, primFixed, (>$<), (>*<))
    import           Data.ByteString.Builder.Prim.Internal    (fixedPrim, size)
    import           System.IO.Streams                        (InputStream, OutputStream)
    import qualified System.IO.Streams                        as Streams
    ------------------------------------------------------------------------------
    import qualified Paths_snap_server                        as V
    import           Snap.Core                                (EscapeSnap (..))
    import           Snap.Core                                (Snap, runSnap)
    import           Snap.Internal.Core                       (fixupResponse)
    import           Snap.Internal.Http.Server.Clock          (getClockTime)
    import           Snap.Internal.Http.Server.Common         (eatException)
    import           Snap.Internal.Http.Server.Date           (getDateString)
    import           Snap.Internal.Http.Server.Parser         (IRequest (..), getStdConnection, getStdContentLength, getStdContentType, getStdCookie, getStdHost, getStdTransferEncoding, parseCookie, parseRequest, parseUrlEncoded, readChunkedTransferEncoding, writeChunkedTransferEncoding)
    import           Snap.Internal.Http.Server.Thread         (SnapThread)
    import qualified Snap.Internal.Http.Server.Thread         as Thread
    import           Snap.Internal.Http.Server.TimeoutManager (TimeoutManager)
    import qualified Snap.Internal.Http.Server.TimeoutManager as TM
    import           Snap.Internal.Http.Server.Types          (AcceptFunc (..), PerSessionData (..), SendFileHandler, ServerConfig (..), ServerHandler)
    import           Snap.Internal.Http.Types                 (Cookie (..), HttpVersion, Method (..), Request (..), Response (..), ResponseBody (..), StreamProc, getHeader, headers, rspBodyToEnum, updateHeaders)
    import           Snap.Internal.Parsing                    (unsafeFromNat)
    import           Snap.Types.Headers                       (Headers)
    import qualified Snap.Types.Headers                       as H
    import           System.IO.Unsafe                         (unsafePerformIO)

    ------------------------------------------------------------------------------
    data TerminateSessionException = TerminateSessionException SomeException
      deriving (Typeable, Int -> TerminateSessionException -> ShowS
    [TerminateSessionException] -> ShowS
    TerminateSessionException -> String
    (Int -> TerminateSessionException -> ShowS)
    -> (TerminateSessionException -> String)
    -> ([TerminateSessionException] -> ShowS)
    -> Show TerminateSessionException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TerminateSessionException -> ShowS
    showsPrec :: Int -> TerminateSessionException -> ShowS
    $cshow :: TerminateSessionException -> String
    show :: TerminateSessionException -> String
    $cshowList :: [TerminateSessionException] -> ShowS
    showList :: [TerminateSessionException] -> ShowS
    Show)
    instance Exception TerminateSessionException

    data BadRequestException = BadRequestException
      deriving (Typeable, Int -> BadRequestException -> ShowS
    [BadRequestException] -> ShowS
    BadRequestException -> String
    (Int -> BadRequestException -> ShowS)
    -> (BadRequestException -> String)
    -> ([BadRequestException] -> ShowS)
    -> Show BadRequestException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> BadRequestException -> ShowS
    showsPrec :: Int -> BadRequestException -> ShowS
    $cshow :: BadRequestException -> String
    show :: BadRequestException -> String
    $cshowList :: [BadRequestException] -> ShowS
    showList :: [BadRequestException] -> ShowS
    Show)
    instance Exception BadRequestException

    data LengthRequiredException = LengthRequiredException
      deriving (Typeable, Int -> LengthRequiredException -> ShowS
    [LengthRequiredException] -> ShowS
    LengthRequiredException -> String
    (Int -> LengthRequiredException -> ShowS)
    -> (LengthRequiredException -> String)
    -> ([LengthRequiredException] -> ShowS)
    -> Show LengthRequiredException
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> LengthRequiredException -> ShowS
    showsPrec :: Int -> LengthRequiredException -> ShowS
    $cshow :: LengthRequiredException -> String
    show :: LengthRequiredException -> String
    $cshowList :: [LengthRequiredException] -> ShowS
    showList :: [LengthRequiredException] -> ShowS
    Show)
    instance Exception LengthRequiredException

    ------------------------------------------------------------------------------
    snapToServerHandler :: Snap a -> ServerHandler hookState
    snapToServerHandler :: forall a hookState. Snap a -> ServerHandler hookState
    snapToServerHandler !Snap a
    snap !ServerConfig hookState
    serverConfig !PerSessionData
    perSessionData !Request
    req =
        Snap a
    -> (ByteString -> IO ())
    -> ((Int -> Int) -> IO ())
    -> Request
    -> IO (Request, Response)
    forall a.
    Snap a
    -> (ByteString -> IO ())
    -> ((Int -> Int) -> IO ())
    -> Request
    -> IO (Request, Response)
    runSnap Snap a
    snap ByteString -> IO ()
    logErr (Int -> Int) -> IO ()
    tickle Request
    req
      where
        logErr :: ByteString -> IO ()
    logErr = ServerConfig hookState -> Builder -> IO ()
    forall hookState. ServerConfig hookState -> Builder -> IO ()
    _logError ServerConfig hookState
    serverConfig (Builder -> IO ())
    -> (ByteString -> Builder) -> ByteString -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Builder
    byteString
        tickle :: (Int -> Int) -> IO ()
    tickle = PerSessionData -> (Int -> Int) -> IO ()
    _twiddleTimeout PerSessionData
    perSessionData

    ------------------------------------------------------------------------------
    mAX_HEADERS_SIZE :: Int64
    mAX_HEADERS_SIZE :: Int64
    mAX_HEADERS_SIZE = Int64
    256 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    1024

    ------------------------------------------------------------------------------
    -- | For each cpu, we store:
    --    * An accept thread
    --    * A TimeoutManager
    --    * An mvar to signal when the timeout thread is shutdown
    data EventLoopCpu = EventLoopCpu
        { EventLoopCpu -> SnapThread
    _acceptThread   :: SnapThread
        , EventLoopCpu -> TimeoutManager
    _timeoutManager :: TimeoutManager
        }

    ------------------------------------------------------------------------------
    -- | The main Snap webserver loop. Given a server handler, configuration, and a
    -- function to accept new connections, runs an HTTP loop forever over N
    -- threads, until a ThreadKilled exception is received.
    httpAcceptLoop :: forall hookState .
                      ServerHandler hookState  -- ^ server handler
                   -> ServerConfig hookState   -- ^ server config
                   -> AcceptFunc               -- ^ accept function
                   -> IO ()
    httpAcceptLoop :: forall hookState.
    ServerHandler hookState
    -> ServerConfig hookState -> AcceptFunc -> IO ()
    httpAcceptLoop ServerHandler hookState
    serverHandler ServerConfig hookState
    serverConfig AcceptFunc
    acceptFunc = IO ()
    runLoops
      where
        --------------------------------------------------------------------------
        logError :: Builder -> IO ()
    logError       = ServerConfig hookState -> Builder -> IO ()
    forall hookState. ServerConfig hookState -> Builder -> IO ()
    _logError ServerConfig hookState
    serverConfig
        nLoops :: Int
    nLoops         = ServerConfig hookState -> Int
    forall hookState. ServerConfig hookState -> Int
    _numAcceptLoops ServerConfig hookState
    serverConfig
        defaultTimeout :: Int
    defaultTimeout = ServerConfig hookState -> Int
    forall hookState. ServerConfig hookState -> Int
    _defaultTimeout ServerConfig hookState
    serverConfig

        --------------------------------------------------------------------------
        logException :: Exception e => e -> IO ()
        logException :: forall e. Exception e => e -> IO ()
    logException e
    e =
            Builder -> IO ()
    logError (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ ByteString -> Builder
    byteString ByteString
    "got exception in httpAcceptFunc: "
                    , e -> Builder
    forall a. Show a => a -> Builder
    fromShow e
    e
                    ]

        --------------------------------------------------------------------------
        runLoops :: IO ()
    runLoops = IO [EventLoopCpu]
    -> ([EventLoopCpu] -> IO ()) -> ([EventLoopCpu] -> IO ()) -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    E.bracket ((Int -> IO EventLoopCpu) -> [Int] -> IO [EventLoopCpu]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Int -> IO EventLoopCpu
    newLoop [Int
    0 .. (Int
    nLoops Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)])
                             ((EventLoopCpu -> IO ()) -> [EventLoopCpu] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ EventLoopCpu -> IO ()
    killLoop)
                             ((EventLoopCpu -> IO ()) -> [EventLoopCpu] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ EventLoopCpu -> IO ()
    waitLoop)

        --------------------------------------------------------------------------
        loop :: TimeoutManager
             -> (forall a. IO a -> IO a)
             -> IO ()
        loop :: TimeoutManager -> (forall a. IO a -> IO a) -> IO ()
    loop TimeoutManager
    tm forall a. IO a -> IO a
    loopRestore = IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    -> IO ()
    forall a. IO a -> IO ()
    eatException IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    go
          where
            ----------------------------------------------------------------------
            handlers :: [Handler
       (SendFileHandler, ByteString, Int, ByteString, Int,
        InputStream ByteString, OutputStream ByteString, IO ())]
    handlers =
                [ (AsyncException
     -> IO
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ()))
    -> Handler
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler ((AsyncException
      -> IO
           (SendFileHandler, ByteString, Int, ByteString, Int,
            InputStream ByteString, OutputStream ByteString, IO ()))
     -> Handler
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ()))
    -> (AsyncException
        -> IO
             (SendFileHandler, ByteString, Int, ByteString, Int,
              InputStream ByteString, OutputStream ByteString, IO ()))
    -> Handler
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a b. (a -> b) -> a -> b
    $ \(AsyncException
    e :: AsyncException) -> IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a. IO a -> IO a
    loopRestore (AsyncException
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (AsyncException
     -> IO
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ()))
    -> AsyncException
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a b. (a -> b) -> a -> b
    $! AsyncException
    e)
                , (SomeException
     -> IO
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ()))
    -> Handler
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler ((SomeException
      -> IO
           (SendFileHandler, ByteString, Int, ByteString, Int,
            InputStream ByteString, OutputStream ByteString, IO ()))
     -> Handler
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ()))
    -> (SomeException
        -> IO
             (SendFileHandler, ByteString, Int, ByteString, Int,
              InputStream ByteString, OutputStream ByteString, IO ()))
    -> Handler
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a b. (a -> b) -> a -> b
    $ \(SomeException
    e :: SomeException)  -> SomeException -> IO ()
    forall e. Exception e => e -> IO ()
    logException SomeException
    e IO ()
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    go
                ]

            go :: IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    go = do
                (sendFileHandler, localAddress, localPort, remoteAddress,
                 remotePort, readEnd, writeEnd,
                 cleanup) <- AcceptFunc
    -> (forall a. IO a -> IO a)
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    runAcceptFunc AcceptFunc
    acceptFunc IO a -> IO a
    forall a. IO a -> IO a
    loopRestore
                                           IO
      (SendFileHandler, ByteString, Int, ByteString, Int,
       InputStream ByteString, OutputStream ByteString, IO ())
    -> [Handler
          (SendFileHandler, ByteString, Int, ByteString, Int,
           InputStream ByteString, OutputStream ByteString, IO ())]
    -> IO
         (SendFileHandler, ByteString, Int, ByteString, Int,
          InputStream ByteString, OutputStream ByteString, IO ())
    forall a. IO a -> [Handler a] -> IO a
    `E.catches` [Handler
       (SendFileHandler, ByteString, Int, ByteString, Int,
        InputStream ByteString, OutputStream ByteString, IO ())]
    handlers
                let threadLabel = [ByteString] -> ByteString
    S.concat [ ByteString
    "snap-server: client "
                                           , ByteString
    remoteAddress
                                           , ByteString
    ":"
                                           , String -> ByteString
    S.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    remotePort
                                           ]
                thMVar <- newEmptyMVar
                th <- TM.register tm threadLabel $ \forall a. IO a -> IO a
    restore ->
                        IO () -> IO ()
    forall a. IO a -> IO ()
    eatException (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                        MVar TimeoutThread
    -> SendFileHandler
    -> ByteString
    -> Int
    -> ByteString
    -> Int
    -> InputStream ByteString
    -> OutputStream ByteString
    -> IO ()
    -> (forall a. IO a -> IO a)
    -> IO ()
    prep MVar TimeoutThread
    thMVar SendFileHandler
    sendFileHandler ByteString
    localAddress Int
    localPort ByteString
    remoteAddress
                             Int
    remotePort InputStream ByteString
    readEnd OutputStream ByteString
    writeEnd IO ()
    cleanup IO a -> IO a
    forall a. IO a -> IO a
    restore
                putMVar thMVar th
                go

            prep :: MVar TM.TimeoutThread
                 -> SendFileHandler
                 -> ByteString
                 -> Int
                 -> ByteString
                 -> Int
                 -> InputStream ByteString
                 -> OutputStream ByteString
                 -> IO ()
                 -> (forall a . IO a -> IO a)
                 -> IO ()
            prep :: MVar TimeoutThread
    -> SendFileHandler
    -> ByteString
    -> Int
    -> ByteString
    -> Int
    -> InputStream ByteString
    -> OutputStream ByteString
    -> IO ()
    -> (forall a. IO a -> IO a)
    -> IO ()
    prep MVar TimeoutThread
    thMVar SendFileHandler
    sendFileHandler ByteString
    localAddress Int
    localPort ByteString
    remoteAddress
                 Int
    remotePort InputStream ByteString
    readEnd OutputStream ByteString
    writeEnd IO ()
    cleanup forall a. IO a -> IO a
    restore =
              do
                connClose <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False
                newConn   <- newIORef True
                let twiddleTimeout = IO ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
    forall a. IO a -> a
    unsafePerformIO (IO ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ())
    -> IO ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                                       th <- MVar TimeoutThread -> IO TimeoutThread
    forall a. MVar a -> IO a
    readMVar MVar TimeoutThread
    thMVar
                                       return $! TM.modify th
                let cleanupTimeout = MVar TimeoutThread -> IO TimeoutThread
    forall a. MVar a -> IO a
    readMVar MVar TimeoutThread
    thMVar IO TimeoutThread -> (TimeoutThread -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TimeoutThread -> IO ()
    TM.cancel

                let !psd = IORef Bool
    -> ((Int -> Int) -> IO ())
    -> IORef Bool
    -> SendFileHandler
    -> ByteString
    -> Int
    -> ByteString
    -> Int
    -> InputStream ByteString
    -> OutputStream ByteString
    -> PerSessionData
    PerSessionData IORef Bool
    connClose
                                          (Int -> Int) -> IO ()
    twiddleTimeout
                                          IORef Bool
    newConn
                                          SendFileHandler
    sendFileHandler
                                          ByteString
    localAddress
                                          Int
    localPort
                                          ByteString
    remoteAddress
                                          Int
    remotePort
                                          InputStream ByteString
    readEnd
                                          OutputStream ByteString
    writeEnd
                restore (session psd)
                    `E.finally` cleanup
                    `E.finally` cleanupTimeout

        --------------------------------------------------------------------------
        session :: PerSessionData -> IO ()
    session PerSessionData
    psd = do
            buffer <- Int -> IO Buffer
    newBuffer Int
    defaultChunkSize
            httpSession buffer serverHandler serverConfig psd

        --------------------------------------------------------------------------
        newLoop :: Int -> IO EventLoopCpu
    newLoop Int
    cpu = IO EventLoopCpu -> IO EventLoopCpu
    forall a. IO a -> IO a
    E.mask_ (IO EventLoopCpu -> IO EventLoopCpu)
    -> IO EventLoopCpu -> IO EventLoopCpu
    forall a b. (a -> b) -> a -> b
    $ do
            -- TODO(greg): move constant into config
            tm  <- Double -> Double -> IO ClockTime -> IO TimeoutManager
    TM.initialize (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    defaultTimeout) Double
    2 IO ClockTime
    getClockTime
            let threadLabel = [ByteString] -> ByteString
    S.concat [ ByteString
    "snap-server: accept loop #"
                                       , String -> ByteString
    S.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    cpu
                                       ]

            tid <- Thread.forkOn threadLabel cpu $ loop tm
            return $! EventLoopCpu tid tm

        --------------------------------------------------------------------------
        waitLoop :: EventLoopCpu -> IO ()
    waitLoop (EventLoopCpu SnapThread
    tid TimeoutManager
    _) = SnapThread -> IO ()
    Thread.wait SnapThread
    tid

        --------------------------------------------------------------------------
        killLoop :: EventLoopCpu -> IO ()
    killLoop EventLoopCpu
    ev = IO () -> IO ()
    forall a. IO a -> IO a
    E.uninterruptibleMask_ (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            SnapThread -> IO ()
    Thread.cancelAndWait SnapThread
    tid
            TimeoutManager -> IO ()
    TM.stop TimeoutManager
    tm
          where
            tid :: SnapThread
    tid = EventLoopCpu -> SnapThread
    _acceptThread EventLoopCpu
    ev
            tm :: TimeoutManager
    tm  = EventLoopCpu -> TimeoutManager
    _timeoutManager EventLoopCpu
    ev

    ------------------------------------------------------------------------------
    httpSession :: forall hookState .
                   Buffer
                -> ServerHandler hookState
                -> ServerConfig hookState
                -> PerSessionData
                -> IO ()
    httpSession :: forall hookState.
    Buffer
    -> ServerHandler hookState
    -> ServerConfig hookState
    -> PerSessionData
    -> IO ()
    httpSession !Buffer
    buffer !ServerHandler hookState
    serverHandler !ServerConfig hookState
    config !PerSessionData
    sessionData = IO ()
    loop
      where
        --------------------------------------------------------------------------
        defaultTimeout :: Int
    defaultTimeout          = ServerConfig hookState -> Int
    forall hookState. ServerConfig hookState -> Int
    _defaultTimeout ServerConfig hookState
    config
        isSecure :: Bool
    isSecure                = ServerConfig hookState -> Bool
    forall hookState. ServerConfig hookState -> Bool
    _isSecure ServerConfig hookState
    config
        localHostname :: ByteString
    localHostname           = ServerConfig hookState -> ByteString
    forall hookState. ServerConfig hookState -> ByteString
    _localHostname ServerConfig hookState
    config
        logAccess :: Request -> Response -> Word64 -> IO ()
    logAccess               = ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
    forall hookState.
    ServerConfig hookState -> Request -> Response -> Word64 -> IO ()
    _logAccess ServerConfig hookState
    config
        logError :: Builder -> IO ()
    logError                = ServerConfig hookState -> Builder -> IO ()
    forall hookState. ServerConfig hookState -> Builder -> IO ()
    _logError ServerConfig hookState
    config
        newRequestHook :: NewRequestHook hookState
    newRequestHook          = ServerConfig hookState -> NewRequestHook hookState
    forall hookState.
    ServerConfig hookState -> NewRequestHook hookState
    _onNewRequest ServerConfig hookState
    config
        parseHook :: ParseHook hookState
    parseHook               = ServerConfig hookState -> ParseHook hookState
    forall hookState. ServerConfig hookState -> ParseHook hookState
    _onParse ServerConfig hookState
    config
        userHandlerFinishedHook :: UserHandlerFinishedHook hookState
    userHandlerFinishedHook = ServerConfig hookState -> UserHandlerFinishedHook hookState
    forall hookState.
    ServerConfig hookState -> UserHandlerFinishedHook hookState
    _onUserHandlerFinished ServerConfig hookState
    config
        dataFinishedHook :: UserHandlerFinishedHook hookState
    dataFinishedHook        = ServerConfig hookState -> UserHandlerFinishedHook hookState
    forall hookState.
    ServerConfig hookState -> UserHandlerFinishedHook hookState
    _onDataFinished ServerConfig hookState
    config
        exceptionHook :: ExceptionHook hookState
    exceptionHook           = ServerConfig hookState -> ExceptionHook hookState
    forall hookState. ServerConfig hookState -> ExceptionHook hookState
    _onException ServerConfig hookState
    config
        escapeHook :: EscapeSnapHook hookState
    escapeHook              = ServerConfig hookState -> EscapeSnapHook hookState
    forall hookState.
    ServerConfig hookState -> EscapeSnapHook hookState
    _onEscape ServerConfig hookState
    config

        --------------------------------------------------------------------------
        forceConnectionClose :: IORef Bool
    forceConnectionClose    = PerSessionData -> IORef Bool
    _forceConnectionClose PerSessionData
    sessionData
        isNewConnection :: IORef Bool
    isNewConnection         = PerSessionData -> IORef Bool
    _isNewConnection PerSessionData
    sessionData
        localAddress :: ByteString
    localAddress            = PerSessionData -> ByteString
    _localAddress PerSessionData
    sessionData
        localPort :: Int
    localPort               = PerSessionData -> Int
    _localPort PerSessionData
    sessionData
        remoteAddress :: ByteString
    remoteAddress           = PerSessionData -> ByteString
    _remoteAddress PerSessionData
    sessionData
        remotePort :: Int
    remotePort              = PerSessionData -> Int
    _remotePort PerSessionData
    sessionData
        readEnd :: InputStream ByteString
    readEnd                 = PerSessionData -> InputStream ByteString
    _readEnd PerSessionData
    sessionData
        tickle :: (Int -> Int) -> IO ()
    tickle Int -> Int
    f                = PerSessionData -> (Int -> Int) -> IO ()
    _twiddleTimeout PerSessionData
    sessionData Int -> Int
    f
        writeEnd :: OutputStream ByteString
    writeEnd                = PerSessionData -> OutputStream ByteString
    _writeEnd PerSessionData
    sessionData
        sendfileHandler :: SendFileHandler
    sendfileHandler         = PerSessionData -> SendFileHandler
    _sendfileHandler PerSessionData
    sessionData

        --------------------------------------------------------------------------
        mkBuffer :: IO (OutputStream Builder)
        mkBuffer :: IO (OutputStream Builder)
    mkBuffer = IO Buffer -> OutputStream ByteString -> IO (OutputStream Builder)
    Streams.unsafeBuilderStream (Buffer -> IO Buffer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Buffer
    buffer) OutputStream ByteString
    writeEnd

        --------------------------------------------------------------------------
        -- Begin HTTP session processing.
        loop :: IO ()
        loop :: IO ()
    loop = do
            -- peek first to ensure startHook gets generated at the right time.
            IO Bool
    readEndAtEof IO Bool -> (Bool -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ((Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (IO () -> Bool -> IO ()) -> IO () -> Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                hookState <- NewRequestHook hookState
    newRequestHook PerSessionData
    sessionData IO hookState
    -> (hookState -> IO (IORef hookState)) -> IO (IORef hookState)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= hookState -> IO (IORef hookState)
    forall a. a -> IO (IORef a)
    newIORef
                -- parse HTTP request
                req <- receiveRequest
                parseHook hookState req
                processRequest hookState req)

        ------------------------------------------------------------------------------
        readEndAtEof :: IO Bool
    readEndAtEof = InputStream ByteString -> IO (Maybe ByteString)
    forall a. InputStream a -> IO (Maybe a)
    Streams.read InputStream ByteString
    readEnd IO (Maybe ByteString) -> (Maybe ByteString -> IO Bool) -> IO Bool
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                       IO Bool -> (ByteString -> IO Bool) -> Maybe ByteString -> IO Bool
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True)
                             (\ByteString
    c -> if ByteString -> Bool
    S.null ByteString
    c
                                      then IO Bool
    readEndAtEof
                                      else ByteString -> InputStream ByteString -> IO ()
    forall a. a -> InputStream a -> IO ()
    Streams.unRead ByteString
    c InputStream ByteString
    readEnd IO () -> IO Bool -> IO Bool
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False)
        {-# INLINE readEndAtEof #-}

        --------------------------------------------------------------------------
        -- Read the HTTP request from the socket, parse it, and pre-process it.
        receiveRequest :: IO Request
        receiveRequest :: IO Request
    receiveRequest = {-# SCC "httpSession/receiveRequest" #-} do
            readEnd' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan Int64
    mAX_HEADERS_SIZE InputStream ByteString
    readEnd
            parseRequest readEnd' >>= toRequest
        {-# INLINE receiveRequest #-}

        --------------------------------------------------------------------------
        toRequest :: IRequest -> IO Request
        toRequest :: IRequest -> IO Request
    toRequest !IRequest
    ireq = {-# SCC "httpSession/toRequest" #-} do
            -- HTTP spec section 14.23: "All Internet-based HTTP/1.1 servers MUST
            -- respond with a 400 (Bad Request) status code to any HTTP/1.1 request
            -- message which lacks a Host header field."
            --
            -- Here we interpret this slightly more liberally: if an absolute URI
            -- including a hostname is given in the request line, we'll take that
            -- if there's no Host header.
            --
            -- For HTTP/1.0 requests, we pick the configured local hostname by
            -- default.
            host <- IO ByteString
    -> (ByteString -> IO ByteString)
    -> Maybe ByteString
    -> IO ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (if Bool
    isHttp11
                             then IO ByteString
    forall a. IO a
    badRequestWithNoHost
                             else ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ByteString
    localHostname)
                          ByteString -> IO ByteString
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    mbHost

            -- Call setupReadEnd, which handles transfer-encoding: chunked or
            -- content-length restrictions, etc
            !readEnd' <- setupReadEnd

            -- Parse an application/x-www-form-urlencoded form, if it was sent
            (!readEnd'', postParams) <- parseForm readEnd'

            let allParams = ([ByteString] -> [ByteString] -> [ByteString])
    -> Map ByteString [ByteString]
    -> Map ByteString [ByteString]
    -> Map ByteString [ByteString]
    forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
    Map.unionWith [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    (++) Map ByteString [ByteString]
    queryParams Map ByteString [ByteString]
    postParams

            -- Decide whether the connection should be closed after the response is
            -- sent (stored in the forceConnectionClose IORef).
            checkConnectionClose version $ getStdConnection stdHdrs

            -- The request is now ready for processing.
            return $! Request host
                              remoteAddress
                              remotePort
                              localAddress
                              localPort
                              localHost
                              isSecure
                              hdrs
                              readEnd''
                              mbCL
                              method
                              version
                              cookies
                              pathInfo
                              contextPath
                              uri
                              queryString
                              allParams
                              queryParams
                              postParams

          where
            ----------------------------------------------------------------------
            !method :: Method
    method       = IRequest -> Method
    iMethod IRequest
    ireq
            !version :: HttpVersion
    version      = IRequest -> HttpVersion
    iHttpVersion IRequest
    ireq
            !stdHdrs :: StandardHeaders
    stdHdrs      = IRequest -> StandardHeaders
    iStdHeaders IRequest
    ireq
            !hdrs :: Headers
    hdrs         = IRequest -> Headers
    iRequestHeaders IRequest
    ireq

            !isHttp11 :: Bool
    isHttp11     = HttpVersion
    version HttpVersion -> HttpVersion -> Bool
    forall a. Ord a => a -> a -> Bool
    >= (Int
    1, Int
    1)

            !mbHost :: Maybe ByteString
    mbHost       = StandardHeaders -> Maybe ByteString
    getStdHost StandardHeaders
    stdHdrs
            !localHost :: ByteString
    localHost    = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    localHostname Maybe ByteString
    mbHost
            mbCL :: Maybe Word64
    mbCL          = ByteString -> Word64
    forall a. (Enum a, Num a, Bits a) => ByteString -> a
    unsafeFromNat (ByteString -> Word64) -> Maybe ByteString -> Maybe Word64
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>
                            StandardHeaders -> Maybe ByteString
    getStdContentLength StandardHeaders
    stdHdrs
            !isChunked :: Bool
    isChunked    = (ByteString -> CI ByteString
    forall s. FoldCase s => s -> CI s
    CI.mk (ByteString -> CI ByteString)
    -> Maybe ByteString -> Maybe (CI ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StandardHeaders -> Maybe ByteString
    getStdTransferEncoding StandardHeaders
    stdHdrs)
                                Maybe (CI ByteString) -> Maybe (CI ByteString) -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI ByteString -> Maybe (CI ByteString)
    forall a. a -> Maybe a
    Just CI ByteString
    "chunked"
            cookies :: [Cookie]
    cookies       = [Cookie] -> Maybe [Cookie] -> [Cookie]
    forall a. a -> Maybe a -> a
    fromMaybe [] (StandardHeaders -> Maybe ByteString
    getStdCookie StandardHeaders
    stdHdrs Maybe ByteString
    -> (ByteString -> Maybe [Cookie]) -> Maybe [Cookie]
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= ByteString -> Maybe [Cookie]
    parseCookie)
            contextPath :: ByteString
    contextPath   = ByteString
    "/"
            !uri :: ByteString
    uri          = IRequest -> ByteString
    iRequestUri IRequest
    ireq
            queryParams :: Map ByteString [ByteString]
    queryParams   = ByteString -> Map ByteString [ByteString]
    parseUrlEncoded ByteString
    queryString
            emptyParams :: Map k a
    emptyParams   = Map k a
    forall k a. Map k a
    Map.empty

            ----------------------------------------------------------------------
            (ByteString
    pathInfo, ByteString
    queryString) = (ByteString -> ByteString)
    -> (ByteString, ByteString) -> (ByteString, ByteString)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first ByteString -> ByteString
    dropLeadingSlash ((ByteString, ByteString) -> (ByteString, ByteString))
    -> ((ByteString, ByteString) -> (ByteString, ByteString))
    -> (ByteString, ByteString)
    -> (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString -> ByteString)
    -> (ByteString, ByteString) -> (ByteString, ByteString)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Int -> ByteString -> ByteString
    S.drop Int
    1)
                                        ((ByteString, ByteString) -> (ByteString, ByteString))
    -> (ByteString, ByteString) -> (ByteString, ByteString)
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    S.break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '?') ByteString
    uri

            ----------------------------------------------------------------------
            dropLeadingSlash :: ByteString -> ByteString
    dropLeadingSlash ByteString
    s = if ByteString -> Bool
    S.null ByteString
    s
                                   then ByteString
    s
                                   else let !a :: Word8
    a = ByteString -> Int -> Word8
    S.unsafeIndex ByteString
    s Int
    0
                                        in if Word8
    a Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Word8
    47   -- 47 == '/'
                                             then Int -> ByteString -> ByteString
    S.unsafeDrop Int
    1 ByteString
    s
                                             else ByteString
    s
            {-# INLINE dropLeadingSlash #-}

            ----------------------------------------------------------------------
            -- | We have to transform the read end of the socket, to limit the
            -- number of bytes read to the content-length, to decode chunked
            -- transfer encoding, or to immediately yield EOF if the request body
            -- is empty.
            setupReadEnd :: IO (InputStream ByteString)
            setupReadEnd :: IO (InputStream ByteString)
    setupReadEnd =
                if Bool
    isChunked
                  then InputStream ByteString -> IO (InputStream ByteString)
    readChunkedTransferEncoding InputStream ByteString
    readEnd
                  else (InputStream ByteString -> IO (InputStream ByteString))
    -> (Word64
        -> InputStream ByteString -> IO (InputStream ByteString))
    -> Maybe Word64
    -> InputStream ByteString
    -> IO (InputStream ByteString)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (IO (InputStream ByteString)
    -> InputStream ByteString -> IO (InputStream ByteString)
    forall a b. a -> b -> a
    const IO (InputStream ByteString)
    noContentLength)
                             (Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.takeBytes (Int64 -> InputStream ByteString -> IO (InputStream ByteString))
    -> (Word64 -> Int64)
    -> Word64
    -> InputStream ByteString
    -> IO (InputStream ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Word64 -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral) Maybe Word64
    mbCL InputStream ByteString
    readEnd
            {-# INLINE setupReadEnd #-}

            ----------------------------------------------------------------------
            -- | If a request is not in chunked transfer encoding and lacks a
            -- content-length, the request body is null string.
            noContentLength :: IO (InputStream ByteString)
            noContentLength :: IO (InputStream ByteString)
    noContentLength = do
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Method
    method Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    POST Bool -> Bool -> Bool
    || Method
    method Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    PUT) IO ()
    forall a. IO a
    return411
                [ByteString] -> IO (InputStream ByteString)
    forall c. [c] -> IO (InputStream c)
    Streams.fromList []

            ----------------------------------------------------------------------
            return411 :: IO b
    return411 = do
                let (Int
    major, Int
    minor) = HttpVersion
    version
                let resp :: Builder
    resp = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ ByteString -> Builder
    byteString ByteString
    "HTTP/"
                                   , Int -> Builder
    forall a. Show a => a -> Builder
    fromShow Int
    major
                                   , Char -> Builder
    char8 Char
    '.'
                                   , Int -> Builder
    forall a. Show a => a -> Builder
    fromShow Int
    minor
                                   , ByteString -> Builder
    byteString ByteString
    " 411 Length Required\r\n\r\n"
                                   , ByteString -> Builder
    byteString ByteString
    "411 Length Required\r\n"
                                   , Builder
    flush
                                   ]
                writeEndB <- IO (OutputStream Builder)
    mkBuffer
                Streams.write (Just resp) writeEndB
                Streams.write Nothing writeEndB
                terminateSession LengthRequiredException

            ----------------------------------------------------------------------
            parseForm :: InputStream ByteString
    -> IO (InputStream ByteString, Map ByteString [ByteString])
    parseForm InputStream ByteString
    readEnd' = if Bool
    hasForm
                                   then IO (InputStream ByteString, Map ByteString [ByteString])
    getForm
                                   else (InputStream ByteString, Map ByteString [ByteString])
    -> IO (InputStream ByteString, Map ByteString [ByteString])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (InputStream ByteString
    readEnd', Map ByteString [ByteString]
    forall k a. Map k a
    emptyParams)
              where
                trimIt :: ByteString -> ByteString
    trimIt  = (ByteString, ByteString) -> ByteString
    forall a b. (a, b) -> a
    fst ((ByteString, ByteString) -> ByteString)
    -> (ByteString -> (ByteString, ByteString))
    -> ByteString
    -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    S.spanEnd (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') (ByteString -> (ByteString, ByteString))
    -> (ByteString -> ByteString)
    -> ByteString
    -> (ByteString, ByteString)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    S.takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ';')
                              (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    S.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ')
                mbCT :: Maybe ByteString
    mbCT    = ByteString -> ByteString
    trimIt (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> StandardHeaders -> Maybe ByteString
    getStdContentType StandardHeaders
    stdHdrs
                hasForm :: Bool
    hasForm = Maybe ByteString
    mbCT Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "application/x-www-form-urlencoded"

                mAX_POST_BODY_SIZE :: Int64
    mAX_POST_BODY_SIZE = Int64
    1024 Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    * Int64
    1024

                getForm :: IO (InputStream ByteString, Map ByteString [ByteString])
    getForm = do
                    readEnd'' <- Int64 -> InputStream ByteString -> IO (InputStream ByteString)
    Streams.throwIfProducesMoreThan
                                   Int64
    mAX_POST_BODY_SIZE InputStream ByteString
    readEnd'
                    contents  <- S.concat <$> Streams.toList readEnd''
                    let postParams = ByteString -> Map ByteString [ByteString]
    parseUrlEncoded ByteString
    contents
                    finalReadEnd <- Streams.fromList [contents]
                    return (finalReadEnd, postParams)

        ----------------------------------------------------------------------
        checkConnectionClose :: (a, b) -> Maybe a -> IO ()
    checkConnectionClose (a, b)
    version Maybe a
    connection = do
            -- For HTTP/1.1: if there is an explicit Connection: close, we'll close
            -- the socket later.
            --
            -- For HTTP/1.0: if there is no explicit Connection: Keep-Alive,
            -- close the socket later.
            let v :: Maybe (CI a)
    v = a -> CI a
    forall s. FoldCase s => s -> CI s
    CI.mk (a -> CI a) -> Maybe a -> Maybe (CI a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe a
    connection
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (((a, b)
    version (a, b) -> (a, b) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (a
    1, b
    1) Bool -> Bool -> Bool
    && Maybe (CI a)
    v Maybe (CI a) -> Maybe (CI a) -> Bool
    forall a. Eq a => a -> a -> Bool
    == CI a -> Maybe (CI a)
    forall a. a -> Maybe a
    Just CI a
    "close") Bool -> Bool -> Bool
    ||
                  ((a, b)
    version (a, b) -> (a, b) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (a
    1, b
    0) Bool -> Bool -> Bool
    && Maybe (CI a)
    v Maybe (CI a) -> Maybe (CI a) -> Bool
    forall a. Eq a => a -> a -> Bool
    /= CI a -> Maybe (CI a)
    forall a. a -> Maybe a
    Just CI a
    "keep-alive")) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                  IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Bool
    forceConnectionClose Bool
    True

        --------------------------------------------------------------------------
        {-# INLINE badRequestWithNoHost #-}
        badRequestWithNoHost :: IO a
        badRequestWithNoHost :: forall a. IO a
    badRequestWithNoHost = do
            let msg :: Builder
    msg = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [
                        ByteString -> Builder
    byteString ByteString
    "HTTP/1.1 400 Bad Request\r\n\r\n"
                      , ByteString -> Builder
    byteString ByteString
    "400 Bad Request: HTTP/1.1 request with no "
                      , ByteString -> Builder
    byteString ByteString
    "Host header\r\n"
                      , Builder
    flush
                      ]
            writeEndB <- IO (OutputStream Builder)
    mkBuffer
            Streams.write (Just msg) writeEndB
            Streams.write Nothing writeEndB
            terminateSession BadRequestException

        --------------------------------------------------------------------------
        {-# INLINE checkExpect100Continue #-}
        checkExpect100Continue :: Request -> IO ()
    checkExpect100Continue Request
    req =
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (CI ByteString -> Request -> Maybe ByteString
    forall a. HasHeaders a => CI ByteString -> a -> Maybe ByteString
    getHeader CI ByteString
    "expect" Request
    req Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "100-continue") (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
                let v :: ByteString
    v = if Request -> HttpVersion
    rqVersion Request
    req HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    1,Int
    1) then ByteString
    "HTTP/1.1" else ByteString
    "HTTP/1.0"

                let hl :: Builder
    hl = ByteString -> Builder
    byteString ByteString
    v                       Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                         ByteString -> Builder
    byteString ByteString
    " 100 Continue\r\n\r\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <>
                         Builder
    flush
                os <- IO (OutputStream Builder)
    mkBuffer
                Streams.write (Just hl) os

        --------------------------------------------------------------------------
        {-# INLINE processRequest #-}
        processRequest :: ParseHook hookState
    processRequest !IORef hookState
    hookState !Request
    req = {-# SCC "httpSession/processRequest" #-} do
            -- successfully parsed a request, so restart the timer
            (Int -> Int) -> IO ()
    tickle ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    defaultTimeout

            -- check for Expect: 100-continue
            Request -> IO ()
    checkExpect100Continue Request
    req
            b <- IORef hookState -> Request -> IO Bool
    runServerHandler IORef hookState
    hookState Request
    req
                   IO Bool -> [Handler Bool] -> IO Bool
    forall a. IO a -> [Handler a] -> IO a
    `E.catches` [ (EscapeSnap -> IO Bool) -> Handler Bool
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler ((EscapeSnap -> IO Bool) -> Handler Bool)
    -> (EscapeSnap -> IO Bool) -> Handler Bool
    forall a b. (a -> b) -> a -> b
    $ IORef hookState -> EscapeSnap -> IO Bool
    escapeSnapHandler IORef hookState
    hookState
                               , (SomeException -> IO Bool) -> Handler Bool
    forall a e. Exception e => (e -> IO a) -> Handler a
    Handler ((SomeException -> IO Bool) -> Handler Bool)
    -> (SomeException -> IO Bool) -> Handler Bool
    forall a b. (a -> b) -> a -> b
    $
                                 IORef hookState
    -> ByteString -> Request -> SomeException -> IO Bool
    forall a.
    IORef hookState -> ByteString -> Request -> SomeException -> IO a
    catchUserException IORef hookState
    hookState ByteString
    "user handler" Request
    req
                               ]
            if b
              then do writeIORef isNewConnection False
                      -- the timer resets to its default value here.
                      loop
              else return $! ()

        --------------------------------------------------------------------------
        {-# INLINE runServerHandler #-}
        runServerHandler :: IORef hookState -> Request -> IO Bool
    runServerHandler !IORef hookState
    hookState !Request
    req = {-# SCC "httpSession/runServerHandler" #-} do
            (req0, rsp0) <- ServerHandler hookState
    serverHandler ServerConfig hookState
    config PerSessionData
    sessionData Request
    req
            userHandlerFinishedHook hookState req rsp0

            -- check whether we should close the connection after sending the
            -- response
            let v      = Request -> HttpVersion
    rqVersion Request
    req
            let is_1_0 = (HttpVersion
    v HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    1,Int
    0))
            cc <- if is_1_0 && (isNothing $ rspContentLength rsp0)
                    then return $! True
                    else readIORef forceConnectionClose

            -- skip unread portion of request body if rspTransformingRqBody is not
            -- true
            unless (rspTransformingRqBody rsp0) $ Streams.skipToEof (rqBody req)

            !date <- getDateString
            rsp1  <- fixupResponse req rsp0
            let (!hdrs, !cc') = addDateAndServerHeaders is_1_0 date cc $
                                headers rsp1
            let rsp = (Headers -> Headers) -> Response -> Response
    forall a. HasHeaders a => (Headers -> Headers) -> a -> a
    updateHeaders (Headers -> Headers -> Headers
    forall a b. a -> b -> a
    const Headers
    hdrs) Response
    rsp1
            writeIORef forceConnectionClose cc'
            bytesSent <- sendResponse req rsp `E.catch`
                         catchUserException hookState "sending-response" req
            dataFinishedHook hookState req rsp
            logAccess req0 rsp bytesSent
            return $! not cc'

        --------------------------------------------------------------------------
        addDateAndServerHeaders :: Bool -> ByteString -> Bool -> Headers -> (Headers, Bool)
    addDateAndServerHeaders !Bool
    is1_0 !ByteString
    date !Bool
    cc !Headers
    hdrs =
            {-# SCC "addDateAndServerHeaders" #-}
            let (![(ByteString, ByteString)]
    hdrs', !Bool
    newcc) = [(ByteString, ByteString)]
    -> Bool
    -> Bool
    -> [(ByteString, ByteString)]
    -> ([(ByteString, ByteString)], Bool)
    forall {a}.
    (Eq a, IsString a) =>
    [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go [(ByteString
    "date",ByteString
    date)] Bool
    False Bool
    cc
                                     ([(ByteString, ByteString)] -> ([(ByteString, ByteString)], Bool))
    -> [(ByteString, ByteString)] -> ([(ByteString, ByteString)], Bool)
    forall a b. (a -> b) -> a -> b
    $ Headers -> [(ByteString, ByteString)]
    H.unsafeToCaseFoldedList Headers
    hdrs
            in ([(ByteString, ByteString)] -> Headers
    H.unsafeFromCaseFoldedList [(ByteString, ByteString)]
    hdrs', Bool
    newcc)
          where
            -- N.B.: here we know the date header has already been removed by
            -- "fixupResponse".
            go :: [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go ![(a, ByteString)]
    l !Bool
    seenServer !Bool
    connClose [] =
                let !l1 :: [(a, ByteString)]
    l1 = if Bool
    seenServer then [(a, ByteString)]
    l else ((a
    "server", ByteString
    sERVER_HEADER)(a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    :[(a, ByteString)]
    l)
                    !l2 :: [(a, ByteString)]
    l2 = if Bool
    connClose then ((a
    "connection", ByteString
    "close")(a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    :[(a, ByteString)]
    l1) else [(a, ByteString)]
    l1
                in ([(a, ByteString)]
    l2, Bool
    connClose)
            go [(a, ByteString)]
    l Bool
    _ Bool
    c (x :: (a, ByteString)
    x@(a
    "server",ByteString
    _):[(a, ByteString)]
    xs) = [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go ((a, ByteString)
    x(a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    :[(a, ByteString)]
    l) Bool
    True Bool
    c [(a, ByteString)]
    xs
            go [(a, ByteString)]
    l Bool
    seenServer Bool
    c (x :: (a, ByteString)
    x@(a
    "connection", ByteString
    v):[(a, ByteString)]
    xs)
                  | Bool
    c = [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go [(a, ByteString)]
    l Bool
    seenServer Bool
    c [(a, ByteString)]
    xs
                  | ByteString
    v ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "close" Bool -> Bool -> Bool
    || (Bool
    is1_0 Bool -> Bool -> Bool
    && ByteString
    v ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "keep-alive") =
                         [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go [(a, ByteString)]
    l Bool
    seenServer Bool
    True [(a, ByteString)]
    xs
                  | Bool
    otherwise = [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go ((a, ByteString)
    x(a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    :[(a, ByteString)]
    l) Bool
    seenServer Bool
    c [(a, ByteString)]
    xs
            go [(a, ByteString)]
    l Bool
    seenServer Bool
    c ((a, ByteString)
    x:[(a, ByteString)]
    xs) = [(a, ByteString)]
    -> Bool -> Bool -> [(a, ByteString)] -> ([(a, ByteString)], Bool)
    go ((a, ByteString)
    x(a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
    forall a. a -> [a] -> [a]
    :[(a, ByteString)]
    l) Bool
    seenServer Bool
    c [(a, ByteString)]
    xs

        --------------------------------------------------------------------------
        escapeSnapHandler :: IORef hookState -> EscapeSnap -> IO Bool
    escapeSnapHandler IORef hookState
    hookState (EscapeHttp EscapeHttpHandler
    escapeHandler) = do
            EscapeSnapHook hookState
    escapeHook IORef hookState
    hookState
            IO (OutputStream Builder)
    mkBuffer IO (OutputStream Builder)
    -> (OutputStream Builder -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= EscapeHttpHandler
    escapeHandler (Int -> Int) -> IO ()
    tickle InputStream ByteString
    readEnd
            Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
        escapeSnapHandler IORef hookState
    _ (TerminateConnection SomeException
    e) = SomeException -> IO Bool
    forall e a. Exception e => e -> IO a
    terminateSession SomeException
    e

        --------------------------------------------------------------------------
        catchUserException :: IORef hookState
                           -> ByteString
                           -> Request
                           -> SomeException
                           -> IO a
        catchUserException :: forall a.
    IORef hookState -> ByteString -> Request -> SomeException -> IO a
    catchUserException IORef hookState
    hookState ByteString
    phase Request
    req SomeException
    e = do
            Builder -> IO ()
    logError (Builder -> IO ()) -> Builder -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [
                ByteString -> Builder
    byteString ByteString
    "Exception leaked to httpSession during phase '"
              , ByteString -> Builder
    byteString ByteString
    phase
              , ByteString -> Builder
    byteString ByteString
    "': \n"
              , Request -> SomeException -> Builder
    requestErrorMessage Request
    req SomeException
    e
              ]
            -- Note: the handler passed to httpSession needs to catch its own
            -- exceptions if it wants to avoid an ungracious exit here.
            IO () -> IO ()
    forall a. IO a -> IO ()
    eatException (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ExceptionHook hookState
    exceptionHook IORef hookState
    hookState SomeException
    e
            SomeException -> IO a
    forall e a. Exception e => e -> IO a
    terminateSession SomeException
    e

        --------------------------------------------------------------------------
        sendResponse :: Request -> Response -> IO Word64
        sendResponse :: Request -> Response -> IO Word64
    sendResponse !Request
    req !Response
    rsp = {-# SCC "httpSession/sendResponse" #-} do
            let !v :: HttpVersion
    v          = Request -> HttpVersion
    rqVersion Request
    req
            let !hdrs' :: Headers
    hdrs'      = Response -> Headers -> Headers
    renderCookies Response
    rsp (Response -> Headers
    forall a. HasHeaders a => a -> Headers
    headers Response
    rsp)
            let !code :: Int
    code       = Response -> Int
    rspStatus Response
    rsp
            let body :: ResponseBody
    body        = Response -> ResponseBody
    rspBody Response
    rsp
            let needChunked :: Bool
    needChunked = Request -> Method
    rqMethod Request
    req Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Method
    HEAD
                                Bool -> Bool -> Bool
    && Maybe Word64 -> Bool
    forall a. Maybe a -> Bool
    isNothing (Response -> Maybe Word64
    rspContentLength Response
    rsp)
                                Bool -> Bool -> Bool
    && Int
    code Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    204
                                Bool -> Bool -> Bool
    && Int
    code Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    304

            let (Headers
    hdrs'', ResponseBody
    body', Bool
    shouldClose) = if Bool
    needChunked
                                                 then Request -> Headers -> ResponseBody -> (Headers, ResponseBody, Bool)
    noCL Request
    req Headers
    hdrs' ResponseBody
    body
                                                 else (Headers
    hdrs', ResponseBody
    body, Bool
    False)

            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    shouldClose (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ IORef Bool -> Bool -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef Bool
    forceConnectionClose (Bool -> IO ()) -> Bool -> IO ()
    forall a b. (a -> b) -> a -> b
    $! Bool
    True
            let hdrPrim :: FixedPrim ()
    hdrPrim       = HttpVersion -> Response -> Headers -> FixedPrim ()
    mkHeaderPrim HttpVersion
    v Response
    rsp Headers
    hdrs''
            let hlen :: Int
    hlen          = FixedPrim () -> Int
    forall a. FixedPrim a -> Int
    size FixedPrim ()
    hdrPrim
            let headerBuilder :: Builder
    headerBuilder = FixedPrim () -> () -> Builder
    forall a. FixedPrim a -> a -> Builder
    primFixed FixedPrim ()
    hdrPrim (() -> Builder) -> () -> Builder
    forall a b. (a -> b) -> a -> b
    $! ()

            nBodyBytes <- case ResponseBody
    body' of
                            Stream StreamProc
    s ->
                                Builder -> Int -> Response -> StreamProc -> IO Word64
    whenStream Builder
    headerBuilder Int
    hlen Response
    rsp StreamProc
    s
                            SendFile String
    f Maybe (Word64, Word64)
    Nothing ->
                                Builder -> Response -> String -> Word64 -> IO Word64
    whenSendFile Builder
    headerBuilder Response
    rsp String
    f Word64
    0
                            -- ignore end length here because we know we had a
                            -- content-length, use that instead.
                            SendFile String
    f (Just (Word64
    st, Word64
    _)) ->
                                Builder -> Response -> String -> Word64 -> IO Word64
    whenSendFile Builder
    headerBuilder Response
    rsp String
    f Word64
    st
            return $! nBodyBytes

        --------------------------------------------------------------------------
        noCL :: Request
             -> Headers
             -> ResponseBody
             -> (Headers, ResponseBody, Bool)
        noCL :: Request -> Headers -> ResponseBody -> (Headers, ResponseBody, Bool)
    noCL Request
    req Headers
    hdrs ResponseBody
    body =
            if HttpVersion
    v HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    1,Int
    1)
              then let origBody :: StreamProc
    origBody = ResponseBody -> StreamProc
    rspBodyToEnum ResponseBody
    body
                       body' :: StreamProc
    body'    = \OutputStream Builder
    os -> do
                                     os' <- StreamProc
    writeChunkedTransferEncoding OutputStream Builder
    os
                                     origBody os'
                   in ( CI ByteString -> ByteString -> Headers -> Headers
    H.set CI ByteString
    "transfer-encoding" ByteString
    "chunked" Headers
    hdrs
                      , StreamProc -> ResponseBody
    Stream StreamProc
    body'
                      , Bool
    False)
              else
                -- We've already noted that we have to close the socket earlier in
                -- runServerHandler.
                (Headers
    hdrs, ResponseBody
    body, Bool
    True)
          where
            v :: HttpVersion
    v = Request -> HttpVersion
    rqVersion Request
    req
        {-# INLINE noCL #-}

        --------------------------------------------------------------------------
        -- | If the response contains a content-length, make sure the response body
        -- StreamProc doesn't yield more (or fewer) than the given number of bytes.
        limitRspBody :: Int                      -- ^ header length
                     -> Response                 -- ^ response
                     -> OutputStream ByteString  -- ^ write end of socket
                     -> IO (OutputStream ByteString)
        limitRspBody :: Int
    -> Response
    -> OutputStream ByteString
    -> IO (OutputStream ByteString)
    limitRspBody Int
    hlen Response
    rsp OutputStream ByteString
    os = IO (OutputStream ByteString)
    -> (Word64 -> IO (OutputStream ByteString))
    -> Maybe Word64
    -> IO (OutputStream ByteString)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (OutputStream ByteString -> IO (OutputStream ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return OutputStream ByteString
    os) Word64 -> IO (OutputStream ByteString)
    forall {a}. Integral a => a -> IO (OutputStream ByteString)
    f (Maybe Word64 -> IO (OutputStream ByteString))
    -> Maybe Word64 -> IO (OutputStream ByteString)
    forall a b. (a -> b) -> a -> b
    $ Response -> Maybe Word64
    rspContentLength Response
    rsp
          where
            f :: a -> IO (OutputStream ByteString)
    f a
    cl = Int64 -> OutputStream ByteString -> IO (OutputStream ByteString)
    Streams.giveExactly (Int -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    hlen Int64 -> Int64 -> Int64
    forall a. Num a => a -> a -> a
    + a -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    cl) OutputStream ByteString
    os
        {-# INLINE limitRspBody #-}

        --------------------------------------------------------------------------
        whenStream :: Builder       -- ^ headers
                   -> Int           -- ^ header length
                   -> Response      -- ^ response
                   -> StreamProc    -- ^ output body
                   -> IO Word64      -- ^ returns number of bytes written
        whenStream :: Builder -> Int -> Response -> StreamProc -> IO Word64
    whenStream Builder
    headerString Int
    hlen Response
    rsp StreamProc
    body = do
            -- note:
            --
            --  * precondition here is that we have a content-length and that we're
            --    not using chunked transfer encoding.
            --
            --  * "headerString" includes http status line.
            --
            -- If you're transforming the request body, you have to manage your own
            -- timeouts.
            let t :: IO ()
    t = if Response -> Bool
    rspTransformingRqBody Response
    rsp
                      then () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (() -> IO ()) -> () -> IO ()
    forall a b. (a -> b) -> a -> b
    $! ()
                      else (Int -> Int) -> IO ()
    tickle ((Int -> Int) -> IO ()) -> (Int -> Int) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    defaultTimeout
            writeEnd0 <- OutputStream ByteString -> IO (OutputStream ByteString)
    forall a. OutputStream a -> IO (OutputStream a)
    Streams.ignoreEof OutputStream ByteString
    writeEnd
            (writeEnd1, getCount) <- Streams.countOutput writeEnd0
            writeEnd2 <- limitRspBody hlen rsp writeEnd1
            writeEndB <- Streams.unsafeBuilderStream (return buffer) writeEnd2 >>=
                         Streams.contramapM (\Builder
    x -> IO ()
    t IO () -> IO Builder -> IO Builder
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Builder -> IO Builder
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Builder
    x)

            Streams.write (Just headerString) writeEndB
            writeEnd' <- body writeEndB
            Streams.write Nothing writeEnd'
            -- Just in case the user handler didn't.
            Streams.write Nothing writeEnd1
            n <- getCount
            return $! fromIntegral n - fromIntegral hlen
        {-# INLINE whenStream #-}

        --------------------------------------------------------------------------
        whenSendFile :: Builder     -- ^ headers
                     -> Response    -- ^ response
                     -> FilePath    -- ^ file to serve
                     -> Word64      -- ^ file start offset
                     -> IO Word64   -- ^ returns number of bytes written
        whenSendFile :: Builder -> Response -> String -> Word64 -> IO Word64
    whenSendFile Builder
    headerString Response
    rsp String
    filePath Word64
    offset = do
            let !cl :: Word64
    cl = Maybe Word64 -> Word64
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
    forall a b. (a -> b) -> a -> b
    $ Response -> Maybe Word64
    rspContentLength Response
    rsp
            SendFileHandler
    sendfileHandler Buffer
    buffer Builder
    headerString String
    filePath Word64
    offset Word64
    cl
            Word64 -> IO Word64
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Word64
    cl
        {-# INLINE whenSendFile #-}

    --------------------------------------------------------------------------
    mkHeaderLine :: HttpVersion -> Response -> FixedPrim ()
    mkHeaderLine :: HttpVersion -> Response -> FixedPrim ()
    mkHeaderLine HttpVersion
    outVer Response
    r =
        case Int
    outCode of
            Int
    200 | HttpVersion
    outVer HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    1, Int
    1) ->
                      -- typo in bytestring here
                      Int -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim Int
    17 ((() -> Ptr Word8 -> IO ()) -> FixedPrim ())
    -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a b. (a -> b) -> a -> b
    $ (Ptr Word8 -> IO ()) -> () -> Ptr Word8 -> IO ()
    forall a b. a -> b -> a
    const (IO (Ptr Word8) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr Word8) -> IO ())
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    "HTTP/1.1 200 OK\r\n")
            Int
    200 | Bool
    otherwise ->
                      Int -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim Int
    17 ((() -> Ptr Word8 -> IO ()) -> FixedPrim ())
    -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a b. (a -> b) -> a -> b
    $ (Ptr Word8 -> IO ()) -> () -> Ptr Word8 -> IO ()
    forall a b. a -> b -> a
    const (IO (Ptr Word8) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr Word8) -> IO ())
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    "HTTP/1.0 200 OK\r\n")
            Int
    _ -> Int -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim Int
    len ((() -> Ptr Word8 -> IO ()) -> FixedPrim ())
    -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a b. (a -> b) -> a -> b
    $ (Ptr Word8 -> IO ()) -> () -> Ptr Word8 -> IO ()
    forall a b. a -> b -> a
    const (IO (Ptr Word8) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr Word8) -> IO ())
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ptr Word8 -> IO (Ptr Word8)
    line)
      where
        outCode :: Int
    outCode = Response -> Int
    rspStatus Response
    r

        v :: ByteString
    v = if HttpVersion
    outVer HttpVersion -> HttpVersion -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Int
    1,Int
    1) then ByteString
    "HTTP/1.1 " else ByteString
    "HTTP/1.0 "

        outCodeStr :: ByteString
    outCodeStr = String -> ByteString
    S.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> String
    forall a. Show a => a -> String
    show Int
    outCode
        space :: Ptr a -> IO (Ptr b)
    space !Ptr a
    op = do
            Ptr a -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    op Int
    0 (Word8
    32 :: Word8)
            Ptr b -> IO (Ptr b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr b -> IO (Ptr b)) -> Ptr b -> IO (Ptr b)
    forall a b. (a -> b) -> a -> b
    $! Ptr a -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr a
    op Int
    1

        line :: Ptr Word8 -> IO (Ptr Word8)
    line = ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    v (Ptr Word8 -> IO (Ptr Word8))
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    outCodeStr (Ptr Word8 -> IO (Ptr Word8))
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Ptr Word8 -> IO (Ptr Word8)
    forall {a} {b}. Ptr a -> IO (Ptr b)
    space (Ptr Word8 -> IO (Ptr Word8))
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    reason
                      (Ptr Word8 -> IO (Ptr Word8))
    -> (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Ptr Word8 -> IO (Ptr Word8)
    crlfPoke

        reason :: ByteString
    reason = Response -> ByteString
    rspStatusReason Response
    r
        len :: Int
    len = Int
    12 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    outCodeStr Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    reason

    ------------------------------------------------------------------------------
    mkHeaderPrim :: HttpVersion -> Response -> Headers -> FixedPrim ()
    mkHeaderPrim :: HttpVersion -> Response -> Headers -> FixedPrim ()
    mkHeaderPrim HttpVersion
    v Response
    r Headers
    hdrs = HttpVersion -> Response -> FixedPrim ()
    mkHeaderLine HttpVersion
    v Response
    r FixedPrim () -> FixedPrim () -> FixedPrim ()
    <+> Headers -> FixedPrim ()
    headersToPrim Headers
    hdrs

    ------------------------------------------------------------------------------
    infixl 4 <+>
    (<+>) :: FixedPrim () -> FixedPrim () -> FixedPrim ()
    FixedPrim ()
    p1 <+> :: FixedPrim () -> FixedPrim () -> FixedPrim ()
    <+> FixedPrim ()
    p2 = () -> ((), ())
    ignore (() -> ((), ())) -> FixedPrim ((), ()) -> FixedPrim ()
    forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
    >$< FixedPrim ()
    p1 FixedPrim () -> FixedPrim () -> FixedPrim ((), ())
    forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
    >*< FixedPrim ()
    p2
      where
        ignore :: () -> ((), ())
    ignore = (() -> () -> ((), ())) -> () -> ((), ())
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (,)

    ------------------------------------------------------------------------------
    {-# INLINE headersToPrim #-}
    headersToPrim :: Headers -> FixedPrim ()
    headersToPrim :: Headers -> FixedPrim ()
    headersToPrim Headers
    hdrs = Int -> (() -> Ptr Word8 -> IO ()) -> FixedPrim ()
    forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
    fixedPrim Int
    len ((Ptr Word8 -> IO ()) -> () -> Ptr Word8 -> IO ()
    forall a b. a -> b -> a
    const Ptr Word8 -> IO ()
    copy)
      where
        len :: Int
    len = (Int -> ByteString -> ByteString -> Int) -> Int -> Headers -> Int
    forall a. (a -> ByteString -> ByteString -> a) -> a -> Headers -> a
    H.foldedFoldl' Int -> ByteString -> ByteString -> Int
    f Int
    0 Headers
    hdrs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    2
          where
            f :: Int -> ByteString -> ByteString -> Int
    f Int
    l ByteString
    k ByteString
    v = Int
    l Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    k Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + ByteString -> Int
    S.length ByteString
    v Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4

        copy :: Ptr Word8 -> IO ()
    copy = [(ByteString, ByteString)] -> Ptr Word8 -> IO ()
    go ([(ByteString, ByteString)] -> Ptr Word8 -> IO ())
    -> [(ByteString, ByteString)] -> Ptr Word8 -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Headers -> [(ByteString, ByteString)]
    H.unsafeToCaseFoldedList Headers
    hdrs

        go :: [(ByteString, ByteString)] -> Ptr Word8 -> IO ()
    go []         !Ptr Word8
    op = IO (Ptr Word8) -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO (Ptr Word8) -> IO ()) -> IO (Ptr Word8) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Ptr Word8 -> IO (Ptr Word8)
    crlfPoke Ptr Word8
    op
        go ((ByteString
    k,ByteString
    v):[(ByteString, ByteString)]
    xs) !Ptr Word8
    op = do
            !op'  <- ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    k Ptr Word8
    op
            pokeByteOff op' 0 (58 :: Word8)  -- colon
            pokeByteOff op' 1 (32 :: Word8)  -- space
            !op''  <- cpBS v $ plusPtr op' 2
            crlfPoke op'' >>= go xs

    {-# INLINE cpBS #-}
    cpBS :: ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS :: ByteString -> Ptr Word8 -> IO (Ptr Word8)
    cpBS ByteString
    s !Ptr Word8
    op = ByteString -> (CStringLen -> IO (Ptr Word8)) -> IO (Ptr Word8)
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    S.unsafeUseAsCStringLen ByteString
    s ((CStringLen -> IO (Ptr Word8)) -> IO (Ptr Word8))
    -> (CStringLen -> IO (Ptr Word8)) -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $ \(Ptr CChar
    cstr, Int
    clen) -> do
                    let !cl :: Int
    cl = Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    clen
                    Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr Word8
    op (Ptr CChar -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr Ptr CChar
    cstr) Int
    cl
                    Ptr Word8 -> IO (Ptr Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $! Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr Word8
    op Int
    cl

    {-# INLINE crlfPoke #-}
    crlfPoke :: Ptr Word8 -> IO (Ptr Word8)
    crlfPoke :: Ptr Word8 -> IO (Ptr Word8)
    crlfPoke !Ptr Word8
    op = do
        Ptr Word8 -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr Word8
    op Int
    0 (Word8
    13 :: Word8)  -- cr
        Ptr Word8 -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr Word8
    op Int
    1 (Word8
    10 :: Word8)  -- lf
        Ptr Word8 -> IO (Ptr Word8)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $! Ptr Word8 -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    plusPtr Ptr Word8
    op Int
    2

    ------------------------------------------------------------------------------
    sERVER_HEADER :: ByteString
    sERVER_HEADER :: ByteString
    sERVER_HEADER = [ByteString] -> ByteString
    S.concat [ByteString
    "Snap/", ByteString
    snapServerVersion]

    ------------------------------------------------------------------------------
    snapServerVersion :: ByteString
    snapServerVersion :: ByteString
    snapServerVersion = String -> ByteString
    S.pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Version -> String
    showVersion (Version -> String) -> Version -> String
    forall a b. (a -> b) -> a -> b
    $ Version
    V.version

    ------------------------------------------------------------------------------
    terminateSession :: Exception e => e -> IO a
    terminateSession :: forall e a. Exception e => e -> IO a
    terminateSession = TerminateSessionException -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (TerminateSessionException -> IO a)
    -> (e -> TerminateSessionException) -> e -> IO a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SomeException -> TerminateSessionException
    TerminateSessionException (SomeException -> TerminateSessionException)
    -> (e -> SomeException) -> e -> TerminateSessionException
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . e -> SomeException
    forall e. (Exception e, HasExceptionContext) => e -> SomeException
    SomeException

    ------------------------------------------------------------------------------
    requestErrorMessage :: Request -> SomeException -> Builder
    requestErrorMessage :: Request -> SomeException -> Builder
    requestErrorMessage Request
    req SomeException
    e =
        [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [ ByteString -> Builder
    byteString ByteString
    "During processing of request from "
                , ByteString -> Builder
    byteString (ByteString -> Builder) -> ByteString -> Builder
    forall a b. (a -> b) -> a -> b
    $ Request -> ByteString
    rqClientAddr Request
    req
                , ByteString -> Builder
    byteString ByteString
    ":"
                , Int -> Builder
    forall a. Show a => a -> Builder
    fromShow (Int -> Builder) -> Int -> Builder
    forall a b. (a -> b) -> a -> b
    $ Request -> Int
    rqClientPort Request
    req
                , ByteString -> Builder
    byteString ByteString
    "\nrequest:\n"
                , String -> Builder
    forall a. Show a => a -> Builder
    fromShow (String -> Builder) -> String -> Builder
    forall a b. (a -> b) -> a -> b
    $ Request -> String
    forall a. Show a => a -> String
    show Request
    req
                , ByteString -> Builder
    byteString ByteString
    "\n"
                , Builder
    msgB
                ]
      where
        msgB :: Builder
    msgB = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [
                 ByteString -> Builder
    byteString ByteString
    "A web handler threw an exception. Details:\n"
               , SomeException -> Builder
    forall a. Show a => a -> Builder
    fromShow SomeException
    e
               ]

    ------------------------------------------------------------------------------
    -- | Convert 'Cookie' into 'ByteString' for output.
    cookieToBS :: Cookie -> ByteString
    cookieToBS :: Cookie -> ByteString
    cookieToBS (Cookie ByteString
    k ByteString
    v Maybe UTCTime
    mbExpTime Maybe ByteString
    mbDomain Maybe ByteString
    mbPath Bool
    isSec Bool
    isHOnly) = ByteString
    cookie
      where
        cookie :: ByteString
    cookie  = [ByteString] -> ByteString
    S.concat [ByteString
    k, ByteString
    "=", ByteString
    v, ByteString
    path, ByteString
    exptime, ByteString
    domain, ByteString
    secure, ByteString
    hOnly]
        path :: ByteString
    path    = ByteString
    -> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    "" (ByteString -> ByteString -> ByteString
    S.append ByteString
    "; path=") Maybe ByteString
    mbPath
        domain :: ByteString
    domain  = ByteString
    -> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    "" (ByteString -> ByteString -> ByteString
    S.append ByteString
    "; domain=") Maybe ByteString
    mbDomain
        exptime :: ByteString
    exptime = ByteString
    -> (UTCTime -> ByteString) -> Maybe UTCTime -> ByteString
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ByteString
    "" (ByteString -> ByteString -> ByteString
    S.append ByteString
    "; expires=" (ByteString -> ByteString)
    -> (UTCTime -> ByteString) -> UTCTime -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . UTCTime -> ByteString
    fmt) Maybe UTCTime
    mbExpTime
        secure :: ByteString
    secure  = if Bool
    isSec then ByteString
    "; Secure" else ByteString
    ""
        hOnly :: ByteString
    hOnly   = if Bool
    isHOnly then ByteString
    "; HttpOnly" else ByteString
    ""
        fmt :: UTCTime -> ByteString
    fmt     = String -> ByteString
    S.pack (String -> ByteString)
    -> (UTCTime -> String) -> UTCTime -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeLocale -> String -> UTCTime -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale
                                      String
    "%a, %d-%b-%Y %H:%M:%S GMT"

    ------------------------------------------------------------------------------
    renderCookies :: Response -> Headers -> Headers
    renderCookies :: Response -> Headers -> Headers
    renderCookies Response
    r Headers
    hdrs
        | [ByteString] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    cookies = Headers
    hdrs
        | Bool
    otherwise = (Headers -> ByteString -> Headers)
    -> Headers -> [ByteString] -> Headers
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\Headers
    m ByteString
    v -> ByteString -> ByteString -> Headers -> Headers
    H.unsafeInsert ByteString
    "set-cookie" ByteString
    v Headers
    m) Headers
    hdrs [ByteString]
    cookies

      where
        cookies :: [ByteString]
    cookies = (Cookie -> ByteString) -> [Cookie] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Cookie -> ByteString
    cookieToBS ([Cookie] -> [ByteString])
    -> (Map ByteString Cookie -> [Cookie])
    -> Map ByteString Cookie
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map ByteString Cookie -> [Cookie]
    forall k a. Map k a -> [a]
    Map.elems (Map ByteString Cookie -> [ByteString])
    -> Map ByteString Cookie -> [ByteString]
    forall a b. (a -> b) -> a -> b
    $ Response -> Map ByteString Cookie
    rspCookies Response
    r

    ------------------------------------------------------------------------------
    fromShow :: Show a => a -> Builder
    fromShow :: forall a. Show a => a -> Builder
    fromShow = String -> Builder
    stringUtf8 (String -> Builder) -> (a -> String) -> a -> Builder
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show