From 66cc65dc527412d56b2b7f20987bbba43f07cb11 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Thu, 13 Jul 2023 02:55:57 +0200 Subject: [PATCH] Validation: WIP. Still cannot build for the moment. --- src/App/Validation.purs | 134 ++++++++++++++++++++++++++++++++++++- src/App/ZoneInterface.purs | 1 - 2 files changed, 133 insertions(+), 2 deletions(-) diff --git a/src/App/Validation.purs b/src/App/Validation.purs index 8852c04..6c32a33 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -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 diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 248ddc0..84f07b0 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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(..))