From ef3be6cc7671dd22bf0ec1c15ba9e7c8de013d74 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sat, 15 Jul 2023 21:54:18 +0200 Subject: [PATCH] Take care of many error responses. --- src/App/AuthenticationForm.purs | 104 ++++++++++++++------- src/App/Messages/AuthenticationDaemon.purs | 11 ++- 2 files changed, 78 insertions(+), 37 deletions(-) diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index c0b8891..084e29e 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -1,7 +1,7 @@ -- | `App.AuthenticationForm` is both the authentication and registration interface. module App.AuthenticationForm where -import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>)) +import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), show) import Data.ArrayBuffer.Types (ArrayBuffer) @@ -170,7 +170,7 @@ render { wsUp, authenticationForm, registrationForm, passwordRecoveryForm} should_be_disabled -- condition , Bulma.box_input "emailPASSR" "Email" "email" -- title, placeholder (HandlePasswordRecovery <<< PASSR_INP_email) -- action - passwordRecoveryForm.login -- value + passwordRecoveryForm.email -- value true -- validity (TODO) should_be_disabled -- condition , HH.button @@ -199,6 +199,23 @@ handleAction = case _ of PASSR_INP_login v -> H.modify_ _ { passwordRecoveryForm { login = v } } PASSR_INP_email v -> H.modify_ _ { passwordRecoveryForm { email = v } } + AuthenticationAttempt ev -> do + H.liftEffect $ Event.preventDefault ev + + { authenticationForm } <- H.get + + case authenticationForm.login, authenticationForm.pass of + "" , _ -> + H.raise $ Log $ UnableToSend "Write your login!" + + _ , "" -> + H.raise $ Log $ UnableToSend "Write your password!" + + login, pass -> do + message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass } + H.raise $ MessageToSend message + H.raise $ Log $ SimpleLog $ "[😇] Trying to authenticate (login: " <> login <> ")" + RegisterAttempt ev -> do H.liftEffect $ Event.preventDefault ev @@ -225,39 +242,22 @@ handleAction = case _ of H.raise $ MessageToSend message H.raise $ Log $ SimpleLog $ "[😇] Trying to register (login: " <> login <> ")" - AuthenticationAttempt ev -> do - H.liftEffect $ Event.preventDefault ev - - { authenticationForm } <- H.get - - case authenticationForm.login, authenticationForm.pass of - "" , _ -> - H.raise $ Log $ UnableToSend "Write your login!" - - _ , "" -> - H.raise $ Log $ UnableToSend "Write your password!" - - login, pass -> do - message <- H.liftEffect $ AuthD.serialize $ AuthD.MkLogin { login: login, password: pass } - H.raise $ MessageToSend message - H.raise $ Log $ SimpleLog $ "[😇] Trying to authenticate (login: " <> login <> ")" - PasswordRecoveryAttempt ev -> do H.liftEffect $ Event.preventDefault ev - { registrationForm } <- H.get - let login = registrationForm.login - email = registrationForm.email + { passwordRecoveryForm } <- H.get + let login = passwordRecoveryForm.login + email = passwordRecoveryForm.email case login, email of "", "" -> H.raise $ Log $ UnableToSend "Write at least either your login or your email!" _, _ -> do - H.raise $ Log $ UnableToSend "Currently not implemented." - --message <- H.liftEffect $ AuthD.serialize $ - -- AuthD.Mk { login: (Just login), email: Just (Email.Email email) } - --H.raise $ MessageToSend message + message <- H.liftEffect $ AuthD.serialize $ + AuthD.MkAskPasswordRecovery { user: (Just login), email: Just (Email.Email email) } + H.raise $ MessageToSend message + H.raise $ Log $ SimpleLog "[😇] Trying to recover the password!" handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of @@ -265,13 +265,14 @@ handleQuery = case _ of receivedMessage <- H.liftEffect $ AuthD.deserialize message case receivedMessage of -- Cases where we didn't understand the message. - Left _ -> pure Nothing - --case err of - -- (AuthD.JSONERROR jerr) -> do + Left err -> do + case err of + (AuthD.JSONERROR jerr) -> do -- print_json_string messageEvent.message - -- handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr <> " JSON is: " <> jerr) - -- (AuthD.UnknownError unerr) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownError" <> (show unerr)) - -- (AuthD.UnknownNumber ) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownNumber") + 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 @@ -280,6 +281,45 @@ handleQuery = case _ of (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!" diff --git a/src/App/Messages/AuthenticationDaemon.purs b/src/App/Messages/AuthenticationDaemon.purs index cd9ca25..fefd924 100644 --- a/src/App/Messages/AuthenticationDaemon.purs +++ b/src/App/Messages/AuthenticationDaemon.purs @@ -70,9 +70,11 @@ codecValidateUser {- NOTE: "user" attribute for both PasswordRecovery and AskPasswordRecovery could be UserID, but they'll be used as login since the user has to type it. -} {- 3 -} -type AskPasswordRecovery = { user :: String } +type AskPasswordRecovery = { user :: Maybe String, email :: Maybe Email.Email } codecAskPasswordRecovery ∷ CA.JsonCodec AskPasswordRecovery -codecAskPasswordRecovery = CA.object "AskPasswordRecovery" (CAR.record { user: CA.string }) +codecAskPasswordRecovery + = CA.object "AskPasswordRecovery" + (CAR.record { user: CAR.optional CA.string, email: CAR.optional Email.codec }) {- 4 -} type PasswordRecovery = { user :: String @@ -232,10 +234,9 @@ codecGotPermissionSet , permission: PermissionLevel.codec }) {- 9 -} -type PasswordRecoverySent = { user :: UserPublic.UserPublic } +type PasswordRecoverySent = { } codecGotPasswordRecoverySent ∷ CA.JsonCodec PasswordRecoverySent -codecGotPasswordRecoverySent - = CA.object "PasswordRecoverySent" (CAR.record { user: UserPublic.codec }) +codecGotPasswordRecoverySent = CA.object "PasswordRecoverySent" (CAR.record { }) {- 10 -} type PasswordRecovered = { }