WIP: automatic re-authentication to `dnsmanagerd` on page reload.

spago.dhall

@@ -35,7 +35,9 @@
   , "validation"
   , "web-encoding"
   , "web-events"
+  , "web-html"
   , "web-socket"
+  , "web-storage"
   , "web-uievents"
   ]
 , packages = ./packages.dhall

src/App/AuthenticationForm.purs

@@ -27,8 +27,11 @@ import App.Messages.AuthenticationDaemon as AuthD
 -- | dnsmanager daemon.
 -- |
 -- | Also, the component can send a message to a websocket and log messages.
+-- |
+-- | TODO: authentication is performed in `App.Container`.
 data Output
   = MessageToSend ArrayBuffer
+  | AuthenticateToAuthd (Tuple String String) -- Login Password
   | Log LogMessage
 
 -- | The component's parent provides received messages.
@@ -204,8 +207,7 @@ handleAction = case _ of
         H.raise $ Log $ UnableToSend "Write your password!"
 
       login, pass -> do
-        message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass }
+        H.raise $ AuthenticateToAuthd (Tuple login pass)
-        H.raise $ MessageToSend message
         H.raise $ Log $ SimpleLog $ "[😇] Trying to authenticate (login: " <> login <> ")"
 
   RegisterAttempt ev -> do

src/App/Container.purs

@@ -1,6 +1,7 @@
+-- | `App.Container` is the parent of all other components of the application.
 module App.Container where
 
-import Prelude (Unit, bind, discard, unit, ($), (<>), show, pure)
+import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure)
 
 import Bulma as Bulma
 
@@ -25,55 +26,87 @@ import Type.Proxy (Proxy(..))
 import Effect.Aff.Class (class MonadAff)
 import Data.ArrayBuffer.Types (ArrayBuffer)
 
+import Web.HTML (window) as HTML
+import Web.HTML.Window (sessionStorage) as Window
+import Web.Storage.Storage as Storage
+
 import App.LogMessage (LogMessage(..))
 
+-- | List all pages the application has:
+-- | Home, Login, Domain list, Zone, `authd` administration.
+-- | This list will grows in a near future.
 data Page = Home | LoginRegister | DomainList | Zone String | AuthAdmin
 
+type Token = String
+type Login = String
+type Password = String
+type LogInfo = Tuple Login Password
+
 data Action
+  -- | Handle events from `AuthenticationComponent`.
   = AuthenticationComponentEvent             AF.Output
+
+  -- | Handle events from `AuthenticationDaemonAdminComponent`.
   | AuthenticationDaemonAdminComponentEvent  AAI.Output -- Admin interface for authd.
+
+  -- | Handle events from `DomainListComponent`.
   | DomainListComponentEvent                 DomainListInterface.Output
+
+  -- | Handle events from `AuthenticationDaemon`.
   | AuthenticationDaemonEvent                WS.Output
+
+  -- | Handle events from `DNSManagerDaemon`.
   | DNSManagerDaemonEvent                    WS.Output
+
+  -- | Handle events from `ZoneInterface`.
   | ZoneInterfaceEvent                       ZoneInterface.Output
 
-  -- | Disconnect from both `authd` and `dnsmanagerd` (remove sockets).
+  -- | 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
 
-  -- | DispatchDNSMessage: a DNS message (from `dnsmanagerd`) was received and decoded through the
+  -- | `DecodeDNSMessage`: decode received `dnsmanagerd` messages into `DNSManager.AnswerMessage`,
-  -- | `DNSRawMessageReceived` action.
+  -- | then provide it to `DispatchDNSMessage`.
-  -- | The message is provided to the right component.
+  | 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
 
-  -- | DNSRawMessageReceived is the action when receiving a message, which is decoded in the handler.
+  -- | `DecodeAuthMessage`: decode received `authd` messages into ``, then provide
-  -- | Then, the message will be provided to the `DispatchDNSMessage` action.
+  -- | Then, the message is provided to the `DispatchAuthDaemonMessage` action (when needed).
-  | DNSRawMessageReceived ArrayBuffer
+  | DecodeAuthMessage ArrayBuffer
-
-  -- | AuthDaemonRawMessageReceived is the action when receiving a message, which is decoded in the handler.
-  -- | Then, the message will be provided to the `DispatchAuthDaemonMessage` action.
-  | AuthDaemonRawMessageReceived ArrayBuffer
 
   -- | DispatchAuthDaemonMessage: an auth daemon message (from `authd`) was received and decoded through the
