From e6bb3c53d6780bb84141a2cf0fc4d5a00b31098f Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 21 Feb 2024 05:16:15 +0100 Subject: [PATCH] Display errors on DomainList interface. --- src/App/DisplayErrors.purs | 133 +++++++++++++++++++++++++++++++ src/App/DomainListInterface.purs | 49 +++++------- src/App/Validation/Label.purs | 41 ++++++++++ src/App/ZoneInterface.purs | 93 +-------------------- 4 files changed, 196 insertions(+), 120 deletions(-) create mode 100644 src/App/DisplayErrors.purs create mode 100644 src/App/Validation/Label.purs diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs new file mode 100644 index 0000000..4558c18 --- /dev/null +++ b/src/App/DisplayErrors.purs @@ -0,0 +1,133 @@ +-- | This module provides functions to display errors in a fancy way. +module App.DisplayErrors where + +import Prelude (show, ($), (<>)) + +-- import Data.Foldable as Foldable +import Data.Maybe (Maybe(..), maybe) +import Halogen.HTML as HH + +import App.Validation.DNS as ValidationDNS +import App.Validation.Label as ValidationLabel +import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser +import GenericParser.IPAddress as IPAddress +import Bulma as Bulma + +error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i +error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) + (case v of + ValidationDNS.UNKNOWN -> Bulma.p "An internal error happened." + ValidationDNS.VEIPv4 err -> maybe default_error show_error_ip4 err.error + ValidationDNS.VEIPv6 err -> maybe default_error show_error_ip6 err.error + ValidationDNS.VEName err -> maybe default_error show_error_domain err.error + ValidationDNS.VETTL min max n -> Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + ValidationDNS.VETXT err -> maybe default_error show_error_txt err.error + ValidationDNS.VECNAME err -> maybe default_error show_error_domain err.error + ValidationDNS.VENS err -> maybe default_error show_error_domain err.error + ValidationDNS.VEMX err -> maybe default_error show_error_domain err.error + ValidationDNS.VEPriority min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + ValidationDNS.VESRV err -> maybe default_error show_error_domain err.error + ValidationDNS.VEProtocol err -> maybe default_error show_error_protocol err.error + ValidationDNS.VEPort min max n -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max + <> ", current value: " <> show n <> "." + ) + where default_error = Bulma.p "" + +-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. +show_error_title :: ValidationDNS.Error -> String +show_error_title v = case v of + ValidationDNS.UNKNOWN -> "Unknown" + ValidationDNS.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEIPv6 err -> "The IPv6 address is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")" + ValidationDNS.VETTL min max n -> "Invalid TTL (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + ValidationDNS.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEPriority min max n -> "Invalid Priority (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + ValidationDNS.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" + ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + ValidationDNS.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" + +show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i +show_error_domain e = case e of + 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_protocol :: forall w i. ValidationDNS.ProtocolError -> HH.HTML w i +show_error_protocol e = case e of + ValidationDNS.InvalidProtocol -> Bulma.p "Protocol should be a value as 'tcp' or 'udp'." + +show_error_ip6 :: forall w i. IPAddress.IPv6Error -> HH.HTML w i +show_error_ip6 e = case e of + IPAddress.IP6TooManyHexaDecimalCharacters -> + Bulma.p "IP6TooManyHexaDecimalCharacters" + IPAddress.IP6NotEnoughChunks -> + Bulma.p """ + The IPv6 representation is erroneous, it should contain 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 contain only up to 8 groups of hexadecimal characters." + IPAddress.IP6IrrelevantShortRepresentation -> + Bulma.p "IPv6 address has been unnecessarily shortened (with two ':')." + +show_error_ip4 :: forall w i. IPAddress.IPv4Error -> HH.HTML w i +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.IP4IrrelevantShortRepresentation -> + Bulma.p "IPv4 address has been unnecessarily shortened (with two '.')." + +show_error_txt :: forall w i. ValidationDNS.TXTError -> HH.HTML w i +show_error_txt e = case e of + ValidationDNS.TXTInvalidCharacter -> Bulma.p "The TXT field contains some invalid characters." + ValidationDNS.TXTTooLong max n -> + Bulma.p $ "An TXT field is limited to " <> show max <> " characters (currently there are " + <> show n <> " characters)." + +domainerror_string :: DomainParser.DomainError -> String +domainerror_string (DomainParser.LabelTooLarge size) = "LabelTooLarge (size: " <> show size <> ")" +domainerror_string (DomainParser.DomainTooLarge size) = "DomainTooLarge (size: " <> show size <> ")" +domainerror_string (DomainParser.InvalidCharacter) = "InvalidCharacter" +domainerror_string (DomainParser.EOFExpected) = "EOFExpected" + +-- | This `error_to_paragraph` is designed to go along the `Validation.Label` module. +error_to_paragraph_label :: forall w i. ValidationLabel.Error -> HH.HTML w i +error_to_paragraph_label v = Bulma.error_message (Bulma.p $ show_error_title_label v) + (case v of + ValidationLabel.ParsingError x -> case x.error of + Nothing -> Bulma.p "" + Just (ValidationLabel.CannotParse err) -> show_error_domain err + Just (ValidationLabel.CannotEntirelyParse) -> Bulma.p "Cannot entirely parse the label." + Just (ValidationLabel.Size min max n) -> + Bulma.p $ "Label size should be between " <> show min <> " and " <> show max + <> " (current size: " <> show n <> ")." + ) + +show_error_title_label :: ValidationLabel.Error -> String +show_error_title_label v = case v of + ValidationLabel.ParsingError x -> case x.error of + Nothing -> "Cannot parse the label (position: " <> show x.position <> ")." + Just (ValidationLabel.CannotParse _) -> + "Cannot parse the label (position: " <> show x.position <> ")." + Just (ValidationLabel.CannotEntirelyParse) -> "Cannot entirely parse the label." + Just (ValidationLabel.Size min max n) -> + "Label size should be between " <> show min <> " and " <> show max + <> " (current size: " <> show n <> ")." diff --git a/src/App/DomainListInterface.purs b/src/App/DomainListInterface.purs index 6dec4cc..cc0827d 100644 --- a/src/App/DomainListInterface.purs +++ b/src/App/DomainListInterface.purs @@ -7,11 +7,11 @@ -- | - create new domains -- | - delete a domain -- | - ask for confirmation --- | - TODO: switch to the interface to show and modify the content of a Zone - +-- | - switch to the interface to show and modify the content of a Zone +-- | - TODO: validate the domain before sending a message to `dnsmanagerd` module App.DomainListInterface where -import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), show) +import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>)) import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) @@ -27,9 +27,10 @@ import Web.Event.Event as Event import Web.Event.Event (Event) import Bulma as Bulma -import GenericParser (DomainError(..), parse) -import GenericParser.DomainParserRFC1035 as RFC1035 ---import GenericParser.DomainParser as DomainParser +import App.DisplayErrors (error_to_paragraph_label) + +import App.Validation.Label as Validation + import App.LogMessage import App.Messages.DNSManagerDaemon as DNSManager @@ -108,7 +109,7 @@ data Action type NewDomainFormState = { new_domain :: String - , error_string :: Maybe String + , _errors :: Array Validation.Error , selected_domain :: String } @@ -145,7 +146,7 @@ default_domain = "netlib.re" initialState :: Input -> State initialState _ = { newDomainForm: { new_domain: "" - , error_string: Nothing + , _errors: [] , selected_domain: default_domain } , accepted_domains: [ default_domain ] @@ -192,9 +193,9 @@ render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal } newDomainForm.new_domain [ HHE.onSelectedIndexChange domain_choice ] accepted_domains - , case newDomainForm.error_string of - Nothing -> HH.div_ [] - Just str -> Bulma.strong str + , if A.length newDomainForm._errors > 0 + then HH.div_ $ map error_to_paragraph_label newDomainForm._errors + else HH.div_ [ ] ] domain_choice :: Int -> Action @@ -224,13 +225,10 @@ handleAction = case _ of INP_newdomain v -> do H.modify_ _ { newDomainForm { new_domain = v } } case v of - "" -> H.modify_ _ { newDomainForm { error_string = Nothing } } - _ -> case parse RFC1035.label { string: v, position: 0 } of - Left { position, error } -> - let error_string = "error " <> (show_error error) - <> " at position: " <> show position - in H.modify_ _ { newDomainForm { error_string = Just error_string } } - Right _ -> H.modify_ _ { newDomainForm { error_string = Nothing } } + "" -> H.modify_ _ { newDomainForm { _errors = [] } } + _ -> case Validation.label v of + Left arr -> H.modify_ _ { newDomainForm { _errors = arr } } + Right _ -> H.modify_ _ { newDomainForm { _errors = [] } } UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } } EnterDomain domain -> do @@ -251,25 +249,18 @@ handleAction = case _ of { newDomainForm } <- H.get let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain - case newDomainForm.error_string, new_domain of - Just error_string, _ -> - H.raise $ Log $ UnableToSend $ "You didn't enter a valid new domain: " <> error_string + case newDomainForm._errors, new_domain of _, "" -> H.raise $ Log $ UnableToSend "You didn't enter the new domain!" - Nothing, _ -> do + [], _ -> do message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkNewDomain { domain: new_domain } H.raise $ MessageToSend message H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")" handleAction $ HandleNewDomainInput $ INP_newdomain "" - where - show_error :: Maybe DomainError -> String - show_error Nothing = "no specific error" - show_error (Just (LabelTooLarge size)) = "LabelTooLarge (size: " <> show size <> ")" - show_error (Just (DomainTooLarge size)) = "DomainTooLarge (size: " <> show size <> ")" - show_error (Just (InvalidCharacter)) = "InvalidCharacter" - show_error (Just (EOFExpected)) = "EOFExpected" + _, _ -> + H.raise $ Log $ UnableToSend $ "You didn't enter a valid new domain" handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of diff --git a/src/App/Validation/Label.purs b/src/App/Validation/Label.purs new file mode 100644 index 0000000..991b013 --- /dev/null +++ b/src/App/Validation/Label.purs @@ -0,0 +1,41 @@ +module App.Validation.Label where + +import Prelude + +import Data.Either (Either(..)) +import Data.Maybe (Maybe(..)) +import Data.Validation.Semigroup (V, invalid, toEither) + +import GenericParser.Parser as G +import GenericParser.SomeParsers as SomeParsers +import GenericParser.DomainParser.Common (DomainError) as DomainParser +import GenericParser.DomainParserRFC1035 (label) as RFC1035 + +data LabelParsingError + = CannotParse (DomainParser.DomainError) + | CannotEntirelyParse + | Size Int Int Int + +data Error + = ParsingError (G.Error LabelParsingError) + +min_label_size = 1 :: Int -- arbitrary +max_label_size = 63 :: Int -- arbitrary + +parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v +parse (G.Parser p) str c = case p { string: str, position: 0 } of + Left x -> invalid $ [c x] + Right x -> pure x.result + +label_parser :: G.Parser LabelParsingError String +label_parser = do + input <- G.current_input + _ <- RFC1035.label G.<:> \e -> CannotParse e + _ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse + pos <- G.current_position + if between min_label_size max_label_size pos + then pure input.string + else G.errorParser (Just $ Size min_label_size max_label_size pos) + +label :: String -> Either (Array Error) String +label s = toEither $ parse label_parser s ParsingError diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 2501a08..9a4b9e7 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -40,11 +40,11 @@ import CSSClasses as C import App.AcceptedRRTypes (AcceptedRRTypes(..)) import App.ResourceRecord (ResourceRecord) +import App.DisplayErrors (error_to_paragraph) + import App.LogMessage (LogMessage(..)) import App.Messages.DNSManagerDaemon as DNSManager import App.Validation.DNS as Validation -import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser -import GenericParser.IPAddress as IPAddress type RRId = Int @@ -822,95 +822,6 @@ loopE f a = case (A.head a) of Nothing -> pure unit Just xs -> loopE f xs -error_to_paragraph :: forall w. Validation.Error -> HH.HTML w Action -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 -> 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 min max n -> Bulma.p $ "TTL should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - 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 min max n -> Bulma.p $ "Priority should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - Validation.VESRV err -> maybe default_error show_error_domain err.error - Validation.VEProtocol err -> maybe default_error show_error_protocol err.error - Validation.VEPort min max n -> Bulma.p $ "Port should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - Validation.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max - <> ", current value: " <> show n <> "." - ) - where default_error = Bulma.p "No actual error reported." - --- | `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.Error -> 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 <> ")" - Validation.VEName err -> "The name (domain label) is wrong (position: " <> show err.position <> ")" - Validation.VETTL min max n -> "Invalid TTL (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" - Validation.VETXT err -> "The TXT input is wrong (position: " <> show err.position <> ")" - Validation.VECNAME err -> "The CNAME input is wrong (position: " <> show err.position <> ")" - Validation.VENS err -> "The NS input is wrong (position: " <> show err.position <> ")" - Validation.VEMX err -> "The MX target input is wrong (position: " <> show err.position <> ")" - Validation.VEPriority min max n -> "Invalid Priority (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" - Validation.VESRV err -> "The SRV target input is wrong (position: " <> show err.position <> ")" - Validation.VEProtocol err -> "The Protocol input is wrong (position: " <> show err.position <> ")" - Validation.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" - Validation.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")" - -show_error_domain :: forall w. DomainParser.DomainError -> HH.HTML w Action -show_error_domain e = case e of - 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_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.IP6IrrelevantShortRepresentation -> - 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.IP4IrrelevantShortRepresentation -> - 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)." - update_field :: ResourceRecord -> Field -> ResourceRecord update_field rr updated_field = case updated_field of Field_Domain val -> rr { name = val }