Registration: validation works.

This commit is contained in:
Philippe Pittoli 2024-02-11 15:36:14 +01:00
parent 9a19462a99
commit 3f2573831a
3 changed files with 102 additions and 55 deletions

View File

@ -2,11 +2,12 @@
-- | Registration requires a login, an email address and a password.
module App.RegistrationInterface where
import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>))
import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), map, show)
import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..))
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
@ -21,9 +22,9 @@ import App.Email as Email
import App.LogMessage
import App.Messages.AuthenticationDaemon as AuthD
--import App.Validation.Login (login, Error(..)) as L
--import App.Validation.Email (email, Error(..)) as E
--import App.Validation.Password (password, Error(..)) as P
import App.Validation.Login as L
import App.Validation.Email as E
import App.Validation.Password as P
data Output
= MessageToSend ArrayBuffer
@ -44,19 +45,29 @@ data RegisterInput
| REG_INP_pass String
data Action
-- | Simply get the inputs from the form.
= HandleRegisterInput RegisterInput
| RegisterAttempt Event
-- | Validate inputs (login, email, password) then send the request
-- | (via `SendRegistrationRequest`) or log errors.
| ValidateInputs Event
-- | Send the registration request to `dnsmanagerd`.
-- | This action is automatically called from `ValidateInputs`.
| SendRegistrationRequest
--data Error
-- | Login L.Error
-- | Email E.Error
-- | Password P.Error
-- | The possible errors come from either the login, email or password input.
data Error
= Login (Array L.Error)
| Email (Array E.Error)
| Password (Array P.Error)
-- | The whole registration form is composed of three strings: login, email and password.
type StateRegistrationForm = { login :: String, email :: String, pass :: String }
-- | State is composed of the registration form, the errors and an indication whether
-- | the websocket connection with `authd` is up or not.
type State =
{ registrationForm :: StateRegistrationForm
--, errors :: Array Error
, errors :: Array Error
, wsUp :: Boolean
}
@ -74,7 +85,7 @@ component =
initialState :: Input -> State
initialState _ =
{ registrationForm: { login: "", email: "", pass: "" }
--, errors: []
, errors: []
, wsUp: true
}
@ -93,7 +104,7 @@ render { wsUp, registrationForm }
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
render_register_form = HH.form
[ HE.onSubmit RegisterAttempt ]
[ HE.onSubmit ValidateInputs ]
[ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
(HandleRegisterInput <<< REG_INP_login) -- action
registrationForm.login -- value
@ -124,49 +135,85 @@ handleAction = case _ of
REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } }
RegisterAttempt ev -> do
-- Validate inputs (login, email, password) then send the request
-- (via SendRegistrationRequest) or log errors.
ValidateInputs ev -> do
H.liftEffect $ Event.preventDefault ev
H.raise $ Log $ UnableToSend "TODO: validation first!"
{ registrationForm } <- H.get
let login = registrationForm.login
email = registrationForm.email
pass = registrationForm.pass
-- { registrationForm } <- H.get
-- let login = registrationForm.login
-- email = registrationForm.email
-- pass = registrationForm.pass
--
-- case login, email, pass of
-- "", _, _ ->
-- H.raise $ Log $ UnableToSend "Write your login!"
--
-- _, "", _ ->
-- H.raise $ Log $ UnableToSend "Write your email!"
--
-- _, _, "" ->
-- H.raise $ Log $ UnableToSend "Write your password!"
--
-- _, _, _ -> do
-- -- TODO: handle validation
-- case L.login login, E.email email, P.password pass of
-- Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error errors
-- _, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error errors
-- _, _, Left errors -> H.raise $ Log $ UnableToSend $ show_error errors
--
-- Right l, Right e, Right p -> do
-- message <- H.liftEffect $ AuthD.serialize $
-- AuthD.MkRegister { login: login
-- , email: Just (Email.Email email)
-- , password: pass }
-- H.raise $ MessageToSend message
-- H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")"
-- where
-- collect_errors
--
-- show_errors :: Array Error -> String
-- show_errors array = A.concat $ map show_error array
-- show_error = case _ of
-- Login _ -> "Error with the Login"
-- Email _ -> "Error with the Email"
-- Password _ -> "Error with the Password"
case login, email, pass of
"", _, _ ->
H.raise $ Log $ UnableToSend "Write your login!"
_, "", _ ->
H.raise $ Log $ UnableToSend "Write your email!"
_, _, "" ->
H.raise $ Log $ UnableToSend "Write your password!"
_, _, _ -> do
case L.login login, E.email email, P.password pass of
Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error $ Login errors
_, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error $ Email errors
_, _, Left errors -> H.raise $ Log $ UnableToSend $ show_error $ Password errors
Right _, Right _, Right _ -> handleAction $ SendRegistrationRequest
SendRegistrationRequest -> do
{ registrationForm } <- H.get
let { login, email, pass } = registrationForm
message <- H.liftEffect $ AuthD.serialize $
AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
H.raise $ MessageToSend message
H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")"
show_error :: Error -> String
show_error = case _ of
Login arr -> "Error with the Login: " <> (A.fold $ map show_error_login arr)
Email arr -> "Error with the Email: " <> (A.fold $ map show_error_email arr)
Password arr -> "Error with the Password: " <> (A.fold $ map show_error_password arr)
show_error_login :: L.Error -> String
show_error_login = case _ of
L.ParsingError {error, position} ->
"position " <> show position <> " " <> maybe "" string_error_login error
string_error_login :: L.LoginParsingError -> String
string_error_login = case _ of
L.CannotParse -> "cannot parse the login"
L.CannotEntirelyParse -> "cannot entirely parse the login"
L.Size min max n -> "login size should be between "
<> show min <> " and " <> show max
<> " (currently: " <> show n <> ")"
show_error_email :: E.Error -> String
show_error_email = case _ of
E.ParsingError {error, position} ->
"position " <> show position <> " " <> maybe "" string_error_email error
string_error_email :: E.EmailParsingError -> String
string_error_email = case _ of
E.CannotParse -> "cannot parse the email"
E.CannotEntirelyParse -> "cannot entirely parse the email"
E.Size min max n -> "email size should be between "
<> show min <> " and " <> show max
<> " (currently: " <> show n <> ")"
show_error_password :: P.Error -> String
show_error_password = case _ of
P.ParsingError {error, position} ->
"position " <> show position <> " " <> maybe "" string_error_password error
string_error_password :: P.PasswordParsingError -> String
string_error_password = case _ of
P.CannotParse -> "cannot parse the password"
P.CannotEntirelyParse -> "cannot entirely parse the password"
P.Size min max n -> "password size should be between "
<> show min <> " and " <> show max
<> " (currently: " <> show n <> ")"
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of

View File

@ -21,7 +21,7 @@ data Error
= ParsingError (G.Error LoginParsingError)
min_login_size :: Int
min_login_size = 1
min_login_size = 2
max_login_size :: Int
max_login_size = 50

View File

@ -731,7 +731,7 @@ render_resources records
A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
# map NonEmpty.toArray -- -> [[xx], [yy], [z]]
# map (map rows) -- -> [[hh], [hh], [h]] ('h' means 'html')
# A.intersperse [emptyline] -- -> [[hh],[line],[hh],[line],[h]]
# A.intersperse [emptyline] -- -> [[hh], [line], [hh], [line], [h]]
# A.concat -- -> [h h line h h line h]
emptyline = HH.tr_ [ Bulma.txt_name "", HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [] ]