diff --git a/src/App/Validation.purs b/src/App/Validation.purs index 3bf2fab..b3b0fe6 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -13,11 +13,16 @@ import Data.String.Regex.Flags as RF import Data.String as S import Data.Int (fromString) import URI.Host.IPv4Address as IPv4 +import URI.Host.IPv6Address as IPv6 import App.RR import App.ResourceRecord (ResourceRecord) +--andThenDrop :: forall errors a b. V errors a -> V errors b -> V errors b +-- andThenDrop f1 f2 = f1 !> (\ _ -> f2) + infixl 8 andThen as !> +-- infixl 8 andThenDrop as !< data Attribute = Name @@ -33,11 +38,24 @@ data Attribute type Errors = Array (Tuple Attribute String) --- | Totally garbage value at the moment. Please fix. +-- | Totally garbage values at the moment. Please fix. **TODO** + min_ttl :: Int min_ttl = 30 max_ttl :: Int max_ttl = 86000 +min_priority :: Int +min_priority = 0 +max_priority :: Int +max_priority = 65535 +min_port :: Int +min_port = 0 +max_port :: Int +max_port = 65535 +min_weight :: Int +min_weight = 0 +max_weight :: Int +max_weight = 65535 name_min_len :: Int name_min_len = 1 name_max_len :: Int @@ -46,8 +64,18 @@ target_min_len :: Int target_min_len = 1 target_max_len :: Int target_max_len = 50 +target_TXT_max_len :: Int +target_TXT_max_len = 500 +protocol_min_len :: Int +protocol_min_len = 1 +protocol_max_len :: Int +protocol_max_len = 10 name_format :: String name_format = "[a-zA-Z]+" +hostname_format :: String +hostname_format = "^(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9-]*[a-zA-Z0-9]).)*([A-Za-z0-9]|[A-Za-z0-9][A-Za-z0-9-]*[A-Za-z0-9])$" +protocol_format :: String +protocol_format = "^(tcp|udp|sctp)$" --name_format = "[a-zA-Z][a-zA-Z0-9_-]*" --target_A_format :: String --target_A_format = "[1-9][][a-zA-Z]+" @@ -65,11 +93,10 @@ lengthIsBetween field minlen maxlen value error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]" -- | `matches` is a simple format verification based on regex parsing. --- | The regex is the last paramater so the verification code can be written this way: +-- | `verify_regex` is a handler to use `matches` with a string regex format. -- | -- | ``` --- | verify_regex Name name_format --- | !> matches Name name +-- | verify_regex Name name_format name -- | ``` matches :: Attribute -> String -> R.Regex -> V Errors String matches field value regex @@ -89,37 +116,116 @@ validate_integer field string Nothing -> invalid [Tuple field "not an integer"] Just i -> pure i -verify_regex :: Attribute -> String -> String -> V Errors R.Regex -verify_regex field str _ - = case R.regex str RF.unicode of +-- | `verify_domain` provides a SIMPLISTIC verification for hostname format. + +verify_domain :: Attribute -> String -> V Errors String +verify_domain field value = verify_regex field hostname_format value + +-- | `verify_regex` provides a reasonable way to verify a value based on a regex. +-- | The regex is a simple string. +-- | An example: +-- | +-- | ``` +-- | verify_length name +-- | !> verify_regex Name name_format +-- | ``` + +verify_regex :: Attribute -> String -> String -> V Errors String +verify_regex field restr value + = case R.regex restr RF.unicode of Left error_string -> invalid [Tuple field $ "error in regex: " <> error_string] - Right regex -> pure regex + Right regex -> matches field value regex verify_ipv4 :: Attribute -> String -> V Errors String verify_ipv4 field str = case runParser str IPv4.parser of Left _ -> invalid [Tuple field "cannot parse this IPv4"] Right _ -> pure str +verify_ipv6 :: Attribute -> String -> V Errors String +verify_ipv6 field str = case runParser str IPv6.parser of + Left _ -> invalid [Tuple field "cannot parse this IPv6"] + Right _ -> pure str + -- Field-related validations. validate_name :: String -> V Errors String -validate_name name = verify_length name !> verify_regex Name name_format !> (matches Name name) +validate_name name + = verify_length name !> verify_regex Name name_format where verify_length = lengthIsBetween Name name_min_len name_max_len validate_ttl :: String -> V Errors Int validate_ttl str_ttl - = is_int str_ttl !> right_range !> pure + = is_int str_ttl !> right_range where is_int = validate_integer TTL right_range = intBetween TTL min_ttl max_ttl +validate_priority :: String -> V Errors Int +validate_priority str_priority + = is_int str_priority !> right_range + where + is_int = validate_integer Priority + right_range = intBetween Priority min_priority max_priority + +validate_protocol :: String -> V Errors String +validate_protocol protocol + = verify_length protocol !> verify_regex Protocol protocol_format + where + verify_length = lengthIsBetween Protocol protocol_min_len protocol_max_len + +validate_weight :: String -> V Errors Int +validate_weight str_weight + = is_int str_weight !> right_range + where + is_int = validate_integer Weight + right_range = intBetween Weight min_weight max_weight + +validate_port :: String -> V Errors Int +validate_port str_port + = is_int str_port !> right_range + where + is_int = validate_integer Port + right_range = intBetween Port min_port max_port + validate_target_A :: String -> V Errors String -validate_target_A target = verify_length target !> verify_format !> pure +validate_target_A target + = verify_length target !> verify_format where verify_length = lengthIsBetween Target target_min_len target_max_len verify_format = verify_ipv4 Target +validate_target_AAAA :: String -> V Errors String +validate_target_AAAA target + = verify_length target !> verify_format + where + verify_length = lengthIsBetween Target target_min_len target_max_len + verify_format = verify_ipv6 Target + +validate_target_TXT :: String -> V Errors String +validate_target_TXT target + = verify_length target + where + verify_length = lengthIsBetween Target target_min_len target_TXT_max_len + +validate_target_CNAME :: String -> V Errors String +validate_target_CNAME target + = verify_length target + where + verify_length = lengthIsBetween Target target_min_len target_max_len + +validate_target_NS :: String -> V Errors String +validate_target_NS target + = verify_length target !> verify_domain Target + where + verify_length = lengthIsBetween Target target_min_len target_max_len + +validate_target_MX :: String -> V Errors String +validate_target_MX target + = verify_length target !> verify_domain Target + where + verify_length = lengthIsBetween Target target_min_len target_max_len + -- Resource-related validations. validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord @@ -130,17 +236,32 @@ validateA form = ado in toRR_basic form.rrid form.readonly "A" name ttl target validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"] +validateAAAA form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_AAAA form.target + in toRR_basic form.rrid form.readonly "AAAA" name ttl target + validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateTXT _ = invalid [Tuple NotAnAttribute "validation not implemented"] +validateTXT form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_TXT form.target + in toRR_basic form.rrid form.readonly "TXT" name ttl target + validateCNAME :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateCNAME _ = invalid [Tuple NotAnAttribute "validation not implemented"] +validateCNAME form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_CNAME form.target + in toRR_basic form.rrid form.readonly "CNAME" name ttl target + validateNS :: forall l. SimpleRR (|l) -> V Errors ResourceRecord -validateNS _ = invalid [Tuple NotAnAttribute "validation not implemented"] -validateMX :: forall l. MXRR (|l) -> V Errors ResourceRecord -validateMX _ = invalid [Tuple NotAnAttribute "validation not implemented"] -validateSRV :: forall l. SRVRR (|l) -> V Errors ResourceRecord -validateSRV _ = invalid [Tuple NotAnAttribute "validation not implemented"] +validateNS form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_NS form.target + in toRR_basic form.rrid form.readonly "NS" name ttl target validateSRR_ :: forall l. SimpleRR (|l) -> V Errors ResourceRecord validateSRR_ form = case form.rrtype of @@ -151,11 +272,30 @@ validateSRR_ form = case form.rrtype of "NS" -> validateNS form _ -> invalid [Tuple NotAnAttribute $ "invalid type: " <> form.rrtype] +validateMX :: forall l. MXRR (|l) -> V Errors ResourceRecord +validateMX form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_MX form.target + priority <- validate_priority form.priority + in toRR_mx form.rrid form.readonly "MX" name ttl target priority + validateMXRR_ :: forall l. MXRR (|l) -> V Errors ResourceRecord validateMXRR_ form = case form.rrtype of "MX" -> validateMX form _ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: MX): " <> form.rrtype] +validateSRV :: forall l. SRVRR (|l) -> V Errors ResourceRecord +validateSRV form = ado + name <- validate_name form.name + ttl <- validate_ttl form.ttl + target <- validate_target_MX form.target + priority <- validate_priority form.priority + protocol <- validate_protocol form.protocol + weight <- validate_weight form.weight + port <- validate_port form.port + in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight + validateSRVRR_ :: forall l. SRVRR (|l) -> V Errors ResourceRecord validateSRVRR_ form = case form.rrtype of "SRV" -> validateSRV form