From e0fc55e5ca540784957ee3b5f652c7ab44b9b8e4 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 3 Jul 2023 04:04:14 +0200 Subject: [PATCH] Put websocket info in a dedicated record. --- .../AuthenticationDaemonAdminInterface.purs | 56 ++++++------- src/App/AuthenticationForm.purs | 78 ++++++++++--------- 2 files changed, 69 insertions(+), 65 deletions(-) diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 99154c3..4303e9a 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -69,16 +69,19 @@ data Action type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } +type WSInfo + = { url :: String + , connection :: Maybe WS.WebSocket + , reconnect :: Boolean + } + type State = { messages :: Array String , messageHistoryLength :: Int , addUserForm :: StateAddUserForm - -- 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 @@ -100,23 +103,22 @@ initialState input = , addUserForm: { login: "", admin: false, email: "", pass: "" } - -- TODO: put network stuff in a record. - , wsUrl: input - , wsConnection: Nothing - , canReconnect: false + , wsInfo: { url: input + , connection: Nothing + , reconnect: false + } } render :: forall m. State -> H.ComponentHTML Action () m render { messages, - wsConnection, - canReconnect, + wsInfo, addUserForm } = HH.div_ [ Bulma.columns_ [ Bulma.column_ adduser_form ] , render_messages --, renderMaxHistoryLength messageHistoryLength - , renderReconnectButton (isNothing wsConnection && canReconnect) + , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect) ] where @@ -125,7 +127,7 @@ render { , render_adduser_form ] - 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 AddUserAttempt ] @@ -154,7 +156,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" ] ] @@ -188,9 +190,9 @@ handleAction = case _ of handleAction ConnectWebSocket -- Finalize -> do - -- { wsConnection } <- H.get + -- { wsInfo } <- H.get -- systemMessage "Finalize" - -- case wsConnection of + -- case wsInfo.connection of -- Nothing -> systemMessage "No socket? How is that even possible?" -- Just socket -> H.liftEffect $ WS.close socket @@ -198,11 +200,11 @@ handleAction = case _ of 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) HandleAddUserInput adduserinp -> do @@ -216,12 +218,12 @@ handleAction = case _ of AddUserAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { wsConnection, addUserForm } <- H.get + { wsInfo, addUserForm } <- H.get let login = addUserForm.login email = addUserForm.email pass = addUserForm.pass - case wsConnection, login, email, pass of + case wsInfo.connection, login, email, pass of Nothing, _, _, _ -> unableToSend "Not connected to server." @@ -244,9 +246,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 @@ -284,14 +286,14 @@ 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 <> "\"!🎉") 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 diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index d3e7991..5809934 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -68,17 +68,20 @@ data Action type StateAuthenticationForm = { login :: String, pass :: String } type StateRegistrationForm = { login :: String, email :: String, pass :: String } +type WSInfo + = { url :: String + , connection :: Maybe WS.WebSocket + , reconnect :: Boolean + } + type State = { messages :: Array String , messageHistoryLength :: Int - , authenticationForm :: StateAuthenticationForm - , registrationForm :: StateRegistrationForm + , authenticationForm :: StateAuthenticationForm + , registrationForm :: StateRegistrationForm - -- 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 @@ -101,24 +104,23 @@ initialState input = , authenticationForm: { login: "", pass: "" } , registrationForm: { login: "", email: "", pass: "" } - -- TODO: put network stuff in a record. - , wsUrl: input - , wsConnection: Nothing - , canReconnect: false + , wsInfo: { url: input + , connection: Nothing + , reconnect: false + } } render :: forall m. State -> H.ComponentHTML Action () m render { messages, - wsConnection, - canReconnect, + wsInfo, authenticationForm, registrationForm } = HH.div_ [ Bulma.columns_ [ Bulma.column_ auth_form, Bulma.column_ register_form ] , render_messages - , renderReconnectButton (isNothing wsConnection && canReconnect) + , renderReconnectButton (isNothing wsInfo.connection && wsInfo.reconnect) ] where @@ -138,16 +140,16 @@ render { (HandleAuthenticationInput <<< AUTH_INP_login) -- action authenticationForm.login -- value true -- validity (TODO) - (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition + (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection) -- condition , Bulma.box_password "Password" "password" -- title, placeholder (HandleAuthenticationInput <<< AUTH_INP_pass) -- action authenticationForm.pass -- value true -- validity (TODO) - (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition + (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection) -- condition , 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" ] ] @@ -158,22 +160,22 @@ render { (HandleRegisterInput <<< REG_INP_login) -- action registrationForm.login -- value true -- validity (TODO) - (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition + (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection) -- condition , Bulma.box_input "Email" "email@example.com" -- title, placeholder (HandleRegisterInput <<< REG_INP_email) -- action registrationForm.email -- value true -- validity (TODO) - (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition + (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection) -- condition , Bulma.box_password "Password" "password" -- title, placeholder (HandleRegisterInput <<< REG_INP_pass) -- action registrationForm.pass -- value true -- validity (TODO) - (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) -- condition + (maybe (HP.disabled true) (\_ -> HP.enabled true) wsInfo.connection) -- condition , HH.div_ [ 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" ] ] @@ -207,9 +209,9 @@ handleAction = case _ of handleAction ConnectWebSocket Finalize -> do - { wsConnection } <- H.get + { wsInfo } <- H.get systemMessage "Finalize" - case wsConnection of + case wsInfo.connection of Nothing -> systemMessage "No socket? How is that even possible?" Just socket -> H.liftEffect $ WS.close socket @@ -217,11 +219,11 @@ handleAction = case _ of 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) HandleAuthenticationInput authinp -> do @@ -238,12 +240,12 @@ handleAction = case _ of RegisterAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { wsConnection, registrationForm } <- H.get + { wsInfo, registrationForm } <- H.get let login = registrationForm.login email = registrationForm.email pass = registrationForm.pass - case wsConnection, login, email, pass of + case wsInfo.connection, login, email, pass of Nothing, _, _, _ -> unableToSend "Not connected to server." @@ -266,9 +268,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 @@ -281,9 +283,9 @@ handleAction = case _ of AuthenticationAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { wsConnection, authenticationForm } <- H.get + { wsInfo, authenticationForm } <- H.get - case wsConnection, authenticationForm.login, authenticationForm.pass of + case wsInfo.connection, authenticationForm.login, authenticationForm.pass of Nothing, _, _ -> unableToSend "Not connected to server." @@ -303,9 +305,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 @@ -342,14 +344,14 @@ 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 <> "\"!🎉") 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