karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Validation: parsers for about everything. WIP.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-02 05:16:50 +01:00
parent 64fe15aff7
commit 4a10ffa4e3
2 changed files with 113 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
src/App/Validation.purs
View File

@ -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]

26
src/App/ZoneInterface.purs
View File

@ -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