decodeAnswerMessage doesn't work atm.

This commit is contained in:
Philippe Pittoli 2023-05-21 20:39:33 +02:00
parent ce57643cec
commit 089ba00c58

View File

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