diff --git a/src/App/Container.purs b/src/App/Container.purs index 1d7c51a..f848c20 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -205,12 +205,11 @@ handleAction = case _ of DomainListComponentEvent ev -> case ev of DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) DomainListInterface.Log message -> H.tell _log unit (AppLog.Log message) - DomainListInterface.DNSManagerReconnect -> handleAction AuthenticateToDNSManager DomainListInterface.StoreState s -> H.modify_ _ { store_DomainListInterface_state = Just s } DomainListInterface.ChangePageZoneInterface domain -> do handleAction $ Routing $ Zone domain - DomainListInterface.AskState -> do + DomainListInterface.AskState -> do state <- H.get H.tell _dli unit (DomainListInterface.ProvideState state.store_DomainListInterface_state) @@ -237,12 +236,12 @@ handleAction = case _ of DNSManagerDaemonEvent ev -> case ev of WS.MessageReceived (Tuple _ message) -> do handleAction $ DNSRawMessageReceived message - WS.WSJustConnected -> do + WS.WSJustConnected -> do 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 (AppLog.Log message) + WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown + WS.Log message -> H.tell _log unit (AppLog.Log message) DNSRawMessageReceived message -> do receivedMessage <- H.liftEffect $ DNSManager.deserialize message @@ -290,43 +289,59 @@ handleAction = case _ of (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 $ Log $ SimpleLog $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)." handleAction $ DispatchDNSMessage m m@(DNSManager.MkAcceptedDomains _) -> do - handleAction $ Log $ SimpleLog $ "Received the list of accepted domains!" + handleAction $ Log $ SimpleLog $ "[🎉] Received the list of accepted domains!" + handleAction $ DispatchDNSMessage m + m@(DNSManager.MkLogged _) -> do + handleAction $ Log $ SimpleLog $ "[🎉] Authenticated to dnsmanagerd!" + handleAction $ DispatchDNSMessage m + m@(DNSManager.MkDomainAdded response) -> do + handleAction $ Log $ SimpleLog $ "[🎉] Domain added: " <> response.domain handleAction $ DispatchDNSMessage 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 _) -> do + m@(DNSManager.MkRRUpdated _) -> do handleAction $ Log $ SimpleLog $ "[🎉] Resource updated!" - (DNSManager.MkRRAdded response) -> do + handleAction $ DispatchDNSMessage m + m@(DNSManager.MkRRAdded response) -> do handleAction $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype + handleAction $ DispatchDNSMessage m (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 + m@(DNSManager.MkDomainDeleted response) -> do + handleAction $ Log $ SimpleLog $ "[🎉] The domain '" <> response.domain <> "' has been deleted!" + handleAction $ DispatchDNSMessage m + m@(DNSManager.MkRRDeleted response) -> do handleAction $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" - (DNSManager.MkZone _) -> do + handleAction $ DispatchDNSMessage m + m@(DNSManager.MkZone _) -> do handleAction $ Log $ SimpleLog $ "[🎉] Zone received!" + handleAction $ DispatchDNSMessage m (DNSManager.MkInvalidRR response) -> do handleAction $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors (DNSManager.MkSuccess _) -> do handleAction $ Log $ SimpleLog $ "[🎉] Success!" + handleAction $ Log $ SimpleLog $ "LETS GOOOOOOOOOOOOO!" pure unit -- Send a received DNS manager message to a component. - DispatchDNSMessage _ -> do + DispatchDNSMessage 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 (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd") + { 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 (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd") pure unit + +--print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit +--print_json_string arraybuffer = do +-- -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String)) +-- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer +-- H.raise $ Log $ SimpleLog $ case (value) of +-- Left _ -> "Cannot even fromTypedIPC the message." +-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string diff --git a/src/App/DomainListInterface.purs b/src/App/DomainListInterface.purs index 92dbe21..fd1f662 100644 --- a/src/App/DomainListInterface.purs +++ b/src/App/DomainListInterface.purs @@ -31,7 +31,6 @@ import CSSClasses as C import Parsing (runParser) import DomainParser as DomainParser - import App.LogMessage import App.Messages.DNSManagerDaemon as DNSManager @@ -51,7 +50,6 @@ import App.Messages.DNSManagerDaemon as DNSManager data Output = MessageToSend ArrayBuffer | Log LogMessage - | DNSManagerReconnect | ChangePageZoneInterface String | AskState | StoreState State @@ -64,7 +62,7 @@ data Output -- | See the explanation for the `Output` data type. data Query a - = MessageReceived ArrayBuffer a + = MessageReceived DNSManager.AnswerMessage a | ConnectionIsDown a | ConnectionIsUp a | ProvideState (Maybe State) a @@ -266,7 +264,7 @@ handleAction = case _ of H.modify_ _ { newDomainForm { new_domain = v } } case v of "" -> H.modify_ _ { newDomainForm { error_string = Nothing } } - otherwise -> case runParser v DomainParser.domain of + _ -> case runParser v DomainParser.domain of Left error_string -> H.modify_ _ { newDomainForm { error_string = Just $ show error_string } } Right _ -> H.modify_ _ { newDomainForm { error_string = Nothing } } UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } } @@ -313,63 +311,21 @@ handleQuery = case _ of pure (Just a) MessageReceived message a -> do - receivedMessage <- H.liftEffect $ DNSManager.deserialize message - case receivedMessage of - -- Cases where we didn't understand the message. - Left _ -> do - -- case err of - -- (DNSManager.JSONERROR jerr) -> do - -- print_json_string message - -- handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr) - -- (DNSManager.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: DNSManager.UnknownError" <> (show unerr)) - -- (DNSManager.UnknownNumber ) -> handleAction $ WebSocketParseError ("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 - H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason - (DNSManager.MkErrorUserNotLogged _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!" - H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..." - H.raise $ DNSManagerReconnect - (DNSManager.MkErrorInvalidToken _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed connection! Invalid token!" - (DNSManager.MkDomainAlreadyExists _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain already exists." - (DNSManager.MkUnacceptableDomain _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)." - - (DNSManager.MkAcceptedDomains response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Received the list of accepted domains!" - handleAction $ UpdateAcceptedDomains response.domains - - (DNSManager.MkLogged response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Authenticated to dnsmanagerd!" - handleAction $ UpdateAcceptedDomains response.accepted_domains - handleAction $ UpdateMyDomains response.my_domains - - (DNSManager.MkDomainAdded response) -> do - { my_domains } <- H.get - H.raise $ Log $ SimpleLog $ "[🎉] Domain added: " <> response.domain - handleAction $ UpdateMyDomains (my_domains <> [response.domain]) - - (DNSManager.MkInvalidDomainName _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" - - (DNSManager.MkDomainDeleted response) -> do - { my_domains } <- H.get - H.raise $ Log $ SimpleLog $ "[🎉] The domain '" <> response.domain <> "' has been deleted!" - handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains - - (DNSManager.MkSuccess _) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Success!" - -- WTH?! - _ -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." - pure (Just a) + case message of + -- The authentication failed. + (DNSManager.MkAcceptedDomains response) -> do + handleAction $ UpdateAcceptedDomains response.domains + (DNSManager.MkLogged response) -> do + handleAction $ UpdateAcceptedDomains response.accepted_domains + handleAction $ UpdateMyDomains response.my_domains + (DNSManager.MkDomainAdded response) -> do + { my_domains } <- H.get + handleAction $ UpdateMyDomains (my_domains <> [response.domain]) + (DNSManager.MkDomainDeleted response) -> do + { my_domains } <- H.get + handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains + _ -> H.raise $ Log $ SimpleLog $ "[😈] Message not handled in DomainListInterface." + pure (Just a) ConnectionIsDown a -> do H.modify_ _ { wsUp = false } @@ -383,11 +339,3 @@ build_new_domain :: String -> String -> String build_new_domain sub tld | endsWith "." sub = sub <> tld | otherwise = sub <> "." <> tld - ---print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit ---print_json_string arraybuffer = do --- -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String)) --- value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer --- H.raise $ Log $ SimpleLog $ case (value) of --- Left _ -> "Cannot even fromTypedIPC the message." --- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index e5fc062..99336df 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -63,7 +63,7 @@ data Output -- | The component is also informed when the connection is lost or up again. data Query a - = MessageReceived ArrayBuffer a + = MessageReceived DNSManager.AnswerMessage a | ConnectionIsDown a | ConnectionIsUp a @@ -493,93 +493,66 @@ handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () O handleQuery = case _ of MessageReceived message a -> do - receivedMessage <- H.liftEffect $ DNSManager.deserialize message - case receivedMessage of - -- Cases where we didn't understand the message. - Left err -> do - --H.raise $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err - case err of - (DNSManager.JSONERROR jerr) -> do - H.raise $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr - (DNSManager.UnknownError unerr) -> - H.raise $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr) - (DNSManager.UnknownNumber ) -> - H.raise $ 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 - H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason - (DNSManager.MkErrorUserNotLogged _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!" - H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..." - H.raise $ DNSManagerReconnect - (DNSManager.MkErrorInvalidToken _) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!" - (DNSManager.MkDomainAlreadyExists _) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists." - (DNSManager.MkUnacceptableDomain _) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)." - - (DNSManager.MkAcceptedDomains _) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!" - - (DNSManager.MkLogged _) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" - - (DNSManager.MkDomainAdded response) -> do - H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain - - (DNSManager.MkRRReadOnly response) -> do - H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " - <> "domain: " <> response.domain - <> "resource rrid: " <> show response.rr.rrid - - (DNSManager.MkRRUpdated response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!" - replace_entry response.rr - - (DNSManager.MkRRAdded response) -> do - state <- H.get - let new_rr = response.rr - H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype - case add_entry state new_rr of - Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message - Right new_state -> H.put new_state - - (DNSManager.MkInvalidDomainName _) -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" - - (DNSManager.MkDomainDeleted response) -> do - H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" - (DNSManager.MkRRDeleted response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" - -- Remove the resource record. - state <- H.get - H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr - , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr - , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr - } - -- Remove its possible errors. - let new_error_hash = Hash.delete response.rrid state._errors - H.modify_ _ { _errors = new_error_hash } - - (DNSManager.MkZone response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Zone received!" - add_entries response.zone.resources - - (DNSManager.MkInvalidRR response) -> do - H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors - - (DNSManager.MkSuccess _) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Success!" - -- WTH?! - _ -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message." - pure (Just a) + case message of + -- The authentication failed. + (DNSManager.MkError errmsg) -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason + (DNSManager.MkErrorUserNotLogged _) -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!" + H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..." + H.raise $ DNSManagerReconnect + (DNSManager.MkErrorInvalidToken _) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!" + (DNSManager.MkDomainAlreadyExists _) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists." + (DNSManager.MkUnacceptableDomain _) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)." + (DNSManager.MkAcceptedDomains _) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!" + (DNSManager.MkLogged _) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" + (DNSManager.MkDomainAdded response) -> do + H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain + (DNSManager.MkRRReadOnly response) -> do + H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " + <> "domain: " <> response.domain + <> "resource rrid: " <> show response.rr.rrid + (DNSManager.MkRRUpdated response) -> do + H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!" + replace_entry response.rr + (DNSManager.MkRRAdded response) -> do + state <- H.get + let new_rr = response.rr + H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype + case add_entry state new_rr of + Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message + Right new_state -> H.put new_state + (DNSManager.MkInvalidDomainName _) -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" + (DNSManager.MkDomainDeleted response) -> do + H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" + (DNSManager.MkRRDeleted response) -> do + H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" + -- Remove the resource record. + state <- H.get + H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr + , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr + , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr + } + -- Remove its possible errors. + let new_error_hash = Hash.delete response.rrid state._errors + H.modify_ _ { _errors = new_error_hash } + (DNSManager.MkZone response) -> do + H.raise $ Log $ SimpleLog $ "[🎉] Zone received!" + add_entries response.zone.resources + (DNSManager.MkInvalidRR response) -> do + H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors + (DNSManager.MkSuccess _) -> do + H.raise $ Log $ SimpleLog $ "[🎉] Success!" + -- WTH?! + _ -> do + H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message." + pure (Just a) ConnectionIsDown a -> do H.modify_ _ { wsUp = false }