Refactoring of Container: split code into multiple functions (WIP).

src/App/Container.purs

@@ -43,7 +43,7 @@
 -- | - mail recovery
 module App.Container where
 
-import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&&), (>))
+import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&&), (>), (<<<))
 
 import Web as Web
 
@@ -113,10 +113,8 @@ max_keepalive = 60 :: Int
 wsURLauthd       = "wss://www.netlib.re/ws/authd"       :: String
 wsURLdnsmanagerd = "wss://www.netlib.re/ws/dnsmanagerd" :: String
 
-data Action
+data PageEvent
-  = Initialize
+  = EventPageAuthentication       PageAuthentication.Output
-
-  | EventPageAuthentication       PageAuthentication.Output
   | EventPageRegistration         PageRegistration.Output
   | EventPageMailValidation       PageMailValidation.Output
   | EventPageSetup                PageSetup.Output
@@ -126,9 +124,19 @@ data Action
   | EventPageZone                 PageZone.Output
   | EventPageMigration            PageMigration.Output
 
-  | EventWSAuthenticationDaemon   WS.Output
+data NetworkEvent
+  = EventWSAuthenticationDaemon   WS.Output
   | EventWSDNSmanagerd            WS.Output
 
+data Action
+  = Initialize
+
+  -- | When an event occurs on a page (including the navigation bar).
+  | EventOnPage PageEvent
+
+  -- | When an event occurs on the network (web-socket related events).
+  | EventOnNetwork NetworkEvent
+
   -- | Disconnect from both `authd` and `dnsmanagerd` (remove sockets),
   -- | then return to the home page.
   | Disconnection
@@ -136,31 +144,9 @@ data Action
   -- | Reconnection to both `authd` and `dnsmanagerd`.
   | Reconnection
 
-  -- | Try to authenticate the user to `dnsmanagerd`.
-  | AuthenticateToDNSManager
-
-  | AuthenticateToAuthd (Either Token LogInfo)
-
   -- | Change the displayed page.
   | Routing Page
 
-  -- | `DecodeDNSMessage`: decode received `dnsmanagerd` messages into `DNSManager.AnswerMessage`,
-  -- | then provide it to `DispatchDNSMessage`.
-  | DecodeDNSMessage ArrayBuffer
-
-  -- | `DispatchDNSMessage`: send the DNS message to the right component.
-  -- | The DNS message (from `dnsmanagerd`) was first received and decoded through the `DecodeDNSMessage` action.
-  | DispatchDNSMessage DNSManager.AnswerMessage
-
-  -- | `DecodeAuthMessage`: decode received `authd` messages into ``, then provide
-  -- | Then, the message is provided to the `DispatchAuthDaemonMessage` action (when needed).
-  | DecodeAuthMessage ArrayBuffer
-
-  -- | DispatchAuthDaemonMessage: an auth daemon message (from `authd`) was received and decoded through the
-  -- | `DecodeAuthMessage` action.
-  -- | The message is provided to the right component.
-  | DispatchAuthDaemonMessage AuthD.AnswerMessage
-
   -- | Log message (through the Log component).
   | Log LogMessage
 
@@ -295,7 +281,6 @@ render state
                      ]
     ]
   where
-
     website_hero :: forall w i. HH.HTML w i
     website_hero =
         HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
