Problem to fix: state is rewritten when changing page.

beta
Philippe Pittoli 2023-07-08 07:09:56 +02:00
parent a395b88ef2
commit dafb90b71a
2 changed files with 26 additions and 17 deletions

View File

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

View File

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