New way to handle messages. Still very much WIP.
parent
864b5f24ee
commit
e19ff224b0
|
@ -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)
|
||||||
|
|
Loading…
Reference in New Issue