diff options
| -rw-r--r-- | hakyll.cabal | 6 | ||||
| -rw-r--r-- | src/Hakyll/Web/Html.hs | 10 | ||||
| -rw-r--r-- | tests/Hakyll/Web/Html/Tests.hs | 13 |
3 files changed, 19 insertions, 10 deletions
diff --git a/hakyll.cabal b/hakyll.cabal index 633a414..8daface 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -162,7 +162,8 @@ Library regex-tdfa >= 1.1 && < 1.2, tagsoup >= 0.12.6 && < 0.13, text >= 0.11 && < 1.12, - time >= 1.1 && < 1.5 + time >= 1.1 && < 1.5, + network >= 2.0 && < 2.5 If flag(previewServer) Build-depends: @@ -238,7 +239,8 @@ Test-suite hakyll-tests regex-tdfa >= 1.1 && < 1.2, tagsoup >= 0.12.6 && < 0.13, text >= 0.11 && < 1.12, - time >= 1.1 && < 1.5 + time >= 1.1 && < 1.5, + network >= 2.0 && < 2.5 If flag(previewServer) Build-depends: diff --git a/src/Hakyll/Web/Html.hs b/src/Hakyll/Web/Html.hs index d06b7c2..3a0aa3b 100644 --- a/src/Hakyll/Web/Html.hs +++ b/src/Hakyll/Web/Html.hs @@ -30,6 +30,7 @@ import System.FilePath (joinPath, splitPath, import Text.Blaze.Html (toHtml) import Text.Blaze.Html.Renderer.String (renderHtml) import qualified Text.HTML.TagSoup as TS +import Network.URI (isUnreserved, escapeURIString) -------------------------------------------------------------------------------- @@ -105,10 +106,11 @@ toUrl url = case url of ('/' : xs) -> '/' : sanitize xs xs -> '/' : sanitize xs where - -- This probably needs to be a separate function - sanitize = concatMap $ \c -> case c of - ' ' -> "%20" - _ -> [c] + -- Everything but unreserved characters should be escaped as we are + -- sanitising the path therefore reserved characters which have a + -- meaning in URI does not appear. Special casing for `/`, because it has + -- a special meaning in FilePath as well as in URI. + sanitize = escapeURIString (\c -> c == '/' || isUnreserved c) -------------------------------------------------------------------------------- diff --git a/tests/Hakyll/Web/Html/Tests.hs b/tests/Hakyll/Web/Html/Tests.hs index a33823c..e150ea2 100644 --- a/tests/Hakyll/Web/Html/Tests.hs +++ b/tests/Hakyll/Web/Html/Tests.hs @@ -43,10 +43,15 @@ tests = testGroup "Hakyll.Web.Html.Tests" $ concat ] , fromAssertions "toUrl" - [ "/foo/bar.html" @=? toUrl "foo/bar.html" - , "/" @=? toUrl "/" - , "/funny-pics.html" @=? toUrl "/funny-pics.html" - , "/funny%20pics.html" @=? toUrl "funny pics.html" + [ "/foo/bar.html" @=? toUrl "foo/bar.html" + , "/" @=? toUrl "/" + , "/funny-pics.html" @=? toUrl "/funny-pics.html" + , "/funny%20pics.html" @=? toUrl "funny pics.html" + -- Test various reserved characters (RFC 3986, section 2.2) + , "/%21%2A%27%28%29%3B%3A%40%26.html" @=? toUrl "/!*'();:@&.html" + , "/%3D%2B%24%2C/%3F%23%5B%5D.html" @=? toUrl "=+$,/?#[].html" + -- Test various characters that are nor reserved, nor unreserved. + , "/%E3%81%82%F0%9D%90%87%E2%88%80" @=? toUrl "\12354\119815\8704" ] , fromAssertions "toSiteRoot" |