dnsmanager-webclient/src/App/Container.purs

-- | `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: TODO
-- | - mail verification: TODO
-- | - 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.
-- |
-- | TODO: application-level heartbeat to avoid disconnections.
-- |
-- | Untested features:
-- | - mail recovery, password change
module App.Container where

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

import Bulma as Bulma

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

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

import App.Log as AppLog
import App.WS as WS

import App.Page.Authentication as AI
import App.Page.Registration   as RI
import App.Page.MailValidation as MVI
import App.Page.Administration as AdminInterface
import App.Page.Setup          as SetupInterface
import App.Page.DomainList     as DomainListInterface
import App.Page.Zone           as ZoneInterface
import App.Page.Home           as HomeInterface
import App.Page.Navigation     as NavigationInterface

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

data Action
  = Initialize

  -- | Handle events from `AuthenticationInterface`.
  | AuthenticationInterfaceEvent  AI.Output

  -- | Handle events from `RegistrationInterface`.
  | RegistrationInterfaceEvent    RI.Output

  -- | Handle events from `MailValidationInterface`.
  | MailValidationInterfaceEvent  MVI.Output

  -- | Handle events from `SetupInterface`.
  | SetupInterfaceEvent           SetupInterface.Output

  -- | Handle events from `NavigationInterface`.
  | NavigationInterfaceEvent  NavigationInterface.Output

  -- | Handle events from `AuthenticationDaemonAdminComponent`.
  | AdministrationEvent           AdminInterface.Output -- Administration interface.

  -- | Handle events from `DomainListComponent`.
  | DomainListComponentEvent      DomainListInterface.Output

  -- | Handle events from `AuthenticationDaemon` (`authd websocket component`).
  | AuthenticationDaemonEvent     WS.Output

  -- | Handle events from `DNSManagerDaemon` (`dnsmanagerd websocket component`).
  | DNSManagerDaemonEvent         WS.Output

  -- | Handle events from `ZoneInterface`.
  | ZoneInterfaceEvent            ZoneInterface.Output

  -- | Disconnect from both `authd` and `dnsmanagerd` (remove sockets),
  -- | then return to the home page.
  | Disconnection

  -- | 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

  -- | `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)

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

  -- | Close the main notification, at the top of the page.
  | CloseNotif

data Notification = NoNotification | GoodNotification String | BadNotification String

-- | The component's state is composed of:
-- | a potential authentication token,
-- | the current page,
-- | the states of both `DomainListInterface` and `AuthenticationDaemonAdmin` modules,
-- | to avoid many useless network exchanges.
type State = { token :: Maybe String
             , current_page :: Page
             , store_DomainListInterface_state :: Maybe DomainListInterface.State
             , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
             , notif :: Notification
             , login :: Maybe String
             }

-- | The list of child components: log, `WS` twice (once for each ws connection),
-- | then all the pages (AuthenticationInterface, RegistrationInterface, MailValidationInterface,
-- | HomeInterface, DomainListInterface, ZoneInterface and AdministrationInterface).
type ChildSlots =
  ( log     :: AppLog.Slot Unit
  , ho      :: HomeInterface.Slot Unit
  , ws_auth :: WS.Slot Unit
  , ws_dns  :: WS.Slot Unit
  , nav     :: NavigationInterface.Slot Unit
  , ai      :: AI.Slot Unit
  , ri      :: RI.Slot Unit
  , mvi     :: MVI.Slot Unit
  , admini  :: AdminInterface.Slot Unit
  , setupi  :: SetupInterface.Slot Unit
  , dli     :: DomainListInterface.Slot Unit
  , zi      :: ZoneInterface.Slot Unit
  )

_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

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
                                     }
    }

-- | Initial state is simple: the user is on the home page, nothing else is stored.
initialState :: forall i. i -> State
initialState _ = { token: Nothing
                 , current_page: Home
                 , store_DomainListInterface_state: Nothing
                 , store_AuthenticationDaemonAdmin_state: Nothing
                 , notif: NoNotification
                 , login: Nothing
                 }

