Bring some consistency in the naming.
This commit is contained in:
parent
dcb0379858
commit
6785540f9e
1 changed files with 115 additions and 129 deletions
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue