diff --git a/src/App/Container.purs b/src/App/Container.purs index a224b32..7b2e0a2 100644 --- a/src/App/Container.purs +++ b/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.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd." + WS.WSJustConnected -> do + 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 diff --git a/src/App/WS.purs b/src/App/WS.purs index 76ad71d..74cda91 100644 --- a/src/App/WS.purs +++ b/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 @@ -90,9 +103,10 @@ data Action -- | `WSInfo` is composed of an URL, an actual socket and a boolean -- | to inform if the connection has to be re-established. type WSInfo - = { url :: String - , connection :: Maybe WS.WebSocket - , reconnect :: Boolean + = { url :: String + , service_name :: String + , connection :: Maybe WS.WebSocket + , reconnect :: Boolean } -- | The state of this component only is composed of the websocket. @@ -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,25 +144,14 @@ 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 = - if cond - then - HH.p_ - [ HH.button - [ HP.type_ HP.ButtonButton - , HE.onClick \_ -> ConnectWebSocket - ] - [ HH.text "Reconnect?" ] - ] - else - HH.p_ - [ renderFootnote $ - "NOTE: A 'Reconnect?' button will appear if the connection drops (for URL: '" - <> - wsInfo.url - <> - "')" - ] + renderReconnectButton cond = HH.p_ [ + if cond then reconnection_btn [ HH.text $ "Reconnect to \"" <> wsInfo.service_name <> "\"" ] + else renderFootnote $ "Connected to \"" <> wsInfo.service_name <> "\"" + ] + reconnection_btn = HH.button [ HP.type_ HP.ButtonButton + , HE.onClick \_ -> ConnectWebSocket + , HP.classes (C.has_background_danger_light <> C.is_large) + ] handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction action = do @@ -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