WS info in a record: code is now clearer.

This commit is contained in:
Philippe Pittoli 2023-07-02 23:32:31 +02:00
parent ab74a4a57e
commit 02f312b447

View File

@ -163,7 +163,7 @@ data Action
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
| NewDomainAttempt Event | NewDomainAttempt Event
-- | Finalize | Finalize
| HandleWebSocket (WebSocketEvent WebSocketMessageType) | HandleWebSocket (WebSocketEvent WebSocketMessageType)
type NewDomainFormState type NewDomainFormState
@ -171,20 +171,22 @@ type NewDomainFormState
, selected_domain :: String , selected_domain :: String
} }
type WSInfo
= { url :: String
, connection :: Maybe WS.WebSocket
, reconnect :: Boolean
, token :: String
}
type State = type State =
{ messages :: Array String { messages :: Array String
, messageHistoryLength :: Int , messageHistoryLength :: Int
, token :: String
, newDomainForm :: NewDomainFormState , newDomainForm :: NewDomainFormState
, accepted_domains :: Array String , accepted_domains :: Array String
, my_domains :: Array String , my_domains :: Array String
-- TODO: put network stuff in a record. , wsInfo :: WSInfo
, wsUrl :: String
, wsConnection :: Maybe WS.WebSocket
, canReconnect :: Boolean
} }
component :: forall m. MonadAff m => H.Component Query Input Output m component :: forall m. MonadAff m => H.Component Query Input Output m
@ -195,7 +197,7 @@ component =
, eval: H.mkEval $ H.defaultEval , eval: H.mkEval $ H.defaultEval
{ initialize = Just Initialize { initialize = Just Initialize
, handleAction = handleAction , handleAction = handleAction
-- , finalize = Just Finalize , finalize = Just Finalize
} }
} }
@ -207,7 +209,6 @@ initialState (Tuple url token) =
{ messages: [] { messages: []
, messageHistoryLength: 10 , messageHistoryLength: 10
, token: token
, newDomainForm: { new_domain: "" , newDomainForm: { new_domain: ""
, selected_domain: default_domain , selected_domain: default_domain
} }
@ -215,10 +216,11 @@ initialState (Tuple url token) =
, accepted_domains: [ default_domain ] , accepted_domains: [ default_domain ]
, my_domains: [ ] , my_domains: [ ]
-- TODO: put network stuff in a record. , wsInfo: { url: url
, wsUrl: url , connection: Nothing
, wsConnection: Nothing , reconnect: false
, canReconnect: false , token: token
}
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
@ -226,14 +228,13 @@ render {
messages, messages,
accepted_domains, accepted_domains,
my_domains, my_domains,
wsConnection, wsInfo,
canReconnect,
newDomainForm } newDomainForm }
= HH.div_ = HH.div_
[ Bulma.columns_ [ Bulma.column_ newdomain_form [ Bulma.columns_ [ Bulma.column_ newdomain_form
, Bulma.column_ list_of_own_domains ] , Bulma.column_ list_of_own_domains ]
, render_messages , render_messages
, renderReconnectButton (isNothing wsConnection && canReconnect) , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect)
] ]
where where
@ -247,7 +248,7 @@ render {
, HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) my_domains , HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) my_domains
] ]
should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection)
render_adduser_form = HH.form render_adduser_form = HH.form
[ HE.onSubmit NewDomainAttempt ] [ HE.onSubmit NewDomainAttempt ]
@ -261,7 +262,7 @@ render {
[ HH.button [ HH.button
[ HP.style "padding: 0.5rem 1.25rem;" [ HP.style "padding: 0.5rem 1.25rem;"
, HP.type_ HP.ButtonSubmit , HP.type_ HP.ButtonSubmit
, maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection , maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection
] ]
[ HH.text "Send Message to Server" ] [ HH.text "Send Message to Server" ]
] ]
@ -300,22 +301,22 @@ handleAction = case _ of
Initialize -> Initialize ->
handleAction ConnectWebSocket handleAction ConnectWebSocket
-- Finalize -> do Finalize -> do
-- { wsConnection } <- H.get { wsInfo } <- H.get
-- systemMessage "Finalize" systemMessage "Finalize"
-- case wsConnection of case wsInfo.connection of
-- Nothing -> systemMessage "No socket? How is that even possible?" Nothing -> systemMessage "No socket? How is that even possible?"
-- Just socket -> H.liftEffect $ WS.close socket Just socket -> H.liftEffect $ WS.close socket
WebSocketParseError error -> WebSocketParseError error ->
systemMessage $ renderError (UnknownError error) systemMessage $ renderError (UnknownError error)
ConnectWebSocket -> do ConnectWebSocket -> do
{ wsUrl } <- H.get { wsInfo } <- H.get
systemMessage ("Connecting to \"" <> wsUrl <> "\"...") systemMessage ("Connecting to \"" <> wsInfo.url <> "\"...")
webSocket <- H.liftEffect $ WS.create wsUrl [] webSocket <- H.liftEffect $ WS.create wsInfo.url []
H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
H.modify_ _ { wsConnection = Just webSocket } H.modify_ _ { wsInfo { connection = Just webSocket } }
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket) void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
UpdateAcceptedDomains domains -> do UpdateAcceptedDomains domains -> do
@ -325,12 +326,12 @@ handleAction = case _ of
H.modify_ _ { my_domains = domains } H.modify_ _ { my_domains = domains }
AuthenticateToDNSManager -> do AuthenticateToDNSManager -> do
{ wsConnection, token } <- H.get { wsInfo } <- H.get
appendMessage $ "[🤖] Trying to authenticate..." appendMessage $ "[🤖] Trying to authenticate..."
case wsConnection of case wsInfo.connection of
Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!" Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!"
Just webSocket -> H.liftEffect $ do Just webSocket -> H.liftEffect $ do
ab <- DNSManager.serialize $ DNSManager.MkLogin { token: token } ab <- DNSManager.serialize $ DNSManager.MkLogin { token: wsInfo.token }
sendArrayBuffer webSocket ab sendArrayBuffer webSocket ab
HandleNewDomainInput adduserinp -> do HandleNewDomainInput adduserinp -> do
@ -342,10 +343,10 @@ handleAction = case _ of
NewDomainAttempt ev -> do NewDomainAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev
{ wsConnection, newDomainForm } <- H.get { wsInfo, newDomainForm } <- H.get
let new_domain = newDomainForm.new_domain <> newDomainForm.selected_domain let new_domain = newDomainForm.new_domain <> newDomainForm.selected_domain
case wsConnection, new_domain of case wsInfo.connection, new_domain of
Nothing, _ -> Nothing, _ ->
unableToSend "Not connected to server." unableToSend "Not connected to server."
@ -362,9 +363,9 @@ handleAction = case _ of
Closed -> do Closed -> do
unableToSend "Connection to server has been closed." unableToSend "Connection to server has been closed."
maybeCurrentConnection <- H.gets _.wsConnection maybeCurrentConnection <- H.gets _.wsInfo.connection
when (isJust maybeCurrentConnection) do when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true } H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
Open -> do Open -> do
H.liftEffect $ do H.liftEffect $ do
@ -426,15 +427,15 @@ handleAction = case _ of
appendMessage $ "[😈] Failed! Authentication server didn't send a valid message." appendMessage $ "[😈] Failed! Authentication server didn't send a valid message."
WebSocketOpen -> do WebSocketOpen -> do
{ wsUrl } <- H.get { wsInfo } <- H.get
systemMessage ("Successfully connected to WebSocket at \"" <> wsUrl <> "\"!🎉") systemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <> "\"!🎉")
handleAction AuthenticateToDNSManager handleAction AuthenticateToDNSManager
WebSocketClose { code, reason, wasClean } -> do WebSocketClose { code, reason, wasClean } -> do
systemMessage $ renderCloseMessage code wasClean reason systemMessage $ renderCloseMessage code wasClean reason
maybeCurrentConnection <- H.gets _.wsConnection maybeCurrentConnection <- H.gets _.wsInfo.connection
when (isJust maybeCurrentConnection) do when (isJust maybeCurrentConnection) do
H.modify_ _ { wsConnection = Nothing, canReconnect = true } H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } }
WebSocketError errorType -> WebSocketError errorType ->
systemMessage $ renderError errorType systemMessage $ renderError errorType