Improve upon error display (and fix a few wrong error messages).

caa
Philippe PITTOLI 2024-06-27 03:02:11 +02:00
parent 3123156468
commit d049d99b1f
6 changed files with 92 additions and 56 deletions

View File

@ -175,7 +175,7 @@ show_error_title_label v = case v of
show_error_login :: L.Error -> String
show_error_login = case _ of
L.ParsingError {error} -> maybe "" string_error_login error
L.ParsingError {error} -> maybe "login is invalid, it should respect the following regex: [a-zA-Z][-_ a-zA-Z0-9']*[a-zA-Z0-9]" string_error_login error
string_error_login :: L.LoginParsingError -> String
string_error_login = case _ of
@ -199,7 +199,7 @@ string_error_email = case _ of
show_error_password :: P.Error -> String
show_error_password = case _ of
P.ParsingError {error} -> maybe "" string_error_password error
P.ParsingError {error} -> maybe "invalid password, it should contain between 15 and 100 characters (ASCII)" string_error_password error
string_error_password :: P.PasswordParsingError -> String
string_error_password = case _ of

View File

@ -2,7 +2,7 @@
-- | Registration requires a login, an email address and a password.
module App.Page.Registration where
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map)
import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between)
import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
@ -17,6 +17,7 @@ import Web.Event.Event (Event)
import Bulma as Bulma
import Data.String as S
import App.Type.Email as Email
import App.Type.LogMessage
import App.Message.AuthenticationDaemon as AuthD
@ -94,17 +95,48 @@ render { registrationForm }
render_register_form = HH.form
[ HE.onSubmit ValidateInputs ]
[ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
(HandleRegisterInput <<< REG_INP_login) -- action
registrationForm.login -- value
, Bulma.box_input "emailREGISTER" "Email" "email@example.com" -- title, placeholder
(HandleRegisterInput <<< REG_INP_email) -- action
registrationForm.email -- value
, Bulma.box_password "passwordREGISTER" "Password" "password" -- title, placeholder
(HandleRegisterInput <<< REG_INP_pass) -- action
registrationForm.pass -- value
, Bulma.btn_validation
]
(login_input <> login_error <>
email_input <> email_error <>
password_input <> password_error <>
validation_btn)
login_input
= [ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
(HandleRegisterInput <<< REG_INP_login) -- action
registrationForm.login -- value
]
login_error
= case between 0 1 (S.length registrationForm.login), L.login registrationForm.login of
true, _ -> []
_, Left errors -> [ Bulma.error_box "loginREGISTER" "Login error" (show_error $ Login errors) ]
_, Right _ -> []
email_input
= [ Bulma.box_input "emailREGISTER" "Email" "email@example.com" -- title, placeholder
(HandleRegisterInput <<< REG_INP_email) -- action
registrationForm.email -- value
]
email_error
= case between 0 5 (S.length registrationForm.email), E.email registrationForm.email of
true, _ -> []
_, Left errors -> [ Bulma.error_box "emailREGISTER" "Email error" (show_error $ Email errors) ]
_, Right _ -> []
password_input
= [ Bulma.box_password "passwordREGISTER" "Password" "password" -- title, placeholder
(HandleRegisterInput <<< REG_INP_pass) -- action
registrationForm.pass -- value
]
password_error
= case between 0 15 (S.length registrationForm.pass), P.password registrationForm.pass of
true, _ -> []
_, Left errors -> [ Bulma.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ]
_, Right _ -> []
validation_btn = [ Bulma.btn_validation ]
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of

View File

