Проверка работы каждого URL-адреса в тестах на сайте Yesod

Я пытался проверить, работают ли все ссылки на главной странице веб-сайта 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.

Есть ли способ заставить его работать так, как я хочу?

Должен ли я добавить функцию, которая удаляет внешние ссылки из тестов?

Это просто не то место, где это можно сделать?


unit-testing haskell yesod hspec
person zigazou    schedule 05.07.2018    source источник
comment
Думаю, что это баг yesod-теста, напишу pull request или issue.   -  person ncaq    schedule 05.07.2018
comment
Кажется, что yesod-test не является ошибкой, потому что он не выполняет фактический HTTP-запрос с использованием runSession. Смущает видеть Google в примере кода. Я думаю, что в случае внешнего запроса на данный момент есть обходной путь, чтобы использовать hspec http-conduit и iodine.   -  person ncaq    schedule 05.07.2018

Ответы (1)


arrow_upward
0
arrow_downward

Чем проще, тем лучше: я убрал из ссылок, которые будут проверяться, все, что начинается с протокола. Спасибо @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
person zigazou    schedule 05.07.2018