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 module App.Validation where
import Prelude
import Data.Array
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import App.ResourceRecord (ResourceRecord) import App.ResourceRecord (ResourceRecord)
import Data.String.Regex
import Data.Int (fromString)
data Attribute data Attribute
= Name = Name
@ -18,8 +23,60 @@ data Attribute
type Errors = Array (Tuple Attribute String) 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 :: 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 :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"] validateAAAA _ = invalid [Tuple NotAnAttribute "validation not implemented"]
validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord validateTXT :: forall l. SimpleRR (|l) -> V Errors ResourceRecord
@ -48,6 +105,81 @@ validateSRVRR form = case form.rrtype of
"SRV" -> validateSRV form "SRV" -> validateSRV form
_ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype] _ -> 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 :: forall l. SimpleRR (|l) -> ResourceRecord
fromLocalSimpleRRRepresentationToResourceRecord form fromLocalSimpleRRRepresentationToResourceRecord form
= { rrtype: form.rrtype = { 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 Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==))
import Data.Array as A import Data.Array as A
import Data.Int (fromString)
import Data.ArrayBuffer.Types (ArrayBuffer) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..)) import Data.Either (Either(..))