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

Provide error messages + fix some warnings.

beta
Philippe Pittoli 2024-02-04 00:54:00 +01:00
parent 2b8a640427
commit cfd356a650
2 changed files with 119 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
src/App/Validation.purs
View File

@ -427,18 +427,18 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
data TTLError data TTLError
= NotInt = TTLNotInt
| NotBetween Int Int Int -- min max value | TTLNotBetween Int Int Int -- min max value
ttl_parser :: G.Parser TTLError Int ttl_parser :: G.Parser TTLError Int
ttl_parser = do pos <- G.current_position 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 if between min_ttl max_ttl n
then pure 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 data TXTError
= InvalidCharacter = TXTInvalidCharacter
| TooLong Int Int -- max current | TXTTooLong Int Int -- max current
-- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`). -- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`).
txt_parser :: G.Parser TXTError String txt_parser :: G.Parser TXTError String
txt_parser = do pos <- G.current_position txt_parser = do pos <- G.current_position
@ -446,12 +446,12 @@ txt_parser = do pos <- G.current_position
e <- G.tryMaybe SomeParsers.eof e <- G.tryMaybe SomeParsers.eof
pos2 <- G.current_position pos2 <- G.current_position
case e of 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 Just _ -> do
let nbchar = pos2 - pos let nbchar = pos2 - pos
if max_txt < nbchar if nbchar < max_txt
then pure $ CU.fromCharArray v 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. -- | `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. -- | The actual validation error contains the parser's error including the position.
@ -510,7 +510,6 @@ priority_parser = do
data ProtocolError data ProtocolError
= InvalidProtocol = InvalidProtocol
| ProtocolNotBetween Int Int Int -- min max value
protocol_parser :: G.Parser ProtocolError String protocol_parser :: G.Parser ProtocolError String
protocol_parser = do protocol_parser = do

150
src/App/ZoneInterface.purs
View File

@ -55,8 +55,9 @@ import App.ResourceRecord (ResourceRecord)
import App.LogMessage (LogMessage(..)) import App.LogMessage (LogMessage(..))
import App.Messages.DNSManagerDaemon as DNSManager import App.Messages.DNSManagerDaemon as DNSManager
import App.Validation as Validation import App.Validation as Validation
import GenericParser.DomainParser.Common as DomainParser import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
import GenericParser.DomainParser as DomainParser -- import GenericParser.DomainParser as DomainParser
import GenericParser.IPAddress as IPAddress
id :: forall a. a -> a id :: forall a. a -> a
@ -237,7 +238,7 @@ render state
[ case state.wsUp, state.active_modal, state.active_new_rr_modal of [ case state.wsUp, state.active_modal, state.active_new_rr_modal of
false, _, _ -> Bulma.p "You are disconnected." false, _, _ -> Bulma.p "You are disconnected."
true, Just rr_id, _ -> modal_rr_delete rr_id 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 true, Nothing, Nothing -> HH.div_ [ Bulma.h1 state._domain
, Bulma.hr , Bulma.hr
, render_soa state._soa , render_soa state._soa
@ -273,15 +274,15 @@ render state
, HH.text "." , HH.text "."
] ]
modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action modal_add_new_rr :: forall w. AcceptedRRTypes -> HH.HTML w Action
modal_add_new_rr t state = case t of modal_add_new_rr t = case t of
A -> template "A" (content_simple "A") (foot_content A) A -> template "A" (content_simple "A") (foot_content A)
AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA) AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA)
TXT -> template "TXT" (content_simple "TXT") (foot_content TXT) TXT -> template "TXT" (content_simple "TXT") (foot_content TXT)
CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME) CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME)
NS -> template "NS" (content_simple "NS") (foot_content NS) NS -> template "NS" (content_simple "NS") (foot_content NS)
MX -> template "MX" content_mx (foot_content MX) MX -> template "MX" content_mx (foot_content MX)
SRV -> template "SRV" content_srv (foot_content SRV) SRV -> template "SRV" content_srv (foot_content SRV)
where where
-- DRY -- DRY
updateForm x = UpdateNewRRForm <<< x updateForm x = UpdateNewRRForm <<< x
@ -289,19 +290,19 @@ render state
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors
else HH.div_ [ ] else HH.div_ [ ]
content_simple :: String -> Array (HH.HTML w Action) content_simple :: String -> Array (HH.HTML w Action)
content_simple t = content_simple t_ =
[ render_errors [ 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 (updateForm Update_MODAL_Domain) -- action
state._newRR.name -- value state._newRR.name -- value
state._newRR.valid -- validity (TODO) state._newRR.valid -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input ("ttl" <> t) "TTL" "600" , Bulma.box_input ("ttl" <> t_) "TTL" "600"
(updateForm Update_MODAL_TTL) (updateForm Update_MODAL_TTL)
state._newRR.ttl state._newRR.ttl
state._newRR.valid state._newRR.valid
should_be_disabled 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) (updateForm Update_MODAL_Target)
state._newRR.target state._newRR.target
state._newRR.valid state._newRR.valid
@ -375,9 +376,9 @@ render state
foot_content x = [ Bulma.btn_add (ValidateRR x) foot_content x = [ Bulma.btn_add (ValidateRR x)
(TellSomethingWentWrong state._newRR.rrid "cannot add") (TellSomethingWentWrong state._newRR.rrid "cannot add")
state._newRR.valid ] state._newRR.valid ]
template t content foot = Bulma.modal template t_ content foot = Bulma.modal
[ Bulma.modal_background [ 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_body content ]
, Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal]) , Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal])
] ]
@ -871,7 +872,7 @@ baseRecords = [ "A", "AAAA", "CNAME", "TXT", "NS" ]
-- Component definition and initial state -- Component definition and initial state
render_new_records :: forall (w :: Type). State -> HH.HTML w Action render_new_records :: forall (w :: Type). State -> HH.HTML w Action
render_new_records state render_new_records _
= Bulma.hdiv = Bulma.hdiv
[ Bulma.h1 "Adding new records" [ Bulma.h1 "Adding new records"
, Bulma.hr , Bulma.hr
@ -1050,29 +1051,30 @@ getNewID state = (_ + 1)
maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr
error_to_paragraph :: forall w. Validation.ValidationError -> HH.HTML w Action 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 (case v of
Validation.UNKNOWN -> Bulma.p "An internal error happened." Validation.UNKNOWN -> Bulma.p "An internal error happened."
Validation.VEIPv4 err -> Bulma.p "put the actual error here" Validation.VEIPv4 err -> maybe default_error show_error_ip4 err.error
Validation.VEIPv6 err -> Bulma.p "put the actual error here" Validation.VEIPv6 err -> maybe default_error show_error_ip6 err.error
Validation.VEName err -> maybe (Bulma.p "no actual error reported") show_error_domain err.error Validation.VEName err -> maybe default_error show_error_domain err.error
Validation.VETTL err -> Bulma.p "put the actual error here" Validation.VETTL err -> maybe default_error show_error_ttl err.error
Validation.VETXT err -> Bulma.p "put the actual error here" Validation.VETXT err -> maybe default_error show_error_txt err.error
Validation.VECNAME err -> Bulma.p "put the actual error here" Validation.VECNAME err -> maybe default_error show_error_domain err.error
Validation.VENS err -> Bulma.p "put the actual error here" Validation.VENS err -> maybe default_error show_error_domain err.error
Validation.VEMX err -> Bulma.p "put the actual error here" Validation.VEMX err -> maybe default_error show_error_domain err.error
Validation.VEPriority err -> Bulma.p "put the actual error here" Validation.VEPriority err -> maybe default_error show_error_priority err.error
Validation.VESRV err -> Bulma.p "put the actual error here" Validation.VESRV err -> maybe default_error show_error_domain err.error
Validation.VEProtocol err -> Bulma.p "put the actual error here" Validation.VEProtocol err -> maybe default_error show_error_protocol err.error
Validation.VEPort err -> Bulma.p "put the actual error here" Validation.VEPort err -> maybe default_error show_error_port err.error
Validation.VEWeight err -> Bulma.p "put the actual error here" Validation.VEWeight err -> maybe default_error show_error_weight err.error
-- Nothing -> "no error reported" -- Nothing -> "no error reported"
-- Just e -> "error reported, will soon appear!" -- 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_title` provide a simple title string to display to the user in case of an error with an entry.
show_error :: Validation.ValidationError -> String show_error_title :: Validation.ValidationError -> String
show_error v = case v of show_error_title v = case v of
Validation.UNKNOWN -> "Unknown" Validation.UNKNOWN -> "Unknown"
Validation.VEIPv4 err -> "The IPv4 address is wrong (position: " <> show err.position <> ")" 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.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 :: forall w. DomainParser.DomainError -> HH.HTML w Action
show_error_domain e = case e of show_error_domain e = case e of
DomainParser.LabelTooLarge size -> Bulma.p $ "LabelTooLarge (" <> show size <> " characters)" DomainParser.LabelTooLarge size ->
DomainParser.DomainTooLarge size -> Bulma.p $ "DomainTooLarge (" <> show size <> " characters)" Bulma.p $ "The label contains too many characters (" <> show size <> ")."
DomainParser.InvalidCharacter -> Bulma.p "InvalidCharacter" DomainParser.DomainTooLarge size ->
DomainParser.EOFExpected -> Bulma.p "EOFExpected" 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)."