Validation: WIP. Still cannot build for the moment.
This commit is contained in:
parent
db6987b3a8
commit
66cc65dc52
@ -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
|
||||
|
@ -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(..))
|
||||
|
Loading…
Reference in New Issue
Block a user