-- | `App.Container` is the parent of all other components of the application.
-- |
-- | Each page has its own module and the `App.Container` informs them when the websocket is up or down.
-- | A module implements Websocket operations and is used twice, once for the connection to `authd`,
-- | another for the connection to `dnsmanagerd`.
-- |
-- | `App.Container` stores the state of different components (domain list and zone interface)
-- | to avoid useless requests to `dnsmanagerd`.
-- |
-- | `App.Container` detects when a page has been reloaded and:
-- | 1. authenticate the user to `dnsmanagerd` via a stored token in session storage.
-- | The authentication to `dnsmanagerd` automatically provides own domains and accepted domains (such as `netlib.re`).
-- | This is enough data for the `DomainList` page.
-- | 2. go back to that page.
-- | In case the old page is `Zone`, send a request to `dnsmanagerd` to get the zone content again.
-- |
-- | Once a message is received, it is transfered to the module of the current page;
-- | except for the `App.Message.DNSManagerDaemon.AnswerMessage` `Logged` which is an hint when the
-- | page has been reloaded, thus having a special treatment.
-- |
-- | TODO:
-- | Each received message is transfered to the current page module because there is no centralized state.
-- | This may be a good idea to store the state of the entire application at the same place, avoiding to
-- | handle messages in the different pages.
-- | Pages could handle semantic operations directly instead.
-- |
-- | Tested features:
-- | - registration, mail validation, login, disconnection
-- | - domain registration
-- | - zone display, RR creation, update and removal
-- |
-- | Validation:
-- | - registration page: login, password, mail
-- | - login and password recovery page
-- | - mail verification
-- | - domain list: domain (`label`) is insufficient.
-- |
-- | TODO: when reading a RR `name`, always make it an FQDN by adding `<user-domain>.netlib.re.`.
-- |
-- | TODO: remove the FQDN when showing RR names.
-- |
-- | Untested features:
-- | - mail recovery
module App.Container where

import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&&), (>), (<<<))

import Web as Web

import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..))
import Data.Foldable (for_)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff)
import Effect (Effect)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Type.Proxy (Proxy(..))
import Web.HTML (HTMLElement)

import App.Message.DNSManagerDaemon as DNSManager
import App.Message.AuthenticationDaemon as AuthD

import App.Log as AppLog
import App.WS as WS
import App.Notification as Notification
import App.Type.Notification (Notification (..))

import Scroll (scrollToTop)

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

import Web.HTML (window) as HTML
import Web.HTML.Window (sessionStorage) as Window
import Web.Storage.Storage as Storage

import App.Type.Email as Email

import App.Type.LogMessage (LogMessage(..))

import App.Type.Pages
import CSSClasses as C

type Token = String
type Login = String
type Password = String
type LogInfo = Tuple Login Password

newtype RawHTML = RawHTML String

-- | Since Halogen doesn't have a function to put raw HTML into a page, we have to improvise.
-- | This foreign function adds raw HTML into a page, given a parent node reference.
foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit

-- | A keepalive message is sent every 30 seconds to keep the connection open.
-- | `max_keepalive` represents the maximum number of keepalive messages
-- | before closing the connections due to inactivity.
-- | Current limit is 30 minutes (`max_keepalive` = 60, 60 * 30 seconds = 30 minutes).
max_keepalive = 60 :: Int

wsURLauthd       = "wss://www.netlib.re/ws/authd"       :: String
wsURLdnsmanagerd = "wss://www.netlib.re/ws/dnsmanagerd" :: String

data PageEvent
  = 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

  | EventPageNotification         Notification.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

  -- | Reconnection to both `authd` and `dnsmanagerd`.
  | Reconnection

  -- | Change the displayed page.
  | Routing Page

  -- | Log message (through the Log component).
  | Log LogMessage

  -- | `KeepAlive` send a keepalive message to either `authd` or `dnsmanagerd`.
  | KeepAlive (Either Unit Unit)

  -- | `ToggleAuthenticated` performs some actions required when a connection or a disconnection occurs.
  -- | Currently, this handles the navigation bar.
  | ToggleAuthenticated (Maybe Token)

  -- | In order to keep the websocket overhead to a minimum, unused connections are
  -- | closed automatically by the client. In practice, this is handled by a simple counter
  -- | incremented each time a KeepAlive message is sent.
  | ResetKeepAliveCounter

  -- | Add a main notification, at the top of the page.
  | AddNotif Notification