@ -418,7 +418,7 @@ render state
] <> case state.rr_modal of
UpdateRRModal ->
if A.elem state._currentRR.rrtype ["A", "AAAA"]
then [ Bulma.labeled_field ("token" <> state._currentRR.rrtype) "Token"
then [ Bulma.field_entry ("token" <> state._currentRR.rrtype) "Token"
(Bulma.p $ fromMaybe "❌​" state._currentRR.token)
]
else []

View File

@ -32,12 +32,15 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
login_parser :: G.Parser LoginParsingError String
login_parser = do
input <- G.current_input
_ <- G.many1 (alpha <|> digit) G.<:> \_ -> CannotParse
_ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
_ <- (alpha <|> digit) G.<:> \_ -> CannotParse
_ <- G.many1 (alpha <|> digit <|> G.char ' ' <|> G.char '_' <|> G.char '\'' <|> G.char '-') G.<:> \_ -> CannotParse
_ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
let last_char_correct = G.parse_last_char input.string (alpha <|> digit)
pos <- G.current_position
if between min_login_size max_login_size pos
then pure input.string
else G.errorParser (Just $ Size min_login_size max_login_size pos)
case between min_login_size max_login_size pos, last_char_correct of
false, _ -> G.errorParser (Just $ Size min_login_size max_login_size pos)
true, false -> G.errorParser (Just $ CannotParse)
_, _ -> pure input.string
login :: String -> Either (Array Error) String
login s = toEither $ parse login_parser s ParsingError

View File

@ -21,7 +21,7 @@ data Error
= ParsingError (G.Error PasswordParsingError)
min_password_size :: Int
min_password_size = 2
min_password_size = 15
max_password_size :: Int
max_password_size = 100
@ -32,8 +32,8 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of
password_parser :: G.Parser PasswordParsingError String
password_parser = do
l <- G.many1 vchar <|> G.Parser \i -> G.failureError i.position (Just CannotParse)
_ <- SomeParsers.eof <|> G.Parser \i -> G.failureError i.position (Just CannotEntirelyParse)
l <- G.many1 (vchar <|> G.char ' ') G.<:> \_ -> CannotParse
_ <- SomeParsers.eof G.<:> \_ -> CannotEntirelyParse
pos <- G.current_position
if pos < min_password_size || pos > max_password_size
then G.Parser \i -> G.failureError i.position (Just $ Size min_password_size max_password_size pos)

View File

@ -302,46 +302,56 @@ render_input password id placeholder action value cond
false -> []
true -> [ HP.type_ HP.InputPassword ]
div_field :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
div_field = HH.div [HP.classes (C.field <> C.is_horizontal)]
-- | Bulma's `field`, which contains an array of `Halogen.HTML` entries.
-- | Two entries are expected: a field label (`div_field_label`) and a field content (`div_field_content`).
div_field :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
div_field classes = HH.div [HP.classes (C.field <> C.is_horizontal <> classes)]
-- | Field label (id and title) for a Bulma `field`.
div_field_label :: forall w i. String -> String -> HH.HTML w i
div_field_label id title = HH.div [HP.classes (C.field_label <> C.normal)]
[HH.label [ HP.classes C.label, HP.for id ] [ HH.text title ]]
-- | Any `Halogen.HTML` data in Bulma `field-body > field > control` divs.
div_field_content :: forall w i. HH.HTML w i -> HH.HTML w i
div_field_content content
= HH.div [ HP.classes C.field_body ]
[ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]
-- | Basic field entry with a title and a field content.
field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
field_entry id title entry
= div_field []
[ div_field_label id title
, div_field_content entry
]
-- | Error field entry with a title and a field content.
error_field_entry :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
error_field_entry id title entry
= div_field C.has_background_danger_light
[ div_field_label id title
, div_field_content entry
]
error_box :: forall w i. String -> String -> String -> HH.HTML w i
error_box id title value = error_field_entry id title $ notification_danger' value
field_inner :: forall w i.
Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
field_inner ispassword cond id title placeholder action value
= div_field
[ div_field_label id title
, div_field_content $ render_input ispassword id placeholder action value cond
]
= field_entry id title $ render_input ispassword id placeholder action value cond
div_field_ :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
div_field_ classes = HH.div [ HP.classes (C.field <> classes) ]
btn_labeled :: forall w i. String -> String -> String -> i -> HH.HTML w i
btn_labeled id title button_text action
= div_field
[ div_field_label id title
, div_field_content $ HH.button
[ HE.onClick \_ -> action
, HP.classes $ C.button <> C.is_small <> C.is_info
, HP.id id
] [ HH.text button_text ]
]
labeled_field :: forall w i. String -> String -> HH.HTML w i -> HH.HTML w i
labeled_field id title content
= div_field
[ div_field_label id title
, div_field_content content
]
= field_entry id title $ HH.button
[ HE.onClick \_ -> action
, HP.classes $ C.button <> C.is_small <> C.is_info
, HP.id id
] [ HH.text button_text ]
box_input_ :: forall w i.
(HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
@ -541,26 +551,17 @@ selection action values selected = HH.div [HP.classes $ C.select <> C.is_normal]
selection_field :: forall w i. String -> String -> (Int -> i) -> Array String -> String -> HH.HTML w i
selection_field id title action values selected
= div_field
[ div_field_label id title
, div_field_content $ selection action values selected
]
= field_entry id title $ selection action values selected
selection_field' :: forall w i.
String -> String -> (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i
selection_field' id title action values selected
= div_field
[ div_field_label id title
, div_field_content $ selection' action values selected
]
= field_entry id title $ selection' action values selected
selection_field'' :: forall w i t. Show t =>
String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
selection_field'' id title action values default_value selected
= div_field
[ div_field_label id title
, div_field_content $ selection' action values selected_value
]
= field_entry id title $ selection' action values selected_value
where
selected_value = (show $ fromMaybe default_value selected)