@@ -335,10 +320,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") EventWSAuthenticationDaemon
+    render_auth_WS = HH.slot _ws_auth unit WS.component (Tuple wsURLauthd "authd") (EventOnNetwork <<< 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") EventWSDNSmanagerd
+    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") (EventOnNetwork <<< EventWSDNSmanagerd)
 
     render_notifications =
       case state.notif of
@@ -349,24 +334,24 @@ render state
     render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     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 PageDomainList.component unit EventPageDomainList
+    render_domainlist_interface = HH.slot _dli unit PageDomainList.component unit (EventOnPage <<< EventPageDomainList)
     render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_auth_form = HH.slot _ai unit PageAuthentication.component unit EventPageAuthentication
+    render_auth_form = HH.slot _ai unit PageAuthentication.component unit (EventOnPage <<< EventPageAuthentication)
     render_registration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_registration = HH.slot _ri unit PageRegistration.component unit EventPageRegistration
+    render_registration = HH.slot _ri unit PageRegistration.component unit (EventOnPage <<< 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 PageSetup.component user_data EventPageSetup
+                     Just user_data -> HH.slot _setupi unit PageSetup.component user_data (EventOnPage <<< 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 PageMailValidation.component unit EventPageMailValidation
+    render_mail_validation = HH.slot _mvi unit PageMailValidation.component unit (EventOnPage <<< EventPageMailValidation)
     render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_zone domain = HH.slot _zi unit PageZone.component domain EventPageZone
+    render_zone domain = HH.slot _zi unit PageZone.component domain (EventOnPage <<< EventPageZone)
     render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_authd_admin_interface = HH.slot _admini unit PageAdministration.component unit EventPageAdministration
+    render_authd_admin_interface = HH.slot _admini unit PageAdministration.component unit (EventOnPage <<< EventPageAdministration)
 
     render_migration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_migration = HH.slot _mi unit PageMigration.component unit EventPageMigration
+    render_migration = HH.slot _mi unit PageMigration.component unit (EventOnPage <<< EventPageMigration)
 
     render_legal_notice :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_legal_notice
@@ -375,7 +360,7 @@ render state
                             ]
 
     render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_nav = HH.slot _nav unit PageNavigation.component unit EventPageNavigation
+    render_nav = HH.slot _nav unit PageNavigation.component unit (EventOnPage <<< EventPageNavigation)
 
     render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_logs = Web.container [ HH.slot_ _log unit AppLog.component unit ]
@@ -477,30 +462,35 @@ handleAction = case _ of
       else do -- handleAction $ Log $ SystemLog "KeepAlive message from WS while connection was closed."
               pure unit
 
-  AuthenticateToAuthd v -> case v of
+  EventOnPage page_event -> act_on_page_event page_event
-    Left token -> do
+  EventOnNetwork network_event -> act_on_network_event network_event
-      handleAction $ Log $ SystemLog "Authenticate to authd with a token."
-      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAuthByToken { token }
-      H.tell _ws_auth unit (WS.ToSend message)
-    Right (Tuple login password) -> do
-      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login, password }
-      H.tell _ws_auth unit (WS.ToSend message)
 
-  AuthenticateToDNSManager -> do
+  AddNotif n -> H.modify_ _ { notif = n }
-    state <- H.get
+  CloseNotif -> H.modify_ _ { notif = NoNotification }
-    case state.token of
+
-      Just token -> do
+  Reconnection -> do
-        message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token }
+    H.tell _ws_auth unit WS.Connect
-        H.tell _ws_dns unit (WS.ToSend message)
+    H.tell _ws_dns  unit WS.Connect
-      Nothing -> do
+    H.modify_ _ { notif = NoNotification }
+
+  Disconnection -> do
+    handleAction $ Routing Home
+
+    -- Preserve the state of the connection (authd and dnsmanagerd).
+    old_state <- H.get
+    H.put $ initialState unit
+    H.modify_ _ { are_we_connected_to_authd       = old_state.are_we_connected_to_authd
+                , are_we_connected_to_dnsmanagerd = old_state.are_we_connected_to_dnsmanagerd
+                }
+
+    handleAction $ ToggleAuthenticated Nothing
+
+    -- Remove all stored session data.
     sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
-        token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
+    H.liftEffect $ Storage.clear sessionstorage
-        case token of
-          Nothing -> pure unit
-          Just t -> do
-            H.modify_ _ { token = Just t }
-            handleAction AuthenticateToDNSManager
 
+act_on_page_event :: forall o monad. MonadAff monad => PageEvent -> H.HalogenM State Action ChildSlots o monad Unit
+act_on_page_event page_event = case page_event of
   EventPageNavigation ev -> case ev of
     PageNavigation.Log message -> handleAction $ Log message
     PageNavigation.Routing page -> handleAction $ Routing page
@@ -523,7 +513,7 @@ handleAction = case _ of
         , new_password: pass }
       H.tell _ws_auth unit (WS.ToSend message)
 
