63a3000 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Account for scheme-relative URLs

63a3000Simonas Kazlauskas14 years ago

src/Hakyll/Check.hs+8−2

compare with master

unifiedsplit

@@ -198,12 +198,14 @@ checkExternalUrl url = do

198 else do

199 isOk <- liftIO $ handle (failure logger) $

200 Http.withManager $ \mgr -> do

201− request <- Http.parseUrl url

201+ request <- Http.parseUrl $ urlToCheck url

202 response <- Http.http (settings request) mgr

203 let code = Http.statusCode (Http.responseStatus response)

204 return $ code >= 200 && code < 300

205

206+ modify $ if schemeRelative url

207+ then S.insert (urlToCheck url) . S.insert url

206− modify $ S.insert url

208+ else S.insert url

207 if isOk then ok url else faulty url

209 if isOk then ok url else faulty url

208 where

210 where

209 -- Add additional request info

211 -- Add additional request info

@@ -221,6 +223,10 @@ checkExternalUrl url = do

221 failure logger (SomeException e) = case cast e of

223 failure logger (SomeException e) = case cast e of

222 Just UserInterrupt -> throw UserInterrupt

224 Just UserInterrupt -> throw UserInterrupt

223 _ -> Logger.error logger (show e) >> return False

225 _ -> Logger.error logger (show e) >> return False

226+

227+ -- Check scheme-relative links

228+ schemeRelative = isPrefixOf "//"

229+ urlToCheck uri = if schemeRelative uri then "http:" ++ uri else uri

224#else

230#else

225checkExternalUrl _ = return ()

231checkExternalUrl _ = return ()

226#endif

232#endif

src/Hakyll/Web/Html.hs+1−1

@@ -120,7 +120,7 @@ toSiteRoot = emptyException . joinPath . map parent

120--------------------------------------------------------------------------------

121-- | Check if an URL links to an external HTTP(S) source

122isExternal :: String -> Bool

123−isExternal url = any (flip isPrefixOf url) ["http://", "https://"]

123+isExternal url = any (flip isPrefixOf url) ["http://", "https://", "//"]

124

125

126--------------------------------------------------------------------------------

tests/Hakyll/Web/Html/Tests.hs+1

@@ -58,6 +58,7 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat

58 , fromAssertions "isExternal"

59 [ assert (isExternal "http://reddit.com")

60 , assert (isExternal "https://mail.google.com")

61+ , assert (isExternal "//ajax.googleapis.com")

61 , assert (not (isExternal "../header.png"))

62 , assert (not (isExternal "../header.png"))

62 , assert (not (isExternal "/foo/index.html"))

63 , assert (not (isExternal "/foo/index.html"))

63 ]

64 ]