New Setup page, to handle user account administration.
This commit is contained in:
parent
e480469ac6
commit
66820d0dd4
@ -58,7 +58,8 @@ import App.RegistrationInterface as RI
|
||||
import App.MailValidationInterface as MVI
|
||||
import App.Log as AppLog
|
||||
import App.WS as WS
|
||||
import App.AdministrationInterface as AdminI
|
||||
import App.AdministrationInterface as AdminInterface
|
||||
import App.SetupInterface as SetupInterface
|
||||
import App.DomainListInterface as DomainListInterface
|
||||
import App.ZoneInterface as ZoneInterface
|
||||
import App.HomeInterface as HomeInterface
|
||||
@ -96,11 +97,14 @@ data Action
|
||||
-- | Handle events from `MailValidationInterface`.
|
||||
| MailValidationInterfaceEvent MVI.Output
|
||||
|
||||
-- | Handle events from `SetupInterface`.
|
||||
| SetupInterfaceEvent SetupInterface.Output
|
||||
|
||||
-- | Handle events from `NavigationInterface`.
|
||||
| NavigationInterfaceEvent NavigationInterface.Output
|
||||
|
||||
-- | Handle events from `AuthenticationDaemonAdminComponent`.
|
||||
| AdministrationEvent AdminI.Output -- Administration interface.
|
||||
| AdministrationEvent AdminInterface.Output -- Administration interface.
|
||||
|
||||
-- | Handle events from `DomainListComponent`.
|
||||
| DomainListComponentEvent DomainListInterface.Output
|
||||
@ -161,7 +165,7 @@ data Action
|
||||
type State = { token :: Maybe String
|
||||
, current_page :: Page
|
||||
, store_DomainListInterface_state :: Maybe DomainListInterface.State
|
||||
, store_AuthenticationDaemonAdmin_state :: Maybe AdminI.State
|
||||
, store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
|
||||
}
|
||||
|
||||
-- | The list of child components: log, `WS` twice (once for each ws connection),
|
||||
@ -176,7 +180,8 @@ type ChildSlots =
|
||||
, ai :: AI.Slot Unit
|
||||
, ri :: RI.Slot Unit
|
||||
, mvi :: MVI.Slot Unit
|
||||
, admini :: AdminI.Slot Unit
|
||||
, admini :: AdminInterface.Slot Unit
|
||||
, setupi :: SetupInterface.Slot Unit
|
||||
, dli :: DomainListInterface.Slot Unit
|
||||
, zi :: ZoneInterface.Slot Unit
|
||||
)
|
||||
@ -190,6 +195,7 @@ _ai = Proxy :: Proxy "ai" -- Authentication Interface
|
||||
_ri = Proxy :: Proxy "ri" -- Registration Interface
|
||||
_mvi = Proxy :: Proxy "mvi" -- Mail Validation Interface
|
||||
_admini = Proxy :: Proxy "admini" -- Administration Interface
|
||||
_setupi = Proxy :: Proxy "setupi" -- Setup Interface
|
||||
_dli = Proxy :: Proxy "dli" -- Domain List
|
||||
_zi = Proxy :: Proxy "zi" -- Zone Interface
|
||||
|
||||
@ -221,6 +227,7 @@ render state
|
||||
MailValidation -> render_mail_validation
|
||||
DomainList -> render_domainlist_interface
|
||||
Zone domain -> render_zone domain
|
||||
Setup -> render_setup
|
||||
Administration -> render_authd_admin_interface
|
||||
-- The footer includes logs and both the WS child components.
|
||||
, Bulma.columns_ [ Bulma.column_ [ render_logs ]
|
||||
@ -236,12 +243,16 @@ render state
|
||||
render_auth_form = HH.slot _ai unit AI.component unit AuthenticationInterfaceEvent
|
||||
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
|
||||
Nothing -> Bulma.p "You shouldn't see this page. Reconnect!"
|
||||
render_mail_validation :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent
|
||||
render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent
|
||||
render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_authd_admin_interface = HH.slot _admini unit AdminI.component unit AdministrationEvent
|
||||
render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent
|
||||
|
||||
render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent
|
||||
@ -281,6 +292,7 @@ handleAction = case _ of
|
||||
DomainList -> H.liftEffect $ Storage.setItem "current-page" "DomainList" sessionstorage
|
||||
Zone zone -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone" sessionstorage
|
||||
H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
|
||||
Setup -> H.liftEffect $ Storage.setItem "current-page" "Setup" sessionstorage
|
||||
Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage
|
||||
H.modify_ _ { current_page = page }
|
||||
|
||||
@ -340,13 +352,17 @@ handleAction = case _ of
|
||||
MVI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
MVI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
SetupInterfaceEvent ev -> case ev of
|
||||
SetupInterface.ChangePassword pass -> handleAction $ Log $ ErrorLog "TODO: change password"
|
||||
SetupInterface.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
|
||||
AdministrationEvent ev -> case ev of
|
||||
AdminI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AdminI.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
AdminI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
|
||||
AdminI.AskState -> do
|
||||
AdminInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
AdminInterface.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
AdminInterface.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
|
||||
AdminInterface.AskState -> do
|
||||
state <- H.get
|
||||
H.tell _admini unit (AdminI.ProvideState state.store_AuthenticationDaemonAdmin_state)
|
||||
H.tell _admini unit (AdminInterface.ProvideState state.store_AuthenticationDaemonAdmin_state)
|
||||
|
||||
ZoneInterfaceEvent ev -> case ev of
|
||||
ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)
|
||||
@ -370,7 +386,7 @@ handleAction = case _ of
|
||||
|
||||
WS.WSJustConnected -> do
|
||||
H.tell _ai unit AI.ConnectionIsUp
|
||||
H.tell _admini unit AdminI.ConnectionIsUp
|
||||
H.tell _admini unit AdminInterface.ConnectionIsUp
|
||||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
|
||||
case token of
|
||||
@ -381,7 +397,7 @@ handleAction = case _ of
|
||||
|
||||
WS.WSJustClosed -> do
|
||||
H.tell _ai unit AI.ConnectionIsDown
|
||||
H.tell _admini unit AdminI.ConnectionIsDown
|
||||
H.tell _admini unit AdminInterface.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Left unit
|
||||
|
||||
@ -498,7 +514,7 @@ handleAction = case _ of
|
||||
DispatchAuthDaemonMessage message -> do
|
||||
{ current_page } <- H.get
|
||||
case current_page of
|
||||
Administration -> H.tell _admini unit (AdminI.MessageReceived message)
|
||||
Administration -> H.tell _admini unit (AdminInterface.MessageReceived message)
|
||||
_ -> handleAction $ Log $ SystemLog "unexpected message from authd"
|
||||
pure unit
|
||||
|
||||
@ -660,6 +676,7 @@ handleAction = case _ of
|
||||
Just "Registration" -> handleAction $ Routing Registration
|
||||
Just "DomainList" -> handleAction $ Routing DomainList
|
||||
Just "MailValidation" -> handleAction $ Routing MailValidation
|
||||
Just "Setup" -> handleAction $ Routing Setup
|
||||
Just "Administration" -> handleAction $ Routing Administration
|
||||
Just "Zone" -> do
|
||||
domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
|
||||
|
||||
@ -90,7 +90,7 @@ handleQuery = case _ of
|
||||
-- |
|
||||
-- | On mobile (a device with low resolution), a `burger icon` appears instead of the navigation bar.
|
||||
-- | When clicked, a list of options (such as pages or a disconnection button) should appear.
|
||||
-- | Also, when clicked again, the list should disappear.
|
||||
-- | Also, when clicked again, the list disappears.
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { logged, active, admin } =
|
||||
@ -112,7 +112,7 @@ render { logged, active, admin } =
|
||||
right_bar_div =
|
||||
case logged of
|
||||
false -> [ link_auth, link_register, link_mail_validation ]
|
||||
_ -> [ link_disconnection ]
|
||||
_ -> [ link_setup, link_disconnection ]
|
||||
|
||||
navbar_color = C.is_success
|
||||
|
||||
@ -122,7 +122,7 @@ render { logged, active, admin } =
|
||||
, ARIA.role "navigation"
|
||||
]
|
||||
|
||||
logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🍉"]
|
||||
logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🔻🍉"]
|
||||
-- HH.a [HP.classes C.navbar_item, HP.href "/"]
|
||||
-- [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
|
||||
|
||||
@ -152,6 +152,7 @@ render { logged, active, admin } =
|
||||
link_auth = nav_link "Login" (Navigate Authentication)
|
||||
link_register = nav_link_strong "Register" (Navigate Registration)
|
||||
link_mail_validation = nav_link "Mail verification" (Navigate MailValidation)
|
||||
link_setup = nav_link_warn "⚒ Setup" (Navigate Setup)
|
||||
link_disconnection =
|
||||
nav_link_ (C.has_text_light <> C.has_background_danger) "Disconnection" UnLog
|
||||
|
||||
@ -171,6 +172,7 @@ render { logged, active, admin } =
|
||||
] [ (HH.strong [] [ HH.text str ]) ]
|
||||
|
||||
nav_link str action = nav_link_ navbar_color str action
|
||||
nav_link_warn str action = nav_link_ (C.has_background_warning <> C.has_text_dark) str action
|
||||
|
||||
nav_link_ classes str action =
|
||||
HH.a [ HP.classes (C.navbar_item <> classes)
|
||||
|
||||
@ -9,4 +9,5 @@ data Page
|
||||
| MailValidation -- | `MailValidation`: to validate email addresses (via a token).
|
||||
| DomainList -- | `DomainList`: to list owned domains and to ask for new domains.
|
||||
| Zone String -- | `Zone`: to manage a zone.
|
||||
| Setup -- | `Setup`: user account administration page
|
||||
| Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
|
||||
|
||||
138
src/App/Setup.purs
Normal file
138
src/App/Setup.purs
Normal file
@ -0,0 +1,138 @@
|
||||
-- | `App.SetupInterface` allows users to change their password or their email address.
|
||||
-- | Users can also erase their account.
|
||||
module App.SetupInterface where
|
||||
|
||||
import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (==))
|
||||
|
||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||
import Data.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 Halogen.HTML.Properties as HP
|
||||
import Web.Event.Event as Event
|
||||
import Web.Event.Event (Event)
|
||||
|
||||
import Bulma as Bulma
|
||||
|
||||
import App.Email as Email
|
||||
import App.LogMessage
|
||||
import App.Messages.AuthenticationDaemon as AuthD
|
||||
|
||||
data Output
|
||||
= Log LogMessage
|
||||
| ChangePassword String
|
||||
|
||||
-- | 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
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
type Input = String
|
||||
|
||||
data AuthenticationInput
|
||||
= AUTH_INP_login String
|
||||
| AUTH_INP_pass String
|
||||
|
||||
data NewPasswordInput
|
||||
= NEWPASS_INP_password String
|
||||
| NEWPASS_INP_confirmation String
|
||||
|
||||
data Action
|
||||
= HandleNewPassword NewPasswordInput
|
||||
| ChangePasswordAttempt Event
|
||||
|
||||
type StateNewPasswordForm = { password :: String, confirmation :: String }
|
||||
|
||||
type State =
|
||||
{ newPasswordForm :: StateNewPasswordForm
|
||||
, token :: String
|
||||
, wsUp :: Boolean
|
||||
}
|
||||
|
||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||
component =
|
||||
H.mkComponent
|
||||
{ initialState
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval
|
||||
{ handleAction = handleAction
|
||||
, handleQuery = handleQuery
|
||||
}
|
||||
}
|
||||
|
||||
initialState :: Input -> State
|
||||
initialState token =
|
||||
{ newPasswordForm: { password: "", confirmation: "" }
|
||||
, token
|
||||
, wsUp: true
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { wsUp, newPasswordForm }
|
||||
= render_new_password_form
|
||||
|
||||
where
|
||||
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
render_new_password_form = HH.form
|
||||
[ HE.onSubmit ChangePasswordAttempt ]
|
||||
[ Bulma.box_input "passwordNEWPASS" "Password" "password"
|
||||
(HandleNewPassword <<< NEWPASS_INP_password)
|
||||
newPasswordForm.password
|
||||
should_be_disabled
|
||||
, Bulma.box_input "confirmationNEWPASS" "Confirmation" "confirmation"
|
||||
(HandleNewPassword <<< NEWPASS_INP_confirmation)
|
||||
newPasswordForm.confirmation
|
||||
should_be_disabled
|
||||
, HH.button
|
||||
[ HP.style "padding: 0.5rem 1.25rem;"
|
||||
, HP.type_ HP.ButtonSubmit
|
||||
, (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
]
|
||||
[ HH.text "Send Message to Server" ]
|
||||
]
|
||||
|
||||
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
||||
handleAction = case _ of
|
||||
HandleNewPassword authinp -> do
|
||||
case authinp of
|
||||
NEWPASS_INP_password v -> H.modify_ _ { newPasswordForm { password = v } }
|
||||
NEWPASS_INP_confirmation v -> H.modify_ _ { newPasswordForm { confirmation = v } }
|
||||
|
||||
ChangePasswordAttempt ev -> do
|
||||
H.liftEffect $ Event.preventDefault ev
|
||||
|
||||
{ newPasswordForm } <- H.get
|
||||
case newPasswordForm.password, newPasswordForm.confirmation of
|
||||
"" , _ -> H.raise $ Log $ UnableToSend "Write your password!"
|
||||
_ , "" -> H.raise $ Log $ UnableToSend "Confirm your password!"
|
||||
pass, confirmation -> do
|
||||
if pass == confirmation
|
||||
then do H.raise $ Log $ SystemLog "Changing the password"
|
||||
H.raise $ ChangePassword pass
|
||||
else H.raise $ Log $ UnableToSend "Confirmation differs from password"
|
||||
|
||||
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
|
||||
_ -> do
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in SetupInterface."
|
||||
pure Nothing
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
@ -91,6 +91,8 @@ has_background_warning_light = [HH.ClassName "has-background-warning-light"]
|
||||
has_background_danger_light :: Array HH.ClassName
|
||||
has_background_danger_light = [HH.ClassName "has-background-danger-light"]
|
||||
|
||||
has_text_dark :: Array HH.ClassName
|
||||
has_text_dark = [HH.ClassName "has-text-dark"]
|
||||
has_text_light :: Array HH.ClassName
|
||||
has_text_light = [HH.ClassName "has-text-light"]
|
||||
has_succeeds_separator :: Array HH.ClassName
|
||||
|
||||
Loading…
Reference in New Issue
Block a user