From 3be96bd436c081631a81b8d1bec8c87005b993d7 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 4 Jul 2023 03:26:09 +0200 Subject: [PATCH] Log all authentication form messages. --- src/App/AuthenticationForm.purs | 56 ++++++++++++++++++--------------- src/App/Container.purs | 8 +++-- 2 files changed, 35 insertions(+), 29 deletions(-) diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index 233ee9a..6d76c75 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -30,6 +30,9 @@ import Data.ArrayBuffer.Types (ArrayBuffer) data Output = AuthToken (Tuple Int String) | MessageToSend ArrayBuffer + | AppendMessage String + | SystemMessage String + | UnableToSend String data Query a = MessageReceived ArrayBuffer a @@ -158,11 +161,11 @@ render { wsUp, handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction = case _ of - Initialize -> pure unit - -- systemMessage "Component initialized!" + Initialize -> + H.raise $ SystemMessage "Authentication form initialized." - Finalize -> pure unit - -- systemMessage "Finalize" + Finalize -> + H.raise $ SystemMessage "Removing the authentication form." HandleAuthenticationInput authinp -> do case authinp of @@ -184,14 +187,14 @@ handleAction = case _ of pass = registrationForm.pass case login, email, pass of - "", _, _ -> pure unit - -- unableToSend "Write your login!" + "", _, _ -> + H.raise $ UnableToSend "Write your login!" - _, "", _ -> pure unit - -- unableToSend "Write your email!" + _, "", _ -> + H.raise $ UnableToSend "Write your email!" - _, _, "" -> pure unit - -- unableToSend "Write your password!" + _, _, "" -> + H.raise $ UnableToSend "Write your password!" _, _, _ -> do message <- H.liftEffect $ AuthD.serialize $ @@ -199,7 +202,7 @@ handleAction = case _ of , email: Just (Email.Email email) , password: pass } H.raise $ MessageToSend message - -- appendMessage "[😇] Trying to register" + H.raise $ AppendMessage "[😇] Trying to register" AuthenticationAttempt ev -> do H.liftEffect $ Event.preventDefault ev @@ -207,16 +210,16 @@ handleAction = case _ of { authenticationForm } <- H.get case authenticationForm.login, authenticationForm.pass of - "" , _ -> pure unit - -- unableToSend "Write your login!" + "" , _ -> + H.raise $ UnableToSend "Write your login!" - _ , "" -> pure unit - -- unableToSend "Write your password!" + _ , "" -> + H.raise $ UnableToSend "Write your password!" login, pass -> do message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass } H.raise $ MessageToSend message - -- appendMessage $ "[😇] Trying to connect with login: " <> login + H.raise $ AppendMessage $ "[😇] Trying to connect with login: " <> login handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) @@ -237,22 +240,23 @@ handleQuery = case _ of Right response -> do case response of -- The authentication failed. - (AuthD.GotError errmsg) -> pure (Just a) - -- appendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason + (AuthD.GotError errmsg) -> do + H.raise $ AppendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason + pure (Just a) -- The authentication was a success! (AuthD.GotToken msg) -> do - -- appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token + H.raise $ AppendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token H.raise $ AuthToken (Tuple msg.uid msg.token) pure (Just a) -- WTH?! - _ -> pure Nothing - -- appendMessage $ "[😈] Failed! Authentication server didn't send a valid message." + _ -> do + H.raise $ AppendMessage $ "[😈] Failed! Authentication server didn't send a valid message." + pure Nothing -print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit +--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 - pure unit - --appendMessage $ case (value) of - -- Left _ -> "Cannot even fromTypedIPC the message." - -- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string + H.raise $ AppendMessage $ 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 01b4469..1927235 100644 --- a/src/App/Container.purs +++ b/src/App/Container.purs @@ -106,9 +106,11 @@ render state handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit handleAction = case _ of OutputAuthComponent ev -> case ev of - AF.AuthToken (Tuple uid token) -> H.modify_ _ { uid = Just uid, token = Just token } - AF.MessageToSend message -> do - H.tell _ws_auth unit (WS.ToSend message) + AF.AuthToken (Tuple uid token) -> H.modify_ _ { uid = Just uid, token = Just token } + AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message) + AF.AppendMessage message -> H.tell _log unit (Log.SimpleLog message) + AF.SystemMessage message -> H.tell _log unit (Log.SystemLog message) + AF.UnableToSend message -> H.tell _log unit (Log.UnableToSend message) -- TODO: depending on the current page, we should provide the received message to -- different components.