From d049d99b1f026cce58efd576f64fb4157eeea855 Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Thu, 27 Jun 2024 03:02:11 +0200 Subject: [PATCH] Improve upon error display (and fix a few wrong error messages). --- src/App/DisplayErrors.purs | 4 +- src/App/Page/Registration.purs | 56 ++++++++++++++++++++------ src/App/Page/Zone.purs | 2 +- src/App/Validation/Login.purs | 13 ++++--- src/App/Validation/Password.purs | 6 +-- src/Bulma.purs | 67 ++++++++++++++++---------------- 6 files changed, 92 insertions(+), 56 deletions(-) diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index da7bad9..3910034 100644 --- a/src/App/DisplayErrors.purs +++ b/src/App/DisplayErrors.purs @@ -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 diff --git a/src/App/Page/Registration.purs b/src/App/Page/Registration.purs index 171787e..50e706f 100644 --- a/src/App/Page/Registration.purs +++ b/src/App/Page/Registration.purs @@ -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 diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index c93a5ae..6397164 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -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 [] diff --git a/src/App/Validation/Login.purs b/src/App/Validation/Login.purs index b8276d9..ffcead0 100644 --- a/src/App/Validation/Login.purs +++ b/src/App/Validation/Login.purs @@ -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 diff --git a/src/App/Validation/Password.purs b/src/App/Validation/Password.purs index 7659428..2496bb2 100644 --- a/src/App/Validation/Password.purs +++ b/src/App/Validation/Password.purs @@ -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) diff --git a/src/Bulma.purs b/src/Bulma.purs index 5ce9f84..25c92ac 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -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)