From 4a10ffa4e30260bd02a4b23f4536f6722378a898 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 2 Feb 2024 05:16:50 +0100 Subject: [PATCH] Validation: parsers for about everything. WIP. --- src/App/Validation.purs | 101 ++++++++++++++++++++++++++++++++++--- src/App/ZoneInterface.purs | 26 +++++++--- 2 files changed, 113 insertions(+), 14 deletions(-) diff --git a/src/App/Validation.purs b/src/App/Validation.purs index f2763b0..9ca8014 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -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] diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 1cbe3f7..40d9128 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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