diff --git a/src/App/RegistrationInterface.purs b/src/App/RegistrationInterface.purs index 23a6a0e..fcb6b53 100644 --- a/src/App/RegistrationInterface.purs +++ b/src/App/RegistrationInterface.purs @@ -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 diff --git a/src/App/Validation/Login.purs b/src/App/Validation/Login.purs index 36ce31a..0e808de 100644 --- a/src/App/Validation/Login.purs +++ b/src/App/Validation/Login.purs @@ -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 diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 68dc0b3..81d1aaf 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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_ [] ]