Haskell社交网站AccessToken获取程序不稳定问题求助

嘿，看起来你在Haskell用Shpider做OAuth令牌获取的时候碰到了挺头疼的稳定性问题——成功率低、首次必败，还时不时出表单处理不了或者无限循环的情况，而Python的Robobrowser版本却稳得一批对吧？作为新手遇到这种差异确实容易懵，我来帮你拆解下可能的问题，再给你点改进方向。

1. 表单处理过于刚性，容错性为0 #

你的代码里直接用head . forms取第一个表单，这是个很大的隐患：如果页面加载不完全、结构有动态变化，或者首次请求没拿到正确的表单，head会直接抛出异常，让后续流程彻底乱掉。而且你默认page2里一定有__CANCEL__这个输入项，万一页面没有这个字段，delete操作等于无效，发送的表单完全不符合网站要求，自然拿不到令牌。

对比Robobrowser，它会自动识别表单结构、处理动态字段，而Shpider属于相对底层的HTTP爬虫，容错性差很多，需要你手动做各种校验。

2. Cookie管理逻辑有漏洞 #

你每次运行都删除cookies文件，但Shpider的Cookie上下文可能没同步更新。比如首次请求时网站会设置会话Cookie，但删除文件后，Shpider可能没正确初始化新的Cookie容器，导致请求状态不一致，这大概率是“首次尝试从未成功”的原因之一。

3. 令牌提取完全没有错误处理 #

用(source page) =~ pattern然后直接取matrix!!0!!1太冒险了——如果页面里找不到access_token的匹配，索引操作会直接崩溃程序。而且你没考虑令牌可能出现在跳转URL里，而不是页面源码中的情况。

4. 全程没有异常捕获和调试日志 #

整个流程没有任何错误捕获，也没打印中间步骤的状态（比如页面返回码、表单内容、源码片段），出问题了你根本不知道是哪一步错了：是初始页面下载失败？还是表单发送后跳转错了？这些没处理的异常，很容易导致无限循环或者奇怪的表单问题。

我给你加了错误处理、调试输出和更稳健的表单/令牌提取逻辑：

import Network.Shpider
import Network.Curl
import Data.Map (delete, fromList)
import Text.Regex.Posix
import System.Directory
import Control.Monad (when, liftM)
import Control.Exception (try, SomeException)

getAccessToken :: String -> String -> String -> String -> IO (Maybe String)
getAccessToken email pass url userAgent = runShpider $ do
    let pattern = "access_token=([a-zA-Z0-9]+)"
        -- 安全提取表单，避免空列表调用head崩溃
        extractForm page = case forms page of
            [] -> Nothing
            (f:_) -> Just f
        -- 安全生成确认表单
        confirmForm page input = case extractForm page of
            Nothing -> Nothing
            Just theForm -> Just $ theForm { inputs = delete input (inputs theForm) }
        -- 安全提取令牌，处理无匹配的情况
        extractToken page = case source page =~ pattern of
            [[_, token]] -> Just token
            _ -> Nothing

    -- 调试：打印Cookie文件状态
    isCookieFile <- liftIO $ doesFileExist "cookies"
    liftIO $ putStrLn $ "Cookie file exists: " ++ show isCookieFile
    when isCookieFile $ liftIO $ do
        removeFile "cookies"
        liftIO $ putStrLn "Deleted old cookie file"

    addCurlOpts [CurlUserAgent userAgent, CurlFollowLocation True, 
                 CurlCookieFile "cookies", CurlCookieJar "cookies"]

    -- 第一步：下载初始页面，捕获异常
    downloadResult <- try $ download url :: Shpider (Either SomeException (Response String, Page String))
    case downloadResult of
        Left e -> do
            liftIO $ putStrLn $ "Failed to download initial page: " ++ show e
            return Nothing
        Right (resp, page1) -> do
            liftIO $ putStrLn $ "Initial page status: " ++ show (respStatus resp)
            case extractForm page1 of
                Nothing -> do
                    liftIO $ putStrLn "No form found on initial page"
                    return Nothing
                Just form1 -> do
                    -- 第二步：填写登录表单
                    let filledForm = fillOutForm form1 $ pairs $ do
                            "email" =: email
                            "pass" =: pass
                    sendFormResult <- try $ sendForm filledForm :: Shpider (Either SomeException (Response String, Page String))
                    case sendFormResult of
                        Left e -> do
                            liftIO $ putStrLn $ "Failed to send login form: " ++ show e
                            return Nothing
                        Right (resp2, page2) -> do
                            liftIO $ putStrLn $ "Login form sent, status: " ++ show (respStatus resp2)
                            case confirmForm page2 "__CANCEL__" of
                                Nothing -> do
                                    liftIO $ putStrLn "No form found or __CANCEL__ input missing on page2"
                                    return Nothing
                                Just form2 -> do
                                    -- 第三步：发送确认表单
                                    sendConfirmResult <- try $ sendForm form2 :: Shpider (Either SomeException (Response String, Page String))
                                    case sendConfirmResult of
                                        Left e -> do
                                            liftIO $ putStrLn $ "Failed to send confirm form: " ++ show e
                                            return Nothing
                                        Right (resp3, page3) -> do
                                            liftIO $ putStrLn $ "Confirm form sent, status: " ++ show (respStatus resp3)
                                            let token = extractToken page3
                                            liftIO $ putStrLn $ "Extracted token: " ++ show token
                                            return token

• 检查JS依赖：如果目标网站的表单是JS动态生成的，Shpider作为纯HTTP爬虫无法处理，而Robobrowser如果结合了无头浏览器（比如Selenium）就能渲染JS，这会导致你的Haskell程序根本拿不到正确的表单，自然失败。
• 打印更多调试信息：比如输出每个页面的源码片段（take 1000 $ source page），看看页面是不是没正确加载，或者表单字段名称和你硬编码的不一样。
• 完善Cookie配置：我在代码里加了CurlCookieFile和CurlCookieJar选项，确保Cookie能正确持久化和读取，这能解决部分会话状态不一致的问题。

内容的提问来源于stack exchange，提问作者Marius Catalin