WS: `send_message` function. Will soon serve for sending keepalive messages.

src/App/Container.purs

@@ -7,8 +7,6 @@
 -- | `App.Container` stores the state of different components (domain list and zone interface)
 -- | to avoid useless requests to `dnsmanagerd`.
 -- |
--- | TODO: store forms in session storage?
--- |
 -- | `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`).
@@ -37,12 +35,10 @@
 -- | - 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: 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: authd administrative page
--- |
 -- | TODO: application-level heartbeat to avoid disconnections.
 -- |
 -- | Untested features:

src/App/WS.purs

@@ -2,8 +2,10 @@
 -- | This includes telling when a connection is established or closed, and notify a message has been received.
 module App.WS where
 
-import Prelude (Unit, bind, discard, pure, show, void, when, ($), (&&), (<$>), (<>), (>>=), (>=>), (<<<), map)
+import Prelude (Unit, bind, discard, pure, show, void, when
+               , ($), (&&), (<$>), (<>), (>>=), (>=>), (<<<), map, (=<<), (+))
 
+import Control.Monad.Rec.Class (forever)
 import Control.Monad.Except (runExcept)
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
@@ -12,6 +14,8 @@ import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), isJust, isNothing)
 import Data.String as String
 import Data.Tuple (Tuple(..))
+import Effect.Aff as Aff
+import Effect.Aff (Milliseconds(..))
 import Effect.Aff.Class (class MonadAff)
 import Effect (Effect)
 import Foreign as F
@@ -30,6 +34,8 @@ import Web.Socket.WebSocket as WS
 
 import App.LogMessage
 
+keepalive = 30000.0 :: Number
+
 -- Input is the WS url.
 type Input = String
 
@@ -47,6 +53,15 @@ data Query a = ToSend ArrayBuffer a
 
 type Slot = H.Slot Query Output
 
+-- | `timer` triggers a `Tick` action every `keepalive` seconds.
+timer :: forall m a. MonadAff m => a -> m (HS.Emitter a)
+timer val = do
+  { emitter, listener } <- H.liftEffect HS.create
+  _ <- H.liftAff $ Aff.forkAff $ forever do
+    Aff.delay $ Milliseconds keepalive
+    H.liftEffect $ HS.notify listener val
+  pure emitter
+
 data Action
   -- | `Initialize` opens the connection (URL is received as an `input` of this component).
   = Initialize
@@ -64,6 +79,8 @@ data Action
   -- | `Finalize` is the action performed once the component is destroyed, ending the connection.
   | Finalize
 
+  | Tick
+
   -- | Every received websocket message and notification is handled in `HandleWebSocket`.
   | HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
@@ -77,7 +94,7 @@ type WSInfo
     }
 
 -- | The state of this component only is composed of the websocket.
-type State = { wsInfo :: WSInfo }
+type State = { wsInfo :: WSInfo, seconds :: Number }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
 component =
@@ -98,13 +115,15 @@ initialState url =
             , connection: Nothing
             , reconnect: false
             }
+  , seconds: 0.0
   }
 
 -- | The component shows a string when the connection is established, or a button when the connection has closed.
 render :: forall m. State -> H.ComponentHTML Action () m
-render { wsInfo }
+render { wsInfo, seconds }
     = HH.div_
        [ renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect)
+       , HH.text ("You have been here for " <> show seconds <> " seconds")
        ]
     where
 
@@ -137,9 +156,16 @@ handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Out
 handleAction action = do
   { wsInfo } <- H.get
   case action of
-    Initialize ->
+    Initialize -> do
+      _ <- H.subscribe =<< timer Tick
       handleAction ConnectWebSocket
 
+    Tick -> do
+      H.modify_ \state -> state { seconds = state.seconds + keepalive }
+      -- TODO: create a message only for applicative keepalive.
+      -- message
+      -- send_message message
+
     Finalize -> do
       -- H.raise $ Log $ SystemLog $ "Closing websocket for '" <> wsInfo.url <> "'"
       case wsInfo.connection of
@@ -200,36 +226,21 @@ 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
+  ToSend message a -> send_message message
+
+send_message :: forall m. MonadAff m => ArrayBuffer -> H.HalogenM State Action () Output m Unit
+send_message message =
     { wsInfo } <- H.get
     case wsInfo.connection of
-      Nothing -> do
+      Nothing -> H.raise $ Log $ UnableToSend "Not connected to server."
-        H.raise $ Log $ UnableToSend "Not connected to server."
-        pure Nothing
-
       Just webSocket -> do
         H.liftEffect (WS.readyState webSocket) >>= case _ of
-          Connecting -> do
+          Connecting -> H.raise $ Log $ UnableToSend "Still connecting to server."
-            H.raise $ Log $ UnableToSend "Still connecting to server."
+          Closing    -> H.raise $ Log $ UnableToSend "Connection to server is closing."
-            pure Nothing
-
-          Closing -> do
-            H.raise $ Log $ UnableToSend "Connection to server is closing."
-            pure Nothing
-
           Closed     -> do
             H.raise $ Log $ UnableToSend "Connection to server has been closed."
-            maybeCurrentConnection <- H.gets _.wsInfo.connection
-            when (isJust maybeCurrentConnection) do
             H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
-            pure Nothing
+          Open -> H.liftEffect $ sendArrayBuffer webSocket message
-
-          Open -> do
-            H.liftEffect $ do
-              sendArrayBuffer webSocket message
-            pure (Just a)
-
-
 --------------------------------------------------------------------------------
 -- WebSocket mess.
 --------------------------------------------------------------------------------