From 6829b6445b57208ee063e62e2fd0414bb3a9998c Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Sun, 1 Oct 2023 01:39:37 +0200
Subject: [PATCH] Put all decoding message code in Container instead of
 AuthenticationForm.

---
 src/App/AuthenticationForm.purs |  88 +++----------------------
 src/App/Container.purs          | 110 +++++++++++++++++++++++++++++---
 2 files changed, 111 insertions(+), 87 deletions(-)

diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs
index 084e29e..6d6b305 100644
--- a/src/App/AuthenticationForm.purs
+++ b/src/App/AuthenticationForm.purs
@@ -6,7 +6,7 @@ import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), show)
 
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
@@ -28,15 +28,14 @@ import App.Messages.AuthenticationDaemon as AuthD
 -- |
 -- | Also, the component can send a message to a websocket and log messages.
 data Output
-  = AuthToken (Tuple Int String)
-  | MessageToSend ArrayBuffer
+  = MessageToSend ArrayBuffer
   | Log LogMessage
 
 -- | The component's parent provides received messages.
 -- |
 -- | Also, the component is informed when the connection went up or down.
 data Query a
-  = MessageReceived ArrayBuffer a
+  = MessageReceived AuthD.AnswerMessage a
   | ConnectionIsDown a
   | ConnectionIsUp a
 
@@ -261,74 +260,13 @@ handleAction = case _ of
 
 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 a -> do
