Display current and pending email addresses.

This commit is contained in:
Philippe PITTOLI 2024-07-07 19:53:21 +02:00
parent 411de1be6c
commit b3be75c2fb
3 changed files with 33 additions and 14 deletions

View File

@ -178,6 +178,7 @@ data Notification = NoNotification | GoodNotification String | BadNotification S
-- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules, -- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules,
-- | to avoid many useless network exchanges. -- | to avoid many useless network exchanges.
type State = { token :: Maybe String type State = { token :: Maybe String
, user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email))
, current_page :: Page , current_page :: Page
, store_DomainListInterface_state :: Maybe DomainListInterface.State , store_DomainListInterface_state :: Maybe DomainListInterface.State
, store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.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. -- | Initial state is simple: the user is on the home page, nothing else is stored.
initialState :: forall i. i -> State initialState :: forall i. i -> State
initialState _ = { token: Nothing initialState _ = { token: Nothing
, user_data: Nothing
, current_page: Home , current_page: Home
, store_DomainListInterface_state: Nothing , store_DomainListInterface_state: Nothing
, store_AuthenticationDaemonAdmin_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 :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent
render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_setup = case state.token of render_setup = case state.user_data of
Just token -> HH.slot _setupi unit SetupInterface.component token SetupInterfaceEvent Just user_data -> HH.slot _setupi unit SetupInterface.component user_data SetupInterfaceEvent
Nothing -> Bulma.p "You shouldn't see this page. Please, reconnect." 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 :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent
@ -628,7 +630,8 @@ handleAction = case _ of
-- The authentication was a success! -- The authentication was a success!
(AuthD.GotToken msg) -> do (AuthD.GotToken msg) -> do
handleAction $ Log $ SuccessLog $ "Authenticated to authd." 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) handleAction $ ToggleAuthenticated (Just msg.token)
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window

View File

@ -186,9 +186,13 @@ codecGotError ∷ CA.JsonCodec Error
codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
{- 1 -} {- 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.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 -} {- 2 -}
type User = { user :: UserPublic.UserPublic } type User = { user :: UserPublic.UserPublic }

View File

@ -5,6 +5,7 @@ module App.Page.Setup where
import Prelude (Unit, bind, discard, pure, ($), (<<<), (==), (<>), show, map) import Prelude (Unit, bind, discard, pure, ($), (<<<), (==), (<>), show, map)
import Data.Array as A import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Effect.Aff.Class (class MonadAff) import Effect.Aff.Class (class MonadAff)
@ -36,7 +37,7 @@ data Query a
type Slot = H.Slot Query Output type Slot = H.Slot Query Output
type Input = String type Input = Tuple (Maybe Email.Email) (Maybe Email.Email)
data AuthenticationInput data AuthenticationInput
= AUTH_INP_login String = AUTH_INP_login String
@ -66,10 +67,10 @@ data Modal
| DeleteAccountModal | DeleteAccountModal
type State = type State =
{ newPasswordForm :: StateNewPasswordForm { newPasswordForm :: StateNewPasswordForm
, new_email_address :: String , new_email_address :: String
, token :: String , emails :: Tuple (Maybe Email.Email) (Maybe Email.Email)
, modal :: Modal , modal :: Modal
} }
component :: forall m. MonadAff m => H.Component Query Input Output m component :: forall m. MonadAff m => H.Component Query Input Output m
@ -84,17 +85,19 @@ component =
} }
initialState :: Input -> State initialState :: Input -> State
initialState token = initialState emails =
{ newPasswordForm: { password: "", confirmation: "" } { newPasswordForm: { password: "", confirmation: "" }
, new_email_address: "" , new_email_address: ""
, token , emails
, modal: NoModal , modal: NoModal
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render { modal, newPasswordForm, new_email_address } = render { modal, newPasswordForm, new_email_address, emails } =
Bulma.section_small Bulma.section_small
[ case modal of [ render_emails emails
, Bulma.hr
, case modal of
DeleteAccountModal -> render_delete_account_modal DeleteAccountModal -> render_delete_account_modal
NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change email address", render_new_email_form ] NoModal -> Bulma.columns_ [ b [ Bulma.h3 "Change email address", render_new_email_form ]
, b [ Bulma.h3 "Change password", render_new_password_form ] , b [ Bulma.h3 "Change password", render_new_password_form ]
@ -105,6 +108,15 @@ render { modal, newPasswordForm, new_email_address } =
where where
b e = Bulma.column_ e 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_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup
render_new_email_form = HH.form render_new_email_form = HH.form