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

Provide error messages + fix some warnings.

Browse Source
This commit is contained in:
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
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

150
src/App/ZoneInterface.purs
View File

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