From 089ba00c58e7b2af170069d98eaa3f7a22794b22 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 21 May 2023 20:39:33 +0200 Subject: [PATCH] decodeAnswerMessage doesn't work atm. --- src/App/Messages/AuthenticationDaemon.purs | 133 ++++++++++++++------- 1 file changed, 92 insertions(+), 41 deletions(-) diff --git a/src/App/Messages/AuthenticationDaemon.purs b/src/App/Messages/AuthenticationDaemon.purs index f0d9c60..82bca1f 100644 --- a/src/App/Messages/AuthenticationDaemon.purs +++ b/src/App/Messages/AuthenticationDaemon.purs @@ -10,13 +10,20 @@ import Data.Codec.Argonaut as CA import Data.Maybe import Data.Either import Data.Codec.Argonaut.Record as CAR +import Data.UInt (fromInt, UInt) -import App.IPC (toTypedIPC, fromTypedIPC) +import Data.Tuple (Tuple(..)) +import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer +import Data.ArrayBuffer.Types (ArrayBuffer, DataView) + +import Effect.Class (liftEffect) +import Control.Monad.Trans.Class (lift) + +import App.IPC as IPC {- TODO: Possible requests: - - 0 type GetToken = { login :: String, password :: String } - 1 type AddUser = { shared_key :: String, login :: String, password :: String, email :: Maybe String, phone :: Maybe String, profile :: Maybe Hash(String, JSON::Any) } - 2 type ValidateUser = { login :: String, activation_key :: String } - 3 type GetUser = { user :: Int32 | String } @@ -38,9 +45,19 @@ import App.IPC (toTypedIPC, fromTypedIPC) -- Deletion can be triggered by either an admin or the user. Possible answers: - - PasswordRecoverySent and PasswordRecovered, - - PermissionCheck and PermissionSet, - - User, UserAdded, UserEdited, UserValidated, UsersList, MatchingUsers + - 0 type Error = { reason :: Maybe String } + - 1 type Token = { uid :: Int32, token :: String } + - 2 type User = { user :: ::AuthD::User::Public } + - 3 type UserAdded = { user :: ::AuthD::User::Public } + - 4 type UserEdited = { uid :: Int32 } + - 5 type UserValidated = { user :: ::AuthD::User::Public } + - 6 type UsersList = { users :: Array(::AuthD::User::Public) } + - 7 type PermissionCheck = { user :: Int32, service :: String, resource :: String, permission :: ::AuthD::User::PermissionLevel } + - 8 type PermissionSet = { user :: Int32, service :: String, resource :: String, permission :: ::AuthD::User::PermissionLevel } + - 9 type PasswordRecoverySent = { user :: ::AuthD::User::Public } + - 10 type PasswordRecovered = { user :: ::AuthD::User::Public } + - 11 type MatchingUsers = { users :: Array(::AuthD::User::Public) } + - 12 type Contacts = { user :: Int32, email :: Maybe String, phone :: Maybe String } -} @@ -55,35 +72,44 @@ type GetToken = { login :: String, password :: String } -- All possible requests. data RequestMessage - = MkGetToken GetToken -- 0 GetToken - -- 1 AddUser - -- 2 ValidateUser - -- 3 GetUser - -- 4 GetUserByCredentials - -- 6 Register - -- 7 UpdatePassword - -- 8 ListUsers - -- 9 CheckPermission - -- 10 SetPermission - -- 11 PasswordRecovery - -- 12 AskPasswordRecovery - -- 13 SearchUser - -- 14 EditProfile - -- 15 EditProfileContent - -- 16 EditContacts - -- 17 Delete - -- 18 GetContacts + = MkGetToken GetToken -- 0 + --| MkAddUser -- 1 + --| MkValidateUser -- 2 + --| MkGetUser -- 3 + --| MkGetUserByCredentials -- 4 + --| MkRegister -- 6 + --| MkUpdatePassword -- 7 + --| MkListUsers -- 8 + --| MkCheckPermission -- 9 + --| MkSetPermission -- 10 + --| MkPasswordRecovery -- 11 + --| MkAskPasswordRecovery -- 12 + --| MkSearchUser -- 13 + --| MkEditProfile -- 14 + --| MkEditProfileContent -- 15 + --| MkEditContacts -- 16 + --| MkDelete -- 17 + --| MkGetContacts -- 18 -- All possible answers from the authentication daemon (authd). data AnswerMessage - = AuthenticationDaemonError Error - | Logged Token - | Contact Contacts + = GotError Error -- 0 + | GotToken Token -- 1 + -- | GotUser -- 2 + -- | GotUserAdded -- 3 + -- | GotUserEdited -- 4 + -- | GotUserValidated -- 5 + -- | GotUsersList -- 6 + -- | GotPermissionCheck -- 7 + -- | GotPermissionSet -- 8 + -- | GotPasswordRecoverySent -- 9 + -- | GotPasswordRecovered -- 10 + -- | GotMatchingUsers -- 11 + | GotContacts Contacts -- 12 -encode ∷ RequestMessage → J.Json +encode ∷ RequestMessage -> Tuple UInt String encode m = case m of - (MkGetToken token) -> CA.encode codec_token token - -- 0 GetToken + (MkGetToken token) -> Tuple (fromInt 0) (J.stringify $ CA.encode codecGetToken token) -- 1 AddUser -- 2 ValidateUser -- 3 GetUser @@ -103,20 +129,32 @@ encode m = case m of -- 18 GetContacts where - codec_token ∷ CA.JsonCodec GetToken - codec_token = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string }) + codecGetToken ∷ CA.JsonCodec GetToken + codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string }) data DecodeError = JSONERROR CA.JsonDecodeError + | UnknownError String | UnknownNumber decode :: Int -> J.Json -> Either DecodeError AnswerMessage decode number json = case number of - 0 -> error_management codec_error AuthenticationDaemonError - 10 -> error_management codec_token Logged - 12 -> error_management codec_contacts Contact + 0 -> error_management codecGotError GotError + 1 -> error_management codecGotToken GotToken + 12 -> error_management codec_contacts GotContacts _ -> Left UnknownNumber + -- 1 type Token = { uid :: Int32, token :: String } + -- 2 type User = { user :: ::AuthD::User::Public } + -- 3 type UserAdded = { user :: ::AuthD::User::Public } + -- 4 type UserEdited = { uid :: Int32 } + -- 5 type UserValidated = { user :: ::AuthD::User::Public } + -- 6 type UsersList = { users :: Array(::AuthD::User::Public) } + -- 7 type PermissionCheck = { user :: Int32, service :: String, resource :: String, permission :: ::AuthD::User::PermissionLevel } + -- 8 type PermissionSet = { user :: Int32, service :: String, resource :: String, permission :: ::AuthD::User::PermissionLevel } + -- 9 type PasswordRecoverySent = { user :: ::AuthD::User::Public } + -- 10 type PasswordRecovered = { user :: ::AuthD::User::Public } + -- 11 type MatchingUsers = { users :: Array(::AuthD::User::Public) } where -- Signature is required since the compiler's guess is wrong. error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage @@ -126,18 +164,31 @@ decode number json (Right v) -> Right (f v) -- Related JSON codecs. - codec_error ∷ CA.JsonCodec Error - codec_error = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) - codec_token ∷ CA.JsonCodec Token - codec_token = CA.object "Token" (CAR.record { uid: CA.int, token: CA.string }) + codecGotError ∷ CA.JsonCodec Error + codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) + codecGotToken ∷ CA.JsonCodec Token + codecGotToken = CA.object "Token" (CAR.record { uid: CA.int, token: CA.string }) codec_contacts ∷ CA.JsonCodec Contacts codec_contacts = CA.object "Contacts" (CAR.record { user: CA.int, email: CAR.optional CA.string, phone: CAR.optional CA.string }) --- login_serialize :: GetToken -> String --- login_serialize = J.stringify <<< login_encode + +serialize :: RequestMessage -> Effect ArrayBuffer +serialize request + = case (encode request) of + (Tuple messageTypeNumber string) -> IPC.toTypedIPC messageTypeNumber string + +deserialize :: ArrayBuffer -> Effect (Either DecodeError AnswerMessage) +deserialize arraybuffer + = do + case (IPC.fromTypedIPC arraybuffer) of + Left err -> Left (UnknownError $ show err) + Right (Tuple messageTypeNumber string) -> case (decode messageTypeNumber $ J.fromString string) of + Left parsingError -> Left parsingError + Right answerMessage -> Right answerMessage + -- login_decode ∷ J.Json → Either CA.JsonDecodeError GetToken -- login_decode = CA.decode codec_login --- +-- -- example_login_deserialize :: J.Json -> Effect Unit -- example_login_deserialize serialized_login -- = case (login_decode serialized_login) of