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

-- | `App.AuthenticationInterface` is both the authentication and password recovery interface.
-- | TODO: token validation.
module App.Page.Authentication where

import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show, unit)

import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..))
import Data.Eq (class Eq)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..))
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 Web.HTML (window) as HTML
import Web.HTML.Window (sessionStorage) as Window
import Web.Storage.Storage as Storage

import App.Type.LogMessage
import App.Message.AuthenticationDaemon as AuthD

import App.Validation.Login as L
import App.Validation.Email as E
import App.Validation.Password as P

type Login = String
type Email = String
type Password = String
type PasswordRecoveryToken = String

data Error
  = Login (Array L.Error)
  | Email    (Array E.Error)
  | Password (Array P.Error)

-- | The component can inform the parent (`App.Container`) that the authentication is complete,
-- | and share both the uid and token. The token is useful to authenticate the user to the
-- | dnsmanager daemon.
-- |
-- | Also, the component can send a message to a websocket and log messages.
-- |
-- | TODO: authentication is performed in `App.Container`.
data Output
  = MessageToSend ArrayBuffer
  | AuthenticateToAuthd (Tuple Login Password)
  | Log LogMessage
  | UserLogin String
  | PasswordRecovery Login PasswordRecoveryToken Password
  | AskPasswordRecovery (Either Email Login)

-- | The component's parent provides received messages.
-- |
-- | Also, the component is informed when the connection went up or down.
data Query a
  = MessageReceived AuthD.AnswerMessage a

type Slot = H.Slot Query Output

type Input = Unit

data AuthenticationInput
  = AUTH_INP_login String
  | AUTH_INP_pass String

data PasswordRecoveryInput
  = PASSR_INP_login String
  | PASSR_INP_email String

data NewPasswordInput
  = NEWPASS_INP_login String
  | NEWPASS_INP_token String
  | NEWPASS_INP_password String
  | NEWPASS_INP_confirmation String

data Action
  = Initialize
  | HandleAuthenticationInput AuthenticationInput
  | HandlePasswordRecovery    PasswordRecoveryInput
  | HandleNewPassword         NewPasswordInput
  --
  | AuthenticationAttempt Event
  | PasswordRecoveryAttempt Event
  | NewPasswordAttempt Event

  -- | Change the displayed tab.
  | ChangeTab Tab

-- | There are different tabs in the administration page.
-- | For example, users can be searched (`authd`) and a list is provided.
data Tab = Auth | ILostMyPassword | Recovery
derive instance eqTab :: Eq Tab

type StateAuthenticationForm = { login :: String, pass :: String }
type StatePasswordRecoveryForm = { login :: String, email :: String }
type StateNewPasswordForm = { login :: String, token :: String, password :: String, confirmation :: String }

type State =
  { authenticationForm     :: StateAuthenticationForm
  , passwordRecoveryForm   :: StatePasswordRecoveryForm
  , newPasswordForm        :: StateNewPasswordForm
  , errors                 :: Array Error
  , current_tab            :: Tab
  }

initialState :: Input -> State
initialState _ =
  { authenticationForm:   { login: "", pass:  "" }
  , passwordRecoveryForm: { login: "", email: "" }
  , newPasswordForm: { login: "", token: "", password: "", confirmation: "" }
  , errors: []
  , current_tab: Auth
  }

component :: forall m. MonadAff m => H.Component Query Input Output m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval
        { initialize   = Just Initialize
        , handleAction = handleAction
        , handleQuery  = handleQuery
        }
    }

