1
1
mirror of https://github.com/aelve/guide.git synced 2024-12-23 12:52:31 +03:00

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

This commit is contained in:
Artyom 2017-04-26 21:33:03 +03:00
parent e0ebf3da64
commit 2dae6df953
No known key found for this signature in database
GPG Key ID: B8E35A33FF522710
2 changed files with 16 additions and 4 deletions

View File

@ -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

View File

@ -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
----------------------------------------------------------------------------
@ -174,9 +177,16 @@ type Url = Text
sanitiseUrl :: Url -> Maybe Url
sanitiseUrl u
| not (sanitaryURI u) = Nothing
| "http:" `T.isPrefixOf` u = Just u
| "https:" `T.isPrefixOf` u = Just u
| otherwise = Just ("http://" <> u)
| otherwise =
Just $ case URI.uriScheme <$> parse (T.toString u) of
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).