Improve upon error display (and fix a few wrong error messages).
parent
3123156468
commit
d049d99b1f
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 []
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in New Issue