Account for scheme-relative URLs

http://url.spec.whatwg.org/#concept-scheme-relative-url

3 files changed, 10 insertions, 3 deletions

diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs
index 48bb655..68ece18 100644
--- a/src/Hakyll/Check.hs
+++ b/src/Hakyll/Check.hs
@@ -198,12 +198,14 @@ checkExternalUrl url = do
         else do
             isOk <- liftIO $ handle (failure logger) $
                 Http.withManager $ \mgr -> do
-                    request  <- Http.parseUrl url
+                    request  <- Http.parseUrl $ urlToCheck url
                     response <- Http.http (settings request) mgr
                     let code = Http.statusCode (Http.responseStatus response)
                     return $ code >= 200 && code < 300
 
-            modify $ S.insert url
+            modify $ if schemeRelative url
+                         then S.insert (urlToCheck url) . S.insert url
+                         else S.insert url
             if isOk then ok url else faulty url
   where
     -- Add additional request info
@@ -221,6 +223,10 @@ checkExternalUrl url = do
     failure logger (SomeException e) = case cast e of
         Just UserInterrupt -> throw UserInterrupt
         _                  -> Logger.error logger (show e) >> return False
+
+    -- Check scheme-relative links
+    schemeRelative = isPrefixOf "//"
+    urlToCheck uri = if schemeRelative uri then "http:" ++ uri else uri
 #else
 checkExternalUrl _ = return ()
 #endif
diff --git a/src/Hakyll/Web/Html.hs b/src/Hakyll/Web/Html.hs
index 4053003..37e517d 100644
--- a/src/Hakyll/Web/Html.hs
+++ b/src/Hakyll/Web/Html.hs
@@ -120,7 +120,7 @@ toSiteRoot = emptyException . joinPath . map parent
 --------------------------------------------------------------------------------
 -- | Check if an URL links to an external HTTP(S) source
 isExternal :: String -> Bool
-isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
+isExternal url = any (flip isPrefixOf url) ["http://", "https://", "//"]
 
 
 --------------------------------------------------------------------------------
diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs
index 1c17f5c..bfb6b7c 100644
--- a/tests/Hakyll/Web/Html/Tests.hs
+++ b/tests/Hakyll/Web/Html/Tests.hs
@@ -58,6 +58,7 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat
     , fromAssertions "isExternal"
         [ assert (isExternal "http://reddit.com")
         , assert (isExternal "https://mail.google.com")
+        , assert (isExternal "//ajax.googleapis.com")
         , assert (not (isExternal "../header.png"))
         , assert (not (isExternal "/foo/index.html"))
         ]