Haskell用Network.HTTP.Simple登录Lemmy获取JWT遇403错误求助

问题 #

我需要从Lemmy服务器获取JWT Token，用户名和密码均正确——用curl执行以下请求能正常返回Token：

curl --location 'https://enterprise.lemmy.ml/api/v3/user/login' \
--header 'Content-Type: application/json' \
--data '{
  "username_or_email": "PaneCaMeusa",
  "password": "***"
}'

但用Haskell的Network.HTTP.Simple库实现相同逻辑时，返回403 Forbidden响应：

<html>
<head><title>403 Forbidden</title></head>
<body>
<center><h1>403 Forbidden</h1></center>
<hr><center>nginx</center>
</body>
</html>

我的Haskell代码如下：

{-# LANGUAGE OverloadedStrings #-}

module Lemmy where

import Network.HTTP.Simple
import Data.Aeson
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import qualified Data.Text.Encoding as TE 
import System.Console.Haskeline
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Lazy.Char8 as LBS

getPasswordIO :: IO (Maybe String)
getPasswordIO = runInputT defaultSettings $ getPassword (Just '*') "Enter password: "

-- Login to Lemmy and get a JWT token
loginToLemmy :: Text -> Text -> Text -> IO (Either String LoginResponse)
loginToLemmy instanceUrl user password = do
    let loginUrl = T.unpack instanceUrl <> "/api/v3/user/login"
    let requestBody = object[ "username_or_email" .= user, "password" .= password]
    putStrLn $ show requestBody
    putStrLn loginUrl
    TIO.putStrLn  user
    TIO.putStrLn password
    request <- parseRequest loginUrl
    let req = setRequestBodyJSON requestBody 
            $ setRequestMethod "POST" 
            $ setRequestHeader "Content-Type" ["application/json"] 
            $ request
    
    response <- httpLBS req
    let responseBody = getResponseBody response
    putStrLn $ LBS.unpack responseBody
    return $ eitherDecode responseBody

entrypoint :: IO ()
entrypoint = do

    password <- getPasswordIO

    let instanceUrl = "https://enterprise.lemmy.ml"
        myUsername = "PaneCaMeusa"
        myPassword = T.pack $ fromMaybe ""  password

    -- Step 1: Log in and get JWT
    loginResult <- loginToLemmy instanceUrl myUsername myPassword
    case loginResult of
        Left err -> putStrLn $ "Login failed: " <> err
        Right loginResponse -> do
            putStrLn $ "Logged in! JWT: " <> T.unpack (jwt loginResponse)

            -- Step 2: Fetch user details
            userResult <- fetchUserDetails instanceUrl (jwt loginResponse) myUsername
            case userResult of
                Left err -> putStrLn $ "Failed to fetch user: " <> err
                Right userDetails -> do
                    putStrLn $ "User Details:"
                    putStrLn $ "- ID: " <> show (userId userDetails)
                    putStrLn $ "- Username: " <> T.unpack (username userDetails)
                    putStrLn $ "- Email: " <> maybe "None" T.unpack (email userDetails)

代码中打印的URL、用户名和密码均正确，请问该如何修复这个问题？

解决方案 #

核心原因：缺少User-Agent请求头 #

很多Lemmy实例的nginx服务器会拦截无明确标识的请求，curl默认会携带类似curl/7.81.0的User-Agent头，而Network.HTTP.Simple默认请求不包含该头，导致被判定为异常请求返回403。

修复步骤 #

在构建请求时添加User-Agent头，同时可启用自动跟随重定向（对应curl的--location参数），修改后的loginToLemmy函数关键部分如下：

let req = setRequestBodyJSON requestBody 
        $ setRequestMethod "POST" 
        $ setRequestHeader "Content-Type" ["application/json"] 
        $ setRequestHeader "User-Agent" ["Lemmy-Haskell-Client/1.0"] -- 添加自定义User-Agent
        $ setRequestFollowRedirects True -- 启用自动跟随重定向
        $ request

额外验证点 #

1. 确认请求体JSON格式与curl完全一致：代码中用object构建的请求体无问题，无需调整。
2. 检查URL拼接逻辑：打印的URL正确，可排除路径错误。

添加上述头信息后，请求会被服务器识别为合法客户端请求，即可正常获取JWT Token。

内容的提问来源于stack exchange，提问作者Vitaly Olegovitch