diff --git a/src/App/Container.purs b/src/App/Container.purs index 050dabc..1a0e060 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -1,6 +1,6 @@ module App.Container where -import Prelude +import Prelude (Unit, bind, discard, unit, ($)) import Bulma as Bulma @@ -13,11 +13,14 @@ import App.Log as Log import App.WS as WS import App.AuthenticationDaemonAdminInterface as AAI import App.DomainListInterface as DomainListInterface +import App.Messages.DNSManagerDaemon as DNSManager import Halogen as H import Halogen.HTML as HH import Type.Proxy (Proxy(..)) import Effect.Aff.Class (class MonadAff) +import App.LogMessage (LogMessage(..)) + data Page = Home | LoginRegister | DomainList | Zone | AuthAdmin data Action @@ -26,6 +29,7 @@ data Action | DomainListComponentEvent DomainListInterface.Output | AuthenticationDaemonEvent WS.Output | DNSManagerDaemonEvent WS.Output + | AuthenticateToDNSManager | Routing Page type State = { token :: Maybe String @@ -136,8 +140,19 @@ handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Act handleAction = case _ of Routing page -> H.modify_ _ { current_page = page } + AuthenticateToDNSManager -> do + state <- H.get + case state.token of + Just token -> do + 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") + AuthenticationComponentEvent ev -> case ev of - AF.AuthToken (Tuple uid token) -> H.modify_ _ { uid = Just uid, token = Just token, current_page = DomainList } + 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) @@ -148,6 +163,7 @@ 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 (Log.Log message) + DomainListInterface.DNSManagerReconnect -> handleAction AuthenticateToDNSManager -- TODO: depending on the current page, we should provide the received message to different components. AuthenticationDaemonEvent ev -> case ev of @@ -162,12 +178,14 @@ 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 (Log.Log message) -- TODO: depending on the current page, we should provide the received message to different components. DNSManagerDaemonEvent ev -> case ev of WS.MessageReceived (Tuple _ message) -> H.tell _dli unit (DomainListInterface.MessageReceived message) - WS.WSJustConnected -> H.tell _dli unit DomainListInterface.ConnectionIsUp + WS.WSJustConnected -> do + H.tell _log unit (Log.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) - diff --git a/src/App/DomainListInterface.purs b/src/App/DomainListInterface.purs index 22ab7d4..abcae5d 100644 --- a/src/App/DomainListInterface.purs +++ b/src/App/DomainListInterface.purs @@ -36,6 +36,7 @@ import App.Messages.DNSManagerDaemon as DNSManager data Output = MessageToSend ArrayBuffer | Log LogMessage + | DNSManagerReconnect data Query a = MessageReceived ArrayBuffer a @@ -54,8 +55,6 @@ data Action = UpdateAcceptedDomains (Array String) | UpdateMyDomains (Array String) - | AuthenticateToDNSManager - | HandleNewDomainInput NewDomainFormAction | NewDomainAttempt Event @@ -82,8 +81,7 @@ component = { initialState , render , eval: H.mkEval $ H.defaultEval - { initialize = Just AuthenticateToDNSManager - , handleAction = handleAction + { handleAction = handleAction , handleQuery = handleQuery } } @@ -157,11 +155,6 @@ handleAction = case _ of UpdateMyDomains domains -> do H.modify_ _ { my_domains = domains } - AuthenticateToDNSManager -> do - { token } <- H.get - message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkLogin { token: token } - H.raise $ MessageToSend message - HandleNewDomainInput adduserinp -> do case adduserinp of INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } } @@ -217,7 +210,7 @@ handleQuery = case _ of (DNSManager.MkErrorUserNotLogged _) -> do H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!" H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..." - handleAction AuthenticateToDNSManager + H.raise $ DNSManagerReconnect (DNSManager.MkErrorInvalidToken _) -> do H.raise $ Log $ SimpleLog $ "[😈] Failed connection! Invalid token!" (DNSManager.MkDomainAlreadyExists _) -> do @@ -260,8 +253,6 @@ handleQuery = case _ of ConnectionIsUp a -> do H.modify_ _ { wsUp = true } - H.raise $ Log $ SimpleLog "Connection with dnsmanagerd was closed, let's re-authenticate" - handleAction AuthenticateToDNSManager pure (Just a) build_new_domain :: String -> String -> String