From 6785540f9eecc60fbcbcb8e185e73936d9729367 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 7 May 2025 01:43:14 +0200 Subject: [PATCH] Bring some consistency in the naming. --- src/App/Container.purs | 244 +++++++++++++++++++---------------------- 1 file changed, 115 insertions(+), 129 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index a7ee168..fe1bebe 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -40,7 +40,7 @@ -- | TODO: remove the FQDN when showing RR names. -- | -- | Untested features: --- | - mail recovery, password change +-- | - mail recovery module App.Container where import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&&), (>)) @@ -69,16 +69,16 @@ import App.WS as WS import Scroll (scrollToTop) -import App.Page.Authentication as AI -import App.Page.Registration as RI -import App.Page.MailValidation as MVI -import App.Page.Administration as AdminInterface -import App.Page.Setup as SetupInterface -import App.Page.DomainList as DomainListInterface -import App.Page.Zone as ZoneInterface -import App.Page.Home as HomeInterface -import App.Page.Migration as MigrationInterface -import App.Page.Navigation as NavigationInterface +import App.Page.Authentication as PageAuthentication +import App.Page.Registration as PageRegistration +import App.Page.MailValidation as PageMailValidation +import App.Page.Administration as PageAdministration +import App.Page.Setup as PageSetup +import App.Page.DomainList as PageDomainList +import App.Page.Zone as PageZone +import App.Page.Home as PageHome +import App.Page.Migration as PageMigration +import App.Page.Navigation as PageNavigation import App.Text.Explanations as Explanations @@ -116,38 +116,18 @@ wsURLdnsmanagerd = "wss://www.netlib.re/ws/dnsmanagerd" :: String data Action = Initialize - -- | Handle events from `AuthenticationInterface`. - | AuthenticationInterfaceEvent AI.Output + | EventPageAuthentication PageAuthentication.Output + | EventPageRegistration PageRegistration.Output + | EventPageMailValidation PageMailValidation.Output + | EventPageSetup PageSetup.Output + | EventPageNavigation PageNavigation.Output + | EventPageAdministration PageAdministration.Output + | EventPageDomainList PageDomainList.Output + | EventPageZone PageZone.Output + | EventPageMigration PageMigration.Output - -- | Handle events from `RegistrationInterface`. - | RegistrationInterfaceEvent RI.Output - - -- | 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 AdminInterface.Output -- Administration interface. - - -- | Handle events from `DomainListComponent`. - | DomainListComponentEvent DomainListInterface.Output - - -- | Handle events from `AuthenticationDaemon` (`authd websocket component`). - | AuthenticationDaemonEvent WS.Output - - -- | Handle events from `DNSManagerDaemon` (`dnsmanagerd websocket component`). - | DNSManagerDaemonEvent WS.Output - - -- | Handle events from `ZoneInterface`. - | ZoneInterfaceEvent ZoneInterface.Output - - -- | Handle events from `MigrationInterface`. - | MigrationInterfaceEvent MigrationInterface.Output + | EventWSAuthenticationDaemon WS.Output + | EventWSDNSmanagerd WS.Output -- | Disconnect from both `authd` and `dnsmanagerd` (remove sockets), -- | then return to the home page. @@ -207,13 +187,12 @@ data Notification = NoNotification | GoodNotification String | BadNotification S -- | The component's state is composed of: -- | a potential authentication token, -- | the current page, --- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules, +-- | the states of both `PageDomainList` 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 + , childstates :: ChildStates , notif :: Notification , login :: Maybe String , keepalive_counter :: Int @@ -223,21 +202,21 @@ type State = { token :: Maybe String -- | The list of child components: log, `WS` twice (once for each ws connection), -- | then all the pages (AuthenticationInterface, RegistrationInterface, MailValidationInterface, --- | HomeInterface, DomainListInterface, ZoneInterface and AdministrationInterface). +-- | PageHome, PageDomainList, PageZone and AdministrationInterface). type ChildSlots = ( log :: AppLog.Slot Unit - , ho :: HomeInterface.Slot Unit + , ho :: PageHome.Slot Unit , ws_auth :: WS.Slot Unit , ws_dns :: WS.Slot Unit - , nav :: NavigationInterface.Slot Unit - , ai :: AI.Slot Unit - , ri :: RI.Slot Unit - , mvi :: MVI.Slot Unit - , admini :: AdminInterface.Slot Unit - , setupi :: SetupInterface.Slot Unit - , dli :: DomainListInterface.Slot Unit - , zi :: ZoneInterface.Slot Unit - , mi :: MigrationInterface.Slot Unit + , nav :: PageNavigation.Slot Unit + , ai :: PageAuthentication.Slot Unit + , ri :: PageRegistration.Slot Unit + , mvi :: PageMailValidation.Slot Unit + , admini :: PageAdministration.Slot Unit + , setupi :: PageSetup.Slot Unit + , dli :: PageDomainList.Slot Unit + , zi :: PageZone.Slot Unit + , mi :: PageMigration.Slot Unit ) _ho = Proxy :: Proxy "ho" -- Home Interface @@ -264,13 +243,20 @@ component = } } +type ChildStates = + { domainlist :: Maybe PageDomainList.State + , administration :: Maybe PageAdministration.State + } + -- | 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 + , childstates: + { domainlist: Nothing + , administration: Nothing + } , notif: NoNotification , login: Nothing , keepalive_counter: 0 @@ -366,10 +352,10 @@ render state then HH.div_ [] else Web.btn_ [C.is_large, C.is_danger] "You have been disconnected. Click here to reconnect." Reconnection render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_auth_WS = HH.slot _ws_auth unit WS.component (Tuple wsURLauthd "authd") AuthenticationDaemonEvent + render_auth_WS = HH.slot _ws_auth unit WS.component (Tuple wsURLauthd "authd") EventWSAuthenticationDaemon render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") DNSManagerDaemonEvent + render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") EventWSDNSmanagerd render_notifications = case state.notif of @@ -378,26 +364,26 @@ render state BadNotification v -> Web.box [Web.notification_danger v CloseNotif] render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_home = HH.slot_ _ho unit HomeInterface.component unit + render_home = HH.slot_ _ho unit PageHome.component unit render_domainlist_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_domainlist_interface = HH.slot _dli unit DomainListInterface.component unit DomainListComponentEvent + render_domainlist_interface = HH.slot _dli unit PageDomainList.component unit EventPageDomainList render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_auth_form = HH.slot _ai unit AI.component unit AuthenticationInterfaceEvent + render_auth_form = HH.slot _ai unit PageAuthentication.component unit EventPageAuthentication 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 PageRegistration.component unit EventPageRegistration render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_setup = case state.user_data of - Just user_data -> HH.slot _setupi unit SetupInterface.component user_data SetupInterfaceEvent + Just user_data -> HH.slot _setupi unit PageSetup.component user_data EventPageSetup Nothing -> Web.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 + render_mail_validation = HH.slot _mvi unit PageMailValidation.component unit EventPageMailValidation render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent + render_zone domain = HH.slot _zi unit PageZone.component domain EventPageZone render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent + render_authd_admin_interface = HH.slot _admini unit PageAdministration.component unit EventPageAdministration render_migration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_migration = HH.slot _mi unit MigrationInterface.component unit MigrationInterfaceEvent + render_migration = HH.slot _mi unit PageMigration.component unit EventPageMigration render_legal_notice :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_legal_notice @@ -406,7 +392,7 @@ render state ] render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent + render_nav = HH.slot _nav unit PageNavigation.component unit EventPageNavigation render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_logs = Web.container [ HH.slot_ _log unit AppLog.component unit ] @@ -428,7 +414,7 @@ handleAction = case _ of case login_name of Nothing -> pure unit Just name -> do H.modify_ _ { login = Just name } - H.tell _nav unit $ NavigationInterface.TellLogin (Just name) + H.tell _nav unit $ PageNavigation.TellLogin (Just name) -- Render the paypal button. -- How it works: it takes all nodes in the DOM with the reference `ref_paypal_div` ("paypal-div") @@ -477,8 +463,8 @@ handleAction = case _ of H.tell _log unit $ AppLog.Log message ToggleAuthenticated maybe_token -> case maybe_token of - Nothing -> H.tell _nav unit $ NavigationInterface.ToggleLogged false - Just _ -> H.tell _nav unit $ NavigationInterface.ToggleLogged true + Nothing -> H.tell _nav unit $ PageNavigation.ToggleLogged false + Just _ -> H.tell _nav unit $ PageNavigation.ToggleLogged true ResetKeepAliveCounter -> H.modify_ _ { keepalive_counter = 0 } KeepAlive auth_or_dnsmanager -> case auth_or_dnsmanager of @@ -532,14 +518,14 @@ handleAction = case _ of H.modify_ _ { token = Just t } handleAction AuthenticateToDNSManager - NavigationInterfaceEvent ev -> case ev of - NavigationInterface.Log message -> handleAction $ Log message - NavigationInterface.Routing page -> handleAction $ Routing page - NavigationInterface.Disconnection -> handleAction $ Disconnection + EventPageNavigation ev -> case ev of + PageNavigation.Log message -> handleAction $ Log message + PageNavigation.Routing page -> handleAction $ Routing page + PageNavigation.Disconnection -> handleAction $ Disconnection - AuthenticationInterfaceEvent ev -> case ev of - AI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - AI.AskPasswordRecovery e -> case e of + EventPageAuthentication ev -> case ev of + PageAuthentication.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + PageAuthentication.AskPasswordRecovery e -> case e of Left email -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAskPasswordRecovery { login: Nothing, email: Just (Email.Email email) } @@ -548,31 +534,31 @@ handleAction = case _ of message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAskPasswordRecovery { login: (Just login), email: Nothing } H.tell _ws_auth unit (WS.ToSend message) - AI.PasswordRecovery login token pass -> do + PageAuthentication.PasswordRecovery login token pass -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkPasswordRecovery { user: login , password_renew_key: token , new_password: pass } H.tell _ws_auth unit (WS.ToSend message) - AI.AuthenticateToAuthd v -> handleAction $ AuthenticateToAuthd (Right v) - AI.Log message -> handleAction $ Log message - AI.UserLogin login -> do + PageAuthentication.AuthenticateToAuthd v -> handleAction $ AuthenticateToAuthd (Right v) + PageAuthentication.Log message -> handleAction $ Log message + PageAuthentication.UserLogin login -> do sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window _ <- H.liftEffect $ Storage.setItem "user-login" login sessionstorage H.modify_ _ { login = Just login } - H.tell _nav unit $ NavigationInterface.TellLogin (Just login) + H.tell _nav unit $ PageNavigation.TellLogin (Just login) - RegistrationInterfaceEvent ev -> case ev of - RI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - RI.Log message -> handleAction $ Log message + EventPageRegistration ev -> case ev of + PageRegistration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + PageRegistration.Log message -> handleAction $ Log message - MailValidationInterfaceEvent ev -> case ev of - MVI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - MVI.Log message -> handleAction $ Log message + EventPageMailValidation ev -> case ev of + PageMailValidation.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + PageMailValidation.Log message -> handleAction $ Log message - SetupInterfaceEvent ev -> case ev of - SetupInterface.DeleteUserAccount -> do + EventPageSetup ev -> case ev of + PageSetup.DeleteUserAccount -> do handleAction $ Log $ SystemLog "Self termination. 😿" {- no user id, it's self termination -} @@ -584,8 +570,8 @@ handleAction = case _ of -- Once the user has been deleted, just act like it was just a disconnection. handleAction $ Disconnection - SetupInterface.ChangeEmailAddress -> handleAction $ Routing Migration - SetupInterface.ChangePassword pass -> do + PageSetup.ChangeEmailAddress -> handleAction $ Routing Migration + PageSetup.ChangePassword pass -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkModUser { user: Nothing , admin: Nothing , password: Just pass @@ -593,16 +579,16 @@ handleAction = case _ of } H.tell _ws_auth unit (WS.ToSend message) - SetupInterface.Log message -> handleAction $ Log message + PageSetup.Log message -> handleAction $ Log message - AdministrationEvent ev -> case ev of - AdminInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - AdminInterface.Log message -> handleAction $ Log message - AdminInterface.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s } - AdminInterface.AskState -> do + EventPageAdministration ev -> case ev of + PageAdministration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + PageAdministration.Log message -> handleAction $ Log message + PageAdministration.StoreState s -> H.modify_ _ { childstates { administration = Just s } } + PageAdministration.AskState -> do state <- H.get - H.tell _admini unit (AdminInterface.ProvideState state.store_AuthenticationDaemonAdmin_state) - AdminInterface.DeleteUserAccount uid -> do + H.tell _admini unit (PageAdministration.ProvideState state.childstates.administration) + PageAdministration.DeleteUserAccount uid -> do handleAction $ Log $ SystemLog "Remove user account. 😿" {- User id is provided this time, it's (probably) NOT self termination. -} @@ -610,28 +596,28 @@ handleAction = case _ of auth_message <- H.liftEffect $ AuthD.serialize $ AuthD.MkDeleteUser { user: Just uid } H.tell _ws_dns unit (WS.ToSend dns_message) H.tell _ws_auth unit (WS.ToSend auth_message) - AdminInterface.GetOrphanDomains -> do + PageAdministration.GetOrphanDomains -> do message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {} H.tell _ws_dns unit (WS.ToSend message) - ZoneInterfaceEvent ev -> case ev of - ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) - ZoneInterface.Log message -> handleAction $ Log message - ZoneInterface.ToDomainList -> handleAction $ Routing DomainList + EventPageZone ev -> case ev of + PageZone.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) + PageZone.Log message -> handleAction $ Log message + PageZone.ToDomainList -> handleAction $ Routing DomainList - DomainListComponentEvent ev -> case ev of - DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) - DomainListInterface.Log message -> handleAction $ Log message - DomainListInterface.StoreState s -> H.modify_ _ { store_DomainListInterface_state = Just s } - DomainListInterface.ChangePageZoneInterface domain -> do + EventPageDomainList ev -> case ev of + PageDomainList.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) + PageDomainList.Log message -> handleAction $ Log message + PageDomainList.StoreState s -> H.modify_ _ { childstates { domainlist = Just s } } + PageDomainList.ChangePageZoneInterface domain -> do handleAction $ Routing $ Zone domain - DomainListInterface.AskState -> do + PageDomainList.AskState -> do state <- H.get - H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state) + H.tell _dli unit (PageDomainList.ProvideState state.childstates.domainlist) -- | `authd websocket component` wants to do something. - AuthenticationDaemonEvent ev -> case ev of + EventWSAuthenticationDaemon ev -> case ev of WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message WS.WSJustConnected -> do @@ -814,16 +800,16 @@ handleAction = case _ of pure unit -- TODO - MigrationInterfaceEvent ev -> case ev of - MigrationInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - MigrationInterface.Log message -> handleAction $ Log message + EventPageMigration ev -> case ev of + PageMigration.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + PageMigration.Log message -> handleAction $ Log message -- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component. DispatchAuthDaemonMessage message -> do { current_page } <- H.get case current_page of - Authentication -> H.tell _ai unit (AI.MessageReceived message) - Administration -> H.tell _admini unit (AdminInterface.MessageReceived message) + Authentication -> H.tell _ai unit (PageAuthentication.MessageReceived message) + Administration -> H.tell _admini unit (PageAdministration.MessageReceived message) _ -> handleAction $ Log $ SystemLog "unexpected message from authd" pure unit @@ -852,7 +838,7 @@ handleAction = case _ of H.liftEffect $ Storage.clear sessionstorage -- | `dnsmanagerd websocket component` wants to do something. - DNSManagerDaemonEvent ev -> case ev of + EventWSDNSmanagerd ev -> case ev of WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message WS.WSJustConnected -> do H.modify_ _ { are_we_connected_to_dnsmanagerd = true } @@ -933,7 +919,7 @@ handleAction = case _ of handleAction $ DispatchDNSMessage m m@(DNSManager.MkLogged logged_message) -> do handleAction $ Log $ SuccessLog $ "Authenticated to dnsmanagerd." - H.tell _nav unit $ NavigationInterface.ToggleAdmin logged_message.admin + H.tell _nav unit $ PageNavigation.ToggleAdmin logged_message.admin handleAction $ AddNotif $ GoodNotification "You are now authenticated." handleAction $ DispatchDNSMessage m m@(DNSManager.MkDomainAdded response) -> do @@ -976,7 +962,7 @@ handleAction = case _ of handleAction $ Log $ SuccessLog $ "(generic) Success." DNSManager.MkOrphanDomainList response -> do handleAction $ Log $ SuccessLog "Received orphan domain list." - H.tell _admini unit (AdminInterface.GotOrphanDomainList response.domains) + H.tell _admini unit (PageAdministration.GotOrphanDomainList response.domains) (DNSManager.GotKeepAlive _) -> do -- handleAction $ Log $ SystemLog $ "KeepAlive." pure unit @@ -1007,16 +993,16 @@ handleAction = case _ of _, m@(DNSManager.MkLogged _) -> do -- handleAction $ Log $ SystemLog "logged to dnsmanagerd, do not change page" update_domain_list state m - DomainList, _ -> H.tell _dli unit (DomainListInterface.MessageReceived message) - Zone _ , _ -> H.tell _zi unit (ZoneInterface.MessageReceived message) + DomainList, _ -> H.tell _dli unit (PageDomainList.MessageReceived message) + Zone _ , _ -> H.tell _zi unit (PageZone.MessageReceived message) _, _ -> handleAction $ Log $ SystemLog "unexpected message from dnsmanagerd" pure unit where update_domain_list state m = do - case state.store_DomainListInterface_state of + case state.childstates.domainlist of Nothing -> do - let new_value = DomainListInterface.page_reload (DomainListInterface.initialState unit) m - H.modify_ _ { store_DomainListInterface_state = Just new_value } + let new_value = PageDomainList.page_reload (PageDomainList.initialState unit) m + H.modify_ _ { childstates { domainlist = Just new_value } } Just _ -> pure unit revert_old_page = do