Implement Keep Alive messages.
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,6 +393,7 @@ data AnswerMessage
|
|||
| GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
|
||||
| GotErrorCannotContactUser ErrorCannotContactUser -- 33
|
||||
| GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34
|
||||
| GotKeepAlive KeepAlive -- 250
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
encode m = case m of
|
||||
|
|
@ -402,6 +414,7 @@ encode m = case m of
|
|||
(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)
|
||||
|
|
@ -442,6 +455,7 @@ decode number string
|
|||
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,6 +237,7 @@ data RequestMessage
|
|||
| MkAddRR AddRR -- 14
|
||||
| MkUpdateRR UpdateRR -- 15
|
||||
| MkDeleteRR DeleteRR -- 16
|
||||
| MkKeepAlive KeepAlive -- 250
|
||||
|
||||
-- All possible answers from the authentication daemon (authd).
|
||||
data AnswerMessage
|
||||
|
|
@ -255,7 +266,7 @@ data AnswerMessage
|
|||
| MkRRReadOnly RRReadOnly -- 22
|
||||
| MkUnknownUser UnknownUser -- 50
|
||||
| MkNoOwnership NoOwnership -- 51
|
||||
|
||||
| GotKeepAlive KeepAlive -- 250
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
encode m = case m of
|
||||
|
|
@ -269,6 +280,7 @@ encode m = case m of
|
|||
(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)
|
||||
|
|
@ -306,6 +318,7 @@ decode number string
|
|||
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