-  -- | `AuthDaemonRawMessageReceived` action.
+  -- | `DecodeAuthMessage` action.
   -- | The message is provided to the right component.
-  -- | DispatchAuthDaemonMessage AuthD.AnswerMessage
+  | DispatchAuthDaemonMessage AuthD.AnswerMessage
 
   -- | Log message (through the Log component).
   | Log LogMessage
 
+-- | 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
-             , uid :: Maybe Int
              , current_page :: Page
              , store_DomainListInterface_state :: Maybe DomainListInterface.State
              , store_AuthenticationDaemonAdmin_state :: Maybe AAI.State
              }
 
+-- | The list of child components: log, `WS` twice (once for each ws connection),
+-- | then all the pages (AuthenticationForm, HomeInterface, DomainListInterface, ZoneInterface and
+-- | AuthenticationDaemonAdminInterface).
 type ChildSlots =
   ( log     :: AppLog.Slot Unit
   , ho      :: HomeInterface.Slot Unit
@@ -85,14 +118,14 @@ type ChildSlots =
   , zi      :: ZoneInterface.Slot Unit
   )
 
-_ho      = Proxy :: Proxy "ho"
+_ho      = Proxy :: Proxy "ho"       -- Home Interface
-_log     = Proxy :: Proxy "log"
+_log     = Proxy :: Proxy "log"      -- Log
-_ws_auth = Proxy :: Proxy "ws_auth"
+_ws_auth = Proxy :: Proxy "ws_auth"  -- WS with `authd`
-_ws_dns  = Proxy :: Proxy "ws_dns"
+_ws_dns  = Proxy :: Proxy "ws_dns"   -- WS with `dnsmanagerd`
-_af      = Proxy :: Proxy "af"
+_af      = Proxy :: Proxy "af"       -- Authentication Form
-_aai     = Proxy :: Proxy "aai"
+_aai     = Proxy :: Proxy "aai"      -- Authd Administration Interface
-_dli     = Proxy :: Proxy "dli"
+_dli     = Proxy :: Proxy "dli"      -- Domain List
-_zi      = Proxy :: Proxy "zi"
+_zi      = Proxy :: Proxy "zi"       -- Zone Interface
 
 component :: forall q i o m. MonadAff m => H.Component q i o m
 component =
@@ -102,9 +135,9 @@ component =
     , eval: H.mkEval $ H.defaultEval { 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
-                 , uid: Nothing
                  , current_page: Home
                  , store_DomainListInterface_state: Nothing
                  , store_AuthenticationDaemonAdmin_state: Nothing
@@ -121,7 +154,9 @@ render state
         DomainList    -> render_newdomain_interface
         Zone domain   -> render_zone domain
         AuthAdmin     -> render_authd_admin_interface
-    , Bulma.columns_ [ Bulma.column_ [ render_logs ], Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
+    -- The footer includes logs and both the WS child components.
+    , Bulma.columns_ [ Bulma.column_ [ render_logs ]
+                     , Bulma.column_ [ render_auth_WS, render_dnsmanager_WS ] ]
     ]
   where
 
@@ -151,9 +186,7 @@ render state
     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 = case state.token of
+    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent
-      Nothing -> render_nothing
-      Just _ ->  HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent
 
     render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_auth_form = case state.token of
@@ -190,11 +223,19 @@ handleAction = case _ of
         message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token }
         H.tell _ws_dns unit (WS.ToSend message)
       Nothing -> do
-        H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
+        sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+        token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
+        case token of
+          Nothing -> handleAction $ Log $ SimpleLog "no token!"
+          Just t -> do
+            H.modify_ _ { token = Just t }
+            handleAction $ Log $ SimpleLog $ "Let's start again to auth to dnsmanagerd with this token: " <> t
+            handleAction AuthenticateToDNSManager
 
   AuthenticationComponentEvent ev -> case ev of
