From c2e51dc9640d6a4c3699f13a66f7bf4a5d8e56d8 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 20 Feb 2024 18:19:23 +0100 Subject: [PATCH] Administration page now handles administration for both `authd` and `dnsmanagerd`. --- ...face.purs => AdministrationInterface.purs} | 16 ++-- src/App/Container.purs | 82 ++++++++++--------- src/App/Nav.purs | 6 +- 3 files changed, 57 insertions(+), 47 deletions(-) rename src/App/{AuthenticationDaemonAdminInterface.purs => AdministrationInterface.purs} (96%) diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AdministrationInterface.purs similarity index 96% rename from src/App/AuthenticationDaemonAdminInterface.purs rename to src/App/AdministrationInterface.purs index 0fe6903..10deb2b 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AdministrationInterface.purs @@ -1,17 +1,19 @@ -{- Administration interface for the authentication daemon. - This interface should allow to: - - TODO: add, remove, search, validate users - - TODO: raise a user to admin +{- Administration interface. + Allows to: + - add, remove, search users + - TODO: validate users + - TODO: change user password + - TODO: show user details (list of owned domains) + - TODO: show user domain details (zone content) and to modify users' zone + - TODO: raise a user to admin (and vice versa) - TODO: list users (getting them slowly, otherwise it will cause problems with thousands of logins) - Is this page should be used to provide `dnsmanager` administration? -} -module App.AuthenticationDaemonAdminInterface where +module App.AdministrationInterface where import Prelude (Unit, bind, discard, not, pure, show, ($), (<<<), (<>), (=<<), map, (/=)) import Bulma as Bulma -import Data.Either (Either(..)) import Data.Maybe (Maybe(..), maybe) import Data.Array as A import Effect.Aff.Class (class MonadAff) diff --git a/src/App/Container.purs b/src/App/Container.purs index c5a10f0..50ce26e 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -60,7 +60,7 @@ import App.RegistrationInterface as RI import App.MailValidationInterface as MVI import App.Log as AppLog import App.WS as WS -import App.AuthenticationDaemonAdminInterface as AAI +import App.AdministrationInterface as AdminI import App.DomainListInterface as DomainListInterface import App.ZoneInterface as ZoneInterface import App.HomeInterface as HomeInterface @@ -78,10 +78,17 @@ import Web.Storage.Storage as Storage import App.LogMessage (LogMessage(..)) --- | List all pages the application has: --- | Home, Login, Domain list, Zone, `authd` administration. --- | This list will grows in a near future. -data Page = Home | Authentication | Registration | MailValidation | DomainList | Zone String | AuthAdmin +-- | This list will grow in a near future. +-- | +-- | TODO: +data Page + = Home -- | `Home`: presentation of the project. + | Authentication -- | `Authentication`: authentication page. + | Registration -- | `Registration`: to register new people. + | 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. + | Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`). type Token = String type Login = String @@ -90,28 +97,28 @@ type LogInfo = Tuple Login Password data Action -- | Handle events from `AuthenticationInterface`. - = AuthenticationInterfaceEvent AI.Output + = AuthenticationInterfaceEvent AI.Output -- | Handle events from `RegistrationInterface`. - | RegistrationInterfaceEvent RI.Output + | RegistrationInterfaceEvent RI.Output -- | Handle events from `MailValidationInterface`. - | MailValidationInterfaceEvent MVI.Output + | MailValidationInterfaceEvent MVI.Output -- | Handle events from `AuthenticationDaemonAdminComponent`. - | AuthenticationDaemonAdminComponentEvent AAI.Output -- Admin interface for authd. + | AdministrationEvent AdminI.Output -- Administration interface. -- | Handle events from `DomainListComponent`. - | DomainListComponentEvent DomainListInterface.Output + | DomainListComponentEvent DomainListInterface.Output - -- | Handle events from `AuthenticationDaemon`. - | AuthenticationDaemonEvent WS.Output + -- | Handle events from `AuthenticationDaemon` (`authd websocket component`). + | AuthenticationDaemonEvent WS.Output - -- | Handle events from `DNSManagerDaemon`. - | DNSManagerDaemonEvent WS.Output + -- | Handle events from `DNSManagerDaemon` (`dnsmanagerd websocket component`). + | DNSManagerDaemonEvent WS.Output -- | Handle events from `ZoneInterface`. - | ZoneInterfaceEvent ZoneInterface.Output + | ZoneInterfaceEvent ZoneInterface.Output -- | Disconnect from both `authd` and `dnsmanagerd` (remove sockets), -- | then return to the home page. @@ -156,12 +163,12 @@ data Action type State = { token :: Maybe String , current_page :: Page , store_DomainListInterface_state :: Maybe DomainListInterface.State - , store_AuthenticationDaemonAdmin_state :: Maybe AAI.State + , store_AuthenticationDaemonAdmin_state :: Maybe AdminI.State } -- | The list of child components: log, `WS` twice (once for each ws connection), -- | then all the pages (AuthenticationInterface, RegistrationInterface, MailValidationInterface, --- | HomeInterface, DomainListInterface, ZoneInterface and AuthenticationDaemonAdminInterface). +-- | HomeInterface, DomainListInterface, ZoneInterface and AdministrationInterface). type ChildSlots = ( log :: AppLog.Slot Unit , ho :: HomeInterface.Slot Unit @@ -170,7 +177,7 @@ type ChildSlots = , ai :: AI.Slot Unit , ri :: RI.Slot Unit , mvi :: MVI.Slot Unit - , aai :: AAI.Slot Unit + , admini :: AdminI.Slot Unit , dli :: DomainListInterface.Slot Unit , zi :: ZoneInterface.Slot Unit ) @@ -182,7 +189,7 @@ _ws_dns = Proxy :: Proxy "ws_dns" -- WS with `dnsmanagerd` _ai = Proxy :: Proxy "ai" -- Authentication Interface _ri = Proxy :: Proxy "ri" -- Registration Interface _mvi = Proxy :: Proxy "mvi" -- Mail Validation Interface -_aai = Proxy :: Proxy "aai" -- Authd Administration Interface +_admini = Proxy :: Proxy "admini" -- Administration Interface _dli = Proxy :: Proxy "dli" -- Domain List _zi = Proxy :: Proxy "zi" -- Zone Interface @@ -214,7 +221,7 @@ render state MailValidation -> render_mail_validation DomainList -> render_domainlist_interface Zone domain -> render_zone domain - AuthAdmin -> render_authd_admin_interface + Administration -> render_authd_admin_interface -- The footer includes logs and both the WS child components. , Bulma.columns_ [ Bulma.column_ [ render_logs ] , Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ] @@ -234,7 +241,7 @@ render state 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 _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent + render_authd_admin_interface = HH.slot _admini unit AdminI.component unit AdministrationEvent authenticated = case state.token of Nothing -> false @@ -247,7 +254,7 @@ render state render_nav = Nav.netlibre_navbar authenticated admin (Routing Home) (Routing DomainList) - (Routing AuthAdmin) + (Routing Administration) (Routing Authentication) (Routing Registration) (Routing MailValidation) @@ -280,7 +287,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 - AuthAdmin -> H.liftEffect $ Storage.setItem "current-page" "AuthAdmin" sessionstorage + Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage H.modify_ _ { current_page = page } Log message -> H.tell _log unit $ AppLog.Log message @@ -330,13 +337,13 @@ handleAction = case _ of MVI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) MVI.Log message -> H.tell _log unit (AppLog.Log message) - AuthenticationDaemonAdminComponentEvent ev -> case ev of - AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - AAI.Log message -> H.tell _log unit (AppLog.Log message) - AAI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s } - AAI.AskState -> do + 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 state <- H.get - H.tell _aai unit (AAI.ProvideState state.store_AuthenticationDaemonAdmin_state) + H.tell _admini unit (AdminI.ProvideState state.store_AuthenticationDaemonAdmin_state) ZoneInterfaceEvent ev -> case ev of ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) @@ -353,13 +360,14 @@ handleAction = case _ of state <- H.get H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state) + -- | `authd websocket component` wants to do something. AuthenticationDaemonEvent ev -> case ev of WS.MessageReceived (Tuple _ message) -> do handleAction $ DecodeAuthMessage message WS.WSJustConnected -> do H.tell _ai unit AI.ConnectionIsUp - H.tell _aai unit AAI.ConnectionIsUp + H.tell _admini unit AdminI.ConnectionIsUp sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage case token of @@ -370,7 +378,7 @@ handleAction = case _ of WS.WSJustClosed -> do H.tell _ai unit AI.ConnectionIsDown - H.tell _aai unit AAI.ConnectionIsDown + H.tell _admini unit AdminI.ConnectionIsDown WS.Log message -> H.tell _log unit (AppLog.Log message) WS.KeepAlive -> handleAction $ KeepAlive $ Left unit @@ -418,13 +426,13 @@ handleAction = case _ of m@(AuthD.GotMatchingUsers _) -> do { current_page } <- H.get case current_page of - AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m + Administration -> handleAction $ DispatchAuthDaemonMessage m _ -> handleAction $ Log $ SimpleLog "[😈] received a GotMatchingUsers message while not on authd admin page." m@(AuthD.GotUserDeleted _) -> do { current_page } <- H.get case current_page of - AuthAdmin -> handleAction $ DispatchAuthDaemonMessage m + Administration -> handleAction $ DispatchAuthDaemonMessage m _ -> handleAction $ Log $ SimpleLog "[😈] received a GotUserDeleted message while not on authd admin page." (AuthD.GotErrorMustBeAuthenticated _) -> do @@ -480,8 +488,8 @@ handleAction = case _ of DispatchAuthDaemonMessage message -> do { current_page } <- H.get case current_page of - AuthAdmin -> H.tell _aai unit (AAI.MessageReceived message) - _ -> handleAction $ Log $ SystemLog "unexpected message from authd" + Administration -> H.tell _admini unit (AdminI.MessageReceived message) + _ -> handleAction $ Log $ SystemLog "unexpected message from authd" pure unit Disconnection -> do @@ -491,7 +499,7 @@ handleAction = case _ of sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window H.liftEffect $ Storage.clear sessionstorage - -- TODO: depending on the current page, we should provide the received message to different components. + -- | `dnsmanagerd websocket component` wants to do something. DNSManagerDaemonEvent ev -> case ev of WS.MessageReceived (Tuple _ message) -> do handleAction $ DecodeDNSMessage message @@ -629,7 +637,7 @@ handleAction = case _ of Just "Registration" -> handleAction $ Routing Registration Just "DomainList" -> handleAction $ Routing DomainList Just "MailValidation" -> handleAction $ Routing MailValidation - Just "AuthAdmin" -> handleAction $ Routing AuthAdmin + Just "Administration" -> handleAction $ Routing Administration Just "Zone" -> do domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage case domain of diff --git a/src/App/Nav.purs b/src/App/Nav.purs index 62e772b..da0d725 100644 --- a/src/App/Nav.purs +++ b/src/App/Nav.purs @@ -14,7 +14,7 @@ import Bulma as Bulma -- | `admin` (is the user an administrator) -- | `actionHome` (the action to get to the home page) -- | `actionDomainList` (the action to get to the domain list page) --- | `actionAuthdAdmin` (the action to get to the administration page) +-- | `actionAdmin` (the action to get to the administration page) -- | `_` (not used parameter) -- | `actionLogin` (the action to get to the login page) -- | `actionDisconnection` (the action to disconnect the user) @@ -22,7 +22,7 @@ import Bulma as Bulma -- | TODO: make the "burger" component actually useful. For now, it's empty. netlibre_navbar :: forall w i. Boolean -> Boolean -> i -> i -> i -> i -> i -> i -> i -> HH.HTML w i netlibre_navbar authenticated admin - actionHome actionDomainList actionAuthdAdmin + actionHome actionDomainList actionAdmin actionLogin actionRegistration actionMailValidation actionDisconnection = main_nav [ nav_brand [ logo, burger_menu ] @@ -68,7 +68,7 @@ netlibre_navbar authenticated admin navbar_end = HH.div [HP.classes C.navbar_end] link_home = nav_button C.is_info "Home" actionHome link_domains = nav_button C.is_info "Domains" actionDomainList - link_authd_admin = nav_button C.is_info "Authd Admin" actionAuthdAdmin + link_authd_admin = nav_button C.is_info "Admin" actionAdmin nav_button_disconnection = nav_button C.is_danger "Disconnection" actionDisconnection --dropdown title dropdown_elements -- = HH.div [HP.classes (C.navbar_item <> C.has_dropdown <> C.is_hoverable)]