3

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

目前我正在尝试使用HTTP.Conduit库将我自己的标头插入x-oauth-basic到我的 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

标头没有出现在那里，这表明天坑没有拾取 x 标头。curl 示例也适用于我的预期端点，即 github API，因此我知道 curl 方法是正确的，而我的 HTTP.Conduit 方法不是。

所以我的问题是，如何让我的 HTTP.Conduit 标头显示为一个x-header，例如 curls'，而不是http-x-header我得到的电流？

另外，不用担心，使用的 github 密钥不是实际密钥...

更新和修复

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

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

感谢所有的帮助！

4

1 回答 1

1

我认为问题出在您的沉洞应用程序上。看起来它正在打印标题的 CGI 版本。我不知道天坑是什么样子的，所以我在 Warp 中实现了一个简单的，确实请求标头正在正确传递。您可以在 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
于 2014-01-26T16:01:41.373 回答