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