Question

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...

Update and fix

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!

Était-ce utile?

La solution

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
Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top