Playing with AuthD messages. WIP.

src/App/Messages/AuthenticationDaemon.purs

@@ -0,0 +1,121 @@
+module App.Messages where
+
+import Prelude
+
+import Effect (Effect)
+import Effect.Console (log)
+
+import Data.Argonaut.Core as J
+import Data.Codec.Argonaut as CA
+import Data.Maybe
+import Data.Either
+import Data.Codec.Argonaut.Record as CAR
+
+{- TODO:
+
+	Possible requests:
+    - 0 type GetToken = { login :: String, password :: String }
+    - 1 type AddUser = { shared_key :: String, login :: String, password :: String, email :: String?, phone :: String?, profile :: Hash(String, JSON::Any)? }
+    - 2 type ValidateUser = { login :: String, activation_key :: String }
+    - 3 type GetUser = { user :: Int32 | String }
+    - 4 type GetUserByCredentials = { login :: String, password :: String }
+    - 6 type Register = { login :: String, password :: String, email :: String?, phone :: String? , profile :: Hash(String, JSON::Any)? }
+    - 7 type UpdatePassword = { login :: String, old_password :: String, new_password :: String }
+    - 8 type ListUsers = { token :: String?, key :: String? }
+    - 9 type CheckPermission = { shared_key :: String?, token :: String?, user :: Int32 | String, service :: String, resource :: String }
+    - 10 type SetPermission = { shared_key :: String, user :: Int32 | String, service :: String, resource :: String, permission :: ::AuthD::User::PermissionLevel }
+    - 11 type PasswordRecovery = { user :: Int32 | String, password_renew_key :: String, new_password :: String }
+    - 12 type AskPasswordRecovery = { user       :: Int32 | String, email      :: String }
+    - 13 type SearchUser = { user :: String }
+    - 14 type EditProfile = { token :: String, new_profile :: Hash(String, JSON::Any) }
+    - 15 type EditProfileContent = { token      :: String?, shared_key :: String?, user :: Int32 | String | Nil, new_profile :: Hash(String, JSON::Any) }
+    - 16 type EditContacts = { token :: String, email :: String?, phone :: String? }
+    - 17 type Delete = { shared_key :: String?, login      :: String?, password   :: String?, user       :: String | Int32 }
+    - 18 type GetContacts = { token :: String }
+
+ -- 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
+-}
+
+-- Basic message types.
+type Error = { reason :: Maybe String }
+type Token = { uid :: Int, token :: String }
+type Contacts = { user :: Int, email :: Maybe String, phone :: Maybe String }
+
+type Email = String
+type Password = String
+type Login = { email :: Email, password :: Password }
+
+-- All possible requests.
+data RequestMessage
+  = MessageLogin Login
+
+-- All possible answers from the authentication daemon (authd).
+data AnswerMessage
+  = AuthenticationDaemonError Error
+  | Logged Token
+  | Contact Contacts
+
+encode ∷ RequestMessage → J.Json
+encode m = case m of
+    (MessageLogin login) -> CA.encode codec_login login
+    -- 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
+
+data DecodeError
+  = JSONERROR CA.JsonDecodeError
+  | 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
+    _  -> Left UnknownNumber
+  where
+    -- Signature is required since the compiler's guess is wrong.
+    error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage
+    error_management codec f
+      = case (CA.decode codec json) of
+          (Left err) -> Left (JSONERROR err)
+          (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 })
+    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 :: Login -> String
+-- login_serialize = J.stringify <<< login_encode
+-- login_decode ∷ J.Json → Either CA.JsonDecodeError Login
+-- login_decode = CA.decode codec_login
+-- 
+-- example_login_deserialize :: J.Json -> Effect Unit
+-- example_login_deserialize serialized_login
+--   = case (login_decode serialized_login) of
+--       Left err -> log $ show err
+--       Right l -> log $ show l