-- | `App.Page.Registration` is a registration interface. -- | Registration requires a login, an email address and a password. module App.Page.Registration where import Prelude (Unit, bind, discard, ($), (<<<), (<>), map, between, not) import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Maybe (Maybe(..)) import Data.Either (Either(..)) import Effect.Aff.Class (class MonadAff) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Properties as HP import Halogen.HTML.Events as HE import Web.Event.Event as Event import Web.Event.Event (Event) import App.Text.Explanations as Explanations import Style as Style import CSSClasses as C import Data.String as S import App.Type.Email as Email import App.Type.LogMessage import App.Message.AuthenticationDaemon as AuthD import App.DisplayErrors (show_error_login, show_error_email, show_error_password) import Scroll (scrollToTop) import App.Validation.Login as L import App.Validation.Email as E import App.Validation.Password as P data Output = MessageToSend ArrayBuffer | Log LogMessage data Query a = DoNothing a type Slot = H.Slot Query Output type Input = Unit data RegisterInput = REG_INP_login String | REG_INP_email String | REG_INP_pass String data Action -- | Simply get the inputs from the form. = HandleRegisterInput RegisterInput -- | 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 -- | The user clicked on the checkbox. | LegalCheckboxToggle -- | 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, checked :: Boolean } -- | 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 } initialState :: Input -> State initialState _ = { registrationForm: { login: "", email: "", pass: "", checked: false } , errors: [] } component :: forall m. MonadAff m => H.Component Query Input Output m component = H.mkComponent { initialState , render , eval: H.mkEval $ H.defaultEval { handleAction = handleAction } } render :: forall m. State -> H.ComponentHTML Action () m render { registrationForm } = Style.section_small [Style.columns_ [ b registration_form ]] where b e = Style.column_ [ Style.box e ] registration_form = [ Style.h3 "Register", render_register_form ] render_register_form = HH.form [ HE.onSubmit ValidateInputs ] (username_input <> username_error <> email_input <> email_error <> password_input <> password_error <> legal_mentions <> validation_btn) username_input = [ Style.username_input "Username" registrationForm.login (HandleRegisterInput <<< REG_INP_login) ] username_error = case between 0 1 (S.length registrationForm.login), L.login registrationForm.login of true, _ -> [] _, Left errors -> [ Style.error_box "loginREGISTER" "Login error" (show_error $ Login errors) ] _, Right _ -> [] email_input = [ Style.email_input "Email" registrationForm.email (HandleRegisterInput <<< REG_INP_email) ] email_error = case between 0 5 (S.length registrationForm.email), E.email registrationForm.email of true, _ -> [] _, Left errors -> [ Style.error_box "emailREGISTER" "Email error" (show_error $ Email errors) ] _, Right _ -> [] password_input = [ Style.password_input "Password" registrationForm.pass (HandleRegisterInput <<< REG_INP_pass) ] password_error = case between 0 15 (S.length registrationForm.pass), P.password registrationForm.pass of true, _ -> [] _, Left errors -> [ Style.error_box "passwordREGISTER" "Password error" (show_error $ Password errors) ] _, Right _ -> [] legal_mentions = [ Explanations.legal_notice , HH.div [HP.classes [C.margin_top 3, C.margin_bottom 3]] [ Style.checkbox [HH.span [HP.classes [C.margin_left 3]] [HH.text "I have read and accept the terms of service and privacy policy."]] LegalCheckboxToggle ] ] validation_btn = [ Style.btn_validation ] handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction = case _ of HandleRegisterInput reginp -> do case reginp of REG_INP_login v -> H.modify_ _ { registrationForm { login = v } } REG_INP_email v -> H.modify_ _ { registrationForm { email = v } } REG_INP_pass v -> H.modify_ _ { registrationForm { pass = v } } LegalCheckboxToggle -> do { registrationForm } <- H.get H.modify_ _ { registrationForm { checked = not registrationForm.checked } } -- Validate inputs (login, email, password) then send the request -- (via SendRegistrationRequest) or log errors. ValidateInputs ev -> do H.liftEffect $ Event.preventDefault ev { registrationForm } <- H.get let login = registrationForm.login email = registrationForm.email pass = registrationForm.pass check = registrationForm.checked case login, email, pass, check of "", _, _, _ -> do H.raise $ Log $ UnableToSend "Please, write your login." H.liftEffect scrollToTop _, "", _, _ -> do H.raise $ Log $ UnableToSend "Please, write your email." H.liftEffect scrollToTop _, _, "", _ -> do H.raise $ Log $ UnableToSend "Please, write your password." H.liftEffect scrollToTop _, _, _, false -> do H.raise $ Log $ UnableToSend "Please, accept the terms of service." H.liftEffect scrollToTop _, _, _, _ -> 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 $ SystemLog $ "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)