karchnu
/
halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Put websocket info in a dedicated record.

beta
Philippe Pittoli 2023-07-03 04:04:14 +02:00
parent 15e407972a
commit e0fc55e5ca
2 changed files with 69 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/App/AuthenticationDaemonAdminInterface.purs
View File

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

74
src/App/AuthenticationForm.purs
View File

@ -68,6 +68,12 @@ 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
@ -75,10 +81,7 @@ type State =
, 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