From 9fe2cde24139c4a832c80d9e81c3513d7ff941ff Mon Sep 17 00:00:00 2001 From: Amitai Burstein Date: Sat, 30 Dec 2023 12:12:43 +0200 Subject: [PATCH] Use a more robust check for `isUrl` validator (#1880) * Use a more robust check for isUrl * URL must start with http:// or https:// --- IHP/ValidationSupport/ValidateField.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/IHP/ValidationSupport/ValidateField.hs b/IHP/ValidationSupport/ValidateField.hs index d287b1280..045ac1e8c 100644 --- a/IHP/ValidationSupport/ValidateField.hs +++ b/IHP/ValidationSupport/ValidateField.hs @@ -18,6 +18,7 @@ import IHP.ModelSupport import IHP.HaskellSupport import Text.Regex.TDFA import Data.List ((!!)) +import Network.URI (parseURI, uriScheme) -- | A function taking some value and returning a 'ValidatorResult' -- @@ -411,10 +412,15 @@ isColor = validateAny [isRgbHexColor, isRgbaHexColor, isRgbColor, isRgbaColor] -- Success -- -- >>> isUrl "digitallyinduced.com" --- Failure "is not a valid url. It needs to start with http:// or https://" +-- Failure "URL must start with http:// or https://" isUrl :: Text -> ValidatorResult -isUrl text | "http://" `isPrefixOf` text || "https://" `isPrefixOf` text = Success -isUrl text = Failure "is not a valid url. It needs to start with http:// or https://" +isUrl url = + case parseURI (unpack url) of + Just uri -> + if uriScheme uri `elem` ["http:", "https:"] + then Success + else Failure "URL must start with http:// or https://" + Nothing -> Failure "Invalid URL" {-# INLINABLE isUrl #-}