Log all authentication form messages.

This commit is contained in:
Philippe Pittoli 2023-07-04 03:26:09 +02:00
parent 7c9f5a7a56
commit 3be96bd436
2 changed files with 35 additions and 29 deletions

View File

@ -30,6 +30,9 @@ import Data.ArrayBuffer.Types (ArrayBuffer)
data Output data Output
= AuthToken (Tuple Int String) = AuthToken (Tuple Int String)
| MessageToSend ArrayBuffer | MessageToSend ArrayBuffer
| AppendMessage String
| SystemMessage String
| UnableToSend String
data Query a = MessageReceived ArrayBuffer a 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 :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of handleAction = case _ of
Initialize -> pure unit Initialize ->
-- systemMessage "Component initialized!" H.raise $ SystemMessage "Authentication form initialized."
Finalize -> pure unit Finalize ->
-- systemMessage "Finalize" H.raise $ SystemMessage "Removing the authentication form."
HandleAuthenticationInput authinp -> do HandleAuthenticationInput authinp -> do
case authinp of case authinp of
@ -184,14 +187,14 @@ handleAction = case _ of
pass = registrationForm.pass pass = registrationForm.pass
case login, email, pass of 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 _, _, _ -> do
message <- H.liftEffect $ AuthD.serialize $ message <- H.liftEffect $ AuthD.serialize $
@ -199,7 +202,7 @@ handleAction = case _ of
, email: Just (Email.Email email) , email: Just (Email.Email email)
, password: pass } , password: pass }
H.raise $ MessageToSend message H.raise $ MessageToSend message
-- appendMessage "[😇] Trying to register" H.raise $ AppendMessage "[😇] Trying to register"
AuthenticationAttempt ev -> do AuthenticationAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev
@ -207,16 +210,16 @@ handleAction = case _ of
{ authenticationForm } <- H.get { authenticationForm } <- H.get
case authenticationForm.login, authenticationForm.pass of 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 login, pass -> do
message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass } message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass }
H.raise $ MessageToSend message 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) 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 Right response -> do
case response of case response of
-- The authentication failed. -- The authentication failed.
(AuthD.GotError errmsg) -> pure (Just a) (AuthD.GotError errmsg) -> do
-- appendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason H.raise $ AppendMessage $ "[😈] Failed: " <> maybe "server didn't tell why" (\v -> v) errmsg.reason
pure (Just a)
-- The authentication was a success! -- The authentication was a success!
(AuthD.GotToken msg) -> do (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) H.raise $ AuthToken (Tuple msg.uid msg.token)
pure (Just a) pure (Just a)
-- WTH?! -- WTH?!
_ -> pure Nothing _ -> do
-- appendMessage $ "[😈] Failed! Authentication server didn't send a valid message." 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 print_json_string arraybuffer = do
-- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String)) -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
pure unit H.raise $ AppendMessage $ case (value) of
--appendMessage $ case (value) of Left _ -> "Cannot even fromTypedIPC the message."
-- Left _ -> "Cannot even fromTypedIPC the message." Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string
-- Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> ", received string: " <> string

View File

@ -107,8 +107,10 @@ handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Act
handleAction = case _ of handleAction = case _ of
OutputAuthComponent ev -> case ev of OutputAuthComponent ev -> case ev of
AF.AuthToken (Tuple uid token) -> H.modify_ _ { uid = Just uid, token = Just token } AF.AuthToken (Tuple uid token) -> H.modify_ _ { uid = Just uid, token = Just token }
AF.MessageToSend message -> do AF.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend 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 -- TODO: depending on the current page, we should provide the received message to
-- different components. -- different components.