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

Display errors on DomainList interface.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-21 05:16:15 +01:00
parent 6883263b24
commit e6bb3c53d6
4 changed files with 196 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

133
src/App/DisplayErrors.purs Normal file
View File

@ -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 <> ")."

49
src/App/DomainListInterface.purs
View File

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

41
src/App/Validation/Label.purs Normal file
View File

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

93
src/App/ZoneInterface.purs
View File

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