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

-- | `App.RegistrationInterface` 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)

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.Events as HE
import Web.Event.Event as Event
import Web.Event.Event (Event)

import Bulma as Bulma

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 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 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
  }

initialState :: Input -> State
initialState _ =
  { registrationForm: { login: "", email: "", pass: "" }
  , 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 }
  = Bulma.section_small [Bulma.columns_ [ b registration_form ]]

  where
    b e = Bulma.column_ [ Bulma.box e ]
    registration_form = [ Bulma.h3 "Register", render_register_form ]

    render_register_form = HH.form
      [ HE.onSubmit ValidateInputs ]
      [ Bulma.box_input "loginREGISTER" "Login" "login"                -- title, placeholder
          (HandleRegisterInput <<< REG_INP_login)      -- action
          registrationForm.login                       -- value
      , Bulma.box_input "emailREGISTER" "Email" "email@example.com"    -- title, placeholder
          (HandleRegisterInput <<< REG_INP_email)      -- action
          registrationForm.email                       -- value
      , Bulma.box_password "passwordREGISTER" "Password" "password"       -- title, placeholder
          (HandleRegisterInput <<< REG_INP_pass)       -- action
          registrationForm.pass                        -- value
      , Bulma.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 } }

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

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