Baguette/dnsmanager-webclient
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Bring some consistency in the naming.

Browse source
This commit is contained in:
Philippe Pittoli 2025-05-07 01:43:14 +02:00
parent dcb0379858
commit 6785540f9e
1 changed files with 115 additions and 129 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

244
src/App/Container.purs
View file

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