Make notifications temporary.

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.

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 }

src/App/Type/Notification.purs

@@ -0,0 +1,3 @@
+module App.Type.Notification where
+
+data Notification = NoNotification | GoodNotification String | BadNotification String