Baguette/dnsmanager-webclient
3
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

WIP: big button for reconnection + automatic disconnection.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-11-13 02:24:03 +01:00
parent 418495e274
commit db8cd669ae
2 changed files with 91 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
src/App/Container.purs
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
@ -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

77
src/App/WS.purs
View File

@ -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