From 0dce7e57620dafc18ba5cc8e347fe5a9a47dde16 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 21 Mar 2024 00:16:59 +0100
Subject: [PATCH] Authentication page: tabs!
---
src/App/Page/Authentication.purs | 71 ++++++++++++++++++++++++++------
1 file changed, 58 insertions(+), 13 deletions(-)
diff --git a/src/App/Page/Authentication.purs b/src/App/Page/Authentication.purs
index b706104..a9e6e29 100644
--- a/src/App/Page/Authentication.purs
+++ b/src/App/Page/Authentication.purs
@@ -2,12 +2,13 @@
-- | TODO: token validation.
module App.Page.Authentication where
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (>), (==), map, show)
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (=<<), (<>), (>), (==), map, show)
import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..), maybe)
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
@@ -19,6 +20,10 @@ 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
@@ -77,7 +82,8 @@ data NewPasswordInput
| NEWPASS_INP_confirmation String
data Action
- = HandleAuthenticationInput AuthenticationInput
+ = Initialize
+ | HandleAuthenticationInput AuthenticationInput
| HandlePasswordRecovery PasswordRecoveryInput
| HandleNewPassword NewPasswordInput
--
@@ -85,6 +91,14 @@ data Action
| 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 | TabPasswordRecovery | 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 }
@@ -95,6 +109,7 @@ type State =
, newPasswordForm :: StateNewPasswordForm
, errors :: Array Error
, wsUp :: Boolean
+ , current_tab :: Tab
}
initialState :: Input -> State
@@ -104,6 +119,7 @@ initialState _ =
, newPasswordForm: { login: "", token: "", password: "", confirmation: "" }
, wsUp: true
, errors: []
+ , current_tab: Auth
}
component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -112,26 +128,35 @@ component =
{ initialState
, render
, eval: H.mkEval $ H.defaultEval
- { handleAction = handleAction
+ { initialize = Just Initialize
+ , handleAction = handleAction
, handleQuery = handleQuery
}
}
render :: forall m. State -> H.ComponentHTML Action () m
-render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
+render { wsUp, current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
Bulma.section_small
- [ case wsUp of
+ [ 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 wsUp of
false -> Bulma.p "You are disconnected."
- true ->
- if A.length errors > 0
- then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ]
- , Bulma.columns_ [ b auth_form, b passrecovery_form, b newpass_form ]
- ]
- else Bulma.columns_ [ b auth_form, b passrecovery_form, b newpass_form ]
+ true -> case current_tab of
+ Auth -> Bulma.box auth_form
+ TabPasswordRecovery -> Bulma.box passrecovery_form
+ Recovery -> Bulma.box newpass_form
]
where
- b e = Bulma.column_ [ Bulma.box e ]
+ fancy_tab_bar =
+ Bulma.fancy_tabs
+ [ Bulma.tab_entry (is_tab_active Auth) "Authentication" (ChangeTab Auth)
+ , Bulma.tab_entry (is_tab_active TabPasswordRecovery) "Ask for Password Recovery" (ChangeTab TabPasswordRecovery)
+ , 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
@@ -248,6 +273,17 @@ render { wsUp, authenticationForm, passwordRecoveryForm, newPasswordForm, errors
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 -> H.raise $ Log $ ErrorLog "We hadn't changed tab before reload apparently."
+ Just current_tab -> case current_tab of
+ "Auth" -> handleAction $ ChangeTab Auth
+ "TabPasswordRecovery" -> handleAction $ ChangeTab TabPasswordRecovery
+ "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 } }
@@ -323,6 +359,15 @@ handleAction = case _ of
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 -> H.liftEffect $ Storage.setItem "current-auth-tab" "Auth" sessionstorage
+ TabPasswordRecovery -> H.liftEffect $ Storage.setItem "current-auth-tab" "TabPasswordRecovery" sessionstorage
+ Recovery -> 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.