157 lines
9.5 KiB
Plaintext
157 lines
9.5 KiB
Plaintext
|
-- | 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 <> "."
|
||
|
|
|
||
|
|
-- SPF dedicated RR
|
||
|
|
ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
|
||
|
|
ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
|
||
|
|
ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
|
||
|
|
ValidationDNS.VESPFModifierName err -> maybe default_error show_error_domain err.error
|
||
|
|
|
||
|
|
ValidationDNS.DKIMInvalidKeySize min max -> show_error_key_sizes min max
|
||
|
|
)
|
||
|
|
where default_error = Bulma.p ""
|
||
|
|
|
||
|
|
show_error_key_sizes :: forall w i. Int -> Int -> HH.HTML w i
|
||
|
|
show_error_key_sizes min max
|
||
|
|
= Bulma.p $ "Chosen signature algorithm only accepts public key input between "
|
||
|
|
<> show min <> " and " <> show max <> " characters."
|
||
|
|
|
||
|
|
-- | `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 <> ")"
|
||
|
|
|
||
|
|
-- SPF dedicated RR
|
||
|
|
ValidationDNS.VESPFMechanismName err -> "The domain name in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||
|
|
ValidationDNS.VESPFMechanismIPv4 err -> "The IPv4 address in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||
|
|
ValidationDNS.VESPFMechanismIPv6 err -> "The IPv6 address in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||
|
|
|
||
|
|
ValidationDNS.VESPFModifierName err -> "The domain name in a SPF modifier (EXP or REDIRECT) is wrong (position: " <> show err.position <> ")"
|
||
|
|
ValidationDNS.DKIMInvalidKeySize _ _ -> "Public key has an invalid length."
|
||
|
|
|
||
|
|
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 ':')."
|
||
|
|
IPAddress.IP6InvalidRange -> Bulma.p "IPv6 address or range isn't valid."
|
||
|
|
|
||
|
|
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 '.')."
|
||
|
|
IPAddress.IP4InvalidRange -> Bulma.p "IPv4 address or range isn't valid."
|
||
|
|
|
||
|
|
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 <> ")."
|