mirror of
https://github.com/aelve/guide.git
synced 2024-12-23 21:02:13 +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
|
, mtl >= 2.1.1
|
||||||
, neat-interpolation == 0.3.*
|
, neat-interpolation == 0.3.*
|
||||||
, network
|
, network
|
||||||
|
, network-uri
|
||||||
, patches-vector
|
, patches-vector
|
||||||
, path-pieces
|
, path-pieces
|
||||||
, random >= 1.1
|
, random >= 1.1
|
||||||
@ -128,6 +129,7 @@ library
|
|||||||
, transformers
|
, transformers
|
||||||
, uniplate
|
, uniplate
|
||||||
, unix
|
, unix
|
||||||
|
, utf8-string
|
||||||
, vector
|
, vector
|
||||||
, wai
|
, wai
|
||||||
, wai-middleware-metrics
|
, 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.TH.Quote (QuasiQuoter(..))
|
||||||
import Language.Haskell.Meta (parseExp)
|
import Language.Haskell.Meta (parseExp)
|
||||||
import Data.Generics.Uniplate.Data (transform)
|
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 :: Url -> Maybe Url
|
||||||
sanitiseUrl u
|
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
|
-- | Make text suitable for inclusion into an URL (by turning spaces into
|
||||||
-- hyphens and so on).
|
-- hyphens and so on).
|
||||||
|
Loading…
Reference in New Issue
Block a user