render :: forall m. State -> H.ComponentHTML Action () m
render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
  Bulma.section_small
    [ fancy_tab_bar
    , if A.length errors > 0
      then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ] ]
      else HH.div_ []
    , case current_tab of
        Auth            -> Bulma.box auth_form
        ILostMyPassword -> Bulma.box passrecovery_form
        Recovery        -> Bulma.box newpass_form
    ]

  where
    fancy_tab_bar =
      Bulma.fancy_tabs
        [ Bulma.tab_entry (is_tab_active Auth) "Authentication" (ChangeTab Auth)
        , Bulma.tab_entry (is_tab_active ILostMyPassword) "I lost my password! 😟" (ChangeTab ILostMyPassword)
        , Bulma.tab_entry (is_tab_active Recovery) "Recover with a token" (ChangeTab Recovery)
        ]
    is_tab_active tab = current_tab == tab

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

    auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
    passrecovery_form =
      [ Bulma.h3 "You forgot your password (or your login)"
      , Bulma.div_content
        [ Bulma.p "Enter either your login or email and you'll receive a recovery token."
        ]
      , render_password_recovery_form
      ]
    newpass_form =
      [ Bulma.h3 "You got the password recovery mail"
      , Bulma.div_content
        [ Bulma.p "Nice! You get to choose your new password."
        ]
      , render_new_password_form
      ]

    render_auth_form = HH.form
      [ HE.onSubmit AuthenticationAttempt ]
      [ Bulma.box_input "loginLOGIN" "Login" "login"                    -- title, placeholder
          (HandleAuthenticationInput <<< AUTH_INP_login)   -- action
          authenticationForm.login                         -- value
      , Bulma.box_password "passwordLOGIN" "Password" "password"           -- title, placeholder
          (HandleAuthenticationInput <<< AUTH_INP_pass)    -- action
          authenticationForm.pass                          -- value
      , Bulma.btn_validation

      ]

    render_password_recovery_form = HH.form
      [ HE.onSubmit PasswordRecoveryAttempt ]
      [ Bulma.box_input "loginPASSR" "Login" "login"                    -- title, placeholder
          (HandlePasswordRecovery <<< PASSR_INP_login)  -- action
          passwordRecoveryForm.login                       -- value
      , Bulma.box_input "emailPASSR" "Email" "email"                    -- title, placeholder
          (HandlePasswordRecovery <<< PASSR_INP_email)  -- action
          passwordRecoveryForm.email                       -- value
      , Bulma.btn_validation
      ]

    render_new_password_form = HH.form
      [ HE.onSubmit NewPasswordAttempt ]
      [ Bulma.box_input "loginNEWPASS" "Login" "login"
          (HandleNewPassword <<< NEWPASS_INP_login)
          newPasswordForm.login
      , Bulma.box_input "tokenNEWPASS" "Token" "token"
          (HandleNewPassword <<< NEWPASS_INP_token)
          newPasswordForm.token
      , Bulma.box_password "passwordNEWPASS" "Password" "password"
          (HandleNewPassword <<< NEWPASS_INP_password)
          newPasswordForm.password
      , Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
          (HandleNewPassword <<< NEWPASS_INP_confirmation)
          newPasswordForm.confirmation
      , Bulma.btn_validation
      ]


handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  Initialize -> do
    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
    old_tab <- H.liftEffect $ Storage.getItem "current-auth-tab" sessionstorage
    case old_tab of
      Nothing -> pure unit
      Just current_tab -> case current_tab of
        "Auth"            -> handleAction $ ChangeTab Auth
        "ILostMyPassword" -> handleAction $ ChangeTab ILostMyPassword
        "Recovery"        -> handleAction $ ChangeTab Recovery
        _  -> H.raise $ Log $ ErrorLog $ "Reload but cannot understand old current_tab: " <> current_tab

  HandleAuthenticationInput authinp -> do
    case authinp of
      AUTH_INP_login v -> H.modify_ _ { authenticationForm { login = v } }
      AUTH_INP_pass  v -> H.modify_ _ { authenticationForm { pass  = v } }

  HandlePasswordRecovery passrecovinp -> do
    case passrecovinp of
      PASSR_INP_login v -> H.modify_ _ { passwordRecoveryForm { login = v } }
      PASSR_INP_email v -> H.modify_ _ { passwordRecoveryForm { email = v } }

  HandleNewPassword newpassinp -> do
    case newpassinp of
      NEWPASS_INP_login        v -> H.modify_ _ { newPasswordForm { login = v } }
      NEWPASS_INP_token        v -> H.modify_ _ { newPasswordForm { token = v } }
      NEWPASS_INP_password     v -> H.modify_ _ { newPasswordForm { password = v } }
      NEWPASS_INP_confirmation v -> H.modify_ _ { newPasswordForm { confirmation = v } }

  AuthenticationAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { authenticationForm } <- H.get
    let { login, pass } = authenticationForm

    H.raise $ UserLogin login
    case login, pass of
      "" , _ ->
        H.raise $ Log $ UnableToSend "Write your login!"

      _ , "" ->
        H.raise $ Log $ UnableToSend "Write your password!"

      _, _ -> do
        case L.login login, P.password pass of
          Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
          _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
          _, _            -> do H.modify_ _ { errors = [] }
                                H.raise $ AuthenticateToAuthd (Tuple login pass)
        H.raise $ Log $ SystemLog $ "authenticate (login: " <> login <> ")"

  PasswordRecoveryAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { passwordRecoveryForm } <- H.get
    let login = passwordRecoveryForm.login
        email = passwordRecoveryForm.email

    case login, email of
      "", "" -> H.raise $ Log $ UnableToSend "Write your login or your email!"
      _, _ -> do
        H.raise $ Log $ SystemLog "password recovery"
        if email == ""
        then case L.login login of
               Left errors -> H.modify_ _ { errors = [ Login errors ] }
               _           -> do H.modify_ _ { errors = [] }
                                 H.raise $ AskPasswordRecovery (Right login)
        else case E.email email of
               Left errors -> H.modify_ _ { errors = [ Email errors ] }
               _           -> do H.modify_ _ { errors = [] }
                                 H.raise $ AskPasswordRecovery (Left email)

  NewPasswordAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { newPasswordForm } <- H.get
    let { login, token, password, confirmation} = newPasswordForm

    if A.any (_ == "") [ login, token, password, confirmation ]
    then H.raise $ Log $ ErrorLog "All entries are required."
    else if password == confirmation
         then case L.login login, P.password password of
                Left errors, _ -> H.modify_ _ { errors = [ Login    errors ] }
                _, Left errors -> H.modify_ _ { errors = [ Password errors ] }
                _, _           -> do H.modify_ _ { errors = [] }
                                     H.raise $ Log $ SystemLog $ "Sending a new password"
                                     H.raise $ PasswordRecovery login token password
         else H.raise $ Log $ UnableToSend "Confirmation differs from password"

  ChangeTab current_tab -> do
    -- Store the current tab we are on and restore it when we reload.
    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
    _ <- case current_tab of
      Auth -> do
        H.modify_ \state -> state { authenticationForm { login = state.newPasswordForm.login } }
        H.liftEffect $ Storage.setItem "current-auth-tab" "Auth"                sessionstorage
      ILostMyPassword -> H.liftEffect $ Storage.setItem "current-auth-tab" "ILostMyPassword" sessionstorage
      Recovery -> do
        H.modify_ \state -> state { newPasswordForm { login = state.passwordRecoveryForm.login } }
        H.liftEffect $ Storage.setItem "current-auth-tab" "Recovery"            sessionstorage
    H.modify_ _ { current_tab = current_tab }

handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of
  -- For now, no message actually needs to be handled here.
  -- Error messages are simply logged (see the code in the Container component).
  MessageReceived message _ -> do
    case message of
      AuthD.GotPasswordRecovered _ -> do
        handleAction $ ChangeTab Auth
      AuthD.GotPasswordRecoverySent _ -> do
        handleAction $ ChangeTab Recovery
      _ -> do
        H.raise $ Log $ ErrorLog $ "Message not handled in AuthenticationInterface."
    pure Nothing