Validation: parsers for about everything. WIP.
parent
64fe15aff7
commit
4a10ffa4e3
|
|
@ -56,6 +56,14 @@ data ValidationError
|
|||
| VEName (G.Error DomainParser.DomainError)
|
||||
| VETTL (G.Error TTLError)
|
||||
| VETXT (G.Error TXTError)
|
||||
| VECNAME (G.Error DomainParser.DomainError)
|
||||
| VENS (G.Error DomainParser.DomainError)
|
||||
| VEMX (G.Error DomainParser.DomainError)
|
||||
| VEPriority (G.Error PriorityError)
|
||||
| VESRV (G.Error DomainParser.DomainError)
|
||||
| VEProtocol (G.Error ProtocolError)
|
||||
| VEPort (G.Error PortError)
|
||||
| VEWeight (G.Error WeightError)
|
||||
|
||||
type AVErrors = Array ValidationError
|
||||
|
||||
|
|
@ -329,7 +337,6 @@ validateSRVRR_ form = case form.rrtype of
|
|||
"SRV" -> validateSRV form
|
||||
_ -> invalid [Tuple NotAnAttribute $ "invalid type (expected: SRV): " <> form.rrtype]
|
||||
|
||||
|
||||
validateSRR :: forall l. SimpleRR (|l) -> Either Errors ResourceRecord
|
||||
validateSRR = toEither <<< validateSRR_
|
||||
|
||||
|
|
@ -421,7 +428,7 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
|
|||
|
||||
data TTLError
|
||||
= NotInt
|
||||
| NotBetween Int Int Int
|
||||
| NotBetween Int Int Int -- min max value
|
||||
ttl_parser :: G.Parser TTLError Int
|
||||
ttl_parser = do pos <- G.current_position
|
||||
n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just NotInt)
|
||||
|
|
@ -475,9 +482,91 @@ validationTXT form = ado
|
|||
target <- parse txt_parser form.target VETXT
|
||||
in toRR_basic form.rrid form.readonly "TXT" name ttl target
|
||||
|
||||
validationCNAME :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
|
||||
validationCNAME form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
ttl <- parse ttl_parser form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VECNAME
|
||||
in toRR_basic form.rrid form.readonly "CNAME" name ttl target
|
||||
|
||||
validationNS :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
|
||||
validationNS form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
ttl <- parse ttl_parser form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VENS
|
||||
in toRR_basic form.rrid form.readonly "NS" name ttl target
|
||||
|
||||
data PriorityError
|
||||
= PriorityNotInt
|
||||
| PriorityNotBetween Int Int Int -- min max value
|
||||
|
||||
priority_parser :: G.Parser PriorityError Int
|
||||
priority_parser = do
|
||||
pos <- G.current_position
|
||||
n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PriorityNotInt)
|
||||
if between min_priority max_priority n
|
||||
then pure n
|
||||
else G.Parser \_ -> G.failureError pos (Just $ PriorityNotBetween min_priority max_priority n)
|
||||
|
||||
data ProtocolError
|
||||
= InvalidProtocol
|
||||
| ProtocolNotBetween Int Int Int -- min max value
|
||||
|
||||
protocol_parser :: G.Parser ProtocolError String
|
||||
protocol_parser = do
|
||||
pos <- G.current_position
|
||||
G.string "tcp" <|> G.string "udp" <|> G.Parser \_ -> G.failureError pos (Just InvalidProtocol)
|
||||
|
||||
data PortError
|
||||
= PortNotInt
|
||||
| PortNotBetween Int Int Int -- min max value
|
||||
|
||||
port_parser :: G.Parser PortError Int
|
||||
port_parser = do
|
||||
pos <- G.current_position
|
||||
n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just PortNotInt)
|
||||
if between min_port max_port n
|
||||
then pure n
|
||||
else G.Parser \_ -> G.failureError pos (Just $ PortNotBetween min_port max_port n)
|
||||
|
||||
data WeightError
|
||||
= WeightNotInt
|
||||
| WeightNotBetween Int Int Int -- min max value
|
||||
|
||||
weight_parser :: G.Parser WeightError Int
|
||||
weight_parser = do
|
||||
pos <- G.current_position
|
||||
n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just WeightNotInt)
|
||||
if between min_weight max_weight n
|
||||
then pure n
|
||||
else G.Parser \_ -> G.failureError pos (Just $ WeightNotBetween min_weight max_weight n)
|
||||
|
||||
validationMX :: forall l. MXRR (|l) -> V AVErrors ResourceRecord
|
||||
validationMX form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
ttl <- parse ttl_parser form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VEMX
|
||||
priority <- parse priority_parser form.priority VEPriority
|
||||
in toRR_mx form.rrid form.readonly "MX" name ttl target priority
|
||||
|
||||
validationSRV :: forall l. SRVRR (|l) -> V AVErrors ResourceRecord
|
||||
validationSRV form = ado
|
||||
name <- parse DomainParser.sub_eof form.name VEName
|
||||
ttl <- parse ttl_parser form.ttl VETTL
|
||||
target <- parse DomainParser.sub_eof form.target VESRV
|
||||
priority <- parse priority_parser form.priority VEPriority
|
||||
protocol <- parse protocol_parser form.protocol VEProtocol
|
||||
port <- parse port_parser form.port VEPort
|
||||
weight <- parse weight_parser form.weight VEWeight
|
||||
in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
|
||||
|
||||
validation :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord
|
||||
validation entry t = case t of
|
||||
A -> toEither $ validationA entry
|
||||
AAAA -> toEither $ validationAAAA entry
|
||||
TXT -> toEither $ validationTXT entry
|
||||
_ -> toEither $ invalid [UNKNOWN]
|
||||
A -> toEither $ validationA entry
|
||||
AAAA -> toEither $ validationAAAA entry
|
||||
TXT -> toEither $ validationTXT entry
|
||||
CNAME -> toEither $ validationCNAME entry
|
||||
NS -> toEither $ validationNS entry
|
||||
MX -> toEither $ validationMX entry
|
||||
SRV -> toEither $ validationSRV entry
|
||||
--_ -> toEither $ invalid [UNKNOWN]
|
||||
|
|
|
|||
|
|
@ -306,7 +306,8 @@ render state
|
|||
]
|
||||
content_mx :: Array (HH.HTML w Action)
|
||||
content_mx =
|
||||
[ Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
|
||||
[ render_errors
|
||||
, Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
|
||||
(updateForm Update_MODAL_Domain) -- action
|
||||
state._newRR.name -- value
|
||||
state._newRR.valid -- validity (TODO)
|
||||
|
|
@ -329,7 +330,8 @@ render state
|
|||
]
|
||||
content_srv :: Array (HH.HTML w Action)
|
||||
content_srv =
|
||||
[ Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
|
||||
[ render_errors
|
||||
, Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
|
||||
(updateForm Update_MODAL_Domain) -- action
|
||||
state._newRR.name -- value
|
||||
state._newRR.valid -- validity (TODO)
|
||||
|
|
@ -1049,9 +1051,17 @@ error_to_paragraph v = Bulma.p $ show_error v
|
|||
-- | `show_error` provide a string to display to the user in case of an error with an entry.
|
||||
show_error :: Validation.ValidationError -> String
|
||||
show_error v = case v of
|
||||
Validation.UNKNOWN -> "Unknown"
|
||||
Validation.VEIPv4 err -> "VEIPv4 pos: " <> show err.position
|
||||
Validation.VEIPv6 err -> "VEIPv6 pos: " <> show err.position
|
||||
Validation.VEName err -> "VEName pos: " <> show err.position
|
||||
Validation.VETTL err -> "VETTL pos: " <> show err.position
|
||||
Validation.VETXT err -> "VETXT pos: " <> show err.position
|
||||
Validation.UNKNOWN -> "Unknown"
|
||||
Validation.VEIPv4 err -> "VEIPv4 pos: " <> show err.position
|
||||
Validation.VEIPv6 err -> "VEIPv6 pos: " <> show err.position
|
||||
Validation.VEName err -> "VEName pos: " <> show err.position
|
||||
Validation.VETTL err -> "VETTL pos: " <> show err.position
|
||||
Validation.VETXT err -> "VETXT pos: " <> show err.position
|
||||
Validation.VECNAME err -> "VECNAME pos: " <> show err.position
|
||||
Validation.VENS err -> "VENS pos: " <> show err.position
|
||||
Validation.VEMX err -> "VEMX pos: " <> show err.position
|
||||
Validation.VEPriority err -> "VEPriority pos: " <> show err.position
|
||||
Validation.VESRV err -> "VESRV pos: " <> show err.position
|
||||
Validation.VEProtocol err -> "VEProtocol pos: " <> show err.position
|
||||
Validation.VEPort err -> "VEPort pos: " <> show err.position
|
||||
Validation.VEWeight err -> "VEWeight pos: " <> show err.position
|
||||
|
|
|
|||
Loading…
Reference in New Issue