diff --git a/src/App/Container.purs b/src/App/Container.purs index e857ff2..896bc2c 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -151,7 +151,7 @@ render state , case state.current_page of Home -> render_home LoginRegister -> render_auth_form - DomainList -> render_newdomain_interface + DomainList -> render_domainlist_interface Zone domain -> render_zone domain AuthAdmin -> render_authd_admin_interface -- The footer includes logs and both the WS child components. @@ -160,9 +160,16 @@ render state ] where - render_home = Bulma.box [ HH.slot_ _ho unit HomeInterface.component unit] - - render_zone domain = Bulma.box [ HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent] + render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_home = HH.slot_ _ho unit HomeInterface.component unit + render_domainlist_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_domainlist_interface = HH.slot _dli unit DomainListInterface.component unit DomainListComponentEvent + render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_auth_form = HH.slot _af unit AF.component unit AuthenticationComponentEvent + render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent + render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad + render_authd_admin_interface = HH.slot _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent authenticated = case state.token of Nothing -> false @@ -188,31 +195,28 @@ render state render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_dnsmanager_WS = HH.slot _ws_dns unit WS.component "ws://127.0.0.1:8081" DNSManagerDaemonEvent - render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_auth_form = case state.token of - Nothing -> Bulma.box [ HH.slot _af unit AF.component unit AuthenticationComponentEvent ] - Just _ -> render_nothing - - render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_authd_admin_interface = case state.token of - Just _ -> Bulma.box $ - [ HH.slot _aai unit AAI.component unit AuthenticationDaemonAdminComponentEvent - ] - Nothing -> render_nothing - - render_newdomain_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad - render_newdomain_interface = case state.token of - Just _ -> Bulma.box $ - [ HH.slot _dli unit DomainListInterface.component unit DomainListComponentEvent - ] - Nothing -> render_nothing + --case state.token of + -- Just _ -> Bulma.box $ + -- [ HH.slot _dli unit DomainListInterface.component unit DomainListComponentEvent + -- ] + -- Nothing -> render_nothing render_nothing :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_nothing = HH.div_ [] handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit handleAction = case _ of - Routing page -> H.modify_ _ { current_page = page } + Routing page -> do + -- TODO: store the current page we are on and restore it when we reload. + sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window + _ <- case page of + Home -> H.liftEffect $ Storage.setItem "current-page" "Home" sessionstorage + LoginRegister -> H.liftEffect $ Storage.setItem "current-page" "LoginRegister" sessionstorage + DomainList -> H.liftEffect $ Storage.setItem "current-page" "DomainList" sessionstorage + Zone zone -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone" sessionstorage + H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage + AuthAdmin -> H.liftEffect $ Storage.setItem "current-page" "AuthAdmin" sessionstorage + H.modify_ _ { current_page = page } Log message -> H.tell _log unit $ AppLog.Log message @@ -385,6 +389,8 @@ handleAction = case _ of H.put $ initialState unit sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window _ <- H.liftEffect $ Storage.removeItem "user-authd-token" sessionstorage + _ <- H.liftEffect $ Storage.removeItem "current-page" sessionstorage + _ <- H.liftEffect $ Storage.removeItem "current-zone" sessionstorage handleAction $ Routing Home -- TODO: depending on the current page, we should provide the received message to different components. @@ -487,11 +493,46 @@ handleAction = case _ of -- | TODO: in case the message is a `logged` message, it means that the connection has been reset, and should be -- | handled no matter the actual page we're on. DispatchDNSMessage 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 (AppLog.Log $ SystemLog "unexpected message from dnsmanagerd") + + -- The message `Logged` can be received after a re-connection (typically, after a page reload). + -- This is an hint, and the application should do a series of actions based on this. + -- First, we should check if there is a "current page", if so, switch page. + -- Second, depending on the page, actions have to be undertaken. + -- For `DomainList`, send a request to `dnsmanagerd` for the list of own domains and acceptable domains. + -- For `Zone`, send a request to `dnsmanagerd` for the zone content. + state <- H.get + case state.current_page, message of + Home, m@(DNSManager.MkLogged _) -> do + handleAction $ Log $ SystemLog "page reload!" + case state.store_DomainListInterface_state of + Nothing -> do + let new_value = DomainListInterface.page_reload (DomainListInterface.initialState unit) m + H.modify_ _ { store_DomainListInterface_state = Just new_value } + Just _ -> handleAction $ Log $ SystemLog "we already have a state? WTH?!" + + -- Get back to the previous page. + sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window + page <- H.liftEffect $ Storage.getItem "current-page" sessionstorage + case page of + Nothing -> pure unit + Just "Home" -> handleAction $ Routing Home + Just "LoginRegister" -> handleAction $ Routing LoginRegister + Just "DomainList" -> handleAction $ Routing DomainList + + Just "Zone" -> do + handleAction $ Log $ SystemLog "wait, we were on the Zone page!!" + domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage + case domain of + Nothing -> handleAction $ Log $ SystemLog "Zone but no domain recorded!! WEIRD" + Just zone -> do handleAction $ Log $ SystemLog $ "Zone where to go: " <> zone + handleAction $ Routing (Zone zone) + + Just "AuthAdmin" -> handleAction $ Routing AuthAdmin + Just p -> handleAction $ Log $ SystemLog $ "Oopsie, we didn't understand the old page: " <> p + + DomainList, _ -> H.tell _dli unit (DomainListInterface.MessageReceived message) + Zone _ , _ -> H.tell _zi unit (ZoneInterface.MessageReceived message) + _, _ -> handleAction $ Log $ SystemLog "unexpected message from dnsmanagerd" pure unit --print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit diff --git a/src/App/DomainListInterface.purs b/src/App/DomainListInterface.purs index 41dd365..bed7f4a 100644 --- a/src/App/DomainListInterface.purs +++ b/src/App/DomainListInterface.purs @@ -329,6 +329,7 @@ handleQuery = case _ of (DNSManager.MkLogged response) -> do handleAction $ UpdateAcceptedDomains response.accepted_domains handleAction $ UpdateMyDomains response.my_domains + H.raise $ Log $ SimpleLog $ "[😈] LOOOOOOOOOGGED DomainListInterface." (DNSManager.MkDomainAdded response) -> do { my_domains } <- H.get handleAction $ UpdateMyDomains (my_domains <> [response.domain]) @@ -346,6 +347,15 @@ handleQuery = case _ of H.modify_ _ { wsUp = true } pure (Just a) +page_reload :: State -> DNSManager.AnswerMessage -> State +page_reload s1 message = + case message of + DNSManager.MkLogged response -> + s1 { accepted_domains = response.accepted_domains + , my_domains = response.my_domains + } + _ -> s1 + build_new_domain :: String -> String -> String build_new_domain sub tld | endsWith "." sub = sub <> tld