Haskell reverse proxy issue

Question

I am a newbie to Haskell and functional programming. In order to gain some hands-on experience, I wrote this simple reverse proxy application. The idea is simple, based on the x-tenant-id header in the request, the proxy forwards the request to the corresponding upstream host tenant-${tenantid} . The application works well for GET and DELETE requests. But for POST and PUT, from time to time(almost every other request) it complains incorrect Content-Length , even though there is nothing wrong with it. I did some search on the internet, it seems no one has encountered similar issue before, so probably my code is messed up somewhere.

Error message:

WrongRequestBodyStreamSize 200 0

200 is the actual content length, but the upstream server thinks it's 0. My first thought was the request got truncated somehow, but Wireshark revealed the request was fully sent to upstream... Now my speculation is the whole request is split into two by the proxy, the headers are in the first request while the payload falls into the second.

Code:

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
module Main where

import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.ReverseProxy as ReverseProxy
import qualified Network.Wai as Wai
import qualified Network.Wai.Request as Request
import qualified Network.Wai.Handler.Warp as Warp
import qualified Data.Maybe as Maybe
import qualified Data.ByteString as ByteString

main = do
  manager <- Client.newManager $ Client.defaultManagerSettings { Client.managerConnCount = 5000, Client.managerIdleConnectionCount = 5000 }
  let settings = Warp.setPort 80 $ Warp.setHTTP2Disabled Warp.defaultSettings
  Warp.runSettings settings $ mainApp manager

mainApp :: Client.Manager -> Wai.Application
mainApp manager req res = do
  let maybeUpstream = lookup "x-tenant-id" $ Wai.requestHeaders $ req
  let upstream = if Maybe.isNothing(maybeUpstream) then "12345" else Maybe.fromJust(maybeUpstream)
  proxyApp upstream manager req res

proxyApp :: ByteString.ByteString -> Client.Manager -> Wai.Application
proxyApp upstream manager req res = do
  let host = ByteString.concat(["tenant-", upstream])
  let dest = ReverseProxy.WPRProxyDest ReverseProxy.ProxyDest { ReverseProxy.pdHost = host, ReverseProxy.pdPort = 80 }
  ReverseProxy.waiProxyTo (const $ return dest) ReverseProxy.defaultOnExc manager req res

Answer 1

I experienced this same problem and opened a PR against http-reverse-proxy to fix it: https://github.com/fpco/http-reverse-proxy/pull/35 .

The solution has a slightly performance penalty as written, but it works. Hopefully that will be corrected in review.