New way to handle messages. Still very much WIP.

master
Philippe Pittoli 2023-05-21 02:13:09 +02:00
parent 864b5f24ee
commit e19ff224b0
1 changed files with 36 additions and 17 deletions

View File

@ -1,49 +1,68 @@
module App.Messages where module App.Messages where
import Prelude
import Effect (Effect) import Effect (Effect)
import Effect.Console (log)
import Data.Argonaut.Core as J import Data.Argonaut.Core as J
import Data.Codec.Argonaut as CA import Data.Codec.Argonaut as CA
import Data.Maybe
import Data.Either import Data.Either
import Data.Codec.Argonaut.Record as CAR import Data.Codec.Argonaut.Record as CAR
-- Base types. -- Base types.
type AuthDError = { reason :: Maybe String }
type AuthDToken = { uid :: Int, token :: String }
type AuthDContacts = { user :: Int, email :: Maybe String, phone :: Maybe String }
type Email = String type Email = String
type Password = String type Password = String
type Login = { email :: Email, password :: Password } type Login = { email :: Email, password :: Password }
type Token = { token :: String }
-- Their related JSON codecs. -- Their related JSON codecs.
login_codec ∷ CA.JsonCodec Login authd_codec_error ∷ CA.JsonCodec AuthDError
login_codec = CA.object "Login" (CAR.record { email: CA.string, password: CA.string }) authd_codec_error = CA.object "AuthDError" (CAR.record { reason: CAR.optional CA.string })
token_codec ∷ CA.JsonCodec Token authd_codec_token ∷ CA.JsonCodec AuthDToken
token_codec = CA.object "Token" (CAR.record { token: CA.string }) authd_codec_token = CA.object "AuthDToken" (CAR.record { uid: CA.int, token: CA.string })
authd_codec_contacts ∷ CA.JsonCodec AuthDContacts
authd_codec_contacts = CA.object "AuthDContacts" (CAR.record { user: CA.int, email: CAR.optional CA.string, phone: CAR.optional CA.string })
codec_login ∷ CA.JsonCodec Login
codec_login = CA.object "Login" (CAR.record { email: CA.string, password: CA.string })
-- All possible requests. -- All possible requests.
data RequestMessage data RequestMessage
= MessageLogin Login = MessageLogin Login
-- All possible answers. -- All possible answers from the authentication daemon (authd).
data AnswerMessage data AuthDAnswerMessage
= Logged Token = AuthenticationDaemonError AuthDError
| Logged AuthDToken
| Contact AuthDContacts
encodeRequest ∷ RequestMessage → J.Json encodeRequest ∷ RequestMessage → J.Json
encodeRequest m = case m of encodeRequest m = case m of
(MessageLogin login) -> CA.encode login_codec login (MessageLogin login) -> CA.encode codec_login login
-- TODO -- TODO
--rawSerialize :: RequestMessage -> ArrayBuffer --rawSerialize :: RequestMessage -> ArrayBuffer
--rawDeserialize :: ArrayBuffer -> AnswerMessage --rawDeserialize :: ArrayBuffer -> AuthDAnswerMessage
data DecodeError data DecodeError
= JSONERROR CA.JsonDecodeError = JSONERROR CA.JsonDecodeError
| UnknownNumber | UnknownNumber
decodeAnswer :: Int -> J.Json -> Either DecodeError AnswerMessage decodeAuthDAnswer :: Int -> J.Json -> Either DecodeError AuthDAnswerMessage
decodeAnswer number json decodeAuthDAnswer number json
= case number of = case number of
-- TODO: take right values 0 -> error_management authd_codec_error AuthenticationDaemonError
11 -> case (CA.decode token_codec json) of 10 -> error_management authd_codec_token Logged
(Left err) -> Left (JSONERROR err) 12 -> error_management authd_codec_contacts Contact
(Right v) -> Right (Logged v)
_ -> Left UnknownNumber _ -> Left UnknownNumber
where
-- Signature is required since the compiler's guess is wrong.
error_management :: forall a. CA.JsonCodec a -> (a -> AuthDAnswerMessage) -> Either DecodeError AuthDAnswerMessage
error_management codec f
= case (CA.decode codec json) of
(Left err) -> Left (JSONERROR err)
(Right v) -> Right (f v)