From 51d8f07b9e57377049cd480c9858b0f901b0fa1d Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Mon, 18 Nov 2024 07:45:08 +0100
Subject: [PATCH] Users can now change their email address.

---
 src/App/Container.purs                    |  8 ++++++--
 src/App/Message/AuthenticationDaemon.purs | 21 +++++++++++++++++++++
 2 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/src/App/Container.purs b/src/App/Container.purs
index 8fcda9f..6d2c333 100644
--- a/src/App/Container.purs
+++ b/src/App/Container.purs
@@ -347,7 +347,7 @@ render state
     render_authd_admin_interface = HH.slot _admini unit AdminInterface.component unit AdministrationEvent
 
     render_migration :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
-    render_migration = HH.slot_ _mi unit MigrationInterface.component unit
+    render_migration = HH.slot _mi unit MigrationInterface.component unit MigrationInterfaceEvent
 
     render_legal_notice :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_legal_notice
@@ -689,6 +689,10 @@ handleAction = case _ of
             case current_page of
               Administration -> handleAction $ DispatchAuthDaemonMessage m
               _ -> pure unit
+          (AuthD.GotNewEmailTokenSent _) -> do
+            handleAction $ Log $ SuccessLog "New email address is pending. Please enter validation token."
+          (AuthD.GotNewEmailAddressValidated _) -> do
+            handleAction $ Log $ SuccessLog "New email address has been validated."
           (AuthD.GotErrorMustBeAuthenticated _) -> do
             handleAction $ Log $ ErrorLog "received a GotErrorMustBeAuthenticated message."
             handleAction $ AddNotif $ BadNotification "Sorry, you must be authenticated to perform this action."
@@ -778,7 +782,7 @@ handleAction = case _ of
 
   -- TODO
   MigrationInterfaceEvent ev -> case ev of
-    MigrationInterface.MessageToSend message  -> H.tell _ws_dns unit (WS.ToSend message)
+    MigrationInterface.MessageToSend message  -> H.tell _ws_auth unit (WS.ToSend message)
     MigrationInterface.Log message            -> handleAction $ Log message
 
   -- | Send a received authentication daemon message `AuthD.AnswerMessage` to a component.
diff --git a/src/App/Message/AuthenticationDaemon.purs b/src/App/Message/AuthenticationDaemon.purs
index f28d848..fbb427f 100644
--- a/src/App/Message/AuthenticationDaemon.purs
+++ b/src/App/Message/AuthenticationDaemon.purs
@@ -281,6 +281,21 @@ type UserDeleted = { uid :: Int }
 codecGotUserDeleted ∷ CA.JsonCodec UserDeleted
 codecGotUserDeleted = CA.object "UserDeleted" (CAR.record { uid: CA.int })
 
+-- {- 13 -}
+-- type Contacts = { TODO }
+-- codecGotContacts ∷ CA.JsonCodec Contacts
+-- codecGotContacts = CA.object "Contacts" (CAR.record { TODO })
+
+{- 14 -}
+type NewEmailTokenSent = {}
+codecGotNewEmailTokenSent ∷ CA.JsonCodec NewEmailTokenSent
+codecGotNewEmailTokenSent = CA.object "NewEmailTokenSent" (CAR.record {})
+
+{- 15 -}
+type NewEmailAddressValidated = {}
+codecGotNewEmailAddressValidated ∷ CA.JsonCodec NewEmailAddressValidated
+codecGotNewEmailAddressValidated = CA.object "NewEmailAddressValidated" (CAR.record {})
+
 {- 20 -}
 type ErrorMustBeAuthenticated = {}
 codecGotErrorMustBeAuthenticated :: CA.JsonCodec ErrorMustBeAuthenticated
@@ -413,6 +428,9 @@ data AnswerMessage
   | GotPasswordRecovered             PasswordRecovered             -- 10
   | GotMatchingUsers                 MatchingUsers                 -- 11
   | GotUserDeleted                   UserDeleted                   -- 12
+  -- | GotContacts                      Contacts                      -- 13
+  | GotNewEmailTokenSent             NewEmailTokenSent             -- 14
+  | GotNewEmailAddressValidated      NewEmailAddressValidated      -- 15
   | GotErrorMustBeAuthenticated      ErrorMustBeAuthenticated      -- 20
   | GotErrorAlreadyUsedLogin         ErrorAlreadyUsedLogin         -- 21
   | GotErrorMailRequired             ErrorMailRequired             -- 22
@@ -480,6 +498,9 @@ decode number string
     10  -> error_management codecGotPasswordRecovered             GotPasswordRecovered
     11  -> error_management codecGotMatchingUsers                 GotMatchingUsers
     12  -> error_management codecGotUserDeleted                   GotUserDeleted
+    -- 13  -> error_management codecGotContacts                      GotContacts
+    14  -> error_management codecGotNewEmailTokenSent             GotNewEmailTokenSent
+    15  -> error_management codecGotNewEmailAddressValidated      GotNewEmailAddressValidated
     20  -> error_management codecGotErrorMustBeAuthenticated      GotErrorMustBeAuthenticated
     21  -> error_management codecGotErrorAlreadyUsedLogin         GotErrorAlreadyUsedLogin
     22  -> error_management codecGotErrorMailRequired             GotErrorMailRequired