WIP: big button for reconnection + automatic disconnection.

src/App/Container.purs

@@ -45,7 +45,7 @@
 -- | - mail recovery, password change
 module App.Container where
 
-import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure)
+import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure, (+), (&&))
 
 import Bulma as Bulma
 
@@ -170,6 +170,11 @@ data Action
   -- | Close the main notification, at the top of the page.
   | CloseNotif
 
+  -- | 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
+
 data Notification = NoNotification | GoodNotification String | BadNotification String
 
 -- | The component's state is composed of:
@@ -184,6 +189,9 @@ type State = { token :: Maybe String
              , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
              , notif :: Notification
              , 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),
@@ -236,6 +244,9 @@ initialState _ = { token: Nothing
                  , store_AuthenticationDaemonAdmin_state: Nothing
                  , notif: NoNotification
                  , 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
@@ -243,6 +254,7 @@ render state
   = HH.div_ $
     [ render_header
     , render_nav
+    , reconnection_bar
     , render_notifications
     , case state.current_page of
         Home           -> render_home
@@ -256,9 +268,20 @@ render state
     -- 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 ] ]
+                     , Bulma.column_ [ Bulma.level [ render_auth_WS, render_dnsmanager_WS ] [] ] ]
     ]
   where
+    reconnection_bar :: forall w i. HH.HTML w i
+    reconnection_bar =
+      if (state.are_we_connected_to_authd && state.are_we_connected_to_dnsmanagerd)
+      then Bulma.p "yay, you're connected"
+      else Bulma.p "OH NOES :("
+    render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_auth_WS = HH.slot _ws_auth unit WS.component (Tuple "ws://127.0.0.1:8080" "authd") AuthenticationDaemonEvent
+
+    render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple "ws://127.0.0.1:8081" "dnsmanagerd") DNSManagerDaemonEvent
+
     render_notifications =
       case state.notif of
         NoNotification -> HH.div_ []
@@ -303,12 +326,6 @@ render state
     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
@@ -349,13 +366,16 @@ handleAction = case _ of
     Nothing -> H.tell _nav unit $ NavigationInterface.ToggleLogged false
     Just _  -> H.tell _nav unit $ NavigationInterface.ToggleLogged true
 
+  ResetKeepAliveCounter -> H.modify_ _ { keepalive_counter = 0 }
   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)
+      H.tell _ws_auth unit (WS.ToSendKeepAlive message)
+      H.modify_ \state -> state { keepalive_counter = state.keepalive_counter + 1 }
+
     Right _ -> do
       message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
-      H.tell _ws_dns unit (WS.ToSend message)
+      H.tell _ws_dns unit (WS.ToSendKeepAlive message)
 
   AuthenticateToAuthd v -> case v of
     Left token -> do
@@ -490,6 +510,7 @@ handleAction = case _ of
     WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message
 
     WS.WSJustConnected -> do
+      H.modify_ _ { are_we_connected_to_authd = true }
       sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
       token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
       case token of
@@ -498,10 +519,14 @@ handleAction = case _ of
           handleAction $ Log $ SystemLog "Let's authenticate to authd"
           handleAction $ AuthenticateToAuthd (Left t)
 
-    WS.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from authd."
+    WS.WSJustClosed -> do
+      H.modify_ _ { are_we_connected_to_dnsmanagerd = false }
+      handleAction $ Log $ ErrorLog "You just got disconnected from authd."
     WS.Log message  -> handleAction $ Log message
     WS.KeepAlive    -> handleAction $ KeepAlive $ Left unit
 
+    WS.ResetKeepAliveCounter -> handleAction ResetKeepAliveCounter
+
   DecodeAuthMessage message -> do
     receivedMessage <- H.liftEffect $ AuthD.deserialize message
     case receivedMessage of
@@ -671,11 +696,17 @@ handleAction = case _ of
   -- | `dnsmanagerd websocket component` wants to do something.
   DNSManagerDaemonEvent ev -> case ev of
     WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message
-    WS.WSJustConnected -> handleAction AuthenticateToDNSManager
+    WS.WSJustConnected -> do
-    WS.WSJustClosed    -> handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
+      H.modify_ _ { are_we_connected_to_dnsmanagerd = true }
+      handleAction AuthenticateToDNSManager
+    WS.WSJustClosed    -> do
+      H.modify_ _ { are_we_connected_to_dnsmanagerd = false }
+      handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
     WS.Log message     -> handleAction $ Log message
     WS.KeepAlive       -> handleAction $ KeepAlive $ Right unit
 
