Closing connections due to inactiviy: WORKS! \o/

This commit is contained in:
Philippe Pittoli 2024-11-13 17:57:24 +01:00
parent fa988a2cca
commit 2ac56d4880
2 changed files with 57 additions and 9 deletions

View File

@ -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
@ -94,6 +94,12 @@ type Login = String
type Password = String
type LogInfo = Tuple Login Password
-- | A keepalive message is sent every 30 seconds to keep the connection open.
-- | `max_keepalive` represents the maximum number of keepalive messages
-- | before closing the connections due to inactivity.
-- | Current limit is 30 minutes (`max_keepalive` = 60, 60 * 30 seconds = 30 minutes).
max_keepalive = 60 :: Int
data Action
= Initialize
@ -374,13 +380,30 @@ handleAction = case _ of
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.ToSendKeepAlive message)
H.modify_ \state -> state { keepalive_counter = state.keepalive_counter + 1 }
state <- H.get
if state.are_we_connected_to_authd
then if (state.keepalive_counter + 1) > max_keepalive
then do handleAction $ Log $ SystemLog "Closing the websockets due to inactivity."
H.tell _ws_auth unit (WS.CloseConnection)
H.tell _ws_dns unit (WS.CloseConnection)
H.modify_ _ { are_we_connected_to_authd = false
, are_we_connected_to_dnsmanagerd = false
--, are_we_closed_due_to_inactiviy = true
}
else do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkKeepAlive {}
H.tell _ws_auth unit (WS.ToSendKeepAlive message)
H.modify_ _ { keepalive_counter = state.keepalive_counter + 1 }
else do -- handleAction $ Log $ SystemLog "KeepAlive message from WS while connection was closed."
pure unit
Right _ -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
H.tell _ws_dns unit (WS.ToSendKeepAlive message)
state <- H.get
if state.are_we_connected_to_dnsmanagerd
then do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
H.tell _ws_dns unit (WS.ToSendKeepAlive message)
else do -- handleAction $ Log $ SystemLog "KeepAlive message from WS while connection was closed."
pure unit
AuthenticateToAuthd v -> case v of
Left token -> do

View File

@ -36,7 +36,11 @@ import App.Type.LogMessage
import CSSClasses as C
keepalive = 5000.0 :: Number
-- | Send a keepalive message every 30 seconds, otherwise websockets
-- | are automatically disconnected. There is a limit in `App.Container`
-- | named `max_keepalive` to close the connection due to inactivity.
-- | Current limit is 30 minutes (`max_keepalive` = 60, 60 * 30 seconds = 30 minutes).
keepalive = 30000.0 :: Number
-- Input is the WS url.
type Input = (Tuple String String)
@ -63,7 +67,19 @@ data Output
| ResetKeepAliveCounter
-- | The component can receive a single action from other components: sending a message throught the websocket.
data Query a = ToSend ArrayBuffer a | ToSendKeepAlive ArrayBuffer a | Connect a
data Query a =
-- | Send a message.
ToSend ArrayBuffer a
-- | Send a keepalive message: do not tell the parent to reset the keepalive counter.
| ToSendKeepAlive ArrayBuffer a
-- | Restarts the connection.
| Connect a
-- | Close connection due to inactivity.
| CloseConnection a
type Slot = H.Slot Query Output
@ -223,11 +239,12 @@ handleAction action = do
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of
-- Send a message.
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.
-- Send a keepalive message: do not tell the parent to reset the keepalive counter.
ToSendKeepAlive message a -> do
-- In case a KeepAlive is sent while the connection is down, just ignore it.
state <- H.get
@ -236,6 +253,7 @@ handleQuery = case _ of
Just _ -> do
send_message message
pure (Just a)
-- Restarts the connection.
Connect a -> do
state <- H.get
case state.wsInfo.connection of
@ -243,6 +261,13 @@ handleQuery = case _ of
handleAction ConnectWebSocket
pure (Just a)
Just _ -> pure Nothing
-- Close connection due to inactivity.
CloseConnection a -> do
{ wsInfo } <- H.get
case wsInfo.connection of
Nothing -> pure unit
Just socket -> H.liftEffect $ WS.close socket
pure (Just a)
send_message :: forall m. MonadAff m =>
ArrayBuffer -> H.HalogenM State Action () Output m Unit