Let's try some parsing.
This commit is contained in:
parent
2c439667cf
commit
f261e836b4
@ -30,6 +30,7 @@
|
||||
, "transformers"
|
||||
, "tuples"
|
||||
, "uint"
|
||||
, "uri"
|
||||
, "validation"
|
||||
, "web-encoding"
|
||||
, "web-events"
|
||||
|
@ -4,6 +4,7 @@ import Prelude (apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=),
|
||||
|
||||
import Data.Validation.Semigroup (V, andThen, invalid, toEither)
|
||||
-- import Data.Array as A
|
||||
import Parsing (runParser)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Either (Either(..))
|
||||
import Data.Tuple (Tuple(..))
|
||||
@ -11,6 +12,7 @@ import Data.String.Regex as R
|
||||
import Data.String.Regex.Flags as RF
|
||||
import Data.String as S
|
||||
import Data.Int (fromString)
|
||||
import URI.Host.IPv4Address as IPv4
|
||||
|
||||
import App.RR
|
||||
import App.ResourceRecord (ResourceRecord)
|
||||
@ -46,7 +48,9 @@ target_max_len :: Int
|
||||
target_max_len = 50
|
||||
name_format :: String
|
||||
name_format = "[a-zA-Z]+"
|
||||
-- name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
|
||||
--name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
|
||||
--target_A_format :: String
|
||||
--target_A_format = "[1-9][][a-zA-Z]+"
|
||||
|
||||
-- Basic tools for validation.
|
||||
|
||||
@ -60,8 +64,15 @@ lengthIsBetween field minlen maxlen value
|
||||
valid_condition = actual_len >= minlen && actual_len <= maxlen
|
||||
error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
|
||||
|
||||
matches :: Attribute -> R.Regex -> String -> V Errors String
|
||||
matches field regex value
|
||||
-- | `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 Name name_format
|
||||
-- | !> matches Name name
|
||||
-- | ```
|
||||
matches :: Attribute -> String -> R.Regex -> V Errors String
|
||||
matches field value regex
|
||||
| R.test regex value = pure value
|
||||
| otherwise = invalid [Tuple field "unacceptable format"]
|
||||
|
||||
@ -78,29 +89,36 @@ validate_integer field string
|
||||
Nothing -> invalid [Tuple field "not an integer"]
|
||||
Just i -> pure i
|
||||
|
||||
xx :: forall y a. y -> Array a -> y
|
||||
xx f _ = f
|
||||
verify_regex :: Attribute -> String -> String -> V Errors R.Regex
|
||||
verify_regex field str _
|
||||
= case R.regex str RF.unicode of
|
||||
Left error_string -> invalid [Tuple field $ "error in regex: " <> error_string]
|
||||
Right regex -> pure 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
|
||||
|
||||
-- Field-related validations.
|
||||
|
||||
validate_name :: String -> V Errors String
|
||||
validate_name name
|
||||
= case R.regex name_format RF.unicode of
|
||||
Left error_string -> invalid [Tuple NotAnAttribute $ "error in name regex: " <> error_string]
|
||||
Right regex -> verify_length name !> (matches Name regex)
|
||||
where
|
||||
verify_length = lengthIsBetween Name name_min_len name_max_len
|
||||
validate_name name = verify_length name !> verify_regex Name name_format !> (matches Name name)
|
||||
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 !> (intBetween TTL min_ttl max_ttl) !> pure
|
||||
= is_int str_ttl !> right_range !> pure
|
||||
where
|
||||
is_int = validate_integer TTL
|
||||
right_range = intBetween TTL min_ttl max_ttl
|
||||
|
||||
validate_target :: String -> V Errors String
|
||||
validate_target target = verify_length target !> pure
|
||||
validate_target_A :: String -> V Errors String
|
||||
validate_target_A target = verify_length target !> verify_format !> pure
|
||||
where
|
||||
verify_length = lengthIsBetween Target target_min_len target_max_len
|
||||
verify_format = verify_ipv4 Target
|
||||
|
||||
-- Resource-related validations.
|
||||
|
||||
@ -108,7 +126,7 @@ validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
|
||||
validateA form = ado
|
||||
name <- validate_name form.name
|
||||
ttl <- validate_ttl form.ttl
|
||||
target <- validate_target form.target
|
||||
target <- validate_target_A form.target
|
||||
in toRR_basic form.rrid form.readonly "A" name ttl target
|
||||
|
||||
validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
|
||||
|
Loading…
Reference in New Issue
Block a user