New Setup page, to handle user account administration.

src/App/Container.purs

@@ -58,7 +58,8 @@ import App.RegistrationInterface as RI
 import App.MailValidationInterface as MVI
 import App.Log as AppLog
 import App.WS as WS
-import App.AdministrationInterface as AdminI
+import App.AdministrationInterface as AdminInterface
+import App.SetupInterface as SetupInterface
 import App.DomainListInterface as DomainListInterface
 import App.ZoneInterface as ZoneInterface
 import App.HomeInterface as HomeInterface
@@ -96,11 +97,14 @@ data Action
   -- | Handle events from `MailValidationInterface`.
   | MailValidationInterfaceEvent  MVI.Output
 
+  -- | Handle events from `SetupInterface`.
+  | SetupInterfaceEvent           SetupInterface.Output
+
   -- | Handle events from `NavigationInterface`.
   | NavigationInterfaceEvent  NavigationInterface.Output
 
   -- | Handle events from `AuthenticationDaemonAdminComponent`.
-  | AdministrationEvent           AdminI.Output -- Administration interface.
+  | AdministrationEvent           AdminInterface.Output -- Administration interface.
 
   -- | Handle events from `DomainListComponent`.
   | DomainListComponentEvent      DomainListInterface.Output
@@ -161,7 +165,7 @@ data Action
 type State = { token :: Maybe String
              , current_page :: Page
              , store_DomainListInterface_state :: Maybe DomainListInterface.State
-             , store_AuthenticationDaemonAdmin_state :: Maybe AdminI.State
+             , store_AuthenticationDaemonAdmin_state :: Maybe AdminInterface.State
              }
 
 -- | The list of child components: log, `WS` twice (once for each ws connection),
@@ -176,7 +180,8 @@ type ChildSlots =
   , ai      :: AI.Slot Unit
   , ri      :: RI.Slot Unit
   , mvi     :: MVI.Slot Unit
-  , admini  :: AdminI.Slot Unit
+  , admini  :: AdminInterface.Slot Unit
+  , setupi  :: SetupInterface.Slot Unit
   , dli     :: DomainListInterface.Slot Unit
   , zi      :: ZoneInterface.Slot Unit
   )
@@ -190,6 +195,7 @@ _ai      = Proxy :: Proxy "ai"       -- Authentication Interface
 _ri      = Proxy :: Proxy "ri"       -- Registration Interface
 _mvi     = Proxy :: Proxy "mvi"      -- Mail Validation Interface
 _admini  = Proxy :: Proxy "admini"   -- Administration Interface
+_setupi  = Proxy :: Proxy "setupi"   -- Setup Interface
 _dli     = Proxy :: Proxy "dli"      -- Domain List
 _zi      = Proxy :: Proxy "zi"       -- Zone Interface
 
@@ -221,6 +227,7 @@ render state
         MailValidation -> render_mail_validation
         DomainList     -> render_domainlist_interface
         Zone domain    -> render_zone domain
