45 lines
1.6 KiB
Plaintext
45 lines
1.6 KiB
Plaintext
|
import Data.String.Regex as R
|
||
|
|
import Data.String.Regex.Flags as RF
|
||
|
|
import Data.Validation.Semigroup (V, andThen, invalid, toEither)
|
||
|
|
|
||
|
|
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 !<
|
||
|
|
|
||
|
|
name_format :: String
|
||
|
|
name_format = "[a-zA-Z]+"
|
||
|
|
protocol_format :: String
|
||
|
|
protocol_format = "^(tcp|udp|sctp)$"
|
||
|
|
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])[.]?$"
|
||
|
|
-- Basic tools for validation.
|
||
|
|
|
||
|
|
lengthIsBetween :: Attribute -> Int -> Int -> String -> V Errors String
|
||
|
|
lengthIsBetween field minlen maxlen value
|
||
|
|
= if valid_condition
|
||
|
|
then pure value
|
||
|
|
else invalid [ Tuple field error_message ]
|
||
|
|
where
|
||
|
|
actual_len = S.length value
|
||
|
|
valid_condition = actual_len >= minlen && actual_len <= maxlen
|
||
|
|
error_message = "acceptable length [" <> show minlen <> "-" <> show maxlen <> "]"
|
||
|
|
|
||
|
|
-- | `matches` is a simple format verification based on regex parsing.
|
||
|
|
-- | `verify_regex` is a handler to use `matches` with a string regex format.
|
||
|
|
-- |
|
||
|
|
-- | ```
|
||
|
|
-- | verify_regex Name name_format 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"]
|
||
|
|
|
||
|
|
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 -> matches field value regex
|