Put websocket info in a dedicated record.
This commit is contained in:
parent
15e407972a
commit
e0fc55e5ca
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user