-- | The component's state is composed of:
-- | a potential authentication token,
-- | the current page,
-- | 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
             , childstates :: ChildStates
             , login :: Maybe String
             , keepalive_counter :: Int
             , are_we_connected_to_authd :: Boolean
             , are_we_connected_to_dnsmanagerd :: Boolean
             }

-- | The list of child components: log, `WS` twice (once for each ws connection),
-- | then all the pages (AuthenticationInterface, RegistrationInterface, MailValidationInterface,
-- | PageHome, PageDomainList, PageZone and AdministrationInterface).
type ChildSlots =
  ( log     :: AppLog.Slot Unit
  , ho      :: PageHome.Slot Unit
  , ws_auth :: WS.Slot Unit
  , ws_dns  :: WS.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

  , notificationinterface :: Notification.Slot Unit
  )

_ho      = Proxy :: Proxy "ho"       -- Home Interface
_log     = Proxy :: Proxy "log"      -- Log
_ws_auth = Proxy :: Proxy "ws_auth"  -- WS with `authd`
_ws_dns  = Proxy :: Proxy "ws_dns"   -- WS with `dnsmanagerd`
_nav     = Proxy :: Proxy "nav"      -- Navigation Interface
_ai      = Proxy :: Proxy "ai"       -- Authentication Interface
_ri      = Proxy :: Proxy "ri"       -- Registration Interface
_mvi     = Proxy :: Proxy "mvi"      -- Mail Validation Interface
_admini  = Proxy :: Proxy "admini"   -- Administration Interface
_setupi  = Proxy :: Proxy "setupi"   -- Setup Interface
_dli     = Proxy :: Proxy "dli"      -- Domain List
_zi      = Proxy :: Proxy "zi"       -- Zone Interface
_mi      = Proxy :: Proxy "mi"       -- Migration Interface
_notificationinterface = Proxy :: Proxy "notificationinterface" -- Setup Interface

component :: forall q i o m. MonadAff m => H.Component q i o m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval { initialize = Just Initialize
                                     , handleAction = handleAction
                                     }
    }

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
                 , childstates:
                   { domainlist: Nothing
                   , administration: Nothing
                   }
                 , login: Nothing
                 , keepalive_counter: 0
                 , are_we_connected_to_authd: false
                 , are_we_connected_to_dnsmanagerd: false
                 }

