From 8786af38a7dfcfdd1cf915f69ca191f7ed2f7729 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 29 Jul 2023 20:33:29 +0200 Subject: [PATCH] Decode DNS messages in the Container module (WIP: NOT BUILDABLE). --- src/App/Container.purs | 88 +++++++++++++++++++++++++++++++++++++----- 1 file changed, 79 insertions(+), 9 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index 3f85036..63f8bf2 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -35,6 +35,8 @@ data Action | Disconnection | AuthenticateToDNSManager | Routing Page + | DNSMessageReceived DNSManager.AnswerMessage + | DNSRawMessageReceived ArrayBuffer type State = { token :: Maybe String , uid :: Maybe Int @@ -151,6 +153,8 @@ handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Act handleAction = case _ of Routing page -> H.modify_ _ { current_page = page } + Log message -> H.tell _log unit $ Log.Log message + AuthenticateToDNSManager -> do state <- H.get case state.token of @@ -207,21 +211,87 @@ handleAction = case _ of H.tell _aai unit AAI.ConnectionIsDown WS.Log message -> H.tell _log unit (Log.Log message) + Disconnection -> do + H.put $ initialState unit + handleAction $ Routing Home + -- TODO: depending on the current page, we should provide the received message to different components. DNSManagerDaemonEvent ev -> case ev of WS.MessageReceived (Tuple _ message) -> do - { current_page } <- H.get - case current_page of - DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message) - Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message) - _ -> H.tell _log unit (Log.Log $ SystemLog "unexpected message from dnsmanagerd") + handleAction $ DNSRawMessageReceived message WS.WSJustConnected -> do - H.tell _log unit (Log.Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate") + handleAction Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate" handleAction AuthenticateToDNSManager H.tell _dli unit DomainListInterface.ConnectionIsUp WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown WS.Log message -> H.tell _log unit (Log.Log message) - Disconnection -> do - H.put $ initialState unit - handleAction $ Routing Home + DNSRawMessageReceived message -> do + receivedMessage <- H.liftEffect $ DNSManager.deserialize message + case receivedMessage of + -- Cases where we didn't understand the message. + Left err -> do + -- handleAction Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err + case err of + (DNSManager.JSONERROR jerr) -> do + handleAction Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr + (DNSManager.UnknownError unerr) -> + handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr) + (DNSManager.UnknownNumber ) -> + handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber" + pure Nothing + + -- Cases where we understood the message. + Right received_msg -> do + case received_msg of + -- The authentication failed. + (DNSManager.MkError errmsg) -> do + handleAction Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason + (DNSManager.MkErrorUserNotLogged _) -> do + handleAction Log $ SimpleLog $ "[😈] Failed! The user isn't connected!" + handleAction Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..." + handleAction AuthenticateToDNSManager + (DNSManager.MkErrorInvalidToken _) -> do + H.modify_ _ { token = Nothing, current_page = Home } + handleAction Log $ SimpleLog $ "Failed connection! Invalid token! Try re-authenticate." + (DNSManager.MkDomainAlreadyExists _) -> do + handleAction Log $ SimpleLog $ "Failed! The domain already exists." + m@(DNSManager.MkUnacceptableDomain _) -> do + handleAction Log $ SimpleLog $ "Failed! The domain is not acceptable (not in the list of accepted domains)." + handleAction $ DNSMessageReceived m + m@(DNSManager.MkAcceptedDomains _) -> do + handleAction Log $ SimpleLog $ "Received the list of accepted domains!" + handleAction $ DNSMessageReceived m + (DNSManager.MkLogged _) -> do + handleAction Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" + (DNSManager.MkDomainAdded response) -> do + handleAction Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain + (DNSManager.MkRRReadOnly response) -> do + handleAction Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " + <> "domain: " <> response.domain + <> "resource rrid: " <> show response.rr.rrid + (DNSManager.MkRRUpdated response) -> do + handleAction Log $ SimpleLog $ "[🎉] Resource updated!" + (DNSManager.MkRRAdded response) -> do + handleAction Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype + (DNSManager.MkInvalidDomainName _) -> do + handleAction Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" + (DNSManager.MkDomainDeleted response) -> do + handleAction Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" + (DNSManager.MkRRDeleted response) -> do + handleAction Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" + (DNSManager.MkZone response) -> do + handleAction Log $ SimpleLog $ "[🎉] Zone received!" + (DNSManager.MkInvalidRR response) -> do + handleAction Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors + (DNSManager.MkSuccess _) -> do + handleAction Log $ SimpleLog $ "[🎉] Success!" + + -- Send a received DNS manager message to a component. + DNSMessageReceived message -> do + handleAction Log $ SimpleLog "should send a DNS message to a component" + --{ current_page } <- H.get + --case current_page of + -- DomainList -> H.tell _dli unit (DomainListInterface.MessageReceived message) + -- Zone _ -> H.tell _zi unit (ZoneInterface.MessageReceived message) + -- _ -> H.tell _log unit (Log.Log $ SystemLog "unexpected message from dnsmanagerd")