From 5ac94bf0fe5c9c10e2b02d5a2fbd78e52378e705 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 30 Sep 2023 14:52:48 +0200 Subject: [PATCH] Can build again --- src/App/Container.purs | 105 +++++++++++++++++++++++++---------------- 1 file changed, 64 insertions(+), 41 deletions(-) diff --git a/src/App/Container.purs b/src/App/Container.purs index 63eda3e..1d7c51a 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -1,15 +1,17 @@ module App.Container where -import Prelude (Unit, bind, discard, unit, ($)) +import Prelude (Unit, bind, discard, unit, ($), (<>), show, pure) import Bulma as Bulma import App.Nav as Nav +import Data.Array as A import Data.Maybe (Maybe(..)) +import Data.Either (Either(..)) import Data.Tuple (Tuple(..)) import App.AuthenticationForm as AF -import App.Log as Log +import App.Log as AppLog import App.WS as WS import App.AuthenticationDaemonAdminInterface as AAI import App.DomainListInterface as DomainListInterface @@ -20,6 +22,7 @@ import Halogen as H import Halogen.HTML as HH import Type.Proxy (Proxy(..)) import Effect.Aff.Class (class MonadAff) +import Data.ArrayBuffer.Types (ArrayBuffer) import App.LogMessage (LogMessage(..)) @@ -51,6 +54,9 @@ data Action -- | Then, the message will be provided to the `DispatchDNSMessage` action. | DNSRawMessageReceived ArrayBuffer + -- | Log message (through the Log component). + | Log LogMessage + type State = { token :: Maybe String , uid :: Maybe Int , current_page :: Page @@ -59,7 +65,7 @@ type State = { token :: Maybe String } type ChildSlots = - ( log :: Log.Slot Unit + ( log :: AppLog.Slot Unit , ho :: HomeInterface.Slot Unit , ws_auth :: WS.Slot Unit , ws_dns :: WS.Slot Unit @@ -129,7 +135,7 @@ render state Just _ -> Bulma.hero "net libre" "free domains" render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_logs = Bulma.container [ HH.slot_ _log unit Log.component unit ] + render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ] render_auth_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_auth_WS = HH.slot _ws_auth unit WS.component "ws://127.0.0.1:8080" AuthenticationDaemonEvent @@ -165,7 +171,7 @@ 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 + Log message -> H.tell _log unit $ AppLog.Log message AuthenticateToDNSManager -> do state <- H.get @@ -174,18 +180,18 @@ handleAction = case _ of message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token } H.tell _ws_dns unit (WS.ToSend message) Nothing -> do - H.tell _log unit (Log.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token") + H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token") AuthenticationComponentEvent ev -> case ev of AF.AuthToken (Tuple uid token) -> do H.modify_ _ { uid = Just uid, token = Just token, current_page = DomainList } handleAction AuthenticateToDNSManager AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - AF.Log message -> H.tell _log unit (Log.Log message) + AF.Log message -> H.tell _log unit (AppLog.Log message) AuthenticationDaemonAdminComponentEvent ev -> case ev of AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) - AAI.Log message -> H.tell _log unit (Log.Log message) + AAI.Log message -> H.tell _log unit (AppLog.Log message) AAI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s } AAI.AskState -> do state <- H.get @@ -193,12 +199,12 @@ handleAction = case _ of ZoneInterfaceEvent ev -> case ev of ZoneInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) - ZoneInterface.Log message -> H.tell _log unit (Log.Log message) + ZoneInterface.Log message -> H.tell _log unit (AppLog.Log message) ZoneInterface.DNSManagerReconnect -> handleAction AuthenticateToDNSManager DomainListComponentEvent ev -> case ev of DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) - DomainListInterface.Log message -> H.tell _log unit (Log.Log 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 @@ -221,7 +227,7 @@ handleAction = case _ of WS.WSJustClosed -> do H.tell _af unit AF.ConnectionIsDown H.tell _aai unit AAI.ConnectionIsDown - WS.Log message -> H.tell _log unit (Log.Log message) + WS.Log message -> H.tell _log unit (AppLog.Log message) Disconnection -> do H.put $ initialState unit @@ -232,78 +238,95 @@ handleAction = case _ of WS.MessageReceived (Tuple _ message) -> do handleAction $ DNSRawMessageReceived message WS.WSJustConnected -> do - handleAction 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) + WS.Log message -> H.tell _log unit (AppLog.Log message) 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 + -- 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 + handleAction $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr (DNSManager.UnknownError unerr) -> - handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr) + handleAction $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownError" <> (show unerr) (DNSManager.UnknownNumber ) -> - handleAction Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber" - pure Nothing + handleAction $ Log $ SimpleLog $ "[🤖] Parsing error: DNSManager.UnknownNumber" -- Cases where we understood the message. Right received_msg -> do case received_msg of + (DNSManager.MkDomainNotFound _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: DomainNotFound" + (DNSManager.MkRRNotFound _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: RRNotFound" + (DNSManager.MkInvalidZone _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: InvalidZone" + (DNSManager.MkDomainChanged _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: DomainChanged" + (DNSManager.MkUnknownZone _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: UnknownZone" + (DNSManager.MkDomainList _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: MkDomainList" + (DNSManager.MkUnknownUser _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: MkUnknownUser" + (DNSManager.MkNoOwnership _) -> do + handleAction $ Log $ SimpleLog $ "[😈] Fail: MkNoOwnership" -- The authentication failed. (DNSManager.MkError errmsg) -> do - handleAction Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason + 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 $ 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." + handleAction $ Log $ SimpleLog $ "Failed connection! Invalid token! Try re-authenticate." (DNSManager.MkDomainAlreadyExists _) -> do - handleAction Log $ SimpleLog $ "Failed! The domain already exists." + 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 (DNSManager.MkLogged _) -> do - handleAction Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" + handleAction $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" (DNSManager.MkDomainAdded response) -> do - handleAction Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain + handleAction $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain (DNSManager.MkRRReadOnly response) -> do - handleAction Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " + 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.MkRRUpdated _) -> do + handleAction $ Log $ SimpleLog $ "[🎉] Resource updated!" (DNSManager.MkRRAdded response) -> do - handleAction Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype + handleAction $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> response.rr.rrtype (DNSManager.MkInvalidDomainName _) -> do - handleAction Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" + handleAction $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!" (DNSManager.MkDomainDeleted response) -> do - handleAction Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" + 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!" + handleAction $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" + (DNSManager.MkZone _) -> do + handleAction $ Log $ SimpleLog $ "[🎉] Zone received!" (DNSManager.MkInvalidRR response) -> do - handleAction Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors + handleAction $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors (DNSManager.MkSuccess _) -> do - handleAction Log $ SimpleLog $ "[🎉] Success!" + handleAction $ Log $ SimpleLog $ "[🎉] Success!" + pure unit -- Send a received DNS manager message to a component. - DispatchDNSMessage message -> do - handleAction Log $ SimpleLog "should send a DNS message to a component" + DispatchDNSMessage _ -> 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") + -- _ -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd") + pure unit