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
-        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 }
-            handleAction AuthenticateToDNSManager
 
+  Reconnection -> do
+    H.tell _ws_auth unit WS.Connect
+    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
+
+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,189 +637,6 @@ handleAction = case _ of
       state <- H.get
       H.tell _dli unit (PageDomainList.ProvideState state.childstates.domainlist)
 
-  -- | `authd websocket component` wants to do something.
-  EventWSAuthenticationDaemon ev -> case ev of
-    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message
-
-    WS.WSJustConnected -> do
-      H.modify_ _ { are_we_connected_to_authd = true }
-      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
-          handleAction $ Log $ SystemLog "Let's authenticate to authd"
-          handleAction $ AuthenticateToAuthd (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
-    receivedMessage <- H.liftEffect $ AuthD.deserialize message
-    case receivedMessage of
-      -- Cases where we didn't understand the message.
-      Left err -> do
-        -- handleAction $ Log $ ErrorLog $
-        --   "received a message that couldn't be decoded. Reason: " <> show err
-        case err of
-          (AuthD.JSONERROR jerr) -> do
-            -- print_json_string messageEvent.message
-            handleAction $ Log $ ErrorLog $ "JSON parsing error: " <> jerr
-          (AuthD.UnknownError unerr) -> handleAction $ Log $ ErrorLog $
-            "Parsing error: AuthD.UnknownError" <> (show unerr)
-          (AuthD.UnknownNumber     ) -> handleAction $ Log $ ErrorLog
-            "Parsing error: AuthD.UnknownNumber"
-
-      -- Cases where we understood the message.
-      -- TODO: create a modal to show some of these?
-      Right response -> do
-        case response of
-          (AuthD.GotUser _) -> do
-            handleAction $ Log $ ErrorLog "TODO: received a GotUser message."
-          m@(AuthD.GotUserAdded _) -> do
-            { current_page } <- H.get
-            case current_page of
-              Registration -> do
-                let successlog = """
-                    You are now registered. Please verify your email address with the token we have sent you.
-                """
-                handleAction $ Log $ SuccessLog successlog
-                handleAction $ AddNotif $ GoodNotification successlog
-                handleAction $ Routing MailValidation
-              _ -> handleAction $ DispatchAuthDaemonMessage m
-          (AuthD.GotUserEdited u) -> do
-            handleAction $ Log $ SuccessLog $ "User (" <> show u.uid <> ") was modified."
-            handleAction $ AddNotif $ GoodNotification "Modification done."
-          (AuthD.GotUserValidated _) -> do
-            handleAction $ Log $ SuccessLog "User got validated. You can now log in."
-            handleAction $ Routing Authentication
-            handleAction $ AddNotif $ GoodNotification "User got validated. You can now log in."
-          (AuthD.GotUsersList _) -> do
-            handleAction $ Log $ ErrorLog "TODO: received a GotUsersList message."
-          (AuthD.GotPermissionCheck _) -> do
-            handleAction $ Log $ ErrorLog "TODO: received a GotPermissionCheck message."
-          (AuthD.GotPermissionSet _) -> do
-            handleAction $ Log $ ErrorLog "Received a GotPermissionSet message."
-          (AuthD.GotErrorEmailAddressNotValidated _) -> do
-            handleAction $ Log $ ErrorLog """
-                Cannot authenticate: your email address hasn't been validated.
-                Please check your email inbox.
-                """
-          m@(AuthD.GotPasswordRecovered _) -> do
-            handleAction $ Log $ SuccessLog "your new password is now valid."
-            handleAction $ DispatchAuthDaemonMessage 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
-              _ -> 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
-              _ -> pure unit
-          (AuthD.GotNewEmailTokenSent _) -> do
-            handleAction $ Log $ SuccessLog "New email address is pending. Please enter validation token."
-          (AuthD.GotNewEmailAddressValidated msg) -> do
-            handleAction $ Log $ SuccessLog "New email address has been validated."
-            handleAction $ AddNotif $ GoodNotification "Your new email address is now valid."
-            H.modify_ _ { user_data = Just (Tuple (Just msg.email) Nothing) }
-            handleAction $ Routing DomainList
-          (AuthD.GotErrorMustBeAuthenticated _) -> do
-            handleAction $ Log $ ErrorLog "received a GotErrorMustBeAuthenticated message."
-            handleAction $ AddNotif $ BadNotification "Sorry, you must be authenticated to perform this action."
-          (AuthD.GotErrorAlreadyUsedLogin _) -> do
-            handleAction $ Log $ ErrorLog "received a GotErrorAlreadyUsedLogin message."
-            handleAction $ AddNotif $ BadNotification "Sorry, this login is already used."
-            H.liftEffect scrollToTop
-          (AuthD.GotErrorEmailAddressAlreadyUsed _) -> do
-            handleAction $ Log $ ErrorLog "received a GotErrorEmailAddressAlreadyUsed message."
-            handleAction $ AddNotif $ BadNotification "Sorry, this email address is already used."
-            H.liftEffect scrollToTop
-          (AuthD.GotErrorUserNotFound _) -> do
-            handleAction $ Log $ ErrorLog "received a GotErrorUserNotFound message."
-            handleAction $ AddNotif $ BadNotification "User hasn't been found."
-
-          -- The authentication failed.
-          (AuthD.GotError errmsg) -> do
-            handleAction $ Log $ ErrorLog $ " generic error message: "
-              <> maybe "server didn't tell why" (\v -> v) errmsg.reason
-            handleAction $ AddNotif $ BadNotification $ "Sorry, authd sent an error message. "
-              <> maybe "The server didn't tell why." (\v -> "Message was: " <> v) errmsg.reason
-          m@(AuthD.GotPasswordRecoverySent _) -> do
-            handleAction $ Log $ SuccessLog $ "Password recovery: email sent."
-            handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
-            handleAction $ DispatchAuthDaemonMessage m
-          (AuthD.GotErrorPasswordTooShort _) -> do
-            handleAction $ Log $ ErrorLog "Password too short."
-            handleAction $ AddNotif $ BadNotification "Your password is too short."
-          (AuthD.GotErrorMailRequired _) -> do
-            handleAction $ Log $ ErrorLog "Email required."
-            handleAction $ AddNotif $ BadNotification "An email is required."
-          (AuthD.GotErrorInvalidCredentials _) -> do
-            handleAction $ Log $ ErrorLog "Invalid credentials."
-            handleAction $ ToggleAuthenticated Nothing
-            handleAction $ AddNotif $ BadNotification "Invalid credentials."
-          (AuthD.GotErrorRegistrationsClosed _) -> do
-            handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
-            handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
-          (AuthD.GotErrorInvalidLoginFormat _) -> do
-            handleAction $ Log $ ErrorLog "Invalid login format."
-            handleAction $ AddNotif $ BadNotification "Invalid login format."
-          (AuthD.GotErrorInvalidEmailFormat _) -> do
-            handleAction $ Log $ ErrorLog "Invalid email format."
-            handleAction $ AddNotif $ BadNotification "Invalid email format."
-          (AuthD.GotErrorAlreadyUsersInDB _) -> do
-            handleAction $ Log $ ErrorLog "Login already taken."
-            handleAction $ AddNotif $ BadNotification "Login already taken."
-          (AuthD.GotErrorReadOnlyProfileKeys _) -> do
-            handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys."
-            handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys."
-          (AuthD.GotErrorInvalidActivationKey _) -> do
-            handleAction $ Log $ ErrorLog "Invalid activation key."
-            handleAction $ AddNotif $ BadNotification "Invalid activation key."
-          (AuthD.GotErrorUserAlreadyValidated _) -> do
-            handleAction $ Log $ ErrorLog "User already validated."
-            handleAction $ AddNotif $ BadNotification "User already validated."
-          (AuthD.GotErrorCannotContactUser _) -> do
-            handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
-            handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
-          (AuthD.GotErrorInvalidRenewKey _) -> do
-            handleAction $ Log $ ErrorLog "Invalid renew key."
-            handleAction $ AddNotif $ BadNotification "Invalid renew key."
-          (AuthD.GotErrorPasswordTooLong _) -> do
-            handleAction $ Log $ ErrorLog "Password too long."
-            handleAction $ AddNotif $ BadNotification "Password too long."
-          -- The authentication was a success!
-          (AuthD.GotToken msg) -> do
-            handleAction $ Log $ SuccessLog $ "Authenticated to authd."
-            H.modify_ _ { token = Just msg.token
-                        , user_data = Just (Tuple msg.current_email msg.pending_email)
-                        }
-            handleAction $ ToggleAuthenticated (Just msg.token)
-
-            sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
-            _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
-
-            handleAction AuthenticateToDNSManager
-
-            -- 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.
-            case msg.current_email of
-              Nothing -> handleAction $ Routing Migration
-              _       -> pure unit
-
-          (AuthD.GotKeepAlive _) -> pure unit
-    pure unit
-
   EventPageMigration ev -> case ev of
     PageMigration.AskNewEmailAddress email -> do
       message <- H.liftEffect $ AuthD.serialize $ AuthD.MkNewEmailAddress { email }
@@ -840,8 +646,209 @@ handleAction = case _ of
       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.
+act_on_network_event :: forall o monad. MonadAff monad => NetworkEvent -> H.HalogenM State Action ChildSlots o monad Unit
-  DispatchAuthDaemonMessage message -> do
+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) -> decode_message_from_authd message
+    WS.WSJustConnected -> do
+      H.modify_ _ { are_we_connected_to_authd = true }
+      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
+          handleAction $ Log $ SystemLog "Let's authenticate to authd"
+          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
+
+  -- | `dnsmanagerd websocket component` wants to do something.
+  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
+      -- handleAction $ Log $ ErrorLog $
+      --   "received a message that couldn't be decoded. Reason: " <> show err
+      case err of
+        (AuthD.JSONERROR jerr) -> do
+          -- print_json_string messageEvent.message
+          handleAction $ Log $ ErrorLog $ "JSON parsing error: " <> jerr
+        (AuthD.UnknownError unerr) -> handleAction $ Log $ ErrorLog $
+          "Parsing error: AuthD.UnknownError" <> (show unerr)
+        (AuthD.UnknownNumber     ) -> handleAction $ Log $ ErrorLog
+          "Parsing error: AuthD.UnknownNumber"
+
+    -- Cases where we understood the message.
+    -- TODO: create a modal to show some of these?
+    Right response -> do
+      case response of
+        (AuthD.GotUser _) -> do
+          handleAction $ Log $ ErrorLog "TODO: received a GotUser message."
+        m@(AuthD.GotUserAdded _) -> do
+          { current_page } <- H.get
+          case current_page of
+            Registration -> do
+              let successlog = """
+                  You are now registered. Please verify your email address with the token we have sent you.
+              """
+              handleAction $ Log $ SuccessLog successlog
+              handleAction $ AddNotif $ GoodNotification successlog
+              handleAction $ Routing MailValidation
+            _ -> forward m
+        (AuthD.GotUserEdited u) -> do
+          handleAction $ Log $ SuccessLog $ "User (" <> show u.uid <> ") was modified."
+          handleAction $ AddNotif $ GoodNotification "Modification done."
+        (AuthD.GotUserValidated _) -> do
+          handleAction $ Log $ SuccessLog "User got validated. You can now log in."
+          handleAction $ Routing Authentication
+          handleAction $ AddNotif $ GoodNotification "User got validated. You can now log in."
+        (AuthD.GotUsersList _) -> do
+          handleAction $ Log $ ErrorLog "TODO: received a GotUsersList message."
+        (AuthD.GotPermissionCheck _) -> do
+          handleAction $ Log $ ErrorLog "TODO: received a GotPermissionCheck message."
+        (AuthD.GotPermissionSet _) -> do
+          handleAction $ Log $ ErrorLog "Received a GotPermissionSet message."
+        (AuthD.GotErrorEmailAddressNotValidated _) -> do
+          handleAction $ Log $ ErrorLog """
+              Cannot authenticate: your email address hasn't been validated.
+              Please check your email inbox.
+              """
+        m@(AuthD.GotPasswordRecovered _) -> do
+          handleAction $ Log $ SuccessLog "your new password is now valid."
+          forward m
+          handleAction $ AddNotif $ GoodNotification "Your new password is now valid."
+        m@(AuthD.GotMatchingUsers _) -> do
+          { current_page } <- H.get
+          case current_page of
+            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 -> forward m
+            _ -> pure unit
+        (AuthD.GotNewEmailTokenSent _) -> do
+          handleAction $ Log $ SuccessLog "New email address is pending. Please enter validation token."
+        (AuthD.GotNewEmailAddressValidated msg) -> do
+          handleAction $ Log $ SuccessLog "New email address has been validated."
+          handleAction $ AddNotif $ GoodNotification "Your new email address is now valid."
+          H.modify_ _ { user_data = Just (Tuple (Just msg.email) Nothing) }
+          handleAction $ Routing DomainList
+        (AuthD.GotErrorMustBeAuthenticated _) -> do
+          handleAction $ Log $ ErrorLog "received a GotErrorMustBeAuthenticated message."
+          handleAction $ AddNotif $ BadNotification "Sorry, you must be authenticated to perform this action."
+        (AuthD.GotErrorAlreadyUsedLogin _) -> do
+          handleAction $ Log $ ErrorLog "received a GotErrorAlreadyUsedLogin message."
+          handleAction $ AddNotif $ BadNotification "Sorry, this login is already used."
+          H.liftEffect scrollToTop
+        (AuthD.GotErrorEmailAddressAlreadyUsed _) -> do
+          handleAction $ Log $ ErrorLog "received a GotErrorEmailAddressAlreadyUsed message."
+          handleAction $ AddNotif $ BadNotification "Sorry, this email address is already used."
+          H.liftEffect scrollToTop
+        (AuthD.GotErrorUserNotFound _) -> do
+          handleAction $ Log $ ErrorLog "received a GotErrorUserNotFound message."
+          handleAction $ AddNotif $ BadNotification "User hasn't been found."
+
+        -- The authentication failed.
+        (AuthD.GotError errmsg) -> do
+          handleAction $ Log $ ErrorLog $ " generic error message: "
+            <> maybe "server didn't tell why" (\v -> v) errmsg.reason
+          handleAction $ AddNotif $ BadNotification $ "Sorry, authd sent an error message. "
+            <> maybe "The server didn't tell why." (\v -> "Message was: " <> v) errmsg.reason
+        m@(AuthD.GotPasswordRecoverySent _) -> do
+          handleAction $ Log $ SuccessLog $ "Password recovery: email sent."
+          handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
+          forward m
+        (AuthD.GotErrorPasswordTooShort _) -> do
+          handleAction $ Log $ ErrorLog "Password too short."
+          handleAction $ AddNotif $ BadNotification "Your password is too short."
+        (AuthD.GotErrorMailRequired _) -> do
+          handleAction $ Log $ ErrorLog "Email required."
+          handleAction $ AddNotif $ BadNotification "An email is required."
+        (AuthD.GotErrorInvalidCredentials _) -> do
+          handleAction $ Log $ ErrorLog "Invalid credentials."
+          handleAction $ ToggleAuthenticated Nothing
+          handleAction $ AddNotif $ BadNotification "Invalid credentials."
+        (AuthD.GotErrorRegistrationsClosed _) -> do
+          handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
+          handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
+        (AuthD.GotErrorInvalidLoginFormat _) -> do
+          handleAction $ Log $ ErrorLog "Invalid login format."
+          handleAction $ AddNotif $ BadNotification "Invalid login format."
+        (AuthD.GotErrorInvalidEmailFormat _) -> do
+          handleAction $ Log $ ErrorLog "Invalid email format."
+          handleAction $ AddNotif $ BadNotification "Invalid email format."
+        (AuthD.GotErrorAlreadyUsersInDB _) -> do
+          handleAction $ Log $ ErrorLog "Login already taken."
+          handleAction $ AddNotif $ BadNotification "Login already taken."
+        (AuthD.GotErrorReadOnlyProfileKeys _) -> do
+          handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys."
+          handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys."
+        (AuthD.GotErrorInvalidActivationKey _) -> do
+          handleAction $ Log $ ErrorLog "Invalid activation key."
+          handleAction $ AddNotif $ BadNotification "Invalid activation key."
+        (AuthD.GotErrorUserAlreadyValidated _) -> do
+          handleAction $ Log $ ErrorLog "User already validated."
+          handleAction $ AddNotif $ BadNotification "User already validated."
+        (AuthD.GotErrorCannotContactUser _) -> do
+          handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
+          handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
+        (AuthD.GotErrorInvalidRenewKey _) -> do
+          handleAction $ Log $ ErrorLog "Invalid renew key."
+          handleAction $ AddNotif $ BadNotification "Invalid renew key."
+        (AuthD.GotErrorPasswordTooLong _) -> do
+          handleAction $ Log $ ErrorLog "Password too long."
+          handleAction $ AddNotif $ BadNotification "Password too long."
+        -- The authentication was a success!
+        (AuthD.GotToken msg) -> do
+          handleAction $ Log $ SuccessLog $ "Authenticated to authd."
+          H.modify_ _ { token = Just msg.token
+                      , user_data = Just (Tuple msg.current_email msg.pending_email)
+                      }
+          handleAction $ ToggleAuthenticated (Just msg.token)
+
+          sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+          _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
+
+          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.
+          case msg.current_email of
+            Nothing -> handleAction $ Routing Migration
+            _       -> pure unit
+
+        (AuthD.GotKeepAlive _) -> pure unit
+  pure unit
+  where
+  -- | Send a received authentication daemon message `App.Message.AuthenticationDaemon.AnswerMessage` to a component.
+  -- forward :: AuthD.AnswerMessage
+  forward message = do
     { current_page } <- H.get
     case current_page of
       Authentication -> H.tell _ai unit (PageAuthentication.MessageReceived message)