+    WS.ResetKeepAliveCounter -> handleAction ResetKeepAliveCounter
+
   -- | `DecodeDNSMessage`: decode a received `dnsmanagerd` message, then transfer it to `DispatchDNSMessage`.
   DecodeDNSMessage message -> do
     receivedMessage <- H.liftEffect $ DNSManager.deserialize message

src/App/WS.purs

@@ -34,23 +34,36 @@ import Web.Socket.WebSocket as WS
 
 import App.Type.LogMessage
 
-keepalive = 30000.0 :: Number
+import CSSClasses as C
+
+keepalive = 5000.0 :: Number
 
 -- Input is the WS url.
-type Input = String
+type Input = (Tuple String String)
 
 -- | The component can perform 4 actions: log messages, notify that a message has been received,
 -- | notify when a connection has been established or when it has been closed.
 data Output
 -- | MessageReceived (Tuple URL message)
   = MessageReceived (Tuple String ArrayBuffer)  -- Provide a received message to the parent.
-  | WSJustConnected                             -- Inform the parent the connection is up.
+
-  | WSJustClosed                                -- Inform the parent the connection is down.
+  -- | Inform the parent the connection is up.
+  | WSJustConnected
+
+  -- | Inform the parent the connection is down.
+  | WSJustClosed
+
+  -- | Log a message.
   | Log LogMessage
-  | KeepAlive                                   -- Ask the parent to handle a keep-alive message.
+
+  -- | Ask the parent to send a keep-alive message.
+  | KeepAlive
+
+  -- | Ask the parent to reset the keep-alive counter used to automatically close the WS connection.
+  | ResetKeepAliveCounter
 
 -- | The component can receive a single action from other components: sending a message throught the websocket.
-data Query a = ToSend ArrayBuffer a
+data Query a = ToSend ArrayBuffer a | ToSendKeepAlive ArrayBuffer a | Connect a
 
 type Slot = H.Slot Query Output
 
@@ -91,6 +104,7 @@ data Action
 -- | to inform if the connection has to be re-established.
 type WSInfo
   = { url          :: String
+    , service_name :: String
     , connection   :: Maybe WS.WebSocket
     , reconnect    :: Boolean
     }
@@ -112,8 +126,9 @@ component =
     }
 
 initialState :: Input -> State
-initialState url =
+initialState (Tuple url service_name) =
   { wsInfo: { url: url
+            , service_name: service_name
             , connection: Nothing
             , reconnect: false
             }
@@ -129,24 +144,13 @@ render { wsInfo }
         HH.div [ HP.style "margin-bottom: 0.125rem; color: grey;" ] [ HH.small_ [ HH.text txt ] ]
 
       renderReconnectButton :: Boolean -> H.ComponentHTML Action () m
-      renderReconnectButton cond =
+      renderReconnectButton cond = HH.p_ [
-        if cond
+          if cond then reconnection_btn [ HH.text $ "Reconnect to \"" <> wsInfo.service_name <> "\"" ]
-        then
+                  else renderFootnote $ "Connected to \"" <> wsInfo.service_name <> "\""
-          HH.p_
+        ]
-            [ HH.button
+      reconnection_btn = HH.button [ HP.type_ HP.ButtonButton
-              [ HP.type_ HP.ButtonButton
                                    , HE.onClick \_ -> ConnectWebSocket
-              ]
+                                   , HP.classes (C.has_background_danger_light <> C.is_large)
-              [ HH.text "Reconnect?" ]
-            ]
-        else
-          HH.p_
-            [ renderFootnote $
-                "NOTE: A 'Reconnect?' button will appear if the connection drops (for URL: '"
-                <>
-                wsInfo.url
-                <>
-                "')"
                                    ]
 
 handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
@@ -220,10 +224,23 @@ handleAction action = do
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
   ToSend message a -> do
+    H.raise ResetKeepAliveCounter
     send_message message
     pure (Just a)
+  -- Sending a keepalive: do not tell the parent to reset the keepalive counter.
+  ToSendKeepAlive message a -> do
+    send_message message
+    pure (Just a)
+  Connect a -> do
+    state <- H.get
+    case state.wsInfo.connection of
+      Nothing -> do
+        handleAction ConnectWebSocket
+        pure (Just a)
+      Just _ -> pure Nothing
 
-send_message :: forall m. MonadAff m => ArrayBuffer -> H.HalogenM State Action () Output m Unit
+send_message :: forall m. MonadAff m =>
+  ArrayBuffer -> H.HalogenM State Action () Output m Unit
 send_message message = do
     { wsInfo } <- H.get
     case wsInfo.connection of