检查每个 URL 在 Yesod 网站上的测试中有效答案

【问题标题】：Checking each URL works in tests on a Yesod site检查每个 URL 在 Yesod 网站上的测试中有效
【发布时间】：2018-07-05 23:47:04
【问题描述】：

我试图检查 Yesod 网站主页上的所有链接是否有效。我编写了这个 hSpec 测试。

module Handler.HomeSpec (spec) where

import           Data.Either                (fromRight)
import qualified Data.Text                  as T
import           Network.Wai.Test           (simpleBody)
import           TestImport
import           Yesod.Test.TransversingCSS (findAttributeBySelector)

getAllLinks :: YesodExample site [Text]
getAllLinks = withResponse $ \res -> do
    let links = fromRight [] findAttributeBySelector (simpleBody res) "a" "href"
    return $ T.concat <$> links

spec :: Spec
spec = withApp $
    describe "Homepage" $ do
        it "checks all links" $ do
            get HomeR
            statusIs 200
            links <- getAllLinks

            forM_ links $ \oneLink -> do
                get HomeR
                statusIs 200
                get oneLink
                statusIs 200

一切都可以编译，但 get 函数会删除您提供给它的 URL 的主机部分。例如，当你给它https://github.com/zigazou/bazasso时，它会尝试获取/zigazou/bazasso，这会返回一个404代码。

有没有办法让它像我想要的那样工作？

我应该添加一个从测试中删除外部链接的函数吗？

这根本就不是合适的地方吗？

【问题讨论】：

我认为是yesod-test的bug，我会写pull request或者issue。
yesod-test 似乎不是错误，因为它没有使用 runSession 发出实际的 http 请求。在示例代码中看到 Google 令人困惑。我认为暂时有外部请求的情况下使用http-conduit和iodine的hspec有一个变通方法。

标签： unit-testing haskell yesod hspec

【解决方案1】：

越简单越好：我已经从将要检查的链接中删除了所有以协议开头的内容。感谢 @ncaq 提供的 cmets。

module Handler.HomeSpec (spec) where

import           Data.Either                (fromRight)
import qualified Data.Text                  as T
import           Network.Wai.Test           (simpleBody)
import           TestImport
import           Yesod.Test.TransversingCSS (findAttributeBySelector)

isRelative :: Text -> Bool
isRelative url
    | T.take 7 url == "http://"  = False
    | T.take 8 url == "https://" = False
    | T.take 7 url == "mailto:"  = False
    | T.take 4 url == "tel:"     = False
    | otherwise                  = True

getAllLinks :: YesodExample site [Text]
getAllLinks = withResponse $ \res -> do
    let currentHtml = simpleBody res
        links = fromRight [] $ findAttributeBySelector currentHtml "a" "href"
    return $ filter isRelative $ T.concat <$> links

spec :: Spec
spec = withApp $
    describe "Homepage" $ do
        it "checks all links" $ do
            get HomeR
            statusIs 200
            links <- getAllLinks

            forM_ links $ \oneLink -> do
                get HomeR
                statusIs 200
                get oneLink
                statusIs 200

【讨论】：