@@ -849,169 +856,129 @@ 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
+  case receivedMessage of
-    H.modify_ _ { notif = NoNotification }
+    -- Cases where we didn't understand the message.
-
+    Left err -> do
-  Disconnection -> do
+      -- handleAction $ Log $ ErrorLog $
-    handleAction $ Routing Home
+      --   "received a message that couldn't be decoded. Reason: " <> show err
-
+      case err of
-    -- Preserve the state of the connection (authd and dnsmanagerd).
+        (DNSManager.JSONERROR jerr) -> do
-    old_state <- H.get
+          handleAction $ Log $ ErrorLog $ "JSON parsing error: " <> jerr
-    H.put $ initialState unit
+        (DNSManager.UnknownError   unerr) ->
-    H.modify_ _ { are_we_connected_to_authd       = old_state.are_we_connected_to_authd
+          handleAction $ Log $ ErrorLog $ "Parsing error: DNSManager.UnknownError" <> (show unerr)
-                , are_we_connected_to_dnsmanagerd = old_state.are_we_connected_to_dnsmanagerd
+        (DNSManager.UnknownNumber       ) ->
-                }
+          handleAction $ Log $ ErrorLog $ "Parsing error: DNSManager.UnknownNumber"
-
-    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
-        -- handleAction $ Log $ ErrorLog $
-        --   "received a message that couldn't be decoded. Reason: " <> show err
-        case err of
-          (DNSManager.JSONERROR jerr) -> do
-            handleAction $ Log $ ErrorLog $ "JSON parsing error: " <> jerr
-          (DNSManager.UnknownError   unerr) ->
-            handleAction $ Log $ ErrorLog $ "Parsing error: DNSManager.UnknownError" <> (show unerr)
-          (DNSManager.UnknownNumber       ) ->
-            handleAction $ Log $ ErrorLog $ "Parsing error: DNSManager.UnknownNumber"
-
-      -- Cases where we understood the message.
-      Right received_msg -> do
-        case received_msg of
-          (DNSManager.MkDomainNotFound _) -> do
-            handleAction $ Log $ ErrorLog $ "DomainNotFound"
-            handleAction $ AddNotif $ BadNotification $ "The domain doesn't exist."
-          (DNSManager.MkRRNotFound _) -> do
-            handleAction $ Log $ ErrorLog $ "RRNotFound"
-            handleAction $ AddNotif $ BadNotification $ "The resource record doesn't exist."
-          (DNSManager.MkInvalidZone _) -> do
-            handleAction $ Log $ ErrorLog $ "InvalidZone"
-            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
-          (DNSManager.MkUnknownZone _) -> do
-            handleAction $ Log $ ErrorLog $ "UnknownZone"
-            handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
-          (DNSManager.MkDomainList _) -> do
-            handleAction $ Log $ ErrorLog $ "MkDomainList"
-          (DNSManager.MkUnknownUser _) -> do
-            handleAction $ Log $ ErrorLog $ "MkUnknownUser"
-          (DNSManager.MkNoOwnership _) -> do
-            handleAction $ Log $ ErrorLog $ "MkNoOwnership"
-            handleAction $ AddNotif $ BadNotification $ "You don't own this domain."
-          (DNSManager.MkInsufficientRights _) -> do
-            handleAction $ Log $ ErrorLog $ "You do not have sufficient rights."
-            handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
-          -- The authentication failed.
-          (DNSManager.MkError errmsg) -> do
-            handleAction $ Log $ ErrorLog errmsg.reason
-          (DNSManager.MkErrorUserNotLogged _) -> do
-            handleAction $ Log $ ErrorLog $ "The user isn't connected."
-            handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."
-            handleAction AuthenticateToDNSManager
-          (DNSManager.MkErrorInvalidToken _) -> do
-            H.modify_ _ { token = Nothing, current_page = Home }
-            handleAction $ Log $ ErrorLog $ "Invalid token. Try re-authenticate."
-            -- TODO: should we disconnect from authd?
-            handleAction $ ToggleAuthenticated Nothing
-          (DNSManager.MkDomainAlreadyExists _) -> do
-            handleAction $ Log $ ErrorLog $ "The domain already exists."
-            handleAction $ AddNotif $ BadNotification $ "The domain already exists."
-          m@(DNSManager.MkUnacceptableDomain _) -> do
-            handleAction $ Log $ ErrorLog $ "Domain not acceptable (see accepted domain list)."
-            handleAction $ DispatchDNSMessage m
-          m@(DNSManager.MkAcceptedDomains _) -> do
-            handleAction $ Log $ SuccessLog $ "Received the list of accepted domains."
-            handleAction $ DispatchDNSMessage 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
-          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
-          (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
-          m@(DNSManager.MkRRAdded response) -> do
-            handleAction $ Log $ SuccessLog $ "Resource Record added: " <> response.rr.rrtype
-            handleAction $ DispatchDNSMessage m
-          m@(DNSManager.MkGeneratedZoneFile response) -> do
-            handleAction $ Log $ SuccessLog $ "Received zonefile for " <> response.domain
-            handleAction $ DispatchDNSMessage m
-          (DNSManager.MkInvalidDomainName _) -> do
-            handleAction $ Log $ ErrorLog $ "The domain is not valid."
-            handleAction $ AddNotif $ BadNotification $ "Invalid domain name."
-          m@(DNSManager.MkDomainDeleted response) -> do
-            let successlog = "The domain \"" <> response.domain <> "\" has been deleted."
-            handleAction $ Log $ SuccessLog successlog
-            handleAction $ AddNotif $ GoodNotification successlog
-            handleAction $ DispatchDNSMessage m
-          m@(DNSManager.MkRRDeleted response) -> do
-            handleAction $ Log $ SuccessLog $ "Resource record (rrid: \"" <> show response.rrid <> "\") has been deleted."
-            handleAction $ DispatchDNSMessage m
-          m@(DNSManager.MkZone _) -> do
-            handleAction $ Log $ SuccessLog $ "Zone received."
-            handleAction $ DispatchDNSMessage m
-          (DNSManager.MkInvalidRR response) -> do
-            let errorlog = "Invalid resource record: " <> A.intercalate ", " response.errors
-            handleAction $ Log $ ErrorLog errorlog
-            handleAction $ AddNotif $ BadNotification errorlog
-          (DNSManager.MkSuccess _) -> do
-            handleAction $ Log $ SuccessLog $ "(generic) Success."
-          DNSManager.MkOrphanDomainList response -> do
-            handleAction $ Log $ SuccessLog "Received orphan domain list."
-            H.tell _admini unit (PageAdministration.GotOrphanDomainList response.domains)
-          DNSManager.MkFoundDomains response -> do
-            handleAction $ Log $ SuccessLog "Received found domain list."
-            H.tell _admini unit (PageAdministration.GotFoundDomains response.domains)
-          (DNSManager.GotKeepAlive _) -> do
-            -- handleAction $ Log $ SystemLog $ "KeepAlive."
-            pure unit
-    pure unit
-
-  -- | Send a received DNS manager message to a component.
-  -- | TODO: in case the message is a `logged` message, it means that the connection has been reset, and should be
-  -- | handled no matter the actual page we're on.
-  DispatchDNSMessage message -> do
 
+    -- Cases where we understood the message.
+    Right received_msg -> do
+      case received_msg of
+        (DNSManager.MkDomainNotFound _) -> do
+          handleAction $ Log $ ErrorLog $ "DomainNotFound"
+          handleAction $ AddNotif $ BadNotification $ "The domain doesn't exist."
+        (DNSManager.MkRRNotFound _) -> do
+          handleAction $ Log $ ErrorLog $ "RRNotFound"
+          handleAction $ AddNotif $ BadNotification $ "The resource record doesn't exist."
+        (DNSManager.MkInvalidZone _) -> do
+          handleAction $ Log $ ErrorLog $ "InvalidZone"
+          handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
+        m@(DNSManager.MkDomainChanged response) -> do
+          handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated."
+          forward m
+        (DNSManager.MkUnknownZone _) -> do
+          handleAction $ Log $ ErrorLog $ "UnknownZone"
+          handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
+        (DNSManager.MkDomainList _) -> do
+          handleAction $ Log $ ErrorLog $ "MkDomainList"
+        (DNSManager.MkUnknownUser _) -> do
+          handleAction $ Log $ ErrorLog $ "MkUnknownUser"
+        (DNSManager.MkNoOwnership _) -> do
+          handleAction $ Log $ ErrorLog $ "MkNoOwnership"
+          handleAction $ AddNotif $ BadNotification $ "You don't own this domain."
+        (DNSManager.MkInsufficientRights _) -> do
+          handleAction $ Log $ ErrorLog $ "You do not have sufficient rights."
+          handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
+        -- The authentication failed.
+        (DNSManager.MkError errmsg) -> do
+          handleAction $ Log $ ErrorLog errmsg.reason
+        (DNSManager.MkErrorUserNotLogged _) -> do
+          handleAction $ Log $ ErrorLog $ "The user isn't connected."
+          handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."
+          authenticate_to_dnsmanagerd
+        (DNSManager.MkErrorInvalidToken _) -> do
+          H.modify_ _ { token = Nothing, current_page = Home }
+          handleAction $ Log $ ErrorLog $ "Invalid token. Try re-authenticate."
+          -- TODO: should we disconnect from authd?
+          handleAction $ ToggleAuthenticated Nothing
+        (DNSManager.MkDomainAlreadyExists _) -> do
+          handleAction $ Log $ ErrorLog $ "The domain already exists."
+          handleAction $ AddNotif $ BadNotification $ "The domain already exists."
+        m@(DNSManager.MkUnacceptableDomain _) -> do
+          handleAction $ Log $ ErrorLog $ "Domain not acceptable (see accepted domain list)."
+          forward m
+        m@(DNSManager.MkAcceptedDomains _) -> do
+          handleAction $ Log $ SuccessLog $ "Received the list of accepted domains."
+          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."
+          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)."
+          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."
+          forward m
+        m@(DNSManager.MkRRAdded response) -> do
+          handleAction $ Log $ SuccessLog $ "Resource Record added: " <> response.rr.rrtype
+          forward m
+        m@(DNSManager.MkGeneratedZoneFile response) -> do
+          handleAction $ Log $ SuccessLog $ "Received zonefile for " <> response.domain
+          forward m
+        (DNSManager.MkInvalidDomainName _) -> do
+          handleAction $ Log $ ErrorLog $ "The domain is not valid."
+          handleAction $ AddNotif $ BadNotification $ "Invalid domain name."
+        m@(DNSManager.MkDomainDeleted response) -> do
+          let successlog = "The domain \"" <> response.domain <> "\" has been deleted."
+          handleAction $ Log $ SuccessLog successlog
+          handleAction $ AddNotif $ GoodNotification successlog
+          forward m
+        m@(DNSManager.MkRRDeleted response) -> do
+          handleAction $ Log $ SuccessLog $ "Resource record (rrid: \"" <> show response.rrid <> "\") has been deleted."
+          forward m
+        m@(DNSManager.MkZone _) -> do
+          handleAction $ Log $ SuccessLog $ "Zone received."
+          forward m
+        (DNSManager.MkInvalidRR response) -> do
+          let errorlog = "Invalid resource record: " <> A.intercalate ", " response.errors
+          handleAction $ Log $ ErrorLog errorlog
+          handleAction $ AddNotif $ BadNotification errorlog
+        (DNSManager.MkSuccess _) -> do
+          handleAction $ Log $ SuccessLog $ "(generic) Success."
+        DNSManager.MkOrphanDomainList response -> do
+          handleAction $ Log $ SuccessLog "Received orphan domain list."
+          H.tell _admini unit (PageAdministration.GotOrphanDomainList response.domains)
+        DNSManager.MkFoundDomains response -> do
+          handleAction $ Log $ SuccessLog "Received found domain list."
+          H.tell _admini unit (PageAdministration.GotFoundDomains response.domains)
+        (DNSManager.GotKeepAlive _) -> do
+          -- handleAction $ Log $ SystemLog $ "KeepAlive."
+          pure unit
+  pure unit
+  where
+  -- | Send a received dnsmanager daemon message `App.Message.DNSManagerDaemon.AnswerMessage` to a component.
+  forward 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,34 +1011,54 @@ 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
-    -- Get back to the previous page.
+revert_old_page = do
-    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+  -- Get back to the previous page.
-    page <- H.liftEffect $ Storage.getItem "current-page" sessionstorage
+  sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
-    case page of
+  page <- H.liftEffect $ Storage.getItem "current-page" sessionstorage
-      Nothing -> pure unit
+  case page of
-      Just "Home"           -> handleAction $ Routing Home
+    Nothing -> pure unit
-      Just "Authentication" -> handleAction $ Routing Authentication
+    Just "Home"           -> handleAction $ Routing Home
-      Just "Registration"   -> handleAction $ Routing Registration
+    Just "Authentication" -> handleAction $ Routing Authentication
-      Just "DomainList"     -> handleAction $ Routing DomainList
+    Just "Registration"   -> handleAction $ Routing Registration
-      Just "MailValidation" -> handleAction $ Routing MailValidation
+    Just "DomainList"     -> handleAction $ Routing DomainList
-      Just "Setup"          -> handleAction $ Routing Setup
+    Just "MailValidation" -> handleAction $ Routing MailValidation
-      Just "Administration" -> handleAction $ Routing Administration
+    Just "Setup"          -> handleAction $ Routing Setup
-      Just "LegalNotice"    -> handleAction $ Routing LegalNotice
+    Just "Administration" -> handleAction $ Routing Administration
-      Just "Migration"      -> handleAction $ Routing Migration
+    Just "LegalNotice"    -> handleAction $ Routing LegalNotice
-      Just "Zone" -> do
+    Just "Migration"      -> handleAction $ Routing Migration
-        domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
+    Just "Zone" -> do
-        case domain of
+      domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
-          Nothing   -> handleAction $ Log $ SystemLog "Zone but no domain recorded!! WEIRD"
+      case domain of
-          Just zone -> do handleAction $ Log $ SystemLog $ "zone to display: " <> zone
+        Nothing   -> handleAction $ Log $ SystemLog "Zone but no domain recorded!! WEIRD"
-                          handleAction $ Routing (Zone zone)
+        Just zone -> do handleAction $ Log $ SystemLog $ "zone to display: " <> zone
-      Just p  -> handleAction $ Log $ SystemLog $ "Oopsie, we didn't understand the old page: " <> p
+                        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)