Let's try some parsing.

This commit is contained in:
Philippe Pittoli 2023-07-14 03:08:44 +02:00
parent 2c439667cf
commit f261e836b4
2 changed files with 34 additions and 15 deletions

View File

@ -30,6 +30,7 @@
, "transformers" , "transformers"
, "tuples" , "tuples"
, "uint" , "uint"
, "uri"
, "validation" , "validation"
, "web-encoding" , "web-encoding"
, "web-events" , "web-events"

View File

@ -4,6 +4,7 @@ import Prelude (apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=),
import Data.Validation.Semigroup (V, andThen, invalid, toEither) import Data.Validation.Semigroup (V, andThen, invalid, toEither)
-- import Data.Array as A -- import Data.Array as A
import Parsing (runParser)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
@ -11,6 +12,7 @@ import Data.String.Regex as R
import Data.String.Regex.Flags as RF import Data.String.Regex.Flags as RF
import Data.String as S import Data.String as S
import Data.Int (fromString) import Data.Int (fromString)
import URI.Host.IPv4Address as IPv4
import App.RR import App.RR
import App.ResourceRecord (ResourceRecord) import App.ResourceRecord (ResourceRecord)
@ -47,6 +49,8 @@ target_max_len = 50
name_format :: String name_format :: String
name_format = "[a-zA-Z]+" 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. -- Basic tools for validation.
@ -60,8 +64,15 @@ lengthIsBetween field minlen maxlen value
valid_condition = actual_len >= minlen && actual_len <= maxlen valid_condition = actual_len >= minlen && actual_len <= maxlen
error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]" error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
matches :: Attribute -> R.Regex -> String -> V Errors String -- | `matches` is a simple format verification based on regex parsing.
matches field regex value -- | 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 | R.test regex value = pure value
| otherwise = invalid [Tuple field "unacceptable format"] | otherwise = invalid [Tuple field "unacceptable format"]
@ -78,29 +89,36 @@ validate_integer field string
Nothing -> invalid [Tuple field "not an integer"] Nothing -> invalid [Tuple field "not an integer"]
Just i -> pure i Just i -> pure i
xx :: forall y a. y -> Array a -> y verify_regex :: Attribute -> String -> String -> V Errors R.Regex
xx f _ = f 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. -- Field-related validations.
validate_name :: String -> V Errors String validate_name :: String -> V Errors String
validate_name name validate_name name = verify_length name !> verify_regex Name name_format !> (matches 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 where
verify_length = lengthIsBetween Name name_min_len name_max_len verify_length = lengthIsBetween Name name_min_len name_max_len
validate_ttl :: String -> V Errors Int validate_ttl :: String -> V Errors Int
validate_ttl str_ttl validate_ttl str_ttl
= is_int str_ttl !> (intBetween TTL min_ttl max_ttl) !> pure = is_int str_ttl !> right_range !> pure
where where
is_int = validate_integer TTL is_int = validate_integer TTL
right_range = intBetween TTL min_ttl max_ttl
validate_target :: String -> V Errors String validate_target_A :: String -> V Errors String
validate_target target = verify_length target !> pure validate_target_A target = verify_length target !> verify_format !> pure
where where
verify_length = lengthIsBetween Target target_min_len target_max_len verify_length = lengthIsBetween Target target_min_len target_max_len
verify_format = verify_ipv4 Target
-- Resource-related validations. -- Resource-related validations.
@ -108,7 +126,7 @@ validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
validateA form = ado validateA form = ado
name <- validate_name form.name name <- validate_name form.name
ttl <- validate_ttl form.ttl 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 in toRR_basic form.rrid form.readonly "A" name ttl target
validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord