Only add http:// in sanitiseUri if it didn't have *any* scheme

guide.cabal

@@ -111,6 +111,7 @@ library
                      , mtl >= 2.1.1
                      , neat-interpolation == 0.3.*
                      , network
+                     , network-uri
                      , patches-vector
                      , path-pieces
                      , random >= 1.1
@@ -128,6 +129,7 @@ library
                      , transformers
                      , uniplate
                      , unix
+                     , utf8-string
                      , vector
                      , wai
                      , wai-middleware-metrics

src/Guide/Utils.hs

@@ -110,6 +110,9 @@ import qualified Language.Haskell.TH.Syntax as TH (lift)
 import Language.Haskell.TH.Quote (QuasiQuoter(..))
 import Language.Haskell.Meta (parseExp)
 import Data.Generics.Uniplate.Data (transform)
+-- needed for 'sanitiseUrl'
+import qualified Codec.Binary.UTF8.String as UTF8
+import qualified Network.URI as URI
 
 
 ----------------------------------------------------------------------------
@@ -173,10 +176,17 @@ type Url = Text
 -- if it doesn't have a scheme.
 sanitiseUrl :: Url -> Maybe Url
 sanitiseUrl u
-  | not (sanitaryURI u)       = Nothing
+  | not (sanitaryURI u) = Nothing
-  | "http:" `T.isPrefixOf` u  = Just u
+  | otherwise =
-  | "https:" `T.isPrefixOf` u = Just u
+      Just $ case URI.uriScheme <$> parse (T.toString u) of
-  | otherwise                 = Just ("http://" <> u)
+        Nothing -> "http://" <> u
+        Just "" -> "http://" <> u
+        _       -> u
+  where
+    -- code taken from implementation of 'sanitaryURI'
+    parse  = URI.parseURIReference . escape
+    escape = URI.escapeURIString URI.isAllowedInURI .
+             UTF8.encodeString
 
 -- | Make text suitable for inclusion into an URL (by turning spaces into
 -- hyphens and so on).