Store the AuthenticationDaemonAdminInterface state, too.

This commit is contained in:
Philippe Pittoli 2023-07-09 02:40:10 +02:00
parent f6f78f49ed
commit 796cd3ea55
2 changed files with 30 additions and 5 deletions

View File

@ -31,11 +31,14 @@ import App.Messages.AuthenticationDaemon as AuthD
data Output data Output
= MessageToSend ArrayBuffer = MessageToSend ArrayBuffer
| Log LogMessage | Log LogMessage
| AskState
| StoreState State
data Query a data Query a
= MessageReceived ArrayBuffer a = MessageReceived ArrayBuffer a
| ConnectionIsDown a | ConnectionIsDown a
| ConnectionIsUp a | ConnectionIsUp a
| ProvideState (Maybe State) a
type Slot = H.Slot Query Output type Slot = H.Slot Query Output
@ -51,9 +54,11 @@ data Action
= HandleAddUserInput AddUserInput = HandleAddUserInput AddUserInput
| AddUserAttempt | AddUserAttempt
-- | Finalize
| PreventSubmit Event | PreventSubmit Event
| Initialize
| Finalize
type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String } type StateAddUserForm = { login :: String, admin :: Boolean, email :: String, pass :: String }
type State = type State =
@ -67,9 +72,10 @@ component =
{ initialState { initialState
, render , render
, eval: H.mkEval $ H.defaultEval , eval: H.mkEval $ H.defaultEval
{ handleAction = handleAction { initialize = Just Initialize
, handleAction = handleAction
, handleQuery = handleQuery , handleQuery = handleQuery
-- , finalize = Just Finalize , finalize = Just Finalize
} }
} }
@ -123,6 +129,12 @@ render { addUserForm, wsUp }
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of handleAction = case _ of
Initialize -> do
H.raise $ AskState
Finalize -> do
state <- H.get
H.raise $ StoreState state
HandleAddUserInput adduserinp -> do HandleAddUserInput adduserinp -> do
{ addUserForm } <- H.get { addUserForm } <- H.get
@ -162,6 +174,13 @@ handleAction = case _ of
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of
ProvideState maybe_state a -> do
case maybe_state of
Nothing -> pure Nothing
Just s -> do
H.put s
pure (Just a)
MessageReceived message a -> do MessageReceived message a -> do
receivedMessage <- H.liftEffect $ AuthD.deserialize message receivedMessage <- H.liftEffect $ AuthD.deserialize message
case receivedMessage of case receivedMessage of

View File

@ -36,6 +36,7 @@ type State = { token :: Maybe String
, uid :: Maybe Int , uid :: Maybe Int
, current_page :: Page , current_page :: Page
, store_DomainListInterface_state :: Maybe DomainListInterface.State , store_DomainListInterface_state :: Maybe DomainListInterface.State
, store_AuthenticationDaemonAdmin_state :: Maybe AAI.State
} }
type ChildSlots = type ChildSlots =
@ -67,6 +68,7 @@ initialState _ = { token: Nothing
, uid: Nothing , uid: Nothing
, current_page: Home , current_page: Home
, store_DomainListInterface_state: Nothing , store_DomainListInterface_state: Nothing
, store_AuthenticationDaemonAdmin_state: Nothing
} }
render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m render :: forall m. MonadAff m => State -> H.ComponentHTML Action ChildSlots m
@ -161,6 +163,10 @@ handleAction = case _ of
AuthenticationDaemonAdminComponentEvent ev -> case ev of AuthenticationDaemonAdminComponentEvent ev -> case ev of
AAI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) 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 (Log.Log message)
AAI.StoreState s -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
AAI.AskState -> do
state <- H.get
H.tell _aai unit (AAI.ProvideState state.store_AuthenticationDaemonAdmin_state)
DomainListComponentEvent ev -> case ev of DomainListComponentEvent ev -> case ev of
DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message) DomainListInterface.MessageToSend message -> H.tell _ws_dns unit (WS.ToSend message)