Registration: validation works.
parent
9a19462a99
commit
3f2573831a
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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_ [] ]
|
||||
|
|
Loading…
Reference in New Issue