From b3be75c2fb127eced4dc5666ffa2abdf8b08a448 Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Sun, 7 Jul 2024 19:53:21 +0200 Subject: [PATCH] Display current and pending email addresses. --- src/App/Container.purs | 9 ++++--- src/App/Message/AuthenticationDaemon.purs | 8 ++++-- src/App/Page/Setup.purs | 30 ++++++++++++++++------- 3 files changed, 33 insertions(+), 14 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index 6152fd3..5a37641 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -178,6 +178,7 @@ data Notification = NoNotification | GoodNotification String | BadNotification S -- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules, -- | to avoid many useless network exchanges. type State = { token :: Maybe String + , user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email)) , current_page :: Page , store_DomainListInterface_state :: Maybe DomainListInterface.State , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State @@ -229,6 +230,7 @@ component = -- | Initial state is simple: the user is on the home page, nothing else is stored. initialState :: forall i. i -> State initialState _ = { token: Nothing + , user_data: Nothing , current_page: Home , store_DomainListInterface_state: Nothing , store_AuthenticationDaemonAdmin_state: Nothing @@ -272,8 +274,8 @@ render state render_registration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_setup = case state.token of - Just token -> HH.slot _setupi unit SetupInterface.component token SetupInterfaceEvent + render_setup = case state.user_data of + Just user_data -> HH.slot _setupi unit SetupInterface.component user_data SetupInterfaceEvent Nothing -> Bulma.p "You shouldn't see this page. Please, reconnect." render_mail_validation :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent @@ -628,7 +630,8 @@ handleAction = case _ of -- The authentication was a success! (AuthD.GotToken msg) -> do handleAction $ Log $ SuccessLog $ "Authenticated to authd." - H.modify_ _ { token = Just msg.token } + H.modify_ _ { token = Just msg.token + , user_data = Just (Tuple msg.current_email msg.pending_email) } handleAction $ ToggleAuthenticated (Just msg.token) sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window diff --git a/src/App/Message/AuthenticationDaemon.purs b/src/App/Message/AuthenticationDaemon.purs index f689633..56319f9 100644 --- a/src/App/Message/AuthenticationDaemon.purs +++ b/src/App/Message/AuthenticationDaemon.purs @@ -186,9 +186,13 @@ codecGotError ∷ CA.JsonCodec Error codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) {- 1 -} -type Logged = { uid :: Int, token :: String } +type Logged = { uid :: Int, token :: String, current_email :: Maybe Email.Email, pending_email :: Maybe Email.Email } codecGotToken ∷ CA.JsonCodec Logged -codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int, "token": CA.string }) +codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int + , "token": CA.string + , current_email: CAR.optional Email.codec + , pending_email: CAR.optional Email.codec + }) {- 2 -} type User = { user :: UserPublic.UserPublic } diff --git a/src/App/Page/Setup.purs b/src/App/Page/Setup.purs index 5efdb90..3424d26 100644 --- a/src/App/Page/Setup.purs +++ b/src/App/Page/Setup.purs @@ -5,6 +5,7 @@ module App.Page.Setup where import Prelude (Unit, bind, discard, pure, ($), (<<<), (==), (<>), show, map) import Data.Array as A +import Data.Tuple (Tuple(..)) import Data.Maybe (Maybe(..), maybe) import Data.Either (Either(..)) import Effect.Aff.Class (class MonadAff) @@ -36,7 +37,7 @@ data Query a type Slot = H.Slot Query Output -type Input = String +type Input = Tuple (Maybe Email.Email) (Maybe Email.Email) data AuthenticationInput = AUTH_INP_login String @@ -66,10 +67,10 @@ data Modal | DeleteAccountModal type State = - { newPasswordForm :: StateNewPasswordForm - , new_email_address :: String - , token :: String - , modal :: Modal + { newPasswordForm :: StateNewPasswordForm + , new_email_address :: String + , emails :: Tuple (Maybe Email.Email) (Maybe Email.Email) + , modal :: Modal } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -84,17 +85,19 @@ component = } initialState :: Input -> State -initialState token = +initialState emails = { newPasswordForm: { password: "", confirmation: "" } , new_email_address: "" - , token + , emails , modal: NoModal } render :: forall m. State -> H.ComponentHTML Action () m -render { modal, newPasswordForm, new_email_address } = +render { modal, newPasswordForm, new_email_address, emails } = Bulma.section_small - [ case modal of + [ render_emails emails + , Bulma.hr + , case modal of DeleteAccountModal -> render_delete_account_modal NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change email address", render_new_email_form ] , b [ Bulma.h3 "Change password", render_new_password_form ] @@ -105,6 +108,15 @@ render { modal, newPasswordForm, new_email_address } = where b e = Bulma.column_ e + render_emails (Tuple current pending) + = HH.div [] + [ case current of + Just (Email.Email e) -> Bulma.p $ "Current email address: " <> e + Nothing -> Bulma.p "You do not currently have a validated email address!" + , case pending of + Just (Email.Email e) -> Bulma.p $ "Pending email address: " <> e + Nothing -> Bulma.p "You do not have a pending email address." + ] render_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup render_new_email_form = HH.form