WS info in a record: code is now clearer.
This commit is contained in:
parent
ab74a4a57e
commit
02f312b447
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user