Navigation bar now has a dedicated component.

src/App/Container.purs

@@ -49,8 +49,6 @@ import Prelude (Unit, bind, discard, unit, ($), (=<<), (<>), show, pure)
 
 import Bulma as Bulma
 
-import App.Nav as Nav
-
 import Data.Array as A
 import Data.Maybe (Maybe(..), maybe)
 import Data.Either (Either(..))
@@ -64,6 +62,7 @@ import App.AdministrationInterface as AdminI
 import App.DomainListInterface as DomainListInterface
 import App.ZoneInterface as ZoneInterface
 import App.HomeInterface as HomeInterface
+import App.NavigationInterface as NavigationInterface
 import App.Messages.DNSManagerDaemon as DNSManager
 import App.Messages.AuthenticationDaemon as AuthD
 import Halogen as H
@@ -78,17 +77,7 @@ import Web.Storage.Storage as Storage
 
 import App.LogMessage (LogMessage(..))
 
--- | This list will grow in a near future.
+import App.Pages
--- |
--- | TODO: 
-data Page
-  = Home           -- | `Home`: presentation of the project.
-  | Authentication -- | `Authentication`: authentication page.
-  | Registration   -- | `Registration`: to register new people.
-  | MailValidation -- | `MailValidation`: to validate email addresses (via a token).
-  | DomainList     -- | `DomainList`: to list owned domains and to ask for new domains.
-  | Zone String    -- | `Zone`: to manage a zone.
-  | Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
 
 type Token = String
 type Login = String
@@ -105,6 +94,9 @@ data Action
   -- | Handle events from `MailValidationInterface`.
   | MailValidationInterfaceEvent  MVI.Output
 
+  -- | Handle events from `NavigationInterface`.
+  | NavigationInterfaceEvent  NavigationInterface.Output
+
   -- | Handle events from `AuthenticationDaemonAdminComponent`.
   | AdministrationEvent           AdminI.Output -- Administration interface.
 
@@ -155,6 +147,10 @@ data Action
   -- | `KeepAlive` send a keepalive message to either `authd` or `dnsmanagerd`.
   | KeepAlive (Either Unit Unit)
 
+  -- | `ToggleAuthenticated` performs some actions required when a connection or a disconnection occurs.
+  -- | Currently, this handles the navigation bar.
+  | ToggleAuthenticated (Maybe Token)
+
 -- | The component's state is composed of:
 -- | a potential authentication token,
 -- | the current page,
@@ -174,6 +170,7 @@ type ChildSlots =
   , ho      :: HomeInterface.Slot Unit
   , ws_auth :: WS.Slot Unit
   , ws_dns  :: WS.Slot Unit
+  , nav     :: NavigationInterface.Slot Unit
   , ai      :: AI.Slot Unit
   , ri      :: RI.Slot Unit
   , mvi     :: MVI.Slot Unit
@@ -186,6 +183,7 @@ _ho      = Proxy :: Proxy "ho"       -- Home Interface
 _log     = Proxy :: Proxy "log"      -- Log
 _ws_auth = Proxy :: Proxy "ws_auth"  -- WS with `authd`
 _ws_dns  = Proxy :: Proxy "ws_dns"   -- WS with `dnsmanagerd`
+_nav     = Proxy :: Proxy "nav"      -- Navigation Interface
 _ai      = Proxy :: Proxy "ai"       -- Authentication Interface
 _ri      = Proxy :: Proxy "ri"       -- Registration Interface
 _mvi     = Proxy :: Proxy "mvi"      -- Mail Validation Interface
@@ -243,27 +241,13 @@ render state
     render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_authd_admin_interface = HH.slot _admini unit AdminI.component unit AdministrationEvent
 
-    authenticated = case state.token of
-      Nothing -> false
-      Just _  -> true
-
-    -- TODO: this is needed to show the authd admin button
-    admin = true
-
     render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_nav = Nav.netlibre_navbar authenticated admin
+    render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent
-      (Routing Home)
-      (Routing DomainList)
-      (Routing Administration)
-      (Routing Authentication)
-      (Routing Registration)
-      (Routing MailValidation)
-      Disconnection
 
     render_header :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_header = case state.token of
       Nothing -> Bulma.hero "net libre" "free domains"
-      Just _ ->  Bulma.hero "net libre" "free domains"
+      Just _ ->  Bulma.hero "net libre" ""
 
     render_logs :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_logs = Bulma.container [ HH.slot_ _log unit AppLog.component unit ]
@@ -292,6 +276,10 @@ handleAction = case _ of
 
   Log message -> H.tell _log unit $ AppLog.Log message
 
+  ToggleAuthenticated maybe_token -> case maybe_token of
+    Nothing -> H.tell _nav unit $ NavigationInterface.ToggleLogged false
+    Just _  -> H.tell _nav unit $ NavigationInterface.ToggleLogged true
+
   KeepAlive auth_or_dnsmanager -> case auth_or_dnsmanager of
     Left _ -> do
       message <- H.liftEffect $ AuthD.serialize $ AuthD.MkKeepAlive {}
