From 02f312b447239728ef03d5398353ea276da3ee12 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 2 Jul 2023 23:32:31 +0200 Subject: [PATCH] WS info in a record: code is now clearer. --- src/App/DNSManagerDomainsInterface.purs | 79 +++++++++++++------------ 1 file changed, 40 insertions(+), 39 deletions(-) diff --git a/src/App/DNSManagerDomainsInterface.purs b/src/App/DNSManagerDomainsInterface.purs index 2efd396..939ddb5 100644 --- a/src/App/DNSManagerDomainsInterface.purs +++ b/src/App/DNSManagerDomainsInterface.purs @@ -163,7 +163,7 @@ data Action | HandleNewDomainInput NewDomainFormAction | NewDomainAttempt Event - -- | Finalize + | Finalize | HandleWebSocket (WebSocketEvent WebSocketMessageType) type NewDomainFormState @@ -171,20 +171,22 @@ type NewDomainFormState , selected_domain :: String } +type WSInfo + = { url :: String + , connection :: Maybe WS.WebSocket + , reconnect :: Boolean + , token :: String + } + type State = { messages :: Array String , messageHistoryLength :: Int - , token :: String , newDomainForm :: NewDomainFormState - , accepted_domains :: Array String , my_domains :: Array String - -- TODO: put network stuff in a record. - , wsUrl :: String - , wsConnection :: Maybe WS.WebSocket - , canReconnect :: Boolean + , wsInfo :: WSInfo } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -195,7 +197,7 @@ component = , eval: H.mkEval $ H.defaultEval { initialize = Just Initialize , handleAction = handleAction - -- , finalize = Just Finalize + , finalize = Just Finalize } } @@ -207,7 +209,6 @@ initialState (Tuple url token) = { messages: [] , messageHistoryLength: 10 - , token: token , newDomainForm: { new_domain: "" , selected_domain: default_domain } @@ -215,10 +216,11 @@ initialState (Tuple url token) = , accepted_domains: [ default_domain ] , my_domains: [ ] - -- TODO: put network stuff in a record. - , wsUrl: url - , wsConnection: Nothing - , canReconnect: false + , wsInfo: { url: url + , connection: Nothing + , reconnect: false + , token: token + } } render :: forall m. State -> H.ComponentHTML Action () m @@ -226,14 +228,13 @@ render { messages, accepted_domains, my_domains, - wsConnection, - canReconnect, + wsInfo, newDomainForm } = HH.div_ [ Bulma.columns_ [ Bulma.column_ newdomain_form , Bulma.column_ list_of_own_domains ] , render_messages - , renderReconnectButton (isNothing wsConnection && canReconnect) + , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect) ] where @@ -247,7 +248,7 @@ render { , 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 [ HE.onSubmit NewDomainAttempt ] @@ -261,7 +262,7 @@ render { [ HH.button [ HP.style "padding: 0.5rem 1.25rem;" , 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" ] ] @@ -300,22 +301,22 @@ handleAction = case _ of Initialize -> handleAction ConnectWebSocket - -- Finalize -> do - -- { wsConnection } <- H.get - -- systemMessage "Finalize" - -- case wsConnection of - -- Nothing -> systemMessage "No socket? How is that even possible?" - -- Just socket -> H.liftEffect $ WS.close socket + Finalize -> do + { wsInfo } <- H.get + systemMessage "Finalize" + case wsInfo.connection of + Nothing -> systemMessage "No socket? How is that even possible?" + Just socket -> H.liftEffect $ WS.close socket WebSocketParseError error -> systemMessage $ renderError (UnknownError error) ConnectWebSocket -> do - { wsUrl } <- H.get - systemMessage ("Connecting to \"" <> wsUrl <> "\"...") - webSocket <- H.liftEffect $ WS.create wsUrl [] + { wsInfo } <- H.get + systemMessage ("Connecting to \"" <> wsInfo.url <> "\"...") + webSocket <- H.liftEffect $ WS.create wsInfo.url [] H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer - H.modify_ _ { wsConnection = Just webSocket } + H.modify_ _ { wsInfo { connection = Just webSocket } } void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket) UpdateAcceptedDomains domains -> do @@ -325,12 +326,12 @@ handleAction = case _ of H.modify_ _ { my_domains = domains } AuthenticateToDNSManager -> do - { wsConnection, token } <- H.get + { wsInfo } <- H.get appendMessage $ "[🤖] Trying to authenticate..." - case wsConnection of + case wsInfo.connection of Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!" Just webSocket -> H.liftEffect $ do - ab <- DNSManager.serialize $ DNSManager.MkLogin { token: token } + ab <- DNSManager.serialize $ DNSManager.MkLogin { token: wsInfo.token } sendArrayBuffer webSocket ab HandleNewDomainInput adduserinp -> do @@ -342,10 +343,10 @@ handleAction = case _ of NewDomainAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { wsConnection, newDomainForm } <- H.get + { wsInfo, newDomainForm } <- H.get let new_domain = newDomainForm.new_domain <> newDomainForm.selected_domain - case wsConnection, new_domain of + case wsInfo.connection, new_domain of Nothing, _ -> unableToSend "Not connected to server." @@ -362,9 +363,9 @@ handleAction = case _ of Closed -> do unableToSend "Connection to server has been closed." - maybeCurrentConnection <- H.gets _.wsConnection + maybeCurrentConnection <- H.gets _.wsInfo.connection when (isJust maybeCurrentConnection) do - H.modify_ _ { wsConnection = Nothing, canReconnect = true } + H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } } Open -> do H.liftEffect $ do @@ -426,15 +427,15 @@ handleAction = case _ of appendMessage $ "[😈] Failed! Authentication server didn't send a valid message." WebSocketOpen -> do - { wsUrl } <- H.get - systemMessage ("Successfully connected to WebSocket at \"" <> wsUrl <> "\"!🎉") + { wsInfo } <- H.get + systemMessage ("Successfully connected to WebSocket at \"" <> wsInfo.url <> "\"!🎉") handleAction AuthenticateToDNSManager WebSocketClose { code, reason, wasClean } -> do systemMessage $ renderCloseMessage code wasClean reason - maybeCurrentConnection <- H.gets _.wsConnection + maybeCurrentConnection <- H.gets _.wsInfo.connection when (isJust maybeCurrentConnection) do - H.modify_ _ { wsConnection = Nothing, canReconnect = true } + H.modify_ _ { wsInfo { connection = Nothing, reconnect = true } } WebSocketError errorType -> systemMessage $ renderError errorType