Provide error messages + fix some warnings.
parent
2b8a640427
commit
cfd356a650
|
@ -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
|
||||
|
|
|
@ -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)."
|
||||
|
|
Loading…
Reference in New Issue