@@ -324,6 +312,11 @@ handleAction = case _ of
             H.modify_ _ { token = Just t }
             handleAction AuthenticateToDNSManager
 
+  NavigationInterfaceEvent ev -> case ev of
+    NavigationInterface.Log message -> H.tell _log unit (AppLog.Log message)
+    NavigationInterface.Routing page -> handleAction $ Routing page
+    NavigationInterface.Disconnection -> handleAction $ Disconnection
+
   AuthenticationInterfaceEvent ev -> case ev of
     AI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
     AI.AuthenticateToAuthd v  -> handleAction $ AuthenticateToAuthd (Right v)
@@ -457,6 +450,7 @@ handleAction = case _ of
             handleAction $ Log $ ErrorLog "Email required!"
           (AuthD.GotErrorInvalidCredentials _) -> do
             handleAction $ Log $ ErrorLog "Invalid credentials!"
+            handleAction $ ToggleAuthenticated Nothing
           (AuthD.GotErrorRegistrationsClosed _) -> do
             handleAction $ Log $ ErrorLog "Registration closed! Try another time or contact an administrator."
           (AuthD.GotErrorInvalidLoginFormat _) -> do
@@ -479,6 +473,7 @@ handleAction = case _ of
           (AuthD.GotToken msg) -> do
             handleAction $ Log $ SuccessLog $ "Authenticated to authd!"
             H.modify_ _ { token = Just msg.token }
+            handleAction $ ToggleAuthenticated (Just msg.token)
 
             sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
             _ <- H.liftEffect $ Storage.setItem "user-authd-token" msg.token sessionstorage
@@ -561,6 +556,8 @@ handleAction = case _ of
           (DNSManager.MkErrorInvalidToken _) -> do
             H.modify_ _ { token = Nothing, current_page = Home }
             handleAction $ Log $ ErrorLog $ "Invalid token! Try re-authenticate."
+            -- TODO: should we disconnect from authd?
+            handleAction $ ToggleAuthenticated Nothing
           (DNSManager.MkDomainAlreadyExists _) -> do
             handleAction $ Log $ ErrorLog $ "The domain already exists."
           m@(DNSManager.MkUnacceptableDomain _) -> do

src/App/Nav.purs

@@ -32,13 +32,6 @@ netlibre_navbar authenticated admin
                 false, _ -> [ link_home ]
                 _, false -> [ link_home, link_domains ]
                 _, _     -> [ link_home, link_domains, link_authd_admin ]
