karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Page reload: DONE!

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-08 20:20:33 +01:00
parent 7544cb90ee
commit 412a06d10b
2 changed files with 79 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
src/App/Container.purs
View File

@ -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

10
src/App/DomainListInterface.purs
View File

@ -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