-    receivedMessage <- H.liftEffect $ AuthD.deserialize message
-    case receivedMessage of
-        -- Cases where we didn't understand the message.
-        Left err -> do
-          case err of
-            (AuthD.JSONERROR jerr) -> do
-          --    print_json_string messageEvent.message
-              H.raise $ Log $ SimpleLog ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr)
-            (AuthD.UnknownError   unerr) -> H.raise $ Log $ SimpleLog ("Parsing error: AuthD.UnknownError" <> (show unerr))
-            (AuthD.UnknownNumber       ) -> H.raise $ Log $ SimpleLog ("Parsing error: AuthD.UnknownNumber")
-          pure Nothing
-
-        -- Cases where we understood the message.
-        Right response -> do
-          case response of
-            -- The authentication failed.
-            (AuthD.GotError errmsg) -> do
-              H.raise $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
-              pure (Just a)
-            (AuthD.GotPasswordRecoverySent _) -> do
-              H.raise $ Log $ SimpleLog $ "[🎉] Password recovery: email sent!"
-              pure Nothing
-            (AuthD.GotErrorPasswordTooShort _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Password too short!"
-              pure Nothing
-            (AuthD.GotErrorMailRequired _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Email required!"
-              pure Nothing
-            (AuthD.GotErrorInvalidCredentials _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Invalid credentials!"
-              pure Nothing
-            (AuthD.GotErrorRegistrationsClosed _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Registration closed! Try another time or contact an administrator."
-              pure Nothing
-            (AuthD.GotErrorInvalidLoginFormat _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Invalid login format!"
-              pure Nothing
-            (AuthD.GotErrorInvalidEmailFormat _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Invalid email format!"
-              pure Nothing
-            (AuthD.GotErrorAlreadyUsersInDB _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Login already taken!"
-              pure Nothing
-            (AuthD.GotErrorReadOnlyProfileKeys _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Trying to add a profile with some invalid (read-only) keys!"
-              pure Nothing
-            (AuthD.GotErrorInvalidActivationKey _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Invalid activation key!"
-              pure Nothing
-            (AuthD.GotErrorUserAlreadyValidated _) -> do
-              H.raise $ Log $ SimpleLog "[😈] User already validated!"
-              pure Nothing
-            (AuthD.GotErrorCannotContactUser _) -> do
-              H.raise $ Log $ SimpleLog "[😈] User cannot be contacted. Are you sure about your email address?"
-              pure Nothing
-            (AuthD.GotErrorInvalidRenewKey _) -> do
-              H.raise $ Log $ SimpleLog "[😈] Invalid renew key!"
-              pure Nothing
-            -- The authentication was a success!
-            (AuthD.GotToken msg) -> do
-              H.raise $ Log $ SimpleLog $ "[🎉] Authenticated to authd!"
-              H.raise $ AuthToken (Tuple msg.uid msg.token)
-              pure (Just a)
-            -- WTH?!
-            _ -> do
-              H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
-              pure Nothing
+    case message of
+      _ -> do
+        H.raise $ Log $ SimpleLog $ "[😈] Message not handled in AuthenticationForm."
+    pure Nothing
 
   ConnectionIsDown a -> do
     H.modify_ _ { wsUp = false }
@@ -337,11 +275,3 @@ handleQuery = case _ of
   ConnectionIsUp a -> do
     H.modify_ _ { wsUp = true }
     pure (Just a)
-
---print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
---print_json_string arraybuffer = do
---  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
---  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
---  H.raise $ Log $ SimpleLog $ case (value) of
---    Left _ -> "Cannot even fromTypedIPC the message."
---    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
diff --git a/src/App/Container.purs b/src/App/Container.purs
index b658b03..f5f0e5f 100644
--- a/src/App/Container.purs
+++ b/src/App/Container.purs
@@ -7,7 +7,7 @@ import Bulma as Bulma
 import App.Nav as Nav
 
 import Data.Array as A
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), maybe)
 import Data.Either (Either(..))
 import Data.Tuple (Tuple(..))
 import App.AuthenticationForm as AF
@@ -18,6 +18,7 @@ import App.DomainListInterface as DomainListInterface
 import App.ZoneInterface as ZoneInterface
 import App.HomeInterface as HomeInterface
 import App.Messages.DNSManagerDaemon as DNSManager
+import App.Messages.AuthenticationDaemon as AuthD
 import Halogen as H
 import Halogen.HTML as HH
 import Type.Proxy (Proxy(..))
@@ -54,6 +55,15 @@ data Action
   -- | Then, the message will be provided to the `DispatchDNSMessage` action.
   | DNSRawMessageReceived ArrayBuffer
 
+  -- | AuthDaemonRawMessageReceived is the action when receiving a message, which is decoded in the handler.
+  -- | Then, the message will be provided to the `DispatchAuthDaemonMessage` action.
+  | AuthDaemonRawMessageReceived ArrayBuffer
+
+  -- | DispatchAuthDaemonMessage: an auth daemon message (from `authd`) was received and decoded through the
+  -- | `AuthDaemonRawMessageReceived` action.
+  -- | The message is provided to the right component.
+  -- | DispatchAuthDaemonMessage AuthD.AnswerMessage
+
   -- | Log message (through the Log component).
   | Log LogMessage
 
@@ -183,9 +193,6 @@ handleAction = case _ of
         H.tell _log unit (AppLog.Log $ SimpleLog "Trying to authenticate to dnsmanager without a token")
 
   AuthenticationComponentEvent ev -> case ev of
-    AF.AuthToken (Tuple uid token)   -> do
-      H.modify_ _ { uid = Just uid, token = Just token, current_page = DomainList }
-      handleAction AuthenticateToDNSManager
     AF.MessageToSend message         -> H.tell _ws_auth unit (WS.ToSend message)
     AF.Log message                   -> H.tell _log unit (AppLog.Log message)
 
@@ -215,10 +222,7 @@ handleAction = case _ of
   -- TODO: depending on the current page, we should provide the received message to different components.
   AuthenticationDaemonEvent ev -> case ev of
     WS.MessageReceived (Tuple _ message) -> do
-      { token } <- H.get
-      case token of
-        Nothing -> H.tell _af  unit (AF.MessageReceived message)
-        Just _  -> H.tell _aai unit (AAI.MessageReceived message)
+      handleAction $ AuthDaemonRawMessageReceived message
     WS.WSJustConnected -> do
       H.tell _af unit AF.ConnectionIsUp
       H.tell _aai unit AAI.ConnectionIsUp
@@ -227,6 +231,96 @@ handleAction = case _ of
       H.tell _aai unit AAI.ConnectionIsDown
     WS.Log message -> H.tell _log unit (AppLog.Log message)
 
+  AuthDaemonRawMessageReceived message -> do
+    receivedMessage <- H.liftEffect $ AuthD.deserialize message
+    case receivedMessage of
+      -- Cases where we didn't understand the message.
+      Left err -> do
+        -- handleAction $ Log $ SimpleLog $ "[🤖] received a message that couldn't be decoded..., reason: " <> show err
+        case err of
+          (AuthD.JSONERROR jerr) -> do
+            -- print_json_string messageEvent.message
+            handleAction $ Log $ SimpleLog $ "[🤖] JSON parsing error: " <> jerr
+          (AuthD.UnknownError unerr) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownError" <> (show unerr))
+          (AuthD.UnknownNumber       ) -> handleAction $ Log $ SimpleLog ("[🤖] Parsing error: AuthD.UnknownNumber")
+      -- Cases where we understood the message.
+      Right response -> do
+        case response of
+          (AuthD.GotUser _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUser message."
+          (AuthD.GotUserAdded _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserAdded message."
+          (AuthD.GotUserEdited _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserEdited message."
+          (AuthD.GotUserValidated _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUserValidated message."
+          (AuthD.GotUsersList _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotUsersList message."
+          (AuthD.GotPermissionCheck _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPermissionCheck message."
+          (AuthD.GotPermissionSet _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Received a GotPermissionSet message."
+          (AuthD.GotPasswordRecovered _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotPasswordRecovered message."
+          (AuthD.GotMatchingUsers _) -> do
+            handleAction $ Log $ SimpleLog "[😈] TODO: received a GotMatchingUsers message."
+          (AuthD.GotUserDeleted _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Received a GotUserDeleted message."
+          (AuthD.GotErrorMustBeAuthenticated _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorMustBeAuthenticated message."
+          (AuthD.GotErrorAlreadyUsedLogin _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorAlreadyUsedLogin message."
+          (AuthD.GotErrorUserNotFound _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Fail: received a GotErrorUserNotFound message."
+
+          -- The authentication failed.
+          (AuthD.GotError errmsg) -> do
+            handleAction $ Log $ SimpleLog $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
+          (AuthD.GotPasswordRecoverySent _) -> do
+            handleAction $ Log $ SimpleLog $ "[🎉] Password recovery: email sent!"
+          (AuthD.GotErrorPasswordTooShort _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Password too short!"
+          (AuthD.GotErrorMailRequired _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Email required!"
+          (AuthD.GotErrorInvalidCredentials _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Invalid credentials!"
+          (AuthD.GotErrorRegistrationsClosed _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Registration closed! Try another time or contact an administrator."
+          (AuthD.GotErrorInvalidLoginFormat _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Invalid login format!"
+          (AuthD.GotErrorInvalidEmailFormat _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Invalid email format!"
+          (AuthD.GotErrorAlreadyUsersInDB _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Login already taken!"
+          (AuthD.GotErrorReadOnlyProfileKeys _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Trying to add a profile with some invalid (read-only) keys!"
+          (AuthD.GotErrorInvalidActivationKey _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Invalid activation key!"
+          (AuthD.GotErrorUserAlreadyValidated _) -> do
+            handleAction $ Log $ SimpleLog "[😈] User already validated!"
+          (AuthD.GotErrorCannotContactUser _) -> do
+            handleAction $ Log $ SimpleLog "[😈] User cannot be contacted. Are you sure about your email address?"
+          (AuthD.GotErrorInvalidRenewKey _) -> do
+            handleAction $ Log $ SimpleLog "[😈] Invalid renew key!"
+          -- The authentication was a success!
+          (AuthD.GotToken msg) -> do
+            handleAction $ Log $ SimpleLog $ "[🎉] Authenticated to authd!"
+            H.modify_ _ { uid = Just msg.uid, token = Just msg.token, current_page = DomainList }
+            handleAction AuthenticateToDNSManager
+    pure unit
+
+  -- Send a received authentication daemon message to a component.
+  -- DispatchAuthDaemonMessage message -> do
+  --   { token } <- H.get
+  --   case token of
+  --     Nothing -> H.tell _af  unit (AF.MessageReceived message)
+  --     Just _  -> H.tell _aai unit (AAI.MessageReceived message)
+  --   case current_page of
+  --     DomainList  -> H.tell _dli unit (DomainListInterface.MessageReceived message)
+  --     Zone _      -> H.tell _zi  unit (ZoneInterface.MessageReceived message)
+  --     _           -> H.tell _log unit (AppLog.Log $ SystemLog "unexpected message from authd")
+  --   pure unit
+
   Disconnection -> do
     H.put $ initialState unit
     handleAction $ Routing Home