+        Setup          -> render_setup
         Administration -> render_authd_admin_interface
     -- The footer includes logs and both the WS child components.
     , Bulma.columns_ [ Bulma.column_ [ render_logs ]
@@ -236,12 +243,16 @@ render state
     render_auth_form = HH.slot _ai unit AI.component unit AuthenticationInterfaceEvent
     render_registration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_registration = HH.slot _ri unit RI.component unit RegistrationInterfaceEvent
+    render_setup :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_setup = case state.token of
+                     Just token -> HH.slot _setupi unit SetupInterface.component token SetupInterfaceEvent
+                     Nothing -> Bulma.p "You shouldn't see this page. Reconnect!"
     render_mail_validation :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_mail_validation = HH.slot _mvi unit MVI.component unit MailValidationInterfaceEvent
     render_zone :: forall monad. String -> MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_zone domain = HH.slot _zi unit ZoneInterface.component domain ZoneInterfaceEvent
     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
+    render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent
 
     render_nav :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_nav = HH.slot _nav unit NavigationInterface.component unit NavigationInterfaceEvent
@@ -281,6 +292,7 @@ handleAction = case _ of
       DomainList     -> H.liftEffect $ Storage.setItem "current-page" "DomainList"     sessionstorage
       Zone zone      -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone"   sessionstorage
                            H.liftEffect $ Storage.setItem      "current-zone" zone     sessionstorage
+      Setup          -> H.liftEffect $ Storage.setItem "current-page" "Setup"          sessionstorage
       Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage
     H.modify_ _ { current_page = page }
 
@@ -340,13 +352,17 @@ handleAction = case _ of
     MVI.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
     MVI.Log message            -> H.tell _log unit (AppLog.Log message)
 
+  SetupInterfaceEvent ev -> case ev of
+    SetupInterface.ChangePassword pass  -> handleAction $ Log $ ErrorLog "TODO: change password"
+    SetupInterface.Log message          -> H.tell _log unit (AppLog.Log message)
+
   AdministrationEvent ev -> case ev of
-    AdminI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
-    AdminI.Log message           -> H.tell _log unit (AppLog.Log message)
-    AdminI.StoreState s          -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
-    AdminI.AskState              -> do
+    AdminInterface.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
+    AdminInterface.Log message           -> H.tell _log unit (AppLog.Log message)
+    AdminInterface.StoreState s          -> H.modify_ _ { store_AuthenticationDaemonAdmin_state = Just s }
+    AdminInterface.AskState              -> do
       state <- H.get
-      H.tell _admini unit (AdminI.ProvideState state.store_AuthenticationDaemonAdmin_state)
+      H.tell _admini unit (AdminInterface.ProvideState state.store_AuthenticationDaemonAdmin_state)
 
   ZoneInterfaceEvent ev -> case ev of
     ZoneInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
@@ -370,7 +386,7 @@ handleAction = case _ of
 
     WS.WSJustConnected -> do
       H.tell _ai unit AI.ConnectionIsUp
-      H.tell _admini unit AdminI.ConnectionIsUp
+      H.tell _admini unit AdminInterface.ConnectionIsUp
       sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
       token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
       case token of
@@ -381,7 +397,7 @@ handleAction = case _ of
 
     WS.WSJustClosed -> do
       H.tell _ai unit AI.ConnectionIsDown
-      H.tell _admini unit AdminI.ConnectionIsDown
+      H.tell _admini unit AdminInterface.ConnectionIsDown
     WS.Log message -> H.tell _log unit (AppLog.Log message)
     WS.KeepAlive   -> handleAction $ KeepAlive $ Left unit
 
@@ -498,7 +514,7 @@ handleAction = case _ of
   DispatchAuthDaemonMessage message -> do
     { current_page } <- H.get
     case current_page of
-      Administration -> H.tell _admini unit (AdminI.MessageReceived message)
+      Administration -> H.tell _admini unit (AdminInterface.MessageReceived message)
       _              -> handleAction $ Log $ SystemLog "unexpected message from authd"
     pure unit
 
@@ -660,6 +676,7 @@ handleAction = case _ of
       Just "Registration"   -> handleAction $ Routing Registration
       Just "DomainList"     -> handleAction $ Routing DomainList
       Just "MailValidation" -> handleAction $ Routing MailValidation
+      Just "Setup"          -> handleAction $ Routing Setup
       Just "Administration" -> handleAction $ Routing Administration
       Just "Zone" -> do
         domain <- H.liftEffect $ Storage.getItem "current-zone" sessionstorage

src/App/NavigationInterface.purs

@@ -90,7 +90,7 @@ handleQuery = case _ of
 -- |
 -- | On mobile (a device with low resolution), a `burger icon` appears instead of the navigation bar.
 -- | When clicked, a list of options (such as pages or a disconnection button) should appear.
--- | Also, when clicked again, the list should disappear.
+-- | Also, when clicked again, the list disappears.
 
 render :: forall m. State -> H.ComponentHTML Action () m
 render { logged, active, admin } =
@@ -112,7 +112,7 @@ render { logged, active, admin } =
   right_bar_div =
     case logged of
         false -> [ link_auth, link_register, link_mail_validation ]
-        _     -> [ link_disconnection ]
+        _     -> [ link_setup, link_disconnection ]
 
   navbar_color = C.is_success
 
@@ -122,7 +122,7 @@ render { logged, active, admin } =
            , ARIA.role "navigation"
            ]
 
-  logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🍉"]
+  logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🔻🍉"]
   --  HH.a [HP.classes C.navbar_item, HP.href "/"]
   --       [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
 
@@ -152,6 +152,7 @@ render { logged, active, admin } =
   link_auth            = nav_link        "Login"             (Navigate Authentication)
   link_register        = nav_link_strong "Register"          (Navigate Registration)
   link_mail_validation = nav_link        "Mail verification" (Navigate MailValidation)
+  link_setup           = nav_link_warn   "⚒ Setup"           (Navigate Setup)
   link_disconnection   =
     nav_link_ (C.has_text_light <> C.has_background_danger) "Disconnection" UnLog
 
@@ -171,6 +172,7 @@ render { logged, active, admin } =
          ] [ (HH.strong [] [ HH.text str ]) ]
 
   nav_link str action = nav_link_ navbar_color str action
+  nav_link_warn str action = nav_link_ (C.has_background_warning <> C.has_text_dark) str action
 
   nav_link_ classes str action =
     HH.a [ HP.classes (C.navbar_item <> classes)

src/App/Pages.purs

@@ -9,4 +9,5 @@ data Page
   | 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.
+  | Setup          -- | `Setup`: user account administration page
   | Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).

