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
= 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

View File

@ -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.