-            --, dropdown "List of something"
-            --  [ dropdown_element "something 1"
-            --  , dropdown_element "something 2"
-            --  , dropdown_element "something 3"
-            --  , dropdown_separator
-            --  , dropdown_element "something 4"
-            --  ]
             ]
         , navbar_end
             [ navbar_item
@@ -58,7 +51,15 @@ netlibre_navbar authenticated admin
     logo = HH.a [HP.classes C.navbar_item, HP.href "/"] [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
     burger_menu
       = HH.a [HP.classes C.navbar_burger, ARIA.label "menu", ARIA.expanded "false", Bulma.data_target "navbarExample" ]
-          [ HH.span [ARIA.hidden "true"] []
+          [ HH.span [ARIA.hidden "true"] [
+            dropdown "List of something"
+              [ dropdown_element "something 1"
+              , dropdown_element "something 2"
+              , dropdown_element "something 3"
+              , dropdown_separator
+              , dropdown_element "something 4"
+              ]
+          ]
           , HH.span [ARIA.hidden "true"] []
           , HH.span [ARIA.hidden "true"] []
           ]
@@ -70,12 +71,14 @@ netlibre_navbar authenticated admin
     link_domains = nav_button C.is_info "Domains" actionDomainList
     link_authd_admin = nav_button C.is_info "Admin" actionAdmin
     nav_button_disconnection = nav_button C.is_danger "Disconnection" actionDisconnection
-    --dropdown title dropdown_elements
+
-    --  = HH.div [HP.classes (C.navbar_item <> C.has_dropdown <> C.is_hoverable)]
+    dropdown title dropdown_elements
-    --      [ dropdown_title title, HH.div [HP.classes C.navbar_dropdown] dropdown_elements ]
+      = HH.div [HP.classes (C.navbar_item <> C.has_dropdown <> C.is_hoverable)]
-    --dropdown_title str = HH.a [HP.classes C.navbar_link] [HH.text str]
+          [ dropdown_title title, HH.div [HP.classes C.navbar_dropdown] dropdown_elements ]
-    --dropdown_element str = HH.a [HP.classes C.navbar_item] [HH.text str]
+    dropdown_title str = HH.a [HP.classes C.navbar_link] [HH.text str]
-    --dropdown_separator = HH.hr [HP.classes C.navbar_divider]
+    dropdown_element str = HH.a [HP.classes C.navbar_item] [HH.text str]
+    dropdown_separator = HH.hr [HP.classes C.navbar_divider]
+
     nav_button_code = btn_link [] "https://git.baguette.netlib.re/Baguette/dnsmanager" "Code"
     nav_button_strong str action = btn C.is_primary action (HH.strong [] [ HH.text str ])
     nav_button classes str action = btn classes action (HH.text str)

src/App/NavigationInterface.purs

@@ -0,0 +1,104 @@
+-- | `App.NavigationInterface` is the navbar module.
+-- |
+-- | This module is required since some javascript is needed to toggle display of hidden resources.
+-- | On mobile, a burger menu is displayed and hides the navigation buttons.
+-- | On desktop, there is no need for this, all the navigation buttons are displayed by default.
+module App.NavigationInterface where
+
+import Prelude (Unit, not, ($), discard, pure)
+
+import App.Nav as Nav
+
+-- import Data.Array as A
+import Data.Maybe (Maybe(..))
+-- import Data.Either (Either(..))
+import Effect.Aff.Class (class MonadAff)
+import Halogen as H
+--import Halogen.HTML as HH
+--import Halogen.HTML.Events as HE
+--import Halogen.HTML.Properties as HP
+
+import Bulma as Bulma
+
+import App.Pages (Page(..))
+import App.LogMessage (LogMessage)
+
+data Output
+  = Log LogMessage
+  -- | Once someone clicks on a routing button, `App.Container` needs to know.
+  | Routing Page
+  -- | Once someone clicks on a the Disconnection button, `App.Container` needs to know.
+  | Disconnection
+
+-- | The component needs to know when the user is logged or not.
+data Query a = ToggleLogged Boolean a
+
+type Slot = H.Slot Query Output
+
+type Input = Unit
+
+data Action
+  -- | `ToggleMenu`: display or hide the content of the burger menu.
+  = ToggleMenu
+  -- | The navigation interface must be informed when the client wants to change page.
+  -- | The request will be propagated to the parent (`App.Container`).
+  -- | (`Navigate` is `App.Container.Routing`)
+  | Navigate Page
+  -- | The navigation interface must be informed when the client wants to disconnect.
+  -- | The request will be propagated to the parent (`App.Container`).
+  -- | (`UnLog` is `App.Container.Disconnection`)
+  | UnLog
+
+-- | State is composed of:
+-- | - `logged`, a boolean to toggle the display of some parts of the menu.
+-- | - `active`, a boolean to toggle the display of the menu.
+type State = { logged :: Boolean, active :: Boolean }
+
+component :: forall m. MonadAff m => H.Component Query Input Output m
+component =
+  H.mkComponent
+    { initialState
+    , render
+    , eval: H.mkEval $ H.defaultEval { handleAction = handleAction
+                                     , handleQuery = handleQuery
+                                     }
+    }
+
+initialState :: Input -> State
+initialState _ = { logged: false, active: false }
+
+render :: forall m. State -> H.ComponentHTML Action () m
+render { logged, active }
+  = Bulma.section_small
+      [ case active of
+          true  -> Bulma.btn "ACTIVE" ToggleMenu
+          false -> Bulma.alert_btn "NOT ACTIVE" ToggleMenu
+      , render_nav
+      ]
+  where
+
+    -- TODO: this is needed to show the authd admin button
+    admin = true
+
+    render_nav :: forall childslots monad. H.ComponentHTML Action childslots monad
+    render_nav = Nav.netlibre_navbar logged admin
+      (Navigate Home)
+      (Navigate DomainList)
+      (Navigate Administration)
+      (Navigate Authentication)
+      (Navigate Registration)
+      (Navigate MailValidation)
+      UnLog
+
+handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
+handleAction = case _ of
+  ToggleMenu -> H.modify_ \state -> state { active = not state.active }
+  -- | Page change.
+  Navigate page -> H.raise $ Routing page
+  UnLog         -> H.raise $ Disconnection
+
+handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
+handleQuery = case _ of
+  ToggleLogged islogged a -> do
+    H.modify_ _ { logged = islogged }
+    pure (Just a)

src/App/Pages.purs

@@ -0,0 +1,12 @@
+module App.Pages where
+-- | This list will grow in a near future.
+-- |
+-- | TODO: 
+data Page
+  = Home           -- | `Home`: presentation of the project.
+  | Authentication -- | `Authentication`: authentication page.
+  | Registration   -- | `Registration`: to register new people.
+  | MailValidation -- | `MailValidation`: to validate email addresses (via a token).
+  | DomainList     -- | `DomainList`: to list owned domains and to ask for new domains.
+  | Zone String    -- | `Zone`: to manage a zone.
+  | Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).