dnsmanager-webclient/src/App/Page/Registration.purs

-- | `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)