From 84d285c9e94dde711f42ff7e1d4abfbcab0afd0e Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 31 May 2023 02:42:53 +0200 Subject: [PATCH] Add a few requet message codecs (WIP). --- src/App/Messages/AuthenticationDaemon.purs | 114 +++++++++++++-------- 1 file changed, 74 insertions(+), 40 deletions(-) diff --git a/src/App/Messages/AuthenticationDaemon.purs b/src/App/Messages/AuthenticationDaemon.purs index acab044..2b33134 100644 --- a/src/App/Messages/AuthenticationDaemon.purs +++ b/src/App/Messages/AuthenticationDaemon.purs @@ -2,7 +2,6 @@ module App.Messages.AuthenticationDaemon where import Prelude (bind, pure, show, ($)) - import Effect (Effect) import Data.Argonaut.Core as J @@ -29,27 +28,17 @@ import App.IPC as IPC {- TODO: Possible requests: - - 1 type AddUser = { shared_key :: String, login :: String, password :: String, email :: Maybe String, phone :: Maybe Phone.Phone, profile :: Maybe Hash(String, JSON::Any) } - - 2 type ValidateUser = { login :: String, activation_key :: String } - - 3 type GetUser = { user :: Int | String } - - 4 type GetUserByCredentials = { login :: String, password :: String } - - 6 type Register = { login :: String, password :: String, email :: Maybe String, phone :: Maybe Phone.Phone , profile :: Maybe Hash(String, JSON::Any) } - - 7 type UpdatePassword = { login :: String, old_password :: String, new_password :: String } - - 8 type ListUsers = { token :: Maybe String, key :: Maybe String } - 9 type CheckPermission = { shared_key :: Maybe String, token :: Maybe String, user :: Int | String, service :: String, resource :: String } - 10 type SetPermission = { shared_key :: String, user :: Int | String, service :: String, resource :: String, permission :: PermissionLevel.PermissionLevel } - 11 type PasswordRecovery = { user :: Int | String, password_renew_key :: String, new_password :: String } - - 12 type AskPasswordRecovery = { user :: Int | String, email :: String } + - 12 type AskPasswordRecovery = { user :: Int | String, email :: Email.Email } - 13 type SearchUser = { user :: String } - 14 type EditProfile = { token :: String, new_profile :: Hash(String, JSON::Any) } - 15 type EditProfileContent = { token :: Maybe String, shared_key :: Maybe String, user :: Int | String | Nil, new_profile :: Hash(String, JSON::Any) } - - 16 type EditContacts = { token :: String, email :: Maybe String, phone :: Maybe Phone.Phone } + - 16 type EditContacts = { token :: String, email :: Maybe Email.Email, phone :: Maybe Phone.Phone } - 17 type Delete = { shared_key :: Maybe String, login :: Maybe String, password :: Maybe String, user :: String | Int } - - 18 type GetContacts = { token :: String } -- Deletion can be triggered by either an admin or the user. - - Possible answers: -} -- Basic message types. @@ -70,10 +59,48 @@ type MatchingUsers = { users :: Array UserPublic.UserPublic } type Password = String type GetToken = { login :: String, password :: String } +type AddUser = { shared_key :: String, login :: String, password :: String, email :: Maybe Email.Email, phone :: Maybe Phone.Phone } -- profile :: Maybe Hash(String, JSON::Any) +type ValidateUser = { login :: String, activation_key :: String } +-- I'll split a message in two: either get a user by UID or by name. +-- TODO: change it for an Either Int String type. +type GetUserByUID = { user :: Int } +type GetUserByName = { user :: String } +type GetUserByCredentials = { login :: String, password :: String } +type Register = { login :: String, password :: String, email :: Maybe Email.Email, phone :: Maybe Phone.Phone } -- profile :: Maybe Hash(String, JSON::Any) +type UpdatePassword = { login :: String, old_password :: String, new_password :: String } +type ListUsers = { token :: Maybe String, key :: Maybe String } +type GetContacts = { token :: String } -- Related JSON codecs. codecGetToken ∷ CA.JsonCodec GetToken codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string }) +codecAddUser ∷ CA.JsonCodec AddUser +codecAddUser = CA.object "AddUser" (CAR.record { shared_key: CA.string + , login: CA.string + , password: CA.string + , email: CAR.optional Email.codec + , phone: CAR.optional Phone.codec }) +codecValidateUser ∷ CA.JsonCodec ValidateUser +codecValidateUser = CA.object "ValidateUser" (CAR.record { login: CA.string, activation_key: CA.string }) +codecGetUserByUID ∷ CA.JsonCodec GetUserByUID +codecGetUserByUID = CA.object "GetUserByUID" (CAR.record { user: CA.int }) +codecGetUserByName ∷ CA.JsonCodec GetUserByName +codecGetUserByName = CA.object "GetUserByName" (CAR.record { user: CA.string }) +codecGetUserByCredentials ∷ CA.JsonCodec GetUserByCredentials +codecGetUserByCredentials = CA.object "GetUserByCredentials" (CAR.record { login: CA.string, password: CA.string }) +codecRegister ∷ CA.JsonCodec Register +codecRegister = CA.object "Register" (CAR.record { login: CA.string + , password: CA.string + , email: CAR.optional Email.codec + , phone: CAR.optional Phone.codec }) +codecUpdatePassword ∷ CA.JsonCodec UpdatePassword +codecUpdatePassword = CA.object "UpdatePassword" (CAR.record { login: CA.string + , old_password: CA.string + , new_password: CA.string }) +codecListUsers ∷ CA.JsonCodec ListUsers +codecListUsers = CA.object "ListUsers" (CAR.record { token: CAR.optional CA.string, key: CAR.optional CA.string }) +codecGetContacts ∷ CA.JsonCodec GetContacts +codecGetContacts = CA.object "GetContacts" (CAR.record { token: CA.string }) codecGotError ∷ CA.JsonCodec Error codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) @@ -112,14 +139,15 @@ codecGotMatchingUsers = CA.object "MatchingUsers" (CAR.record { users: CA.array -- All possible requests. data RequestMessage - = MkGetToken GetToken -- 0 - --| MkAddUser AddUser -- 1 - --| MkValidateUser ValidateUser -- 2 - --| MkGetUser GetUser -- 3 - --| MkGetUserByCredentials GetUserByCredentials -- 4 - --| MkRegister Register -- 6 - --| MkUpdatePassword UpdatePassword -- 7 - --| MkListUsers ListUsers -- 8 + = MkGetToken GetToken -- 0 + | MkAddUser AddUser -- 1 + | MkValidateUser ValidateUser -- 2 + | MkGetUserByUID GetUserByUID -- 3 + | MkGetUserByName GetUserByName -- 3 (bis) + | MkGetUserByCredentials GetUserByCredentials -- 4 + | MkRegister Register -- 6 + | MkUpdatePassword UpdatePassword -- 7 + | MkListUsers ListUsers -- 8 --| MkCheckPermission CheckPermission -- 9 --| MkSetPermission SetPermission -- 10 --| MkPasswordRecovery PasswordRecovery -- 11 @@ -129,7 +157,7 @@ data RequestMessage --| MkEditProfileContent EditProfileContent -- 15 --| MkEditContacts EditContacts -- 16 --| MkDelete Delete -- 17 - --| MkGetContacts GetContacts -- 18 + | MkGetContacts GetContacts -- 18 -- All possible answers from the authentication daemon (authd). data AnswerMessage @@ -149,24 +177,30 @@ data AnswerMessage encode ∷ RequestMessage -> Tuple UInt String encode m = case m of - (MkGetToken token) -> Tuple (fromInt 0) (J.stringify $ CA.encode codecGetToken token) - -- 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 request) -> get_tuple 0 codecGetToken request + (MkAddUser request) -> get_tuple 1 codecAddUser request + (MkValidateUser request) -> get_tuple 2 codecValidateUser request + -- Both messages are actually a single message type, so they have the same number. + -- TODO: change the message codec for an Either Int String. + (MkGetUserByUID request) -> get_tuple 3 codecGetUserByUID request + (MkGetUserByName request) -> get_tuple 3 codecGetUserByName request + (MkGetUserByCredentials request) -> get_tuple 4 codecGetUserByCredentials request + (MkRegister request) -> get_tuple 6 codecRegister request + (MkUpdatePassword request) -> get_tuple 7 codecUpdatePassword request + (MkListUsers request) -> get_tuple 8 codecListUsers request + -- 9 MkCheckPermission + -- 10 MkSetPermission + -- 11 MkPasswordRecovery + -- 12 MkAskPasswordRecovery + -- 13 MkSearchUser + -- 14 MkEditProfile + -- 15 MkEditProfileContent + -- 16 MkEditContacts + -- 17 MkDelete + (MkGetContacts request) -> get_tuple 18 codecGetContacts request + where + get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String + get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request) data DecodeError = JSONERROR String