Haskell 仆人（客户端）：由于奇怪的接受导致 UnsupportedContentType 错误 header
Haskell Servant (client): UnsupportedContentType error due to weird Accept header
我正在尝试编写一个 HTTP 客户端来使用 Servant 查询 Hackage 并获取 json 数据。但是，当我尝试查询像 /user/alf 这样的端点时（这只是一个 pseudo-random 现有用户名，我也尝试过不同的端点，如 /packages/），我得到一个 UnsupportedContentType 错误。
我使用 wireshark 调查并比较了来自我的代码和来自此 cURL 命令的请求：
$ curl -H "Accept: application/json" http://hackage.haskell.org/user/alf
两者都会导致 200 OK 但 cURL returns json 数据符合预期，而 servant 得到 html 导致错误。
事实上，问题的根源似乎是我的仆人代码产生的 Accept header：
"Accept: application/json;charset=utf-8,application/json"，但我不知道为什么会这样...
下面是我的代码和 运行 它的结果：
import Data.Aeson
(FromJSON(..))
import Data.Proxy
(Proxy(..))
import GHC.Generics
(Generic)
import Network.HTTP.Client
(newManager, defaultManagerSettings)
import Servant.API
(Capture, Get, JSON, (:>))
import Servant.Client
(BaseUrl(..), ClientM, Scheme( Http ),
client, mkClientEnv, runClientM)
data UserDetailed = UserDetailed
{ username :: String
, userid :: Int
, groups :: [String]
} deriving (Eq, Show, Generic)
instance FromJSON UserDetailed
type API =
"user" :> Capture "username" String :> Get '[JSON] UserDetailed
api :: Proxy API
api = Proxy
getUser :: String -> ClientM UserDetailed
getUser = client api
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
let userName = "alf"
let url = BaseUrl Http "hackage.haskell.org" 80 ""
res <- runClientM (getUser userName) (mkClientEnv manager url)
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right user -> putStrLn $
userName ++ " maintains " ++ (show $ length $ groups user) ++ " packages"
及报错信息（省略大部分html内容）：
Error: UnsupportedContentType text/html;charset=utf-8 (Response {responseStatusCode = Status {statusCode = 200, statusMessage = "OK"}, responseHeader
s = fromList [("Server","nginx/1.14.0 (Ubuntu)"),("Content-Type","text/html; charset=utf-8"),("Content-Encoding","gzip"),("Transfer-Encoding","chunke
d"),("Accept-Ranges","bytes"),("Date","Sun, 21 Jul 2019 13:31:41 GMT"),("Via","1.1 varnish"),("Connection","keep-alive"),("X-Served-By","cache-hhn403
3-HHN"),("X-Cache","MISS"),("X-Cache-Hits","0"),("X-Timer","S1563715901.934337,VS0,VE626"),("Vary","Accept, Accept-Encoding")], responseHttpVersion =
HTTP/1.1, responseBody = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
...
</html>"})
在 Servant 中执行此操作并取回 json 的正确方法是什么？知道是什么导致了这些奇怪的 headers 吗？
编辑：
找到了一种使用以下而不是 defaultManagerSettings 来解决此问题的方法：
defaultManagerSettings {
managerModifyRequest = \req -> return $
req { requestHeaders = ("Accept", "application/json") :
filter (("Accept" /=) . fst) (requestHeaders req) }
}
将直接替换 Accept header。它有效，但似乎仍然不是它应该如何完成的。
哇，真不幸。我敢说黑客在这方面被打破了。您（JSON 的仆人的意思）没有将 HTML 列为有效类型，但由于字符集，hackage 还是将其提供给了您。这是 Hackage 的错，而不是 Servants - 希望您举报。
关于您的问题，如何让 servant 只列出 application/json 而不是 charset 作为 mime 类型，而不进行会破坏其他端点的连接范围设置。这可以通过像 JSON 一样定义您自己的类型并为 MimeUnrender、Accept 等提供实现来解决。
忽略导入和语言扩展的具体细节是：
data RealJSON
-- | @application/json@
instance Accept RealJSON where
contentTypes _ =
[ "application" // "json" ]
instance FromJSON a => MimeUnrender RealJSON a where
mimeUnrender _ = eitherDecodeLenient
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
完整的程序是：
#! /usr/bin/env cabal
{- cabal:
build-depends:
base, aeson, attoparsec, bytestring,
http-client, http-media,
servant-client >= 0.16, servant >= 0.16.1,
string-conversions
-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import qualified Data.Aeson.Parser
import Data.Aeson (FromJSON(..))
import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString.Char8
(endOfInput, parseOnly, skipSpace, (<?>))
import Data.ByteString.Lazy (ByteString)
import Data.Proxy (Proxy(..))
import Data.String.Conversions (cs)
import GHC.Generics (Generic)
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.HTTP.Media ((//))
import Servant.API (Capture, Get, JSON, (:>), Accept(..))
import Servant.API.ContentTypes (MimeUnrender(..))
import Servant.Client (BaseUrl(..), ClientM, Scheme( Http ),
client, mkClientEnv, runClientM)
data RealJSON
-- | @application/json@
instance Accept RealJSON where
contentTypes _ =
[ "application" // "json" ]
instance FromJSON a => MimeUnrender RealJSON a where
mimeUnrender _ = eitherDecodeLenient
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
data UserDetailed = UserDetailed
{ username :: String
, userid :: Int
, groups :: [String]
} deriving (Eq, Show, Generic)
instance FromJSON UserDetailed
type API =
"user" :> Capture "username" String :> Get '[RealJSON] UserDetailed
api :: Proxy API
api = Proxy
getUser :: String -> ClientM UserDetailed
getUser = client api
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
let userName = "ThomasDuBuisson"
let url = BaseUrl Http "hackage.haskell.org" 80 ""
res <- runClientM (getUser userName) (mkClientEnv manager url)
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right user -> putStrLn $
userName ++ " \"maintains\" " ++ (show $ length $ groups user) ++ " packages"
我正在尝试编写一个 HTTP 客户端来使用 Servant 查询 Hackage 并获取 json 数据。但是，当我尝试查询像 /user/alf 这样的端点时（这只是一个 pseudo-random 现有用户名，我也尝试过不同的端点，如 /packages/），我得到一个 UnsupportedContentType 错误。
我使用 wireshark 调查并比较了来自我的代码和来自此 cURL 命令的请求：
$ curl -H "Accept: application/json" http://hackage.haskell.org/user/alf
两者都会导致 200 OK 但 cURL returns json 数据符合预期，而 servant 得到 html 导致错误。
事实上，问题的根源似乎是我的仆人代码产生的 Accept header：
"Accept: application/json;charset=utf-8,application/json"，但我不知道为什么会这样...
下面是我的代码和 运行 它的结果：
import Data.Aeson
(FromJSON(..))
import Data.Proxy
(Proxy(..))
import GHC.Generics
(Generic)
import Network.HTTP.Client
(newManager, defaultManagerSettings)
import Servant.API
(Capture, Get, JSON, (:>))
import Servant.Client
(BaseUrl(..), ClientM, Scheme( Http ),
client, mkClientEnv, runClientM)
data UserDetailed = UserDetailed
{ username :: String
, userid :: Int
, groups :: [String]
} deriving (Eq, Show, Generic)
instance FromJSON UserDetailed
type API =
"user" :> Capture "username" String :> Get '[JSON] UserDetailed
api :: Proxy API
api = Proxy
getUser :: String -> ClientM UserDetailed
getUser = client api
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
let userName = "alf"
let url = BaseUrl Http "hackage.haskell.org" 80 ""
res <- runClientM (getUser userName) (mkClientEnv manager url)
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right user -> putStrLn $
userName ++ " maintains " ++ (show $ length $ groups user) ++ " packages"
及报错信息（省略大部分html内容）：
Error: UnsupportedContentType text/html;charset=utf-8 (Response {responseStatusCode = Status {statusCode = 200, statusMessage = "OK"}, responseHeader
s = fromList [("Server","nginx/1.14.0 (Ubuntu)"),("Content-Type","text/html; charset=utf-8"),("Content-Encoding","gzip"),("Transfer-Encoding","chunke
d"),("Accept-Ranges","bytes"),("Date","Sun, 21 Jul 2019 13:31:41 GMT"),("Via","1.1 varnish"),("Connection","keep-alive"),("X-Served-By","cache-hhn403
3-HHN"),("X-Cache","MISS"),("X-Cache-Hits","0"),("X-Timer","S1563715901.934337,VS0,VE626"),("Vary","Accept, Accept-Encoding")], responseHttpVersion =
HTTP/1.1, responseBody = "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
...
</html>"})
在 Servant 中执行此操作并取回 json 的正确方法是什么？知道是什么导致了这些奇怪的 headers 吗？
编辑：
找到了一种使用以下而不是 defaultManagerSettings 来解决此问题的方法：
defaultManagerSettings {
managerModifyRequest = \req -> return $
req { requestHeaders = ("Accept", "application/json") :
filter (("Accept" /=) . fst) (requestHeaders req) }
}
将直接替换 Accept header。它有效，但似乎仍然不是它应该如何完成的。
哇，真不幸。我敢说黑客在这方面被打破了。您（JSON 的仆人的意思）没有将 HTML 列为有效类型，但由于字符集，hackage 还是将其提供给了您。这是 Hackage 的错，而不是 Servants - 希望您举报。
关于您的问题，如何让 servant 只列出 application/json 而不是 charset 作为 mime 类型，而不进行会破坏其他端点的连接范围设置。这可以通过像 JSON 一样定义您自己的类型并为 MimeUnrender、Accept 等提供实现来解决。
忽略导入和语言扩展的具体细节是：
data RealJSON
-- | @application/json@
instance Accept RealJSON where
contentTypes _ =
[ "application" // "json" ]
instance FromJSON a => MimeUnrender RealJSON a where
mimeUnrender _ = eitherDecodeLenient
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
完整的程序是：
#! /usr/bin/env cabal
{- cabal:
build-depends:
base, aeson, attoparsec, bytestring,
http-client, http-media,
servant-client >= 0.16, servant >= 0.16.1,
string-conversions
-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
import qualified Data.Aeson.Parser
import Data.Aeson (FromJSON(..))
import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString.Char8
(endOfInput, parseOnly, skipSpace, (<?>))
import Data.ByteString.Lazy (ByteString)
import Data.Proxy (Proxy(..))
import Data.String.Conversions (cs)
import GHC.Generics (Generic)
import Network.HTTP.Client (newManager, defaultManagerSettings)
import Network.HTTP.Media ((//))
import Servant.API (Capture, Get, JSON, (:>), Accept(..))
import Servant.API.ContentTypes (MimeUnrender(..))
import Servant.Client (BaseUrl(..), ClientM, Scheme( Http ),
client, mkClientEnv, runClientM)
data RealJSON
-- | @application/json@
instance Accept RealJSON where
contentTypes _ =
[ "application" // "json" ]
instance FromJSON a => MimeUnrender RealJSON a where
mimeUnrender _ = eitherDecodeLenient
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")
data UserDetailed = UserDetailed
{ username :: String
, userid :: Int
, groups :: [String]
} deriving (Eq, Show, Generic)
instance FromJSON UserDetailed
type API =
"user" :> Capture "username" String :> Get '[RealJSON] UserDetailed
api :: Proxy API
api = Proxy
getUser :: String -> ClientM UserDetailed
getUser = client api
main :: IO ()
main = do
manager <- newManager defaultManagerSettings
let userName = "ThomasDuBuisson"
let url = BaseUrl Http "hackage.haskell.org" 80 ""
res <- runClientM (getUser userName) (mkClientEnv manager url)
case res of
Left err -> putStrLn $ "Error: " ++ show err
Right user -> putStrLn $
userName ++ " \"maintains\" " ++ (show $ length $ groups user) ++ " packages"