检查每个 URL 在 Yesod 站点上的测试中有效

Question

我试图检查所有链接是否在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时，它将尝试获取返回 404 代码的/zigazou/bazasso。

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

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

它根本不是做这件事的正确地方吗？

Answer 1

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

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