-    PageAuthentication.AuthenticateToAuthd v  -> handleAction $ AuthenticateToAuthd (Right v)
+    PageAuthentication.AuthenticateToAuthd v  -> authenticate_to_authd (Right v)
     PageAuthentication.Log message            -> handleAction $ Log message
     PageAuthentication.UserLogin login        -> do
       sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
@@ -564,7 +554,6 @@ handleAction = case _ of
                                                                   , email:      Nothing
                                                                   }
       H.tell _ws_auth unit (WS.ToSend message)
-
     PageSetup.Log message -> handleAction $ Log message
 
   EventPageAdministration ev     -> case ev of
@@ -648,10 +637,20 @@ handleAction = case _ of
       state <- H.get
       H.tell _dli unit (PageDomainList.ProvideState state.childstates.domainlist)
 
+  EventPageMigration ev -> case ev of
+    PageMigration.AskNewEmailAddress email -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email }
+      H.tell _ws_auth unit (WS.ToSend message)
+    PageMigration.AskNewEmailAddressTokenAddress token -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddressToken { token }
+      H.tell _ws_auth unit (WS.ToSend message)
+    PageMigration.Log message            -> handleAction $ Log message
+
+act_on_network_event :: forall o monad. MonadAff monad => NetworkEvent -> H.HalogenM State Action ChildSlots o monad Unit
+act_on_network_event network_event = case network_event of
   -- | `authd websocket component` wants to do something.
   EventWSAuthenticationDaemon ev -> case ev of
-    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message
+    WS.MessageReceived (Tuple _ message) -> decode_message_from_authd message
-
     WS.WSJustConnected -> do
       H.modify_ _ { are_we_connected_to_authd = true }
       sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
@@ -660,19 +659,35 @@ handleAction = case _ of
         Nothing -> pure unit
         Just t -> do
           handleAction $ Log $ SystemLog "Let's authenticate to authd"
-          handleAction $ AuthenticateToAuthd (Left t)
+          authenticate_to_authd (Left t)
-
     WS.WSJustClosed -> do
       H.modify_ _ { are_we_connected_to_dnsmanagerd = false }
       H.liftEffect scrollToTop
       -- handleAction $ Log $ ErrorLog "You just got disconnected from authd."
     WS.Log message           -> handleAction $ Log message
     WS.KeepAlive             -> handleAction $ KeepAlive $ Left unit
-
     WS.ResetKeepAliveCounter -> handleAction ResetKeepAliveCounter
 
-  DecodeAuthMessage message -> do
+  -- | `dnsmanagerd websocket component` wants to do something.
-    receivedMessage <- H.liftEffect $ AuthD.deserialize message
+  EventWSDNSmanagerd ev -> case ev of
+    WS.MessageReceived (Tuple _ message) -> decode_message_from_dnsmanagerd message
+    WS.WSJustConnected -> do
+      H.modify_ _ { are_we_connected_to_dnsmanagerd = true }
+      authenticate_to_dnsmanagerd
+    WS.WSJustClosed    -> do
+      H.modify_ _ { are_we_connected_to_dnsmanagerd = false }
+      H.liftEffect scrollToTop
+      -- handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
+    WS.Log message           -> handleAction $ Log message
+    WS.KeepAlive             -> handleAction $ KeepAlive $ Right unit
+    WS.ResetKeepAliveCounter -> handleAction ResetKeepAliveCounter
+
+
+-- | Decode received `authd` messages into ``, then provide
+-- | The message can be forwarded to a component when needed.
+decode_message_from_authd :: forall o monad. MonadAff monad => ArrayBuffer -> H.HalogenM State Action ChildSlots o monad Unit
+decode_message_from_authd arraybuffer = do
+  receivedMessage <- H.liftEffect $ AuthD.deserialize arraybuffer
   case receivedMessage of
     -- Cases where we didn't understand the message.
     Left err -> do
@@ -703,7 +718,7 @@ handleAction = case _ of
               handleAction $ Log $ SuccessLog successlog
               handleAction $ AddNotif $ GoodNotification successlog
               handleAction $ Routing MailValidation