render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
render state
  = HH.div_ $
    [ render_header
    , render_nav
    , render_notifications
    , 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
    -- The footer includes logs and both the WS child components.
    , Bulma.hr
    , Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "Logs (watch this if something fails 😅)", render_logs ]
                     , Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
    ]
  where
    render_notifications =
      case state.notif of
        NoNotification -> HH.div_ []
        GoodNotification v -> Bulma.box [Bulma.notification_success v CloseNotif]
        BadNotification  v -> Bulma.box [Bulma.notification_danger  v CloseNotif]

    render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_home = HH.slot_ _ho unit HomeInterface.component unit
    render_domainlist_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_domainlist_interface = HH.slot _dli unit DomainListInterface.component unit DomainListComponentEvent
    render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_auth_form = HH.slot _ai unit AI.component unit AuthenticationInterfaceEvent
    render_registration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent
    render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_setup = case state.token of
                     Just token -> HH.slot _setupi unit SetupInterface.component token SetupInterfaceEvent
                     Nothing -> Bulma.p "You shouldn't see this page. Please, reconnect."
    render_mail_validation :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent
    render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent
    render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent

    render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent

    render_header :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_header =
      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 2015!"
                    ]
                ]
            ]
        ]

    render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ]

    render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_auth_WS = HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthenticationDaemonEvent

    render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent

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 $ NavigationInterface.TellLogin (Just name)

  Routing page -> do
    -- 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 }

  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 $ NavigationInterface.ToggleLogged false
    Just _  -> H.tell _nav unit $ NavigationInterface.ToggleLogged true

  KeepAlive auth_or_dnsmanager -> case auth_or_dnsmanager of
    Left _ -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkKeepAlive {}
      H.tell _ws_auth unit (WS.ToSend message)
    Right _ -> do
      message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
      H.tell _ws_dns unit (WS.ToSend message)

  AuthenticateToAuthd 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)

  AuthenticateToDNSManager -> 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 }
            handleAction AuthenticateToDNSManager

  NavigationInterfaceEvent ev -> case ev of
    NavigationInterface.Log message -> handleAction $ Log message
    NavigationInterface.Routing page -> handleAction $ Routing page
    NavigationInterface.Disconnection -> handleAction $ Disconnection

  AuthenticationInterfaceEvent ev -> case ev of
    AI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
    AI.AskPasswordRecovery e -> case e of
      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)
    AI.PasswordRecovery login token pass -> do
      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkPasswordRecovery
        { user: login
        , password_renew_key: token
        , new_password: pass }
      H.tell _ws_auth unit (WS.ToSend message)

    AI.AuthenticateToAuthd v  -> handleAction $ AuthenticateToAuthd (Right v)
    AI.Log message            -> handleAction $ Log message
    AI.UserLogin login        -> do
      sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
      _ <- H.liftEffect $ Storage.setItem "user-login" login sessionstorage
      H.modify_ _ { login = Just login }
      H.tell _nav unit $ NavigationInterface.TellLogin (Just login)

  RegistrationInterfaceEvent ev -> case ev of
    RI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
    RI.Log message            -> handleAction $ Log message

  MailValidationInterfaceEvent ev -> case ev of
    MVI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
    MVI.Log message            -> handleAction $ Log message

  SetupInterfaceEvent ev -> case ev of
    SetupInterface.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

    SetupInterface.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)

    SetupInterface.Log message -> handleAction $ Log message

  AdministrationEvent ev -> case ev of
    AdminInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
    AdminInterface.Log message           -> handleAction $ Log message
    AdminInterface.StoreState s          -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
    AdminInterface.AskState              -> do
      state <- H.get
      H.tell _admini unit (AdminInterface.ProvideState state.store_AuthenticationDaemonAdmin_state)
    AdminInterface.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)
    AdminInterface.GetOrphanDomains -> do
      message  <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetOrphanDomains {}
      H.tell _ws_dns unit (WS.ToSend message)

  ZoneInterfaceEvent ev -> case ev of
    ZoneInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
    ZoneInterface.Log message            -> handleAction $ Log message

  DomainListComponentEvent ev -> case ev of
    DomainListInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
    DomainListInterface.Log message            -> handleAction $ Log message
    DomainListInterface.StoreState s           -> H.modify_ _ { store_DomainListInterface_state = Just s }
    DomainListInterface.ChangePageZoneInterface domain -> do
      handleAction $ Routing $ Zone domain

    DomainListInterface.AskState -> do
      state <- H.get
      H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state)

  -- | `authd websocket component` wants to do something.
  AuthenticationDaemonEvent ev -> case ev of
    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message

    WS.WSJustConnected -> 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
          handleAction $ Log $ SystemLog "Let's authenticate to authd"
          handleAction $ AuthenticateToAuthd (Left t)

    WS.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from authd."
    WS.Log message  -> handleAction $ Log message
    WS.KeepAlive    -> handleAction $ KeepAlive $ Left unit

  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 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."
          (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."
          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
              _ -> handleAction $ Log $ ErrorLog
                "received a GotUserDeleted message while not on authd admin page."
          (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, your login is already taken."
          (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 "The server told that 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 "GotErrorAlreadyUsersInDB"
            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!"
          -- The authentication was a success!
          (AuthD.GotToken msg) -> do
            handleAction $ Log $ SuccessLog $ "Authenticated to authd."
            H.modify_ _ { token = Just msg.token }
            handleAction $ ToggleAuthenticated (Just msg.token)

            sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
            _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage

            handleAction AuthenticateToDNSManager
          (AuthD.GotKeepAlive _) -> pure unit
    pure unit

  -- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
  DispatchAuthDaemonMessage message -> do
    { current_page } <- H.get
    case current_page of
      Authentication -> H.tell _ai unit (AI.MessageReceived message)
      Administration -> H.tell _admini unit (AdminInterface.MessageReceived message)
      _              -> handleAction $ Log $ SystemLog "unexpected message from authd"
    pure unit

  AddNotif n -> do
    H.modify_ _ { notif = n }

  CloseNotif -> do
    H.modify_ _ { notif = NoNotification }

  Disconnection -> do
    handleAction $ Routing Home

    H.put $ initialState unit

    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.
  DNSManagerDaemonEvent ev -> case ev of
    WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message
    WS.WSJustConnected -> handleAction AuthenticateToDNSManager
    WS.WSJustClosed    -> handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
    WS.Log message     -> handleAction $ Log message
    WS.KeepAlive       -> handleAction $ KeepAlive $ Right unit

  -- | `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."
          (DNSManager.MkDomainChanged _) -> do
            handleAction $ Log $ ErrorLog $ "DomainChanged"
          (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 $ "reason is: " <> 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 $ NavigationInterface.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 $ "RR (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 (AdminInterface.GotOrphanDomainList 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

    -- 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 (DomainListInterface.MessageReceived message)
      Zone _    , _             -> H.tell _zi  unit (ZoneInterface.MessageReceived message)
      _, _                      -> handleAction $ Log $ SystemLog "unexpected message from dnsmanagerd"
    pure unit
  where
  update_domain_list state m = do
    case state.store_DomainListInterface_state of
      Nothing -> do
        let new_value = DomainListInterface.page_reload (DomainListInterface.initialState unit) m
        H.modify_ _ { store_DomainListInterface_state = Just new_value }
      Just _ -> pure 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 "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


--print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
--print_json_string arraybuffer = do
--  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
--  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
--  H.raise $ Log $ ErrorLog $ case (value) of
--    Left _ -> "Cannot even fromTypedIPC the message."
--    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string