I think the problem is with your sinkhole application. It appears like it's printing CGI versions of the headers. I don't know what the sinkhole looks like, so I implemented a simple one in Warp, and indeed the request header is being passed through correctly. You can clone the project on FP Haskell Center to try it out yourself. For completeness, here's the code below:
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (withAsync)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Monoid (mempty, (<>))
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Network.HTTP.Conduit (RequestBody (RequestBodyBS),
checkStatus, httpLbs, method,
parseUrl, requestBody,
requestHeaders, responseBody, secure,
withManager)
import Network.HTTP.Types (status200)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp (run)
import System.Environment (getEnv)
main :: IO ()
main = do
port <- fmap read $ getEnv "PORT"
withAsync (run port app) $ const $ do
submitPostRequest
("http://localhost:" ++ show port)
"dummy-key"
"dummy body" >>= print
app :: Wai.Application
app req = do
liftIO $ mapM_ print $ Wai.requestHeaders req
return $ Wai.responseLBS status200 [] mempty
submitPostRequest :: String -> Text -> ByteString -> IO L.ByteString
submitPostRequest urlString githubKey body =
case parseUrl urlString of
Nothing -> return $ "URL Syntax Error"
Just initReq -> withManager $ \manager -> do
let req = initReq { secure = False -- Turn on https
, method = "POST"
, requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
<> [("User-Agent", "HsCMS")]
, requestBody = RequestBodyBS body
, checkStatus = \_ _ _ -> Nothing
}
res <- httpLbs req manager
return $ responseBody res
When I run this, the output in the console is:
("Host","localhost:8004")
("Accept-Encoding","gzip")
("Content-Length","10")
("x-oauth-basic","dummy-key")
("User-Agent","HsCMS")
Empty