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
|
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
|
||||||
|
@ -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(..))
|
||||||
|
Loading…
Reference in New Issue
Block a user