decodeAnswerMessage doesn't work atm.

master
Philippe Pittoli 2023-05-21 20:39:33 +02:00
parent ce57643cec
commit 089ba00c58
1 changed files with 92 additions and 41 deletions

View File

@ -10,13 +10,20 @@ import Data.Codec.Argonaut as CA
import Data.Maybe import Data.Maybe
import Data.Either import Data.Either
import Data.Codec.Argonaut.Record as CAR 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: {- TODO:
Possible requests: 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) } - 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 } - 2 type ValidateUser = { login :: String, activation_key :: String }
- 3 type GetUser = { user :: Int32 | 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. -- Deletion can be triggered by either an admin or the user.
Possible answers: Possible answers:
- PasswordRecoverySent and PasswordRecovered, - 0 type Error = { reason :: Maybe String }
- PermissionCheck and PermissionSet, - 1 type Token = { uid :: Int32, token :: String }
- User, UserAdded, UserEdited, UserValidated, UsersList, MatchingUsers - 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. -- All possible requests.
data RequestMessage data RequestMessage
= MkGetToken GetToken -- 0 GetToken = MkGetToken GetToken -- 0
-- 1 AddUser --| MkAddUser -- 1
-- 2 ValidateUser --| MkValidateUser -- 2
-- 3 GetUser --| MkGetUser -- 3
-- 4 GetUserByCredentials --| MkGetUserByCredentials -- 4
-- 6 Register --| MkRegister -- 6
-- 7 UpdatePassword --| MkUpdatePassword -- 7
-- 8 ListUsers --| MkListUsers -- 8
-- 9 CheckPermission --| MkCheckPermission -- 9
-- 10 SetPermission --| MkSetPermission -- 10
-- 11 PasswordRecovery --| MkPasswordRecovery -- 11
-- 12 AskPasswordRecovery --| MkAskPasswordRecovery -- 12
-- 13 SearchUser --| MkSearchUser -- 13
-- 14 EditProfile --| MkEditProfile -- 14
-- 15 EditProfileContent --| MkEditProfileContent -- 15
-- 16 EditContacts --| MkEditContacts -- 16
-- 17 Delete --| MkDelete -- 17
-- 18 GetContacts --| MkGetContacts -- 18
-- All possible answers from the authentication daemon (authd). -- All possible answers from the authentication daemon (authd).
data AnswerMessage data AnswerMessage
= AuthenticationDaemonError Error = GotError Error -- 0
| Logged Token | GotToken Token -- 1
| Contact Contacts -- | 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 encode m = case m of
(MkGetToken token) -> CA.encode codec_token token (MkGetToken token) -> Tuple (fromInt 0) (J.stringify $ CA.encode codecGetToken token)
-- 0 GetToken
-- 1 AddUser -- 1 AddUser
-- 2 ValidateUser -- 2 ValidateUser
-- 3 GetUser -- 3 GetUser
@ -103,20 +129,32 @@ encode m = case m of
-- 18 GetContacts -- 18 GetContacts
where where
codec_token ∷ CA.JsonCodec GetToken codecGetToken ∷ CA.JsonCodec GetToken
codec_token = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string }) codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string })
data DecodeError data DecodeError
= JSONERROR CA.JsonDecodeError = JSONERROR CA.JsonDecodeError
| UnknownError String
| UnknownNumber | UnknownNumber
decode :: Int -> J.Json -> Either DecodeError AnswerMessage decode :: Int -> J.Json -> Either DecodeError AnswerMessage
decode number json decode number json
= case number of = case number of
0 -> error_management codec_error AuthenticationDaemonError 0 -> error_management codecGotError GotError
10 -> error_management codec_token Logged 1 -> error_management codecGotToken GotToken
12 -> error_management codec_contacts Contact 12 -> error_management codec_contacts GotContacts
_ -> Left UnknownNumber _ -> 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 where
-- Signature is required since the compiler's guess is wrong. -- Signature is required since the compiler's guess is wrong.
error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage
@ -126,18 +164,31 @@ decode number json
(Right v) -> Right (f v) (Right v) -> Right (f v)
-- Related JSON codecs. -- Related JSON codecs.
codec_error ∷ CA.JsonCodec Error codecGotError ∷ CA.JsonCodec Error
codec_error = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
codec_token ∷ CA.JsonCodec Token codecGotToken ∷ CA.JsonCodec Token
codec_token = CA.object "Token" (CAR.record { uid: CA.int, token: CA.string }) codecGotToken = CA.object "Token" (CAR.record { uid: CA.int, token: CA.string })
codec_contacts ∷ CA.JsonCodec Contacts 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 }) 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 ∷ J.Json → Either CA.JsonDecodeError GetToken
-- login_decode = CA.decode codec_login -- login_decode = CA.decode codec_login
-- --
-- example_login_deserialize :: J.Json -> Effect Unit -- example_login_deserialize :: J.Json -> Effect Unit
-- example_login_deserialize serialized_login -- example_login_deserialize serialized_login
-- = case (login_decode serialized_login) of -- = case (login_decode serialized_login) of