Authentication page: tabs!

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  ->
+        true  -> case current_tab of
-          if A.length errors > 0
+          Auth                -> Bulma.box auth_form
-          then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ]
+          TabPasswordRecovery -> Bulma.box passrecovery_form
-                       , Bulma.columns_ [ b auth_form, b passrecovery_form, b newpass_form ]
+          Recovery            -> Bulma.box newpass_form
-                       ]
-          else Bulma.columns_ [ b auth_form, b passrecovery_form, b 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.