Cannot login and get JWT Token using Haskell Network.HTTP.Simple

I want to get a JWT token from a server. My username and password are correct, because if I run:

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

It returns the correct token.

But when I try to do the same thing in Haskell, I get:

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

My Haskell code is:

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

The URL, password and username printed are the right ones.

What can I do to fix it?

Solution

It appears that enterprise.lemmy.ml is rejecting requests lacking a User-Agent header with 403 Forbidden without checking the credentials (because "security", LOL). So, try supplying such a header. The contents don't seem to matter:

let req = setRequestBodyJSON requestBody
        $ setRequestMethod "POST"
        $ setRequestHeader "User-Agent" ["Haskell Network.HTTP.Simple client version 0.1"]
        $ request

I wasn't able to test with valid credentials, because I don't have them, but with a User-Agent header, my login attempt was rejected with a 401 Unauthorized and a valid JSON {"error":"incorrect_login"} response, which looks more promising than what you were getting.

Also, note that because setRequestBodyJSON automatically sets a Content-Type: application/json; charset=utf-8 header, there's no need to add your own.