Implement Keep Alive messages.
This commit is contained in:
parent
b6b6a6be77
commit
07135d2ea3
@ -9,7 +9,6 @@
|
||||
, "bifunctors"
|
||||
, "codec-argonaut"
|
||||
, "console"
|
||||
, "const"
|
||||
, "control"
|
||||
, "dom-indexed"
|
||||
, "effect"
|
||||
@ -28,6 +27,7 @@
|
||||
, "profunctor"
|
||||
, "strings"
|
||||
, "stringutils"
|
||||
, "tailrec"
|
||||
, "transformers"
|
||||
, "tuples"
|
||||
, "uint"
|
||||
|
||||
@ -145,6 +145,9 @@ data Action
|
||||
-- | Log message (through the Log component).
|
||||
| Log LogMessage
|
||||
|
||||
-- | `KeepAlive` send a keepalive message to either `authd` or `dnsmanagerd`.
|
||||
| KeepAlive (Either Unit Unit)
|
||||
|
||||
-- | The component's state is composed of:
|
||||
-- | a potential authentication token,
|
||||
-- | the current page,
|
||||
@ -282,6 +285,14 @@ handleAction = case _ of
|
||||
|
||||
Log message -> H.tell _log unit $ AppLog.Log message
|
||||
|
||||
KeepAlive auth_or_dnsmanager -> case auth_or_dnsmanager of
|
||||
Left _ -> do
|
||||
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkKeepAlive {}
|
||||
H.tell _ws_auth unit (WS.ToSend message)
|
||||
Right _ -> do
|
||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkKeepAlive {}
|
||||
H.tell _ws_dns unit (WS.ToSend message)
|
||||
|
||||
AuthenticateToAuthd v -> case v of
|
||||
Left token -> do
|
||||
handleAction $ Log $ SimpleLog "[🤖] authenticate to authd with a token!"
|
||||
@ -361,6 +372,7 @@ handleAction = case _ of
|
||||
H.tell _ai unit AI.ConnectionIsDown
|
||||
H.tell _aai unit AAI.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Left unit
|
||||
|
||||
DecodeAuthMessage message -> do
|
||||
receivedMessage <- H.liftEffect $ AuthD.deserialize message
|
||||
@ -460,6 +472,8 @@ handleAction = case _ of
|
||||
_ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
|
||||
|
||||
handleAction AuthenticateToDNSManager
|
||||
(AuthD.GotKeepAlive _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] KeepAlive!🤖🤖🤖"
|
||||
pure unit
|
||||
|
||||
-- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
|
||||
@ -487,6 +501,7 @@ handleAction = case _ of
|
||||
H.tell _dli unit DomainListInterface.ConnectionIsUp
|
||||
WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
|
||||
WS.Log message -> H.tell _log unit (AppLog.Log message)
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Right unit
|
||||
|
||||
-- | `DecodeDNSMessage`: decode a received `dnsmanagerd` message, then transfer it to `DispatchDNSMessage`.
|
||||
DecodeDNSMessage message -> do
|
||||
@ -571,6 +586,8 @@ handleAction = case _ of
|
||||
handleAction $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
|
||||
(DNSManager.MkSuccess _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[🎉] Success!"
|
||||
(DNSManager.GotKeepAlive _) -> do
|
||||
handleAction $ Log $ SimpleLog $ "[🤖] KeepAlive!🤖🤖🤖"
|
||||
pure unit
|
||||
|
||||
-- | Send a received DNS manager message to a component.
|
||||
|
||||
@ -170,6 +170,11 @@ type AuthByToken = { token :: String }
|
||||
codecAuthByToken ∷ CA.JsonCodec AuthByToken
|
||||
codecAuthByToken = CA.object "AuthByToken" (CAR.record { token: CA.string })
|
||||
|
||||
{- 250 -}
|
||||
type KeepAlive = { }
|
||||
codecKeepAlive ∷ CA.JsonCodec KeepAlive
|
||||
codecKeepAlive = CA.object "KeepAlive" (CAR.record { })
|
||||
|
||||
{-
|
||||
RESPONSES
|
||||
-}
|
||||
@ -334,6 +339,11 @@ type ErrorInvalidRenewKey = {}
|
||||
codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey
|
||||
codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {})
|
||||
|
||||
{- 250 -}
|
||||
-- type KeepAlive = { }
|
||||
codecGotKeepAlive ∷ CA.JsonCodec KeepAlive
|
||||
codecGotKeepAlive = CA.object "KeepAlive" (CAR.record { })
|
||||
|
||||
-- All possible requests.
|
||||
data RequestMessage
|
||||
= MkLogin Login -- 0
|
||||
@ -351,6 +361,7 @@ data RequestMessage
|
||||
| MkSetPermission SetPermission -- 11
|
||||
| MkSearchUser SearchUser -- 12
|
||||
| MkAuthByToken AuthByToken -- 15
|
||||
| MkKeepAlive KeepAlive -- 250
|
||||
|
||||
-- All possible answers from the authentication daemon (authd).
|
||||
data AnswerMessage
|
||||
@ -382,26 +393,28 @@ data AnswerMessage
|
||||
| GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
|
||||
| GotErrorCannotContactUser ErrorCannotContactUser -- 33
|
||||
| GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34
|
||||
| GotKeepAlive KeepAlive -- 250
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
encode m = case m of
|
||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||
(MkRegister request) -> get_tuple 1 codecRegister request
|
||||
(MkValidateUser request) -> get_tuple 2 codecValidateUser request
|
||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||
(MkRegister request) -> get_tuple 1 codecRegister request
|
||||
(MkValidateUser request) -> get_tuple 2 codecValidateUser request
|
||||
(MkAskPasswordRecovery request) -> get_tuple 3 codecAskPasswordRecovery request
|
||||
(MkPasswordRecovery request) -> get_tuple 4 codecPasswordRecovery request
|
||||
(MkPasswordRecovery request) -> get_tuple 4 codecPasswordRecovery request
|
||||
-- Both messages are actually a single message type, so they have the same number.
|
||||
-- TODO: change the message codec for an Either Int String.
|
||||
(MkGetUserByUID request) -> get_tuple 5 codecGetUserByUID request
|
||||
(MkGetUserByUID request) -> get_tuple 5 codecGetUserByUID request
|
||||
(MkGetUserByName request) -> get_tuple 5 codecGetUserByName request
|
||||
(MkModUser request) -> get_tuple 6 codecModUser request
|
||||
(MkModUser request) -> get_tuple 6 codecModUser request
|
||||
-- 7 MkEditProfileContent
|
||||
(MkDeleteUser request) -> get_tuple 8 codecDeleteUser request
|
||||
(MkAddUser request) -> get_tuple 9 codecAddUser request
|
||||
(MkCheckPermission request) -> get_tuple 10 codecCheckPermission request
|
||||
(MkSetPermission request) -> get_tuple 11 codecSetPermission request
|
||||
(MkSearchUser request) -> get_tuple 12 codecSearchUser request
|
||||
(MkAuthByToken request) -> get_tuple 15 codecAuthByToken request
|
||||
(MkDeleteUser request) -> get_tuple 8 codecDeleteUser request
|
||||
(MkAddUser request) -> get_tuple 9 codecAddUser request
|
||||
(MkCheckPermission request) -> get_tuple 10 codecCheckPermission request
|
||||
(MkSetPermission request) -> get_tuple 11 codecSetPermission request
|
||||
(MkSearchUser request) -> get_tuple 12 codecSearchUser request
|
||||
(MkAuthByToken request) -> get_tuple 15 codecAuthByToken request
|
||||
(MkKeepAlive request) -> get_tuple 250 codecKeepAlive request
|
||||
where
|
||||
get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String
|
||||
get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request)
|
||||
@ -414,34 +427,35 @@ data DecodeError
|
||||
decode :: Int -> String -> Either DecodeError AnswerMessage
|
||||
decode number string
|
||||
= case number of
|
||||
0 -> error_management codecGotError GotError
|
||||
1 -> error_management codecGotToken GotToken
|
||||
2 -> error_management codecGotUser GotUser
|
||||
3 -> error_management codecGotUserAdded GotUserAdded
|
||||
4 -> error_management codecGotUserEdited GotUserEdited
|
||||
5 -> error_management codecGotUserValidated GotUserValidated
|
||||
6 -> error_management codecGotUsersList GotUsersList
|
||||
7 -> error_management codecGotPermissionCheck GotPermissionCheck
|
||||
8 -> error_management codecGotPermissionSet GotPermissionSet
|
||||
9 -> error_management codecGotPasswordRecoverySent GotPasswordRecoverySent
|
||||
10 -> error_management codecGotPasswordRecovered GotPasswordRecovered
|
||||
11 -> error_management codecGotMatchingUsers GotMatchingUsers
|
||||
12 -> error_management codecGotUserDeleted GotUserDeleted
|
||||
20 -> error_management codecGotErrorMustBeAuthenticated GotErrorMustBeAuthenticated
|
||||
21 -> error_management codecGotErrorAlreadyUsedLogin GotErrorAlreadyUsedLogin
|
||||
22 -> error_management codecGotErrorMailRequired GotErrorMailRequired
|
||||
23 -> error_management codecGotErrorUserNotFound GotErrorUserNotFound
|
||||
24 -> error_management codecGotErrorPasswordTooShort GotErrorPasswordTooShort
|
||||
25 -> error_management codecGotErrorInvalidCredentials GotErrorInvalidCredentials
|
||||
26 -> error_management codecGotErrorRegistrationsClosed GotErrorRegistrationsClosed
|
||||
27 -> error_management codecGotErrorInvalidLoginFormat GotErrorInvalidLoginFormat
|
||||
28 -> error_management codecGotErrorInvalidEmailFormat GotErrorInvalidEmailFormat
|
||||
29 -> error_management codecGotErrorAlreadyUsersInDB GotErrorAlreadyUsersInDB
|
||||
30 -> error_management codecGotErrorReadOnlyProfileKeys GotErrorReadOnlyProfileKeys
|
||||
31 -> error_management codecGotErrorInvalidActivationKey GotErrorInvalidActivationKey
|
||||
32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
|
||||
33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser
|
||||
34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey
|
||||
0 -> error_management codecGotError GotError
|
||||
1 -> error_management codecGotToken GotToken
|
||||
2 -> error_management codecGotUser GotUser
|
||||
3 -> error_management codecGotUserAdded GotUserAdded
|
||||
4 -> error_management codecGotUserEdited GotUserEdited
|
||||
5 -> error_management codecGotUserValidated GotUserValidated
|
||||
6 -> error_management codecGotUsersList GotUsersList
|
||||
7 -> error_management codecGotPermissionCheck GotPermissionCheck
|
||||
8 -> error_management codecGotPermissionSet GotPermissionSet
|
||||
9 -> error_management codecGotPasswordRecoverySent GotPasswordRecoverySent
|
||||
10 -> error_management codecGotPasswordRecovered GotPasswordRecovered
|
||||
11 -> error_management codecGotMatchingUsers GotMatchingUsers
|
||||
12 -> error_management codecGotUserDeleted GotUserDeleted
|
||||
20 -> error_management codecGotErrorMustBeAuthenticated GotErrorMustBeAuthenticated
|
||||
21 -> error_management codecGotErrorAlreadyUsedLogin GotErrorAlreadyUsedLogin
|
||||
22 -> error_management codecGotErrorMailRequired GotErrorMailRequired
|
||||
23 -> error_management codecGotErrorUserNotFound GotErrorUserNotFound
|
||||
24 -> error_management codecGotErrorPasswordTooShort GotErrorPasswordTooShort
|
||||
25 -> error_management codecGotErrorInvalidCredentials GotErrorInvalidCredentials
|
||||
26 -> error_management codecGotErrorRegistrationsClosed GotErrorRegistrationsClosed
|
||||
27 -> error_management codecGotErrorInvalidLoginFormat GotErrorInvalidLoginFormat
|
||||
28 -> error_management codecGotErrorInvalidEmailFormat GotErrorInvalidEmailFormat
|
||||
29 -> error_management codecGotErrorAlreadyUsersInDB GotErrorAlreadyUsersInDB
|
||||
30 -> error_management codecGotErrorReadOnlyProfileKeys GotErrorReadOnlyProfileKeys
|
||||
31 -> error_management codecGotErrorInvalidActivationKey GotErrorInvalidActivationKey
|
||||
32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
|
||||
33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser
|
||||
34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey
|
||||
250 -> error_management codecGotKeepAlive GotKeepAlive
|
||||
_ -> Left UnknownNumber
|
||||
where
|
||||
-- Signature is required since the compiler's guess is wrong.
|
||||
|
||||
@ -79,6 +79,11 @@ type DeleteRR = { domain :: String, rrid :: Int }
|
||||
codecDeleteRR ∷ CA.JsonCodec DeleteRR
|
||||
codecDeleteRR = CA.object "DeleteRR" (CAR.record { domain: CA.string, rrid: CA.int })
|
||||
|
||||
{- 250 -}
|
||||
type KeepAlive = { }
|
||||
codecKeepAlive ∷ CA.JsonCodec KeepAlive
|
||||
codecKeepAlive = CA.object "KeepAlive" (CAR.record { })
|
||||
|
||||
{-
|
||||
RESPONSES
|
||||
-}
|
||||
@ -214,6 +219,11 @@ type NoOwnership = { }
|
||||
codecNoOwnership ∷ CA.JsonCodec NoOwnership
|
||||
codecNoOwnership = CA.object "NoOwnership" (CAR.record { })
|
||||
|
||||
{- 250 -}
|
||||
--type KeepAlive = { }
|
||||
--codecKeepAlive ∷ CA.JsonCodec KeepAlive
|
||||
--codecKeepAlive = CA.object "KeepAlive" (CAR.record { })
|
||||
|
||||
|
||||
-- All possible requests.
|
||||
data RequestMessage
|
||||
@ -227,48 +237,50 @@ data RequestMessage
|
||||
| MkAddRR AddRR -- 14
|
||||
| MkUpdateRR UpdateRR -- 15
|
||||
| MkDeleteRR DeleteRR -- 16
|
||||
| MkKeepAlive KeepAlive -- 250
|
||||
|
||||
-- All possible answers from the authentication daemon (authd).
|
||||
data AnswerMessage
|
||||
= MkError Error -- 0
|
||||
| MkSuccess Success -- 1
|
||||
| MkErrorInvalidToken ErrorInvalidToken -- 2
|
||||
| MkDomainAlreadyExists DomainAlreadyExists -- 3
|
||||
| MkErrorUserNotLogged ErrorUserNotLogged -- 4
|
||||
| MkDomainNotFound DomainNotFound -- 5
|
||||
| MkRRNotFound RRNotFound -- 6
|
||||
| MkUnacceptableDomain UnacceptableDomain -- 7
|
||||
| MkInvalidDomainName InvalidDomainName -- 8
|
||||
| MkDomainDeleted DomainDeleted -- 9
|
||||
| MkInvalidZone InvalidZone -- 10
|
||||
| MkDomainChanged DomainChanged -- 11
|
||||
| MkZone Zone -- 12
|
||||
| MkUnknownZone UnknownZone -- 13
|
||||
| MkDomainList DomainList -- 14
|
||||
| MkAcceptedDomains AcceptedDomains -- 15
|
||||
| MkLogged Logged -- 16
|
||||
| MkDomainAdded DomainAdded -- 17
|
||||
| MkRRDeleted RRDeleted -- 18
|
||||
| MkRRAdded RRAdded -- 19
|
||||
| MkInvalidRR InvalidRR -- 20
|
||||
| MkRRUpdated RRUpdated -- 21
|
||||
| MkRRReadOnly RRReadOnly -- 22
|
||||
| MkUnknownUser UnknownUser -- 50
|
||||
| MkNoOwnership NoOwnership -- 51
|
||||
|
||||
= MkError Error -- 0
|
||||
| MkSuccess Success -- 1
|
||||
| MkErrorInvalidToken ErrorInvalidToken -- 2
|
||||
| MkDomainAlreadyExists DomainAlreadyExists -- 3
|
||||
| MkErrorUserNotLogged ErrorUserNotLogged -- 4
|
||||
| MkDomainNotFound DomainNotFound -- 5
|
||||
| MkRRNotFound RRNotFound -- 6
|
||||
| MkUnacceptableDomain UnacceptableDomain -- 7
|
||||
| MkInvalidDomainName InvalidDomainName -- 8
|
||||
| MkDomainDeleted DomainDeleted -- 9
|
||||
| MkInvalidZone InvalidZone -- 10
|
||||
| MkDomainChanged DomainChanged -- 11
|
||||
| MkZone Zone -- 12
|
||||
| MkUnknownZone UnknownZone -- 13
|
||||
| MkDomainList DomainList -- 14
|
||||
| MkAcceptedDomains AcceptedDomains -- 15
|
||||
| MkLogged Logged -- 16
|
||||
| MkDomainAdded DomainAdded -- 17
|
||||
| MkRRDeleted RRDeleted -- 18
|
||||
| MkRRAdded RRAdded -- 19
|
||||
| MkInvalidRR InvalidRR -- 20
|
||||
| MkRRUpdated RRUpdated -- 21
|
||||
| MkRRReadOnly RRReadOnly -- 22
|
||||
| MkUnknownUser UnknownUser -- 50
|
||||
| MkNoOwnership NoOwnership -- 51
|
||||
| GotKeepAlive KeepAlive -- 250
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
encode m = case m of
|
||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||
(MkMaintenance request) -> get_tuple 7 codecMaintenance request
|
||||
(MkNewDomain request) -> get_tuple 9 codecNewDomain request
|
||||
(MkDeleteDomain request) -> get_tuple 10 codecDeleteDomain request
|
||||
(MkAddOrUpdateZone request) -> get_tuple 11 codecAddOrUpdateZone request
|
||||
(MkGetZone request) -> get_tuple 12 codecGetZone request
|
||||
(MkUserDomains request) -> get_tuple 13 codecUserDomains request
|
||||
(MkAddRR request) -> get_tuple 14 codecAddRR request
|
||||
(MkUpdateRR request) -> get_tuple 15 codecUpdateRR request
|
||||
(MkDeleteRR request) -> get_tuple 16 codecDeleteRR request
|
||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||
(MkMaintenance request) -> get_tuple 7 codecMaintenance request
|
||||
(MkNewDomain request) -> get_tuple 9 codecNewDomain request
|
||||
(MkDeleteDomain request) -> get_tuple 10 codecDeleteDomain request
|
||||
(MkAddOrUpdateZone request) -> get_tuple 11 codecAddOrUpdateZone request
|
||||
(MkGetZone request) -> get_tuple 12 codecGetZone request
|
||||
(MkUserDomains request) -> get_tuple 13 codecUserDomains request
|
||||
(MkAddRR request) -> get_tuple 14 codecAddRR request
|
||||
(MkUpdateRR request) -> get_tuple 15 codecUpdateRR request
|
||||
(MkDeleteRR request) -> get_tuple 16 codecDeleteRR request
|
||||
(MkKeepAlive request) -> get_tuple 250 codecKeepAlive request
|
||||
where
|
||||
get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String
|
||||
get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request)
|
||||
@ -281,31 +293,32 @@ data DecodeError
|
||||
decode :: Int -> String -> Either DecodeError AnswerMessage
|
||||
decode number string
|
||||
= case number of
|
||||
0 -> error_management codecError MkError
|
||||
1 -> error_management codecSuccess MkSuccess
|
||||
2 -> error_management codecErrorInvalidToken MkErrorInvalidToken
|
||||
3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists
|
||||
4 -> error_management codecErrorUserNotLogged MkErrorUserNotLogged
|
||||
5 -> error_management codecDomainNotFound MkDomainNotFound
|
||||
6 -> error_management codecRRNotFound MkRRNotFound
|
||||
7 -> error_management codecUnacceptableDomain MkUnacceptableDomain
|
||||
8 -> error_management codecInvalidDomainName MkInvalidDomainName
|
||||
9 -> error_management codecDomainDeleted MkDomainDeleted
|
||||
10 -> error_management codecInvalidZone MkInvalidZone
|
||||
11 -> error_management codecDomainChanged MkDomainChanged
|
||||
12 -> error_management codecZone MkZone
|
||||
13 -> error_management codecUnknownZone MkUnknownZone
|
||||
14 -> error_management codecDomainList MkDomainList
|
||||
15 -> error_management codecAcceptedDomains MkAcceptedDomains
|
||||
16 -> error_management codecLogged MkLogged
|
||||
17 -> error_management codecDomainAdded MkDomainAdded
|
||||
18 -> error_management codecRRDeleted MkRRDeleted
|
||||
19 -> error_management codecRRAdded MkRRAdded
|
||||
20 -> error_management codecInvalidRR MkInvalidRR
|
||||
21 -> error_management codecRRUpdated MkRRUpdated
|
||||
22 -> error_management codecRRReadOnly MkRRReadOnly
|
||||
50 -> error_management codecUnknownUser MkUnknownUser
|
||||
51 -> error_management codecNoOwnership MkNoOwnership
|
||||
0 -> error_management codecError MkError
|
||||
1 -> error_management codecSuccess MkSuccess
|
||||
2 -> error_management codecErrorInvalidToken MkErrorInvalidToken
|
||||
3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists
|
||||
4 -> error_management codecErrorUserNotLogged MkErrorUserNotLogged
|
||||
5 -> error_management codecDomainNotFound MkDomainNotFound
|
||||
6 -> error_management codecRRNotFound MkRRNotFound
|
||||
7 -> error_management codecUnacceptableDomain MkUnacceptableDomain
|
||||
8 -> error_management codecInvalidDomainName MkInvalidDomainName
|
||||
9 -> error_management codecDomainDeleted MkDomainDeleted
|
||||
10 -> error_management codecInvalidZone MkInvalidZone
|
||||
11 -> error_management codecDomainChanged MkDomainChanged
|
||||
12 -> error_management codecZone MkZone
|
||||
13 -> error_management codecUnknownZone MkUnknownZone
|
||||
14 -> error_management codecDomainList MkDomainList
|
||||
15 -> error_management codecAcceptedDomains MkAcceptedDomains
|
||||
16 -> error_management codecLogged MkLogged
|
||||
17 -> error_management codecDomainAdded MkDomainAdded
|
||||
18 -> error_management codecRRDeleted MkRRDeleted
|
||||
19 -> error_management codecRRAdded MkRRAdded
|
||||
20 -> error_management codecInvalidRR MkInvalidRR
|
||||
21 -> error_management codecRRUpdated MkRRUpdated
|
||||
22 -> error_management codecRRReadOnly MkRRReadOnly
|
||||
50 -> error_management codecUnknownUser MkUnknownUser
|
||||
51 -> error_management codecNoOwnership MkNoOwnership
|
||||
250 -> error_management codecKeepAlive GotKeepAlive
|
||||
_ -> Left UnknownNumber
|
||||
where
|
||||
-- Signature is required since the compiler's guess is wrong.
|
||||
|
||||
@ -47,6 +47,7 @@ data Output
|
||||
| WSJustConnected -- Inform the parent the connection is up.
|
||||
| WSJustClosed -- Inform the parent the connection is down.
|
||||
| Log LogMessage
|
||||
| KeepAlive -- Ask the parent to handle a keep-alive message.
|
||||
|
||||
-- | The component can receive a single action from other components: sending a message throught the websocket.
|
||||
data Query a = ToSend ArrayBuffer a
|
||||
@ -79,6 +80,7 @@ data Action
|
||||
-- | `Finalize` is the action performed once the component is destroyed, ending the connection.
|
||||
| Finalize
|
||||
|
||||
-- | Tick: keep alive WS connections.
|
||||
| Tick
|
||||
|
||||
-- | Every received websocket message and notification is handled in `HandleWebSocket`.
|
||||
@ -162,9 +164,8 @@ handleAction action = do
|
||||
|
||||
Tick -> do
|
||||
H.modify_ \state -> state { seconds = state.seconds + keepalive }
|
||||
-- TODO: create a message only for applicative keepalive.
|
||||
-- message
|
||||
-- send_message message
|
||||
-- Applicative KeepAlive. The same message type works for both `authd` and `dnsmanagerd`.
|
||||
H.raise KeepAlive
|
||||
|
||||
Finalize -> do
|
||||
-- H.raise $ Log $ SystemLog $ "Closing websocket for '" <> wsInfo.url <> "'"
|
||||
@ -226,10 +227,12 @@ handleAction action = do
|
||||
|
||||
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||
handleQuery = case _ of
|
||||
ToSend message a -> send_message message
|
||||
ToSend message a -> do
|
||||
send_message message
|
||||
pure Nothing
|
||||
|
||||
send_message :: forall m. MonadAff m => ArrayBuffer -> H.HalogenM State Action () Output m Unit
|
||||
send_message message =
|
||||
send_message message = do
|
||||
{ wsInfo } <- H.get
|
||||
case wsInfo.connection of
|
||||
Nothing -> H.raise $ Log $ UnableToSend "Not connected to server."
|
||||
|
||||
Loading…
Reference in New Issue
Block a user