From 987c3e100bd1460898fee9d478cb979f54531b0a Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 17 May 2025 23:33:51 +0200 Subject: [PATCH] Make notifications temporary. --- src/App/Container.purs | 35 ++++++++-------- src/App/Notification.purs | 75 ++++++++++++++++++++++++++++++++++ src/App/Type/Notification.purs | 3 ++ 3 files changed, 95 insertions(+), 18 deletions(-) create mode 100644 src/App/Notification.purs create mode 100644 src/App/Type/Notification.purs diff --git a/src/App/Container.purs b/src/App/Container.purs index cdf57b7..490b269 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -66,6 +66,9 @@ import App.Message.AuthenticationDaemon as AuthD import App.Log as AppLog import App.WS as WS +-- import App.Tick as Tick +import App.Notification as Notification +import App.Type.Notification (Notification (..)) import Scroll (scrollToTop) @@ -124,6 +127,8 @@ data PageEvent | EventPageZone PageZone.Output | EventPageMigration PageMigration.Output + | EventPageNotification Notification.Output + data NetworkEvent = EventWSAuthenticationDaemon WS.Output | EventWSDNSmanagerd WS.Output @@ -157,18 +162,13 @@ data Action -- | Currently, this handles the navigation bar. | ToggleAuthenticated (Maybe Token) - -- | Add a main notification, at the top of the page. - | AddNotif Notification - - -- | Close the main notification, at the top of the page. - | CloseNotif - -- | In order to keep the websocket overhead to a minimum, unused connections are -- | closed automatically by the client. In practice, this is handled by a simple counter -- | incremented each time a KeepAlive message is sent. | ResetKeepAliveCounter -data Notification = NoNotification | GoodNotification String | BadNotification String + -- | Add a main notification, at the top of the page. + | AddNotif Notification -- | The component's state is composed of: -- | a potential authentication token, @@ -179,7 +179,6 @@ type State = { token :: Maybe String , user_data :: Maybe (Tuple (Maybe Email.Email) (Maybe Email.Email)) , current_page :: Page , childstates :: ChildStates - , notif :: Notification , login :: Maybe String , keepalive_counter :: Int , are_we_connected_to_authd :: Boolean @@ -203,6 +202,8 @@ type ChildSlots = , dli :: PageDomainList.Slot Unit , zi :: PageZone.Slot Unit , mi :: PageMigration.Slot Unit + + , notificationinterface :: Notification.Slot Unit ) _ho = Proxy :: Proxy "ho" -- Home Interface @@ -218,6 +219,7 @@ _setupi = Proxy :: Proxy "setupi" -- Setup Interface _dli = Proxy :: Proxy "dli" -- Domain List _zi = Proxy :: Proxy "zi" -- Zone Interface _mi = Proxy :: Proxy "mi" -- Migration Interface +_notificationinterface = Proxy :: Proxy "notificationinterface" -- Setup Interface component :: forall q i o m. MonadAff m => H.Component q i o m component = @@ -243,7 +245,6 @@ initialState _ = { token: Nothing { domainlist: Nothing , administration: Nothing } - , notif: NoNotification , login: Nothing , keepalive_counter: 0 , are_we_connected_to_authd: false @@ -325,11 +326,8 @@ render state render_dnsmanager_WS :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_dnsmanager_WS = HH.slot _ws_dns unit WS.component (Tuple wsURLdnsmanagerd "dnsmanagerd") (EventOnNetwork <<< EventWSDNSmanagerd) - render_notifications = - case state.notif of - NoNotification -> HH.div_ [] - GoodNotification v -> Web.box [Web.notification_success v CloseNotif] - BadNotification v -> Web.box [Web.notification_danger v CloseNotif] + notification_duration = 3000 :: Int -- in ms + render_notifications = HH.slot _notificationinterface unit Notification.component notification_duration (EventOnPage <<< EventPageNotification) render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad render_home = HH.slot_ _ho unit PageHome.component unit @@ -421,7 +419,7 @@ handleAction = case _ of H.modify_ _ { current_page = page } -- Finally, when changing page, the notification should be discarded. - handleAction CloseNotif + handleAction $ AddNotif NoNotification Log message -> do _ <- case message of @@ -465,13 +463,12 @@ handleAction = case _ of EventOnPage page_event -> act_on_page_event page_event EventOnNetwork network_event -> act_on_network_event network_event - AddNotif n -> H.modify_ _ { notif = n } - CloseNotif -> H.modify_ _ { notif = NoNotification } + AddNotif n -> H.tell _notificationinterface unit (Notification.Set n) Reconnection -> do H.tell _ws_auth unit WS.Connect H.tell _ws_dns unit WS.Connect - H.modify_ _ { notif = NoNotification } + handleAction $ AddNotif NoNotification Disconnection -> do handleAction $ Routing Home @@ -646,6 +643,8 @@ act_on_page_event page_event = case page_event of H.tell _ws_auth unit (WS.ToSend message) PageMigration.Log message -> handleAction $ Log message + EventPageNotification _ -> handleAction $ Log $ SystemLog "Weird, just received a notification from the notification component." + act_on_network_event :: forall o monad. MonadAff monad => NetworkEvent -> H.HalogenM State Action ChildSlots o monad Unit act_on_network_event network_event = case network_event of -- | `authd websocket component` wants to do something. diff --git a/src/App/Notification.purs b/src/App/Notification.purs new file mode 100644 index 0000000..0c70159 --- /dev/null +++ b/src/App/Notification.purs @@ -0,0 +1,75 @@ +-- | Handle a notification subsystem. +module App.Notification where + +import Prelude + +import Data.Int (toNumber) +import Data.Maybe (Maybe(..)) +import Effect.Aff as Aff +import Effect.Aff (Milliseconds(..)) +import Effect.Aff.Class (class MonadAff) +import Halogen as H +import Halogen.HTML as HH +import Halogen.Subscription as HS + +import App.Type.Notification (Notification (..)) + +import Web as Web + +-- | Input = delay. +type Input = Int + +-- | No output. +data Output = Unit + +type Slot = H.Slot Query Output + +-- | `timer` triggers an action after `tick_delay` ms. +timer :: forall m a. MonadAff m => Number -> a -> m (HS.Emitter a) +timer tick_delay action = do + { emitter, listener } <- H.liftEffect HS.create + _ <- H.liftAff $ Aff.forkAff do + Aff.delay $ Milliseconds tick_delay + H.liftEffect $ HS.notify listener action + pure emitter + +data Action = CloseNotif + +type State = { delay :: Int, notification :: Notification } + +data Query a = Set Notification a + +component :: forall m. MonadAff m => H.Component Query Input Output m +component = + H.mkComponent + { initialState + , render + , eval: H.mkEval $ H.defaultEval + { initialize = Nothing + , handleAction = handleAction + , handleQuery = handleQuery + } + } + +handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) +handleQuery = case _ of + Set notif a -> do + H.modify_ _ { notification = notif } + state <- H.get + _ <- H.subscribe =<< timer (toNumber state.delay) CloseNotif + pure (Just a) + +initialState :: Input -> State +initialState delay = { delay: delay, notification: NoNotification } + +render :: forall m. State -> H.ComponentHTML Action () m +render state = do + case state.notification of + NoNotification -> HH.div_ [] + GoodNotification v -> Web.box [Web.notification_success v CloseNotif] + BadNotification v -> Web.box [Web.notification_danger v CloseNotif] + +handleAction :: forall m. + MonadAff m => Action -> H.HalogenM State Action () Output m Unit +handleAction action = case action of + CloseNotif -> H.modify_ _ { notification = NoNotification } diff --git a/src/App/Type/Notification.purs b/src/App/Type/Notification.purs new file mode 100644 index 0000000..fd30681 --- /dev/null +++ b/src/App/Type/Notification.purs @@ -0,0 +1,3 @@ +module App.Type.Notification where + +data Notification = NoNotification | GoodNotification String | BadNotification String