-              _ -> handleAction $ DispatchAuthDaemonMessage m
+            _ -> forward m
         (AuthD.GotUserEdited u) -> do
           handleAction $ Log $ SuccessLog $ "User (" <> show u.uid <> ") was modified."
           handleAction $ AddNotif $ GoodNotification "Modification done."
@@ -724,18 +739,18 @@ handleAction = case _ of
               """
         m@(AuthD.GotPasswordRecovered _) -> do
           handleAction $ Log $ SuccessLog "your new password is now valid."
-            handleAction $ DispatchAuthDaemonMessage m
+          forward m
           handleAction $ AddNotif $ GoodNotification "Your new password is now valid."
         m@(AuthD.GotMatchingUsers _) -> do
           { current_page } <- H.get
           case current_page of
-              Administration -> handleAction $ DispatchAuthDaemonMessage m
+            Administration -> forward m
             _ -> handleAction $ Log $ ErrorLog
               "received a GotMatchingUsers message while not on authd admin page."
         m@(AuthD.GotUserDeleted _) -> do
           { current_page } <- H.get
           case current_page of
-              Administration -> handleAction $ DispatchAuthDaemonMessage m
+            Administration -> forward m
             _ -> pure unit
         (AuthD.GotNewEmailTokenSent _) -> do
           handleAction $ Log $ SuccessLog "New email address is pending. Please enter validation token."
@@ -768,7 +783,7 @@ handleAction = case _ of
         m@(AuthD.GotPasswordRecoverySent _) -> do
           handleAction $ Log $ SuccessLog $ "Password recovery: email sent."
           handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
-            handleAction $ DispatchAuthDaemonMessage m
+          forward m
         (AuthD.GotErrorPasswordTooShort _) -> do
           handleAction $ Log $ ErrorLog "Password too short."
           handleAction $ AddNotif $ BadNotification "Your password is too short."
@@ -820,7 +835,7 @@ handleAction = case _ of
           sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
           _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
 
-            handleAction AuthenticateToDNSManager
+          authenticate_to_dnsmanagerd
 
           -- In case the account doesn't have a valid email address, the user
           -- shouldn't be able to do anything else than to add their address.
@@ -830,18 +845,10 @@ handleAction = case _ of
 
         (AuthD.GotKeepAlive _) -> pure unit
   pure unit
-
+  where
-  EventPageMigration ev -> case ev of
+  -- | Send a received authentication daemon message `App.Message.AuthenticationDaemon.AnswerMessage` to a component.
-    PageMigration.AskNewEmailAddress email -> do
+  -- forward :: AuthD.AnswerMessage
-      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email }
+  forward message = do
-      H.tell _ws_auth unit (WS.ToSend message)
-    PageMigration.AskNewEmailAddressTokenAddress token -> do
-      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddressToken { token }
-      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 (PageAuthentication.MessageReceived message)
@@ -849,48 +856,11 @@ handleAction = case _ of
       _              -> handleAction $ Log $ SystemLog "unexpected message from authd"
     pure unit
 
-  AddNotif n -> H.modify_ _ { notif = n }
+-- | Decode received `dnsmanagerd` messages into `DNSManager.AnswerMessage`.
-  CloseNotif -> H.modify_ _ { notif = NoNotification }
+-- | Messages can be forwarded to components.
-
+decode_message_from_dnsmanagerd :: forall o monad. MonadAff monad => ArrayBuffer -> H.HalogenM State Action ChildSlots o monad Unit
-  Reconnection -> do
+decode_message_from_dnsmanagerd arraybuffer = do
-    H.tell _ws_auth unit WS.Connect
+  receivedMessage <- H.liftEffect $ DNSManager.deserialize arraybuffer
-    H.tell _ws_dns  unit WS.Connect
-    H.modify_ _ { notif = NoNotification }
-
-  Disconnection -> do
-    handleAction $ Routing Home
-
-    -- Preserve the state of the connection (authd and dnsmanagerd).
-    old_state <- H.get
-    H.put $ initialState unit
-    H.modify_ _ { are_we_connected_to_authd       = old_state.are_we_connected_to_authd
-                , are_we_connected_to_dnsmanagerd = old_state.are_we_connected_to_dnsmanagerd
-                }
-
-    handleAction $ ToggleAuthenticated Nothing
-
-    -- Remove all stored session data.
-    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
-    H.liftEffect $ Storage.clear sessionstorage
-
-  -- | `dnsmanagerd websocket component` wants to do something.
-  EventWSDNSmanagerd ev -> case ev of
-    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message
-    WS.WSJustConnected -> do
-      H.modify_ _ { are_we_connected_to_dnsmanagerd = true }
-      handleAction AuthenticateToDNSManager
-    WS.WSJustClosed    -> do
-      H.modify_ _ { are_we_connected_to_dnsmanagerd = false }
-      H.liftEffect scrollToTop
-      -- handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
-    WS.Log message     -> handleAction $ Log message
-    WS.KeepAlive       -> handleAction $ KeepAlive $ Right unit
-
-    WS.ResetKeepAliveCounter -> handleAction ResetKeepAliveCounter
-
-  -- | `DecodeDNSMessage`: decode a received `dnsmanagerd` message, then transfer it to `DispatchDNSMessage`.
-  DecodeDNSMessage message -> do
-    receivedMessage <- H.liftEffect $ DNSManager.deserialize message
   case receivedMessage of
     -- Cases where we didn't understand the message.
     Left err -> do
@@ -918,7 +888,7 @@ handleAction = case _ of
           handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
         m@(DNSManager.MkDomainChanged response) -> do
           handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated."
-            handleAction $ DispatchDNSMessage m
+          forward m
         (DNSManager.MkUnknownZone _) -> do
           handleAction $ Log $ ErrorLog $ "UnknownZone"
           handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
@@ -938,7 +908,7 @@ handleAction = case _ of
         (DNSManager.MkErrorUserNotLogged _) -> do
           handleAction $ Log $ ErrorLog $ "The user isn't connected."
           handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."
-            handleAction AuthenticateToDNSManager
+          authenticate_to_dnsmanagerd
         (DNSManager.MkErrorInvalidToken _) -> do
           H.modify_ _ { token = Nothing, current_page = Home }
           handleAction $ Log $ ErrorLog $ "Invalid token. Try re-authenticate."
@@ -949,33 +919,33 @@ handleAction = case _ of
           handleAction $ AddNotif $ BadNotification $ "The domain already exists."
         m@(DNSManager.MkUnacceptableDomain _) -> do
           handleAction $ Log $ ErrorLog $ "Domain not acceptable (see accepted domain list)."
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkAcceptedDomains _) -> do
           handleAction $ Log $ SuccessLog $ "Received the list of accepted domains."
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkLogged logged_message) -> do
           handleAction $ Log $ SuccessLog $ "Authenticated to dnsmanagerd."
           H.tell _nav unit $ PageNavigation.ToggleAdmin logged_message.admin
           handleAction $ AddNotif $ GoodNotification "You are now authenticated."
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkDomainAdded response) -> do
           handleAction $ Log $ SuccessLog $ "Domain added: " <> response.domain
           handleAction $ AddNotif $ GoodNotification $ "You have just registered the domain \""
             <> response.domain <> "\". 🥳 You can now manage it (click on its button)."
-            handleAction $ DispatchDNSMessage m
+          forward m
         (DNSManager.MkRRReadOnly response) -> do
           handleAction $ Log $ ErrorLog $ "Trying to modify a read-only resource. "
                                       <> "domain: " <> response.domain
                                       <> "resource rrid: " <> show response.rr.rrid
         m@(DNSManager.MkRRUpdated _) -> do
           handleAction $ Log $ SuccessLog $ "Resource updated."
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkRRAdded response) -> do
           handleAction $ Log $ SuccessLog $ "Resource Record added: " <> response.rr.rrtype
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkGeneratedZoneFile response) -> do
           handleAction $ Log $ SuccessLog $ "Received zonefile for " <> response.domain
-            handleAction $ DispatchDNSMessage m
+          forward m
         (DNSManager.MkInvalidDomainName _) -> do
           handleAction $ Log $ ErrorLog $ "The domain is not valid."
           handleAction $ AddNotif $ BadNotification $ "Invalid domain name."
@@ -983,13 +953,13 @@ handleAction = case _ of
           let successlog = "The domain \"" <> response.domain <> "\" has been deleted."
           handleAction $ Log $ SuccessLog successlog
           handleAction $ AddNotif $ GoodNotification successlog
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkRRDeleted response) -> do
           handleAction $ Log $ SuccessLog $ "Resource record (rrid: \"" <> show response.rrid <> "\") has been deleted."
-            handleAction $ DispatchDNSMessage m
+          forward m
         m@(DNSManager.MkZone _) -> do
           handleAction $ Log $ SuccessLog $ "Zone received."
-            handleAction $ DispatchDNSMessage m
+          forward m
         (DNSManager.MkInvalidRR response) -> do
           let errorlog = "Invalid resource record: " <> A.intercalate ", " response.errors
           handleAction $ Log $ ErrorLog errorlog
@@ -1006,12 +976,9 @@ handleAction = case _ of
           -- handleAction $ Log $ SystemLog $ "KeepAlive."
           pure unit
   pure unit
-
+  where
-  -- | Send a received DNS manager message to a component.
+  -- | Send a received dnsmanager daemon message `App.Message.DNSManagerDaemon.AnswerMessage` to a component.
-  -- | TODO: in case the message is a `logged` message, it means that the connection has been reset, and should be
+  forward message = do
-  -- | handled no matter the actual page we're on.
-  DispatchDNSMessage message -> do
-
     -- The message `Logged` can be received after a re-connection (typically, after a page reload).
     -- This is an hint, and the application should do a series of actions based on this.
     -- First, we should check if there is a "current page", if so, switch page.
@@ -1036,7 +1003,7 @@ handleAction = case _ of
       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.childstates.domainlist of
       Nothing -> do
@@ -1044,7 +1011,8 @@ handleAction = case _ of
         H.modify_ _ { childstates { domainlist = Just new_value } }
       Just _ -> pure unit
 
-  revert_old_page = do
+revert_old_page :: forall o monad. MonadAff monad => H.HalogenM State Action ChildSlots o monad Unit
+revert_old_page = do
   -- Get back to the previous page.
   sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
   page <- H.liftEffect $ Storage.getItem "current-page" sessionstorage
@@ -1067,11 +1035,30 @@ handleAction = case _ of
                         handleAction $ Routing (Zone zone)
     Just p  -> handleAction $ Log $ SystemLog $ "Oopsie, we didn't understand the old page: " <> p
 
+-- | Try to authenticate the user to `dnsmanagerd`.
+authenticate_to_dnsmanagerd :: forall o monad. MonadAff monad => H.HalogenM State Action ChildSlots o monad Unit
+authenticate_to_dnsmanagerd = do
+  state <- H.get
+  case state.token of
+    Just token -> do
+      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token }
+      H.tell _ws_dns unit (WS.ToSend message)
+    Nothing -> do
+      sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+      token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
+      case token of
+        Nothing -> pure unit
+        Just t -> do
+          H.modify_ _ { token = Just t }
+          authenticate_to_dnsmanagerd
 
---print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
+authenticate_to_authd :: forall o monad.
---print_json_string arraybuffer = do
+  MonadAff monad => (Either Token LogInfo) -> H.HalogenM State Action ChildSlots o monad Unit
---  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
+authenticate_to_authd v = case v of
---  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
+  Left token -> do
---  H.raise $ Log $ ErrorLog $ case (value) of
+    handleAction $ Log $ SystemLog "Authenticate to authd with a token."
---    Left _ -> "Cannot even fromTypedIPC the message."
+    message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAuthByToken { token }
---    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
+    H.tell _ws_auth unit (WS.ToSend message)
+  Right (Tuple login password) -> do
+    message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login, password }
+    H.tell _ws_auth unit (WS.ToSend message)