src/App/Setup.purs

@@ -0,0 +1,138 @@
+-- | `App.SetupInterface` allows users to change their password or their email address.
+-- | Users can also erase their account.
+module App.SetupInterface where
+
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (==))
+
+import Data.ArrayBuffer.Types (ArrayBuffer)
+import Data.Maybe (Maybe(..))
+import Data.Tuple (Tuple(..))
+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 Web.Event.Event as Event
+import Web.Event.Event (Event)
+
+import Bulma as Bulma
+
+import App.Email as Email
+import App.LogMessage
+import App.Messages.AuthenticationDaemon as AuthD
+
+data Output
+  = Log LogMessage
+  | ChangePassword String
+
+-- | The component's parent provides received messages.
+-- |
+-- | Also, the component is informed when the connection went up or down.
+data Query a
+  = MessageReceived AuthD.AnswerMessage a
+  | ConnectionIsDown a
+  | ConnectionIsUp a
+
+type Slot = H.Slot Query Output
+
+type Input = String
+
+data AuthenticationInput
+  = AUTH_INP_login String
+  | AUTH_INP_pass String
+
+data NewPasswordInput
+  = NEWPASS_INP_password String
+  | NEWPASS_INP_confirmation String
+
+data Action
+  = HandleNewPassword NewPasswordInput
+  | ChangePasswordAttempt Event
+
+type StateNewPasswordForm = { password :: String, confirmation :: String }
+
+type State =
+  { newPasswordForm :: StateNewPasswordForm
+  , token           :: String
+  , wsUp            :: 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 token =
+  { newPasswordForm: { password: "", confirmation: "" }
+  , token
+  , wsUp: true
+  }
+
+render :: forall m. State -> H.ComponentHTML Action () m
+render { wsUp, newPasswordForm }
+  = render_new_password_form
+
+  where
+  should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
+  render_new_password_form = HH.form
+    [ HE.onSubmit ChangePasswordAttempt ]
+    [ Bulma.box_input "passwordNEWPASS" "Password" "password"
+        (HandleNewPassword <<< NEWPASS_INP_password)
+        newPasswordForm.password
+        should_be_disabled
+    , Bulma.box_input "confirmationNEWPASS" "Confirmation" "confirmation"
+        (HandleNewPassword <<< NEWPASS_INP_confirmation)
+        newPasswordForm.confirmation
+        should_be_disabled
+    , HH.button
+       [ HP.style "padding: 0.5rem 1.25rem;"
+       , HP.type_ HP.ButtonSubmit
+       , (if wsUp then (HP.enabled true) else (HP.disabled true))
+       ]
+       [ HH.text "Send Message to Server" ]
+    ]
+
+handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
+handleAction = case _ of
+  HandleNewPassword authinp -> do
+    case authinp of
+      NEWPASS_INP_password     v -> H.modify_ _ { newPasswordForm { password = v } }
+      NEWPASS_INP_confirmation v -> H.modify_ _ { newPasswordForm { confirmation = v } }
+
+  ChangePasswordAttempt ev -> do
+    H.liftEffect $ Event.preventDefault ev
+
+    { newPasswordForm } <- H.get
+    case newPasswordForm.password, newPasswordForm.confirmation of
+      "" , _ -> H.raise $ Log $ UnableToSend "Write your password!"
+      _ , "" -> H.raise $ Log $ UnableToSend "Confirm your password!"
+      pass, confirmation -> do
+        if pass == confirmation
+        then do H.raise $ Log $ SystemLog "Changing the password"
+                H.raise $ ChangePassword pass
+        else H.raise $ Log $ UnableToSend "Confirmation differs from password"
+
+handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
+handleQuery = case _ of
+  -- For now, no message actually needs to be handled here.
+  -- Error messages are simply logged (see the code in the Container component).
+  MessageReceived message _ -> do
+    case message of
+      _ -> do
+        H.raise $ Log $ ErrorLog $ "Message not handled in SetupInterface."
+    pure Nothing
+
+  ConnectionIsDown a -> do
+    H.modify_ _ { wsUp = false }
+    pure (Just a)
+
+  ConnectionIsUp a -> do
+    H.modify_ _ { wsUp = true }
+    pure (Just a)

src/CSSClasses.purs

@@ -91,6 +91,8 @@ has_background_warning_light = [HH.ClassName "has-background-warning-light"]
 has_background_danger_light :: Array HH.ClassName
 has_background_danger_light = [HH.ClassName "has-background-danger-light"]
 
+has_text_dark :: Array HH.ClassName
+has_text_dark = [HH.ClassName "has-text-dark"]
 has_text_light :: Array HH.ClassName
 has_text_light = [HH.ClassName "has-text-light"]
 has_succeeds_separator :: Array HH.ClassName