Let's try some parsing.
This commit is contained in:
parent
2c439667cf
commit
f261e836b4
@ -30,6 +30,7 @@
|
|||||||
, "transformers"
|
, "transformers"
|
||||||
, "tuples"
|
, "tuples"
|
||||||
, "uint"
|
, "uint"
|
||||||
|
, "uri"
|
||||||
, "validation"
|
, "validation"
|
||||||
, "web-encoding"
|
, "web-encoding"
|
||||||
, "web-events"
|
, "web-events"
|
||||||
|
@ -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)
|
||||||
@ -46,7 +48,9 @@ target_max_len :: Int
|
|||||||
target_max_len = 50
|
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
|
||||||
|
Loading…
Reference in New Issue
Block a user