    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Network.HTTP.HandleStream
    -- Copyright   :  See LICENSE file
    -- License     :  BSD
    --
    -- Maintainer  :  Ganesh Sittampalam <ganesh@earth.li>
    -- Stability   :  experimental
    -- Portability :  non-portable (not tested)
    --
    -- A 'HandleStream'-based version of "Network.HTTP" interface.
    --
    -- For more detailed information about what the individual exports do, please consult
    -- the documentation for "Network.HTTP". /Notice/ however that the functions here do
    -- not perform any kind of normalization prior to transmission (or receipt); you are
    -- responsible for doing any such yourself, or, if you prefer, just switch to using
    -- "Network.HTTP" function instead.
    --
    -----------------------------------------------------------------------------
    module Network.HTTP.HandleStream
           ( simpleHTTP      -- :: Request ty -> IO (Result (Response ty))
           , simpleHTTP_     -- :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
           , sendHTTP        -- :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
           , sendHTTP_notify -- :: HStream ty => HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
           , receiveHTTP     -- :: HStream ty => HandleStream ty -> IO (Result (Request ty))
           , respondHTTP     -- :: HStream ty => HandleStream ty -> Response ty -> IO ()

           , simpleHTTP_debug -- :: FilePath -> Request DebugString -> IO (Response DebugString)
           ) where

    -----------------------------------------------------------------
    ------------------ Imports --------------------------------------
    -----------------------------------------------------------------

    import Network.BufferType
    import Network.Stream ( fmapE, Result )
    import Network.StreamDebugger ( debugByteStream )
    import Network.TCP (HStream(..), HandleStream )

    import Network.HTTP.Base
    import Network.HTTP.Headers
    import Network.HTTP.Utils ( trim, readsOne )

    import Data.Char (toLower)
    import Data.Maybe (fromMaybe)
    import Control.Exception (onException)
    import Control.Monad (when)

    -----------------------------------------------------------------
    ------------------ Misc -----------------------------------------
    -----------------------------------------------------------------

    -- | @simpleHTTP@ transmits a resource across a non-persistent connection.
    simpleHTTP :: HStream ty => Request ty -> IO (Result (Response ty))
    simpleHTTP :: forall ty. HStream ty => Request ty -> IO (Result (Response ty))
    simpleHTTP Request ty
    r = do
      auth <- Request ty -> IO URIAuthority
    forall (m :: * -> *) ty.
    MonadFail m =>
    Request ty -> m URIAuthority
    getAuth Request ty
    r
      failHTTPS (rqURI r)
      c <- openStream (host auth) (fromMaybe 80 (port auth))
      simpleHTTP_ c r

    -- | @simpleHTTP_debug debugFile req@ behaves like 'simpleHTTP', but logs
    -- the HTTP operation via the debug file @debugFile@.
    simpleHTTP_debug :: HStream ty => FilePath -> Request ty -> IO (Result (Response ty))
    simpleHTTP_debug :: forall ty.
    HStream ty =>
    String -> Request ty -> IO (Result (Response ty))
    simpleHTTP_debug String
    httpLogFile Request ty
    r = do
      auth <- Request ty -> IO URIAuthority
    forall (m :: * -> *) ty.
    MonadFail m =>
    Request ty -> m URIAuthority
    getAuth Request ty
    r
      failHTTPS (rqURI r)
      c0   <- openStream (host auth) (fromMaybe 80 (port auth))
      c    <- debugByteStream httpLogFile c0
      simpleHTTP_ c r

    -- | Like 'simpleHTTP', but acting on an already opened stream.
    simpleHTTP_ :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
    simpleHTTP_ :: forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO (Result (Response ty))
    simpleHTTP_ HandleStream ty
    s Request ty
    r = HandleStream ty -> Request ty -> IO (Result (Response ty))
    forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO (Result (Response ty))
    sendHTTP HandleStream ty
    s Request ty
    r

    -- | @sendHTTP hStream httpRequest@ transmits @httpRequest@ over
    -- @hStream@, but does not alter the status of the connection, nor request it to be
    -- closed upon receiving the response.
    sendHTTP :: HStream ty => HandleStream ty -> Request ty -> IO (Result (Response ty))
    sendHTTP :: forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO (Result (Response ty))
    sendHTTP HandleStream ty
    conn Request ty
    rq = HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    sendHTTP_notify HandleStream ty
    conn Request ty
    rq (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    -- | @sendHTTP_notify hStream httpRequest action@ behaves like 'sendHTTP', but
    -- lets you supply an IO @action@ to execute once the request has been successfully
    -- transmitted over the connection. Useful when you want to set up tracing of
    -- request transmission and its performance.
    sendHTTP_notify :: HStream ty
                    => HandleStream ty
                    -> Request ty
                    -> IO ()
                    -> IO (Result (Response ty))
    sendHTTP_notify :: forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    sendHTTP_notify HandleStream ty
    conn Request ty
    rq IO ()
    onSendComplete = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    providedClose (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (HandleStream ty -> Bool -> IO ()
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Bool -> IO ()
    closeOnEnd HandleStream ty
    conn Bool
    True)
      IO (Result (Response ty)) -> IO () -> IO (Result (Response ty))
    forall a b. IO a -> IO b -> IO a
    onException (HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    sendMain HandleStream ty
    conn Request ty
    rq IO ()
    onSendComplete)
                  (HandleStream ty -> IO ()
    forall bufType. HStream bufType => HandleStream bufType -> IO ()
    close HandleStream ty
    conn)
     where
      providedClose :: Bool
    providedClose = [Header] -> Bool
    findConnClose (Request ty -> [Header]
    forall a. Request a -> [Header]
    rqHeaders Request ty
    rq)

    -- From RFC 2616, section 8.2.3:
    -- 'Because of the presence of older implementations, the protocol allows
    -- ambiguous situations in which a client may send "Expect: 100-
    -- continue" without receiving either a 417 (Expectation Failed) status
    -- or a 100 (Continue) status. Therefore, when a client sends this
    -- header field to an origin server (possibly via a proxy) from which it
    -- has never seen a 100 (Continue) status, the client SHOULD NOT wait
    -- for an indefinite period before sending the request body.'
    --
    -- Since we would wait forever, I have disabled use of 100-continue for now.
    sendMain :: HStream ty
             => HandleStream ty
             -> Request ty
             -> (IO ())
             -> IO (Result (Response ty))
    sendMain :: forall ty.
    HStream ty =>
    HandleStream ty -> Request ty -> IO () -> IO (Result (Response ty))
    sendMain HandleStream ty
    conn Request ty
    rqst IO ()
    onSendComplete = do
          --let str = if null (rqBody rqst)
          --              then show rqst
          --              else show (insertHeader HdrExpect "100-continue" rqst)
      -- TODO review throwing away of result
      _ <- HandleStream ty -> ty -> IO (Result ())
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> bufType -> IO (Result ())
    writeBlock HandleStream ty
    conn (BufferOp ty -> String -> ty
    forall a. BufferOp a -> String -> a
    buf_fromStr BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps (String -> ty) -> String -> ty
    forall a b. (a -> b) -> a -> b
    $ Request ty -> String
    forall a. Show a => a -> String
    show Request ty
    rqst)
        -- write body immediately, don't wait for 100 CONTINUE
      -- TODO review throwing away of result
      _ <- writeBlock conn (rqBody rqst)
      onSendComplete
      rsp <- getResponseHead conn
      switchResponse conn True False rsp rqst

       -- Hmmm, this could go bad if we keep getting "100 Continue"
       -- responses...  Except this should never happen according
       -- to the RFC.

    switchResponse :: HStream ty
                   => HandleStream ty
                   -> Bool {- allow retry? -}
                   -> Bool {- is body sent? -}
                   -> Result ResponseData
                   -> Request ty
                   -> IO (Result (Response ty))
    switchResponse :: forall ty.
    HStream ty =>
    HandleStream ty
    -> Bool
    -> Bool
    -> Result ResponseData
    -> Request ty
    -> IO (Result (Response ty))
    switchResponse HandleStream ty
    _ Bool
    _ Bool
    _ (Left ConnError
    e) Request ty
    _ = Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ConnError -> Result (Response ty)
    forall a b. a -> Either a b
    Left ConnError
    e)
                    -- retry on connreset?
                    -- if we attempt to use the same socket then there is an excellent
                    -- chance that the socket is not in a completely closed state.

    switchResponse HandleStream ty
    conn Bool
    allow_retry Bool
    bdy_sent (Right (ResponseCode
    cd,String
    rn,[Header]
    hdrs)) Request ty
    rqst =
       case RequestMethod -> ResponseCode -> ResponseNextStep
    matchResponse (Request ty -> RequestMethod
    forall a. Request a -> RequestMethod
    rqMethod Request ty
    rqst) ResponseCode
    cd of
         ResponseNextStep
    Continue
          | Bool -> Bool
    not Bool
    bdy_sent -> do {- Time to send the body -}
            HandleStream ty -> ty -> IO (Result ())
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> bufType -> IO (Result ())
    writeBlock HandleStream ty
    conn (Request ty -> ty
    forall a. Request a -> a
    rqBody Request ty
    rqst) IO (Result ())
    -> (Result () -> IO (Result (Response ty)))
    -> IO (Result (Response ty))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (ConnError -> IO (Result (Response ty)))
    -> (() -> IO (Result (Response ty)))
    -> Result ()
    -> IO (Result (Response ty))
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result (Response ty) -> IO (Result (Response ty)))
    -> (ConnError -> Result (Response ty))
    -> ConnError
    -> IO (Result (Response ty))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConnError -> Result (Response ty)
    forall a b. a -> Either a b
    Left)
               (\ ()
    _ -> do
                  rsp <- HandleStream ty -> IO (Result ResponseData)
    forall ty.
    HStream ty =>
    HandleStream ty -> IO (Result ResponseData)
    getResponseHead HandleStream ty
    conn
                  switchResponse conn allow_retry True rsp rqst)
          | Bool
    otherwise    -> do {- keep waiting -}
            rsp <- HandleStream ty -> IO (Result ResponseData)
    forall ty.
    HStream ty =>
    HandleStream ty -> IO (Result ResponseData)
    getResponseHead HandleStream ty
    conn
            switchResponse conn allow_retry bdy_sent rsp rqst

         ResponseNextStep
    Retry -> do {- Request with "Expect" header failed.
                        Trouble is the request contains Expects
                        other than "100-Continue" -}
            -- TODO review throwing away of result
            _ <- HandleStream ty -> ty -> IO (Result ())
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> bufType -> IO (Result ())
    writeBlock HandleStream ty
    conn ((BufferOp ty -> ty -> ty -> ty
    forall a. BufferOp a -> a -> a -> a
    buf_append BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps)
                                         (BufferOp ty -> String -> ty
    forall a. BufferOp a -> String -> a
    buf_fromStr BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps (Request ty -> String
    forall a. Show a => a -> String
    show Request ty
    rqst))
                                         (Request ty -> ty
    forall a. Request a -> a
    rqBody Request ty
    rqst))
            rsp <- getResponseHead conn
            switchResponse conn False bdy_sent rsp rqst

         ResponseNextStep
    Done -> do
           Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Header] -> Bool
    findConnClose [Header]
    hdrs)
                (HandleStream ty -> Bool -> IO ()
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Bool -> IO ()
    closeOnEnd HandleStream ty
    conn Bool
    True)
           Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response ty -> Result (Response ty)
    forall a b. b -> Either a b
    Right (Response ty -> Result (Response ty))
    -> Response ty -> Result (Response ty)
    forall a b. (a -> b) -> a -> b
    $ ResponseCode -> String -> [Header] -> ty -> Response ty
    forall a. ResponseCode -> String -> [Header] -> a -> Response a
    Response ResponseCode
    cd String
    rn [Header]
    hdrs (BufferOp ty -> ty
    forall a. BufferOp a -> a
    buf_empty BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps))

         DieHorribly String
    str -> do
           HandleStream ty -> IO ()
    forall bufType. HStream bufType => HandleStream bufType -> IO ()
    close HandleStream ty
    conn
           Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> String -> Result (Response ty)
    forall a. String -> String -> Result a
    responseParseError String
    "Invalid response:" String
    str)
         ResponseNextStep
    ExpectEntity -> do
           r <- (([Header], ty) -> Result (Response ty))
    -> IO (Result ([Header], ty)) -> IO (Result (Response ty))
    forall a b. (a -> Result b) -> IO (Result a) -> IO (Result b)
    fmapE (\ ([Header]
    ftrs,ty
    bdy) -> Response ty -> Result (Response ty)
    forall a b. b -> Either a b
    Right (ResponseCode -> String -> [Header] -> ty -> Response ty
    forall a. ResponseCode -> String -> [Header] -> a -> Response a
    Response ResponseCode
    cd String
    rn ([Header]
    hdrs[Header] -> [Header] -> [Header]
    forall a. [a] -> [a] -> [a]
    ++[Header]
    ftrs) ty
    bdy)) (IO (Result ([Header], ty)) -> IO (Result (Response ty)))
    -> IO (Result ([Header], ty)) -> IO (Result (Response ty))
    forall a b. (a -> b) -> a -> b
    $
                 IO (Result ([Header], ty))
    -> (String -> IO (Result ([Header], ty)))
    -> Maybe String
    -> IO (Result ([Header], ty))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (IO (Result ([Header], ty))
    -> (String -> IO (Result ([Header], ty)))
    -> Maybe String
    -> IO (Result ([Header], ty))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (BufferOp ty -> IO (Result ty) -> [ty] -> IO (Result ([Header], ty))
    forall a.
    BufferOp a -> IO (Result a) -> [a] -> IO (Result ([Header], a))
    hopefulTransfer BufferOp ty
    bo (HandleStream ty -> IO (Result ty)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> IO (Result bufType)
    readLine HandleStream ty
    conn) [])
                           (\ String
    x ->
                              (Int -> IO (Result ([Header], ty)))
    -> IO (Result ([Header], ty))
    -> String
    -> IO (Result ([Header], ty))
    forall a b. Read a => (a -> b) -> b -> String -> b
    readsOne ((Int -> IO (Result ty)) -> Int -> IO (Result ([Header], ty))
    forall a.
    (Int -> IO (Result a)) -> Int -> IO (Result ([Header], a))
    linearTransfer (HandleStream ty -> Int -> IO (Result ty)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Int -> IO (Result bufType)
    readBlock HandleStream ty
    conn))
                                       (Result ([Header], ty) -> IO (Result ([Header], ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Result ([Header], ty) -> IO (Result ([Header], ty)))
    -> Result ([Header], ty) -> IO (Result ([Header], ty))
    forall a b. (a -> b) -> a -> b
    $String -> String -> Result ([Header], ty)
    forall a. String -> String -> Result a
    responseParseError String
    "unrecognized content-length value" String
    x)
                                       String
    x)
                            Maybe String
    cl)
                       (IO (Result ([Header], ty))
    -> IO (Result ([Header], ty))
    -> String
    -> IO (Result ([Header], ty))
    forall a. a -> a -> String -> a
    ifChunked (BufferOp ty
    -> IO (Result ty)
    -> (Int -> IO (Result ty))
    -> IO (Result ([Header], ty))
    forall a.
    BufferOp a
    -> IO (Result a)
    -> (Int -> IO (Result a))
    -> IO (Result ([Header], a))
    chunkedTransfer BufferOp ty
    bo (HandleStream ty -> IO (Result ty)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> IO (Result bufType)
    readLine HandleStream ty
    conn) (HandleStream ty -> Int -> IO (Result ty)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Int -> IO (Result bufType)
    readBlock HandleStream ty
    conn))
                                  (String -> IO (Result ([Header], ty))
    forall a. String -> IO (Result ([Header], a))
    uglyDeathTransfer String
    "sendHTTP"))
                       Maybe String
    tc
           case r of
             Left{} -> do
               HandleStream ty -> IO ()
    forall bufType. HStream bufType => HandleStream bufType -> IO ()
    close HandleStream ty
    conn
               Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result (Response ty)
    r
             Right (Response ResponseCode
    _ String
    _ [Header]
    hs ty
    _) -> do
               Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([Header] -> Bool
    findConnClose [Header]
    hs)
                    (HandleStream ty -> Bool -> IO ()
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Bool -> IO ()
    closeOnEnd HandleStream ty
    conn Bool
    True)
               Result (Response ty) -> IO (Result (Response ty))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result (Response ty)
    r

          where
           tc :: Maybe String
    tc = HeaderName -> [Header] -> Maybe String
    lookupHeader HeaderName
    HdrTransferEncoding [Header]
    hdrs
           cl :: Maybe String
    cl = HeaderName -> [Header] -> Maybe String
    lookupHeader HeaderName
    HdrContentLength [Header]
    hdrs
           bo :: BufferOp ty
    bo = BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps

    -- reads and parses headers
    getResponseHead :: HStream ty => HandleStream ty -> IO (Result ResponseData)
    getResponseHead :: forall ty.
    HStream ty =>
    HandleStream ty -> IO (Result ResponseData)
    getResponseHead HandleStream ty
    conn =
       ([ty] -> Result ResponseData)
    -> IO (Result [ty]) -> IO (Result ResponseData)
    forall a b. (a -> Result b) -> IO (Result a) -> IO (Result b)
    fmapE (\[ty]
    es -> [String] -> Result ResponseData
    parseResponseHead ((ty -> String) -> [ty] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (BufferOp ty -> ty -> String
    forall a. BufferOp a -> a -> String
    buf_toStr BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps) [ty]
    es))
             (BufferOp ty -> IO (Result ty) -> IO (Result [ty])
    forall a. BufferOp a -> IO (Result a) -> IO (Result [a])
    readTillEmpty1 BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps (HandleStream ty -> IO (Result ty)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> IO (Result bufType)
    readLine HandleStream ty
    conn))

    -- | @receiveHTTP hStream@ reads a 'Request' from the 'HandleStream' @hStream@
    receiveHTTP :: HStream bufTy => HandleStream bufTy -> IO (Result (Request bufTy))
    receiveHTTP :: forall bufTy.
    HStream bufTy =>
    HandleStream bufTy -> IO (Result (Request bufTy))
    receiveHTTP HandleStream bufTy
    conn = IO (Result RequestData)
    getRequestHead IO (Result RequestData)
    -> (Result RequestData -> IO (Result (Request bufTy)))
    -> IO (Result (Request bufTy))
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (ConnError -> IO (Result (Request bufTy)))
    -> (RequestData -> IO (Result (Request bufTy)))
    -> Result RequestData
    -> IO (Result (Request bufTy))
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Result (Request bufTy) -> IO (Result (Request bufTy))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result (Request bufTy) -> IO (Result (Request bufTy)))
    -> (ConnError -> Result (Request bufTy))
    -> ConnError
    -> IO (Result (Request bufTy))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ConnError -> Result (Request bufTy)
    forall a b. a -> Either a b
    Left) RequestData -> IO (Result (Request bufTy))
    processRequest
      where
        -- reads and parses headers
       getRequestHead :: IO (Result RequestData)
       getRequestHead :: IO (Result RequestData)
    getRequestHead = do
          ([bufTy] -> Result RequestData)
    -> IO (Result [bufTy]) -> IO (Result RequestData)
    forall a b. (a -> Result b) -> IO (Result a) -> IO (Result b)
    fmapE (\[bufTy]
    es -> [String] -> Result RequestData
    parseRequestHead ((bufTy -> String) -> [bufTy] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (BufferOp bufTy -> bufTy -> String
    forall a. BufferOp a -> a -> String
    buf_toStr BufferOp bufTy
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps) [bufTy]
    es))
                (BufferOp bufTy -> IO (Result bufTy) -> IO (Result [bufTy])
    forall a. BufferOp a -> IO (Result a) -> IO (Result [a])
    readTillEmpty1 BufferOp bufTy
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps (HandleStream bufTy -> IO (Result bufTy)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> IO (Result bufType)
    readLine HandleStream bufTy
    conn))

       processRequest :: RequestData -> IO (Result (Request bufTy))
    processRequest (RequestMethod
    rm,URI
    uri,[Header]
    hdrs) =
          (([Header], bufTy) -> Result (Request bufTy))
    -> IO (Result ([Header], bufTy)) -> IO (Result (Request bufTy))
    forall a b. (a -> Result b) -> IO (Result a) -> IO (Result b)
    fmapE (\ ([Header]
    ftrs,bufTy
    bdy) -> Request bufTy -> Result (Request bufTy)
    forall a b. b -> Either a b
    Right (URI -> RequestMethod -> [Header] -> bufTy -> Request bufTy
    forall a. URI -> RequestMethod -> [Header] -> a -> Request a
    Request URI
    uri RequestMethod
    rm ([Header]
    hdrs[Header] -> [Header] -> [Header]
    forall a. [a] -> [a] -> [a]
    ++[Header]
    ftrs) bufTy
    bdy)) (IO (Result ([Header], bufTy)) -> IO (Result (Request bufTy)))
    -> IO (Result ([Header], bufTy)) -> IO (Result (Request bufTy))
    forall a b. (a -> b) -> a -> b
    $
                 IO (Result ([Header], bufTy))
    -> (String -> IO (Result ([Header], bufTy)))
    -> Maybe String
    -> IO (Result ([Header], bufTy))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                  (IO (Result ([Header], bufTy))
    -> (String -> IO (Result ([Header], bufTy)))
    -> Maybe String
    -> IO (Result ([Header], bufTy))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Result ([Header], bufTy) -> IO (Result ([Header], bufTy))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (([Header], bufTy) -> Result ([Header], bufTy)
    forall a b. b -> Either a b
    Right ([], BufferOp bufTy -> bufTy
    forall a. BufferOp a -> a
    buf_empty BufferOp bufTy
    bo))) -- hopefulTransfer ""
                         (\ String
    x -> (Int -> IO (Result ([Header], bufTy)))
    -> IO (Result ([Header], bufTy))
    -> String
    -> IO (Result ([Header], bufTy))
    forall a b. Read a => (a -> b) -> b -> String -> b
    readsOne ((Int -> IO (Result bufTy)) -> Int -> IO (Result ([Header], bufTy))
    forall a.
    (Int -> IO (Result a)) -> Int -> IO (Result ([Header], a))
    linearTransfer (HandleStream bufTy -> Int -> IO (Result bufTy)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Int -> IO (Result bufType)
    readBlock HandleStream bufTy
    conn))
                                          (Result ([Header], bufTy) -> IO (Result ([Header], bufTy))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return(Result ([Header], bufTy) -> IO (Result ([Header], bufTy)))
    -> Result ([Header], bufTy) -> IO (Result ([Header], bufTy))
    forall a b. (a -> b) -> a -> b
    $String -> String -> Result ([Header], bufTy)
    forall a. String -> String -> Result a
    responseParseError String
    "unrecognized Content-Length value" String
    x)
                                          String
    x)

                         Maybe String
    cl)
                  (IO (Result ([Header], bufTy))
    -> IO (Result ([Header], bufTy))
    -> String
    -> IO (Result ([Header], bufTy))
    forall a. a -> a -> String -> a
    ifChunked (BufferOp bufTy
    -> IO (Result bufTy)
    -> (Int -> IO (Result bufTy))
    -> IO (Result ([Header], bufTy))
    forall a.
    BufferOp a
    -> IO (Result a)
    -> (Int -> IO (Result a))
    -> IO (Result ([Header], a))
    chunkedTransfer BufferOp bufTy
    bo (HandleStream bufTy -> IO (Result bufTy)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> IO (Result bufType)
    readLine HandleStream bufTy
    conn) (HandleStream bufTy -> Int -> IO (Result bufTy)
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> Int -> IO (Result bufType)
    readBlock HandleStream bufTy
    conn))
                             (String -> IO (Result ([Header], bufTy))
    forall a. String -> IO (Result ([Header], a))
    uglyDeathTransfer String
    "receiveHTTP"))
                  Maybe String
    tc
        where
         -- FIXME : Also handle 100-continue.
         tc :: Maybe String
    tc = HeaderName -> [Header] -> Maybe String
    lookupHeader HeaderName
    HdrTransferEncoding [Header]
    hdrs
         cl :: Maybe String
    cl = HeaderName -> [Header] -> Maybe String
    lookupHeader HeaderName
    HdrContentLength [Header]
    hdrs
         bo :: BufferOp bufTy
    bo = BufferOp bufTy
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps

    -- | @respondHTTP hStream httpResponse@ transmits an HTTP 'Response' over
    -- the 'HandleStream' @hStream@. It could be used to implement simple web
    -- server interactions, performing the dual role to 'sendHTTP'.
    respondHTTP :: HStream ty => HandleStream ty -> Response ty -> IO ()
    respondHTTP :: forall ty. HStream ty => HandleStream ty -> Response ty -> IO ()
    respondHTTP HandleStream ty
    conn Response ty
    rsp = do
      -- TODO: review throwing away of result
      _ <- HandleStream ty -> ty -> IO (Result ())
    forall bufType.
    HStream bufType =>
    HandleStream bufType -> bufType -> IO (Result ())
    writeBlock HandleStream ty
    conn (BufferOp ty -> String -> ty
    forall a. BufferOp a -> String -> a
    buf_fromStr BufferOp ty
    forall bufType. BufferType bufType => BufferOp bufType
    bufferOps (String -> ty) -> String -> ty
    forall a b. (a -> b) -> a -> b
    $ Response ty -> String
    forall a. Show a => a -> String
    show Response ty
    rsp)
       -- write body immediately, don't wait for 100 CONTINUE
      -- TODO: review throwing away of result
      _ <- writeBlock conn (rspBody rsp)
      return ()

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

    headerName :: String -> String
    headerName :: String -> String
    headerName String
    x = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (String -> String
    trim String
    x)

    ifChunked :: a -> a -> String -> a
    ifChunked :: forall a. a -> a -> String -> a
    ifChunked a
    a a
    b String
    s =
      case String -> String
    headerName String
    s of
        String
    "chunked" -> a
    a
        String
    _ -> a
    b