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:
parent
e0ebf3da64
commit
2dae6df953
@ -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
|
||||
|
@ -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).
|
||||
|
Loading…
Reference in New Issue
Block a user