Validation: WIP. Still cannot build for the moment.

This commit is contained in:
Philippe Pittoli 2023-07-13 02:55:57 +02:00
parent db6987b3a8
commit 66cc65dc52
2 changed files with 133 additions and 2 deletions

View File

@ -1,7 +1,12 @@
module App.Validation where
import Prelude
import Data.Array
import Data.Tuple (Tuple(..))
import App.ResourceRecord (ResourceRecord)
import Data.String.Regex
import Data.Int (fromString)
data Attribute
= Name
@ -18,8 +23,60 @@ data Attribute
type Errors = Array (Tuple Attribute String)
name_max_len = 50
name_format = "[a-zA-Z]+"
-- name_format = "[a-zA-Z][a-zA-Z0-9_-]*"
-- Basic tools for validation.
lengthIsLessThan :: Attribute -> Int -> String -> V Errors String
lengthIsLessThan field len value
| actual_len >= len = invalid [ Tuple field error_message ]
| otherwise = pure value
where
actual_len = A.length value
error_message = "length should be less than " <> show len
<> " but currently is " <> show actual_len
matches :: Attribute -> Regex -> String -> V Errors String
matches field regex value
| test regex value = pure value
| otherwise = invalid [Tuple field "unacceptable format"]
between :: Attribute -> Int -> Int -> Int -> V Errors Int
between field min max value
| min < value && value < max = pure value
| otherwise = invalid [Tuple field $ "value should be between " <> show min <> " and " <> show max]
validate_integer :: Attribute -> String -> V Errors Int
validate_integer field value
= case fromString form.ttl
Nothing -> invalid [Tuple field "not an integer"]
Just i -> pure i
-- Field-related validations.
validate_name :: String -> V Errors String
validate_name name = ado
_ <- lengthIsLessThan Name name_max_len name
_ <- matches Name name_format name
in pure name
validate_ttl :: String -> V Errors Int
validate_ttl str_ttl = ado
ttl <- validate_integer TTL str_ttl
_ <- between TTL min_ttl max_ttl ttl
pure ttl
-- Resource-related validations.
validateA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
validateA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
validateA form = ado
name <- validate_name form.name
ttl <- validate_ttl form.ttl
-- TODO: validate target
in pure $ toRR_basic form.readonly form.rrid "A" name ttl target
validateAAAA :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
@ -48,6 +105,81 @@ validateSRVRR form = case form.rrtype of
"SRV" -> validateSRV form
_ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype]
-- TODO: whole zone validations.
-- Functions handling network-related structures (ResourceRecord).
type RRPriority = Maybe Int
type RRPort = Maybe Int
type RRProtocol = Maybe String
type RRWeight = Maybe Int
type RRMname = Maybe String
type RRRname = Maybe String
type RRSerial = Maybe Int
type RRRefresh = Maybe Int
type RRRetry = Maybe Int
type RRExpire = Maybe Int
type RRMinttl = Maybe Int
toRR :: Int -> Boolean -> String -> String -> Int -> String
-> RRPriority
-> RRPort
-> RRProtocol
-> RRWeight
-> RRMname
-> RRRname
-> RRSerial
-> RRRefresh
-> RRRetry
-> RRExpire
-> RRMinttl
-> ResourceRecord
toRR rrid readonly rrtype rrname ttl target
priority priority port protocol weight mname rname serial refresh retry expire minttl
= { rrid: rrid
, readonly: readonly
, rrtype: rrtype
, name: name
, ttl: ttl
, target: target
-- MX + SRV
, priority: priority
-- SRV
, port: port
, protocol: protocol
, weight: weight
-- SOA
, mname: mname
, rname: rname
, serial: serial
, refresh: refresh
, retry: retry
, expire: expire
, minttl: minttl
}
toRR_basic :: Int -> Boolean -> String -> String -> Int -> String -> ResourceRecord
toRR_basic rrid readonly rrtype rrname ttl target
= toRR rrid readonly rrtype rrname ttl target
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-- last + priority
toRR_mx :: Int -> Boolean -> String -> String -> Int -> String -> Int -> ResourceRecord
toRR_mx rrid readonly rrtype rrname ttl target priority
= toRR rrid readonly rrtype rrname ttl target (Just priority)
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-- last + port + protocol + weight
toRR_srv :: Int -> Boolean -> String -> String -> Int -> String -> Int -> Int -> String -> Int -> ResourceRecord
toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
= toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight)
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
fromLocalSimpleRRRepresentationToResourceRecord :: forall l. SimpleRR (|l) -> ResourceRecord
fromLocalSimpleRRRepresentationToResourceRecord form
= { rrtype: form.rrtype

View File

@ -17,7 +17,6 @@ module App.ZoneInterface where
import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==))
import Data.Array as A
import Data.Int (fromString)
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))