Examining overlong headers protection in Haskell's http-client library

Posted on January 27, 2022

I am currently working on a project that uses Haskell’s http-client library. I wanted to ensure that my application does not use excessive memory. http-client provides ways to control consumption of response bodies, but the library consumes HTTP headers behind the scenes, so I needed to check that the processes it uses control their memory use appropriately.

It turns out that http-client is indeed robust. It provides protection from memory exhaustion as a result of overlong headers by limiting the number of headers in a response and their lengths:

  1. http-client limits responses to 100 headers and raises the OverlongHeaders exception if there are more than that.

      parseHeaders 100 _ = throwHttp OverlongHeaders
      parseHeaders count front = do
          line <- connectionReadLine conn
          if S.null line
              then return $ front []
              else do
                  mheader <- parseHeader line
                  case mheader of
                      Just header ->
                          parseHeaders (count + 1) $ front . (header:)
                      Nothing ->
                          -- Unparseable header line; rather than throwing
                          -- an exception, ignore it for robustness.
                          parseHeaders count front
  2. When reading lines from the socket, the library only reads a new chunk if the current line has not exceeded 4096 bytes. Again, it raises the OverlongHeaders exception if a line carries over into a chunk beyond this.

    connectionReadLineWith conn bs0 =
      go bs0 id 0
      go bs front total =
          case S.break (== charLF) bs of
              (_, "") -> do
                  let total' = total + S.length bs
                  when (total' > 4096) $ throwHttp OverlongHeaders
                  bs' <- connectionRead conn
                  when (S.null bs') $ throwHttp IncompleteHeaders
                  go bs' (front . (bs:)) total'
              (x, S.drop 1 -> y) -> do
                  unless (S.null y) $! connectionUnread conn y
                  return $! killCR $! S.concat $! front [x]