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