render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
render state
  = HH.div_ $
    [ website_hero
    , render_nav
    , reconnection_bar
    , render_notifications
    , migration_warning_on_email_address
    , case state.current_page of
        Home           -> render_home
        Authentication -> render_auth_form
        Registration   -> render_registration
        MailValidation -> render_mail_validation
        DomainList     -> render_domainlist_interface
        Zone domain    -> render_zone domain
        Setup          -> render_setup
        Administration -> render_authd_admin_interface
        Migration      -> render_migration
        LegalNotice    -> render_legal_notice
    -- The footer includes logs and both the WS child components.
    , Web.hr
    , Web.columns_ [ Web.column_ [ Web.h3 "Logs (watch this if something fails 😅)", render_logs ]
                   , Web.column_ [ Web.level
                     [ render_auth_WS
                     , render_dnsmanager_WS
                     , legal_notice_btn
                     , paypal_btn
                     ] [] ]
                   ]
    ]
  where
    website_hero :: forall w i. HH.HTML w i
    website_hero =
        HH.section [ HP.classes [C.hero, C.is_info, C.is_small] ]
          [ HH.div [ HP.classes [C.hero_body] ]
              [ HH.div [ HP.classes [C.container, C.has_text_centered] ]
                  [ HH.p [ HP.classes [C.subtitle] ]
                      [ HH.strong_ [ HH.u_ [ HH.text "net libre" ]]
                      , HH.text ": providing free domains since 2013!"
                      ]
                  ]
              ]
          ]

    paypal_btn :: forall w i. HH.HTML w i
    paypal_btn = HH.div [ HP.ref ref_paypal_div ] []

    migration_warning_on_email_address :: forall w. HH.HTML w Action
    migration_warning_on_email_address =
      case state.user_data of
        Just (Tuple Nothing _) ->
          Web.big_website_warning
            [ Web.p """
               ⚠️​  MIGRATION (FR): veuillez indiquer une adresse email pour votre compte.
               Tout compte sans adresse email sera supprimé sous 6 mois.
              """
            , Web.p """
               ⚠️​  MIGRATION (EN): please associate an email address to your account.
               Accounts without a validated email address will be discarded within 6 months.
              """
            ]
        _ -> HH.text ""

    legal_notice_btn = Web.btn_ [] "Legal notice" (Routing LegalNotice)
    reconnection_bar :: forall w. HH.HTML w Action
    reconnection_bar =
      if (state.are_we_connected_to_authd && state.are_we_connected_to_dnsmanagerd)
      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") (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") (EventOnNetwork <<< EventWSDNSmanagerd)

    notification_duration = 3000 :: Int -- in ms
    render_notifications = HH.slot _notificationinterface unit Notification.component notification_duration (EventOnPage <<< EventPageNotification)

    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 (EventOnPage <<< EventPageDomainList)
    render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    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 (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 (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 (EventOnPage <<< EventPageMailValidation)
    render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
    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 (EventOnPage <<< EventPageAdministration)

    render_migration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    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
      = Web.section_small [ Explanations.legal_notice
                          , Web.btn_ [C.is_large, C.margin_top 3, C.is_info] "Home page" (Routing Home)
                          ]

    render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    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 ]

ref_paypal_div :: H.RefLabel
ref_paypal_div = H.RefLabel "paypal-div"

handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
handleAction = case _ of
  Initialize -> do
    handleAction $ Log $ SystemLog "Hello, welcome to this application. 🥳"
    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
    token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
    case token of
      Nothing -> revert_old_page
      Just _ -> pure unit -- Authentication will happen when web sockets are up!

    login_name <- H.liftEffect $ Storage.getItem "user-login" sessionstorage
    case login_name of
      Nothing -> pure unit
      Just name -> do H.modify_ _ { login = 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")
    -- then it replaces the inner HTML by the provided code.
    parentElem <- H.getHTMLElementRef ref_paypal_div
    for_ parentElem \el -> do
      H.liftEffect $ unsafeSetInnerHTML el (RawHTML """
        <form action="https://www.paypal.com/donate" method="post" target="_blank">
          <input type="hidden" name="business" value="YBYNZTGHQK5VA" />
          <input type="hidden" name="no_recurring" value="0" />
          <input type="hidden" name="currency_code" value="EUR" />
          <input type="image" src="/paypal.gif" border="0" name="submit"
            title="PayPal - The safer, easier way to pay online!" alt="Donate with PayPal button" />
        </form>
        """)
          -- The following line was replaced, the image is now hosted on our server, don't let Paypal track our users.
          -- <input type="image" src="https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif" border="0" name="submit" title="PayPal - The safer, easier way to pay online!" alt="Donate with PayPal button" />
        -- Last line was removed since it's just a way for Paypal to track users for stats. We don't need that.
        -- <img alt="" border="0" src="https://www.paypal.com/en_FR/i/scr/pixel.gif" width="1" height="1" />

  Routing page -> do
    -- Each time the user change load a new page, the counter gets reset
    -- since it proves they are still active.
    H.modify_ _ { keepalive_counter = 0 }
    H.liftEffect scrollToTop
    -- Store the current page we are on and restore it when we reload.
    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
    H.liftEffect $ Storage.setItem "current-page" (case page of
      Zone _ -> "Zone"
      _      -> show page) sessionstorage

    _ <- case page of
      Zone zone  -> H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
      _          -> pure unit

    H.modify_ _ { current_page = page }

    -- Finally, when changing page, the notification should be discarded.
    handleAction $ AddNotif NoNotification

  Log message -> do
    _ <- case message of
           UnableToSend err -> handleAction $ AddNotif $ BadNotification err
           ErrorLog     err -> handleAction $ AddNotif $ BadNotification err
           _ -> pure unit
    H.tell _log unit $ AppLog.Log message

  ToggleAuthenticated maybe_token -> case maybe_token of
    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
    Left _ -> do
      state <- H.get
      if state.are_we_connected_to_authd
      then if (state.keepalive_counter + 1) > max_keepalive
           then do handleAction $ Log $ SystemLog "Closing the websockets due to inactivity."
                   H.tell _ws_auth unit (WS.CloseConnection)
                   H.tell _ws_dns  unit (WS.CloseConnection)
                   H.modify_ _ { are_we_connected_to_authd = false
                               , are_we_connected_to_dnsmanagerd = false
                               --, are_we_closed_due_to_inactiviy = true
                               }
           else do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkKeepAlive {}
                   H.tell _ws_auth unit (WS.ToSendKeepAlive message)
                   H.modify_ _ { keepalive_counter = state.keepalive_counter + 1 }
      else do -- handleAction $ Log $ SystemLog "KeepAlive message from WS while connection was closed."
              pure unit

    Right _ -> do
      state <- H.get
      if state.are_we_connected_to_dnsmanagerd
      then do
        message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
        H.tell _ws_dns unit (WS.ToSendKeepAlive message)
      else do -- handleAction $ Log $ SystemLog "KeepAlive message from WS while connection was closed."
              pure unit

  EventOnPage page_event -> act_on_page_event page_event
  EventOnNetwork network_event -> act_on_network_event network_event

  AddNotif n -> H.tell _notificationinterface unit (Notification.Set n)

  Reconnection -> do
    H.tell _ws_auth unit WS.Connect
    H.tell _ws_dns  unit WS.Connect
    handleAction $ AddNotif 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
    PageNavigation.Disconnection -> handleAction $ Disconnection

  EventPageAuthentication ev -> case ev of
    PageAuthentication.AskPasswordRecovery e -> case e of
      Left  email -> do
        message <- H.liftEffect $ AuthD.serialize $
          AuthD.MkAskPasswordRecovery { login: Nothing, email: Just (Email.Email email) }
        H.tell _ws_auth unit (WS.ToSend message)
      Right login -> do
        message <- H.liftEffect $ AuthD.serialize $
          AuthD.MkAskPasswordRecovery { login: (Just login), email: Nothing }
        H.tell _ws_auth unit (WS.ToSend message)
    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)

    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
      _ <- H.liftEffect $ Storage.setItem "user-login" login sessionstorage
      H.modify_ _ { login = Just login }
      H.tell _nav unit $ PageNavigation.TellLogin (Just login)

  EventPageRegistration ev -> case ev of
    PageRegistration.AskRegister login email password -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkRegister { login, email, password }
      H.tell _ws_auth unit (WS.ToSend message)
    PageRegistration.Log message -> handleAction $ Log message

  EventPageMailValidation ev -> case ev of
    PageMailValidation.AskValidateUser user activation_key -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkValidateUser { user, activation_key }
      H.tell _ws_auth unit (WS.ToSend message)
    PageMailValidation.Log message            -> handleAction $ Log message

  EventPageSetup ev -> case ev of
    PageSetup.DeleteUserAccount -> do
      handleAction $ Log $ SystemLog "Self termination. 😿"

      {- no user id, it's self termination -}
      dns_message  <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteUser { user_id: Nothing }
      auth_message <- H.liftEffect $ AuthD.serialize      $ AuthD.MkDeleteUser      { user:    Nothing }
      H.tell _ws_dns unit (WS.ToSend dns_message)
      H.tell _ws_auth unit (WS.ToSend auth_message)

      -- Once the user has been deleted, just act like it was just a disconnection.
      handleAction $ Disconnection

    PageSetup.ChangeEmailAddress -> handleAction $ Routing Migration
    PageSetup.ChangePassword pass  -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkModUser { user:       Nothing
                                                                  , admin:      Nothing
                                                                  , password:   Just pass
                                                                  , email:      Nothing
                                                                  }
      H.tell _ws_auth unit (WS.ToSend message)
    PageSetup.Log message -> handleAction $ Log message

  EventPageAdministration ev     -> case ev of
    PageAdministration.DeleteDomain domain      -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
      H.tell _ws_dns  unit (WS.ToSend message)
    PageAdministration.SearchDomain domain      -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkSearchDomain { domain, offset: Just 0 }
      H.tell _ws_dns  unit (WS.ToSend message)
    PageAdministration.ShowZone domain          -> handleAction $ Routing $ Zone domain
    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 (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. -}
      dns_message  <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteUser { user_id: Just uid }
      auth_message <- H.liftEffect $ AuthD.serialize      $ AuthD.MkDeleteUser      { user:    Just uid }
      H.tell _ws_dns unit (WS.ToSend dns_message)
      H.tell _ws_auth unit (WS.ToSend auth_message)
    PageAdministration.AddUser login admin email password -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkAddUser { login, admin, email, password }
      H.tell _ws_auth unit (WS.ToSend message)
    PageAdministration.SearchUser regex offset -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkSearchUser { regex, offset }
      H.tell _ws_auth unit (WS.ToSend message)
    PageAdministration.GetOrphanDomains -> do
      message  <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {}
      H.tell _ws_dns unit (WS.ToSend message)

  EventPageZone ev -> case ev of
    PageZone.Log message            -> handleAction $ Log message
    PageZone.ToDomainList           -> handleAction $ Routing DomainList
    PageZone.AskZoneFile domain     -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskGeneratedZoneFile { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageZone.AskNewToken domain rrid -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkNewToken { domain, rrid }
      H.tell _ws_dns unit (WS.ToSend message)
    PageZone.AskDeleteRR domain rrid -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteRR { domain, rrid }
      H.tell _ws_dns unit (WS.ToSend message)
    PageZone.AskSaveRR domain rr -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkUpdateRR { domain, rr }
      H.tell _ws_dns unit (WS.ToSend message)
    PageZone.AskAddRR domain rr -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain, rr }
      H.tell _ws_dns unit (WS.ToSend message)
    PageZone.AskGetZone domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain }
      H.tell _ws_dns unit (WS.ToSend message)

  EventPageDomainList ev -> case ev of
    PageDomainList.AskShareToken domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageDomainList.AskTransferToken domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageDomainList.AskUnShareDomain domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageDomainList.AskDeleteDomain domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageDomainList.AskNewDomain domain -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkNewDomain { domain }
      H.tell _ws_dns unit (WS.ToSend message)
    PageDomainList.AskGainOwnership uuid -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGainOwnership { uuid }
      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

    PageDomainList.AskState -> do
      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

  EventPageNotification _ -> handleAction $ Log $ SystemLog "Weird, just received a notification from the notification component."

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) -> 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)
      Administration -> H.tell _admini unit (PageAdministration.MessageReceived message)
      _              -> handleAction $ Log $ SystemLog "unexpected message from authd"
    pure unit

