haskell - x-oauth-basic header 在 CURL 和 HTTP.Conduit 中不同

Question

这很可能是我遗漏了一些重要的信息或其他东西，但这里是。

目前我正在尝试插入我自己的 header ，即 x-oauth-basic ，使用 HTTP.Conduit 进入我的 HTTP 请求图书馆。它有点有效，但不是我想要的方式，

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

重要的是

requestHeaders = [("x-oauth-basic", (encodeUtf8 githubKey))]
                 <> [("User-Agent", "HsCMS")]

使用 HTTP sinkhole ，我可以看到标题的形式为 HTTP_X_OAUTH_BASIC 。它不应该有 HTTP前面一点。使用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

标题没有出现there ，这表明天坑不会拾取 x header 。该curl示例也适用于我想要的端点，即github API，因此我知道curl方法是正确的，而我的HTTP.Conduit方法则不然。

所以我的问题是，如何让我的 HTTP.Conduit header 显示为 x-header ，例如curls'，而不是当前的http-x-header我得到了什么？

另外，别担心，使用的 github key 不是实际的 key ...

更新和修复

因此，正如对 Michael Snoymans 答案的评论中提到的那样，它是通过使用不同的 header 解决的，即 ("Authorization", "token " <> (encodeUtf8 githubKey))这显然是 CURL 在执行 <token>:x-oauth-basic 时发送的内容。

我尝试更新标题以使其更适合，但我愿意接受建议......

感谢您的帮助!

Answer 1

我认为问题出在您的污水坑应用程序上。看起来它正在打印 CGI 版本的标题。我不知道污水坑是什么样的，所以我在 Warp 中实现了一个简单的污水坑，并且确实请求 header 被正确传递。您可以clone the project on FP Haskell Center自己尝试一下。为了完整起见，代码如下:

{-# 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

当我运行它时，控制台中的输出是:

("Host","localhost:8004")
("Accept-Encoding","gzip")
("Content-Length","10")
("x-oauth-basic","dummy-key")
("User-Agent","HsCMS")
Empty