This is more than likely me missing some vital piece of information or something, but here goes.
Currently I'm trying to insert my own header, namely x-oauth-basic
, into my HTTP request using the HTTP.Conduit library. It sorta works, but not in my intended way,
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 (toStrict body)
, checkStatus = \_ _ _ -> Nothing
}
res <- httpLbs req manager
return $ responseBody res
the important bit being
requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
<> [("User-Agent", "HsCMS")]
Using a HTTP sinkhole, I can see the header is formed as HTTP_X_OAUTH_BASIC
. It shouldn't have the HTTP
bit in front. Testing with curl,
curl -u 78y8713k1j23nkjnkjnuy366366363666gdasddd:x-oauth-basic --request POST --data '{"description":"Updated via API","files":{"file1.txt":{"filename": "newsies.txt", "content":"New Demo"}}' http://www.posttestserver.com/post.php\?dir\=Testing
the header doesn't appear there, which suggests that the sinkhole doesn't pick up x-headers. The curl example also works with my intended endpoint which is the github API, so I know the curl approach is correct, and my HTTP.Conduit one is not.
So my question is, how do I get my HTTP.Conduit header to appear as a x-header
, such as curls', instead of the current http-x-header
that I'm getting?
Also, don't worry, the github key used is not an actual key...
So, as mentioned in a comment to Michael Snoymans' answer, it got solved by using a different header, namely ("Authorization", "token " <> (encodeUtf8 githubKey))
which apparently was somewhat what CURL was sending when doing <token>:x-oauth-basic
.
I've tried to update the title to fit a little better, but am open to suggestions...
Thanks for all the help!
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