-    AF.MessageToSend message         -> H.tell _ws_auth unit (WS.ToSend message)
+    AF.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
-    AF.Log message                   -> H.tell _log unit (AppLog.Log message)
+    AF.AuthenticateToAuthd v  -> handleAction $ AuthenticateToAuthd (Right v)
+    AF.Log message            -> H.tell _log unit (AppLog.Log message)
 
   AuthenticationDaemonAdminComponentEvent ev -> case ev of
     AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
@@ -222,16 +263,18 @@ handleAction = case _ of
   -- TODO: depending on the current page, we should provide the received message to different components.
   AuthenticationDaemonEvent ev -> case ev of
     WS.MessageReceived (Tuple _ message) -> do
-      handleAction $ AuthDaemonRawMessageReceived message
+      handleAction $ DecodeAuthMessage message
+
     WS.WSJustConnected -> do
       H.tell _af unit AF.ConnectionIsUp
       H.tell _aai unit AAI.ConnectionIsUp
+
     WS.WSJustClosed -> do
       H.tell _af unit AF.ConnectionIsDown
       H.tell _aai unit AAI.ConnectionIsDown
     WS.Log message -> H.tell _log unit (AppLog.Log message)
 
-  AuthDaemonRawMessageReceived message -> do
+  DecodeAuthMessage message -> do
     receivedMessage <- H.liftEffect $ AuthD.deserialize message
     case receivedMessage of
       -- Cases where we didn't understand the message.
@@ -242,7 +285,8 @@ handleAction = case _ of
             -- print_json_string messageEvent.message
             handleAction $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
           (AuthD.UnknownError unerr) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownError" <> (show unerr))
-          (AuthD.UnknownNumber       ) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownNumber")
+          (AuthD.UnknownNumber     ) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownNumber")
+
       -- Cases where we understood the message.
       Right response -> do
         case response of
@@ -305,12 +349,28 @@ handleAction = case _ of
           -- The authentication was a success!
           (AuthD.GotToken msg) -> do
             handleAction $ Log $ SimpleLog $ "[🎉] Authenticated to authd!"
-            H.modify_ _ { uid = Just msg.uid, token = Just msg.token, current_page = DomainList }
+            H.modify_ _ { token = Just msg.token, current_page = DomainList }
+
+            sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+            _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
+
             handleAction AuthenticateToDNSManager
     pure unit
 
-  -- Send a received authentication daemon message to a component.
+  AuthenticateToAuthd v -> case v of
-  -- DispatchAuthDaemonMessage message -> do
+    Left token -> do
+      -- TODO: currently, there is no message to send to `authd` to authenticate a user only with a token.
+      handleAction $ Log $ SimpleLog $ "Trying to login with token: " <> token
+    Right (Tuple login password) -> do
+      message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login, password }
+      H.tell _ws_auth unit (WS.ToSend message)
+
+
+  -- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
+  -- | TODO: **CURRENTLY** this dispatch function is useless since no component require `authd` messages directly.
+  DispatchAuthDaemonMessage _ -> do
+    handleAction $ Log $ SimpleLog "[😈] DispatchAuthDaemonMessage action, called for no reason!"
+    pure unit
   --   { token } <- H.get
   --   case token of
   --     Nothing -> H.tell _af  unit (AF.MessageReceived message)
@@ -323,12 +383,14 @@ handleAction = case _ of
 
   Disconnection -> do
     H.put $ initialState unit
+    sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
+    _ <- H.liftEffect $ Storage.removeItem "user-authd-token" sessionstorage
     handleAction $ Routing Home
 
   -- TODO: depending on the current page, we should provide the received message to different components.
   DNSManagerDaemonEvent ev -> case ev of
     WS.MessageReceived (Tuple _ message) -> do
-      handleAction $ DNSRawMessageReceived message
+      handleAction $ DecodeDNSMessage message
     WS.WSJustConnected -> do
       handleAction $ Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate"
       handleAction AuthenticateToDNSManager
@@ -336,7 +398,8 @@ handleAction = case _ of
     WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
     WS.Log message -> H.tell _log unit (AppLog.Log message)
 
-  DNSRawMessageReceived message -> do
+  -- | `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.
@@ -420,7 +483,9 @@ handleAction = case _ of
             handleAction $ Log $ SimpleLog $ "[🎉] Success!"
     pure unit
 
-  -- Send a received DNS manager message to a component.
+  -- | 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
     { current_page } <- H.get
     case current_page of