-- | Decode received `dnsmanagerd` messages into `DNSManager.AnswerMessage`.
-- | Messages can be forwarded to components.
decode_message_from_dnsmanagerd :: forall o monad. MonadAff monad => ArrayBuffer -> H.HalogenM State Action ChildSlots o monad Unit
decode_message_from_dnsmanagerd arraybuffer = do
  receivedMessage <- H.liftEffect $ DNSManager.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
        (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."
          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.
    -- Second, depending on the page, actions have to be undertaken.
    -- For `DomainList`, send a request to `dnsmanagerd` for the list of own domains and acceptable domains.
    -- For `Zone`, send a request to `dnsmanagerd` for the zone content.
    state <- H.get
    case state.current_page, message of
      -- Home + Logged = page just reloaded.
      Home, m@(DNSManager.MkLogged _) -> do
        update_domain_list state m
        revert_old_page
      Authentication, m@(DNSManager.MkLogged _) -> do
        update_domain_list state m
        -- handleAction $ Log $ SystemLog "go to domain list."
        handleAction $ Routing DomainList
      -- Logged = page just reloaded, but page already changed, no need to do that again.
      _, m@(DNSManager.MkLogged _) -> do
        -- handleAction $ Log $ SystemLog "logged to dnsmanagerd, do not change page"
        update_domain_list state m
      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

  update_domain_list state m = do
    case state.childstates.domainlist of
      Nothing -> do
        let new_value = PageDomainList.page_reload (PageDomainList.initialState unit) m
        H.modify_ _ { childstates { domainlist = Just new_value } }
      Just _ -> pure unit

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
  case page of
    Nothing -> pure unit
    Just "Home"           -> handleAction $ Routing Home
    Just "Authentication" -> handleAction $ Routing Authentication
    Just "Registration"   -> handleAction $ Routing Registration
    Just "DomainList"     -> handleAction $ Routing DomainList
    Just "MailValidation" -> handleAction $ Routing MailValidation
    Just "Setup"          -> handleAction $ Routing Setup
    Just "Administration" -> handleAction $ Routing Administration
    Just "LegalNotice"    -> handleAction $ Routing LegalNotice
    Just "Migration"      -> handleAction $ Routing Migration
    Just "Zone" -> do
      domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage
      case domain of
        Nothing   -> handleAction $ Log $ SystemLog "Zone but no domain recorded!! WEIRD"
        Just zone -> do handleAction $ Log $ SystemLog $ "zone to display: " <> zone
                        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

authenticate_to_authd :: forall o monad.
  MonadAff monad => (Either Token LogInfo) -> H.HalogenM State Action ChildSlots o monad Unit
authenticate_to_authd v = case v of
  Left token -> do
    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)