Registration: validation works.

beta
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. -- | Registration requires a login, an email address and a password.
module App.RegistrationInterface where 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.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer) 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 Effect.Aff.Class (class MonadAff)
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
@ -21,9 +22,9 @@ import App.Email as Email
import App.LogMessage import App.LogMessage
import App.Messages.AuthenticationDaemon as AuthD import App.Messages.AuthenticationDaemon as AuthD
--import App.Validation.Login (login, Error(..)) as L import App.Validation.Login as L
--import App.Validation.Email (email, Error(..)) as E import App.Validation.Email as E
--import App.Validation.Password (password, Error(..)) as P import App.Validation.Password as P
data Output data Output
= MessageToSend ArrayBuffer = MessageToSend ArrayBuffer
@ -44,19 +45,29 @@ data RegisterInput
| REG_INP_pass String | REG_INP_pass String
data Action data Action
-- | Simply get the inputs from the form.
= HandleRegisterInput RegisterInput = 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 -- | The possible errors come from either the login, email or password input.
-- | Login L.Error data Error
-- | Email E.Error = Login (Array L.Error)
-- | Password P.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 } 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 = type State =
{ registrationForm :: StateRegistrationForm { registrationForm :: StateRegistrationForm
--, errors :: Array Error , errors :: Array Error
, wsUp :: Boolean , wsUp :: Boolean
} }
@ -74,7 +85,7 @@ component =
initialState :: Input -> State initialState :: Input -> State
initialState _ = initialState _ =
{ registrationForm: { login: "", email: "", pass: "" } { registrationForm: { login: "", email: "", pass: "" }
--, errors: [] , errors: []
, wsUp: true , wsUp: true
} }
@ -93,7 +104,7 @@ render { wsUp, registrationForm }
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true)) should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
render_register_form = HH.form render_register_form = HH.form
[ HE.onSubmit RegisterAttempt ] [ HE.onSubmit ValidateInputs ]
[ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder [ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
(HandleRegisterInput <<< REG_INP_login) -- action (HandleRegisterInput <<< REG_INP_login) -- action
registrationForm.login -- value registrationForm.login -- value
@ -124,49 +135,85 @@ handleAction = case _ of
REG_INP_email v -> H.modify_ _ { registrationForm { email = v } } REG_INP_email v -> H.modify_ _ { registrationForm { email = v } }
REG_INP_pass v -> H.modify_ _ { registrationForm { pass = 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.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 case login, email, pass of
-- let login = registrationForm.login "", _, _ ->
-- email = registrationForm.email H.raise $ Log $ UnableToSend "Write your login!"
-- pass = registrationForm.pass
-- _, "", _ ->
-- case login, email, pass of H.raise $ Log $ UnableToSend "Write your email!"
-- "", _, _ ->
-- H.raise $ Log $ UnableToSend "Write your login!" _, _, "" ->
-- H.raise $ Log $ UnableToSend "Write your password!"
-- _, "", _ ->
-- H.raise $ Log $ UnableToSend "Write your email!" _, _, _ -> do
-- case L.login login, E.email email, P.password pass of
-- _, _, "" -> Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error $ Login errors
-- H.raise $ Log $ UnableToSend "Write your password!" _, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error $ Email errors
-- _, _, Left errors -> H.raise $ Log $ UnableToSend $ show_error $ Password errors
-- _, _, _ -> do Right _, Right _, Right _ -> handleAction $ SendRegistrationRequest
-- -- TODO: handle validation
-- case L.login login, E.email email, P.password pass of SendRegistrationRequest -> do
-- Left errors, _, _ -> H.raise $ Log $ UnableToSend $ show_error errors { registrationForm } <- H.get
-- _, Left errors, _ -> H.raise $ Log $ UnableToSend $ show_error errors let { login, email, pass } = registrationForm
-- _, _, Left errors -> H.raise $ Log $ UnableToSend $ show_error errors message <- H.liftEffect $ AuthD.serialize $
-- AuthD.MkRegister { login, email: Just (Email.Email email), password: pass }
-- Right l, Right e, Right p -> do H.raise $ MessageToSend message
-- message <- H.liftEffect $ AuthD.serialize $ H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")"
-- AuthD.MkRegister { login: login
-- , email: Just (Email.Email email) show_error :: Error -> String
-- , password: pass } show_error = case _ of
-- H.raise $ MessageToSend message Login arr -> "Error with the Login: " <> (A.fold $ map show_error_login arr)
-- H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")" Email arr -> "Error with the Email: " <> (A.fold $ map show_error_email arr)
-- where Password arr -> "Error with the Password: " <> (A.fold $ map show_error_password arr)
-- collect_errors
-- show_error_login :: L.Error -> String
-- show_errors :: Array Error -> String show_error_login = case _ of
-- show_errors array = A.concat $ map show_error array L.ParsingError {error, position} ->
-- show_error = case _ of "position " <> show position <> " " <> maybe "" string_error_login error
-- Login _ -> "Error with the Login"
-- Email _ -> "Error with the Email" string_error_login :: L.LoginParsingError -> String
-- Password _ -> "Error with the Password" 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 :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of

View File

@ -21,7 +21,7 @@ data Error
= ParsingError (G.Error LoginParsingError) = ParsingError (G.Error LoginParsingError)
min_login_size :: Int min_login_size :: Int
min_login_size = 1 min_login_size = 2
max_login_size :: Int max_login_size :: Int
max_login_size = 50 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]] A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
# map NonEmpty.toArray -- -> [[xx], [yy], [z]] # map NonEmpty.toArray -- -> [[xx], [yy], [z]]
# map (map rows) -- -> [[hh], [hh], [h]] ('h' means 'html') # 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] # 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_ [] ] emptyline = HH.tr_ [ Bulma.txt_name "", HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [], HH.td_ [] ]