diff --git a/src/App/Validation.purs b/src/App/Validation.purs index 9ca8014..d9d5bc7 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -427,18 +427,18 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight Nothing Nothing Nothing Nothing Nothing Nothing Nothing data TTLError - = NotInt - | NotBetween Int Int Int -- min max value + = TTLNotInt + | TTLNotBetween 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) + n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just TTLNotInt) if between min_ttl max_ttl n then pure n - else G.Parser \_ -> G.failureError pos (Just $ NotBetween min_ttl max_ttl n) + else G.Parser \_ -> G.failureError pos (Just $ TTLNotBetween min_ttl max_ttl n) data TXTError - = InvalidCharacter - | TooLong Int Int -- max current + = TXTInvalidCharacter + | TXTTooLong Int Int -- max current -- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`). txt_parser :: G.Parser TXTError String txt_parser = do pos <- G.current_position @@ -446,12 +446,12 @@ txt_parser = do pos <- G.current_position e <- G.tryMaybe SomeParsers.eof pos2 <- G.current_position case e of - Nothing -> G.Parser \i -> G.failureError i.position (Just InvalidCharacter) + Nothing -> G.Parser \i -> G.failureError i.position (Just TXTInvalidCharacter) Just _ -> do let nbchar = pos2 - pos - if max_txt < nbchar + if nbchar < max_txt then pure $ CU.fromCharArray v - else G.Parser \_ -> G.failureError pos (Just $ TooLong max_txt nbchar) + else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar) -- | `parse` allows to run any parser based on `GenericParser` and provide a validation error. -- | The actual validation error contains the parser's error including the position. @@ -510,7 +510,6 @@ priority_parser = do data ProtocolError = InvalidProtocol - | ProtocolNotBetween Int Int Int -- min max value protocol_parser :: G.Parser ProtocolError String protocol_parser = do diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 7315652..22522ee 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -55,8 +55,9 @@ import App.ResourceRecord (ResourceRecord) import App.LogMessage (LogMessage(..)) import App.Messages.DNSManagerDaemon as DNSManager import App.Validation as Validation -import GenericParser.DomainParser.Common as DomainParser -import GenericParser.DomainParser as DomainParser +import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser +-- import GenericParser.DomainParser as DomainParser +import GenericParser.IPAddress as IPAddress id :: forall a. a -> a @@ -237,7 +238,7 @@ render state [ case state.wsUp, state.active_modal, state.active_new_rr_modal of false, _, _ -> Bulma.p "You are disconnected." true, Just rr_id, _ -> modal_rr_delete rr_id - true, Nothing, Just t -> modal_add_new_rr t state + true, Nothing, Just t -> modal_add_new_rr t true, Nothing, Nothing -> HH.div_ [ Bulma.h1 state._domain , Bulma.hr , render_soa state._soa @@ -273,15 +274,15 @@ render state , HH.text "." ] - modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action - modal_add_new_rr t state = case t of - A -> template "A" (content_simple "A") (foot_content A) - AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA) - TXT -> template "TXT" (content_simple "TXT") (foot_content TXT) - CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME) - NS -> template "NS" (content_simple "NS") (foot_content NS) - MX -> template "MX" content_mx (foot_content MX) - SRV -> template "SRV" content_srv (foot_content SRV) + modal_add_new_rr :: forall w. AcceptedRRTypes -> HH.HTML w Action + modal_add_new_rr t = case t of + A -> template "A" (content_simple "A") (foot_content A) + AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA) + TXT -> template "TXT" (content_simple "TXT") (foot_content TXT) + CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME) + NS -> template "NS" (content_simple "NS") (foot_content NS) + MX -> template "MX" content_mx (foot_content MX) + SRV -> template "SRV" content_srv (foot_content SRV) where -- DRY updateForm x = UpdateNewRRForm <<< x @@ -289,19 +290,19 @@ render state then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors else HH.div_ [ ] content_simple :: String -> Array (HH.HTML w Action) - content_simple t = + content_simple t_ = [ render_errors - , Bulma.box_input ("domain" <> t) "Name" "www" -- id, title, placeholder + , Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder (updateForm Update_MODAL_Domain) -- action state._newRR.name -- value state._newRR.valid -- validity (TODO) should_be_disabled -- condition - , Bulma.box_input ("ttl" <> t) "TTL" "600" + , Bulma.box_input ("ttl" <> t_) "TTL" "600" (updateForm Update_MODAL_TTL) state._newRR.ttl state._newRR.valid should_be_disabled - , Bulma.box_input ("target" <> t) "Target" "198.51.100.5" + , Bulma.box_input ("target" <> t_) "Target" "198.51.100.5" (updateForm Update_MODAL_Target) state._newRR.target state._newRR.valid @@ -375,9 +376,9 @@ render state foot_content x = [ Bulma.btn_add (ValidateRR x) (TellSomethingWentWrong state._newRR.rrid "cannot add") state._newRR.valid ] - template t content foot = Bulma.modal + template t_ content foot = Bulma.modal [ Bulma.modal_background - , Bulma.modal_card [Bulma.modal_header $ "New " <> t <> " resource record" + , Bulma.modal_card [Bulma.modal_header $ "New " <> t_ <> " resource record" , Bulma.modal_body content ] , Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal]) ] @@ -871,7 +872,7 @@ baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ] -- Component definition and initial state render_new_records :: forall (w :: Type). State -> HH.HTML w Action -render_new_records state +render_new_records _ = Bulma.hdiv [ Bulma.h1 "Adding new records" , Bulma.hr @@ -1050,29 +1051,30 @@ getNewID state = (_ + 1) maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action -error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error v) +error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) (case v of Validation.UNKNOWN -> Bulma.p "An internal error happened." - Validation.VEIPv4 err -> Bulma.p "put the actual error here" - Validation.VEIPv6 err -> Bulma.p "put the actual error here" - Validation.VEName err -> maybe (Bulma.p "no actual error reported") show_error_domain err.error - Validation.VETTL err -> Bulma.p "put the actual error here" - Validation.VETXT err -> Bulma.p "put the actual error here" - Validation.VECNAME err -> Bulma.p "put the actual error here" - Validation.VENS err -> Bulma.p "put the actual error here" - Validation.VEMX err -> Bulma.p "put the actual error here" - Validation.VEPriority err -> Bulma.p "put the actual error here" - Validation.VESRV err -> Bulma.p "put the actual error here" - Validation.VEProtocol err -> Bulma.p "put the actual error here" - Validation.VEPort err -> Bulma.p "put the actual error here" - Validation.VEWeight err -> Bulma.p "put the actual error here" + Validation.VEIPv4 err -> maybe default_error show_error_ip4 err.error + Validation.VEIPv6 err -> maybe default_error show_error_ip6 err.error + Validation.VEName err -> maybe default_error show_error_domain err.error + Validation.VETTL err -> maybe default_error show_error_ttl err.error + Validation.VETXT err -> maybe default_error show_error_txt err.error + Validation.VECNAME err -> maybe default_error show_error_domain err.error + Validation.VENS err -> maybe default_error show_error_domain err.error + Validation.VEMX err -> maybe default_error show_error_domain err.error + Validation.VEPriority err -> maybe default_error show_error_priority err.error + Validation.VESRV err -> maybe default_error show_error_domain err.error + Validation.VEProtocol err -> maybe default_error show_error_protocol err.error + Validation.VEPort err -> maybe default_error show_error_port err.error + Validation.VEWeight err -> maybe default_error show_error_weight err.error -- Nothing -> "no error reported" -- Just e -> "error reported, will soon appear!" ) + where default_error = Bulma.p "No actual error reported." --- | `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 +-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. +show_error_title :: Validation.ValidationError -> String +show_error_title v = case v of Validation.UNKNOWN -> "Unknown" Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" Validation.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")" @@ -1090,7 +1092,75 @@ show_error v = case v of show_error_domain :: forall w. DomainParser.DomainError -> HH.HTML w Action show_error_domain e = case e of - DomainParser.LabelTooLarge size -> Bulma.p $ "LabelTooLarge (" <> show size <> " characters)" - DomainParser.DomainTooLarge size -> Bulma.p $ "DomainTooLarge (" <> show size <> " characters)" - DomainParser.InvalidCharacter -> Bulma.p "InvalidCharacter" - DomainParser.EOFExpected -> Bulma.p "EOFExpected" + DomainParser.LabelTooLarge size -> + Bulma.p $ "The label contains too many characters (" <> show size <> ")." + DomainParser.DomainTooLarge size -> + Bulma.p $ "The domain contains too many characters (" <> show size <> ")." + -- DomainParser.InvalidCharacter + -- DomainParser.EOFExpected + _ -> Bulma.p """ + The domain (or label) contains invalid characters. + A domain label should start with a letter, + then eventually a series of letters, digits and hyphenations ('-'), + and must finish with either a letter or a digit. + """ + +show_error_priority :: forall w. Validation.PriorityError -> HH.HTML w Action +show_error_priority e = case e of + Validation.PriorityNotInt -> Bulma.p "Priority should be an integer value." + Validation.PriorityNotBetween min max n -> + Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + +show_error_weight :: forall w. Validation.WeightError -> HH.HTML w Action +show_error_weight e = case e of + Validation.WeightNotInt -> Bulma.p "Weight should be an integer value." + Validation.WeightNotBetween min max n -> + Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + +show_error_port :: forall w. Validation.PortError -> HH.HTML w Action +show_error_port e = case e of + Validation.PortNotInt -> Bulma.p "Port should be an integer value." + Validation.PortNotBetween min max n -> + Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + +show_error_ttl :: forall w. Validation.TTLError -> HH.HTML w Action +show_error_ttl e = case e of + Validation.TTLNotInt -> Bulma.p "TTL should be an integer value." + Validation.TTLNotBetween min max n -> + Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + +show_error_protocol :: forall w. Validation.ProtocolError -> HH.HTML w Action +show_error_protocol e = case e of + Validation.InvalidProtocol -> Bulma.p "Protocol should be a value as 'tcp' or 'udp'." + +show_error_ip6 :: forall w. IPAddress.IPv6Error -> HH.HTML w Action +show_error_ip6 e = case e of + IPAddress.IP6TooManyHexaDecimalCharacters -> + Bulma.p "IP6TooManyHexaDecimalCharacters" + IPAddress.IP6NotEnoughChunks -> + Bulma.p """ + The IPv6 representation is erroneous, it should contains 8 groups of hexadecimal characters or + being shortened with a double ':' character, such as '2000::1'. + """ + IPAddress.IP6TooManyChunks -> + Bulma.p "The IPv6 representation is erroneous. It should contains only up to 8 groups of hexadecimal characters." + IPAddress.IP6UnrelevantShortRepresentation -> + Bulma.p "IPv6 address have been unnecessarily shortened (with two ':')." + +show_error_ip4 :: forall w. IPAddress.IPv4Error -> HH.HTML w Action +show_error_ip4 e = case e of + IPAddress.IP4NumberTooBig n -> + Bulma.p $ "IPv4 address contains a number too big (should be between 0 and 255). Current entered number: " <> show n + IPAddress.IP4UnrelevantShortRepresentation -> + Bulma.p "IPv4 address have been unnecessarily shortened (with two '.')." + +show_error_txt :: forall w. Validation.TXTError -> HH.HTML w Action +show_error_txt e = case e of + Validation.TXTInvalidCharacter -> Bulma.p "The TXT field contains some invalid characters." + Validation.TXTTooLong max n -> + Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are " + <> show n <> " characters)."