1

I was trying to check that all links work on a Yesod website home page. I wrote this hSpec test.

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

Everything compiles ok but the get function gets rid of the host part of the URLs you feed it. For example, when you give it https://github.com/zigazou/bazasso, it will try to fetch /zigazou/bazasso which returns a 404 code.

Is there a way to make it work like I want ?

Should I add a function that removes external links from the tests ?

Is it simply not the right place to do it ?

zigazou
  • 1,725
  • 9
  • 13
  • I think that it is bug of yesod-test, I will write pull request or issue. – ncaq Jul 05 '18 at 07:36
  • 1
    It seems that yesod-test is not a bug because it does not make an actual http request using runSession. It's confusing to see Google in the sample code. I think that the case of an external request for the time being there is a workaround to use the hspec of http-conduit and iodine. – ncaq Jul 05 '18 at 08:04

1 Answers1

0

The simpler, the better: I've removed everything that starts with a protocol from the links that will be checked. Thanks to @ncaq for your comments.

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
zigazou
  • 1,725
  • 9
  • 13