diff --git a/spago.dhall b/spago.dhall index 38df728..00830b0 100644 --- a/spago.dhall +++ b/spago.dhall @@ -16,11 +16,12 @@ , "foreign" , "halogen" , "halogen-subscriptions" - , "lists" , "maybe" + , "newtype" , "parsing" , "parsing-dataview" , "prelude" + , "profunctor" , "strings" , "transformers" , "tuples" diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index a8da1df..d9252c2 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -8,8 +8,8 @@ import Data.Array as A import Data.Tuple (Tuple(..)) import Data.Bifunctor (lmap) -- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError) -import Data.Argonaut.Core as J -import Data.Codec.Argonaut as CA +-- import Data.Argonaut.Core as J +-- import Data.Codec.Argonaut as CA import Data.Const (Const) import Data.Either (Either(..)) import Data.Maybe (Maybe(..), isJust, isNothing, maybe) diff --git a/src/App/Email.purs b/src/App/Email.purs new file mode 100644 index 0000000..d4eddf1 --- /dev/null +++ b/src/App/Email.purs @@ -0,0 +1,20 @@ +-- | TODO: Email module should include at least some sort of smart +-- | constructors, rejecting invalid email addresses. +module App.Email where + +import Prelude + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Newtype (class Newtype) +import Data.Profunctor (wrapIso) + +newtype Email = Email String + +derive instance newtypeEmail :: Newtype Email _ +derive instance eqEmail :: Eq Email +derive instance ordEmail :: Ord Email + +-- | Email.codec can be used to parse and encode email addresses. +codec :: JsonCodec Email +codec = wrapIso Email CA.string diff --git a/src/App/Messages/AuthenticationDaemon.purs b/src/App/Messages/AuthenticationDaemon.purs index 33bb9fb..37e1d64 100644 --- a/src/App/Messages/AuthenticationDaemon.purs +++ b/src/App/Messages/AuthenticationDaemon.purs @@ -15,6 +15,10 @@ import Data.UInt (fromInt, toInt, UInt) import Data.Tuple (Tuple(..)) import Data.ArrayBuffer.Types (ArrayBuffer) +import App.Email as Email +import App.Phone as Phone +import App.UserPublic as UserPublic + import Effect.Class (liftEffect) import Data.Argonaut.Parser as JSONParser import Data.Bifunctor (lmap) @@ -24,11 +28,11 @@ import App.IPC as IPC {- TODO: Possible requests: - - 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 Phone.Phone, profile :: Maybe 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 :: Maybe String, phone :: Maybe String , profile :: Maybe Hash(String, JSON::Any) } + - 6 type Register = { login :: String, password :: String, email :: Maybe String, phone :: Maybe Phone.Phone , profile :: Maybe Hash(String, JSON::Any) } - 7 type UpdatePassword = { login :: String, old_password :: String, new_password :: String } - 8 type ListUsers = { token :: Maybe String, key :: Maybe String } - 9 type CheckPermission = { shared_key :: Maybe String, token :: Maybe String, user :: Int32 | String, service :: String, resource :: String } @@ -38,34 +42,30 @@ import App.IPC as IPC - 13 type SearchUser = { user :: String } - 14 type EditProfile = { token :: String, new_profile :: Hash(String, JSON::Any) } - 15 type EditProfileContent = { token :: Maybe String, shared_key :: Maybe String, user :: Int32 | String | Nil, new_profile :: Hash(String, JSON::Any) } - - 16 type EditContacts = { token :: String, email :: Maybe String, phone :: Maybe String } + - 16 type EditContacts = { token :: String, email :: Maybe String, phone :: Maybe Phone.Phone } - 17 type Delete = { shared_key :: Maybe String, login :: Maybe String, password :: Maybe String, user :: String | Int32 } - 18 type GetContacts = { token :: String } -- Deletion can be triggered by either an admin or the user. Possible answers: - - 2 type User = { user :: AuthD::User::Public } - - 3 type UserAdded = { user :: AuthD::User::Public } + - 2 type User = { user :: UserPublic.UserPublic } + - 3 type UserAdded = { user :: UserPublic.UserPublic } - 4 type UserEdited = { uid :: Int32 } - - 5 type UserValidated = { user :: AuthD::User::Public } - - 6 type UsersList = { users :: Array(::AuthD::User::Public) } + - 5 type UserValidated = { user :: UserPublic.UserPublic } + - 6 type UsersList = { users :: Array(UserPublic.UserPublic) } - 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 } - + - 11 type MatchingUsers = { users :: Array(UserPublic.UserPublic) } -} -- Basic message types. --- type Error = { reason :: Maybe String } -type Error = { reason :: String } +type Error = { reason :: Maybe String } type Token = { uid :: Int, token :: String } -type Contacts = { user :: Int, email :: Maybe String, phone :: Maybe String } +type PasswordRecoverySent = { user :: UserPublic.UserPublic } +type PasswordRecovered = { user :: UserPublic.UserPublic } +type Contacts = { user :: Int, email :: Maybe Email.Email, phone :: Maybe Phone.Phone } -type Email = String type Password = String type GetToken = { login :: String, password :: String } @@ -74,12 +74,15 @@ codecGetToken ∷ CA.JsonCodec GetToken codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string }) codecGotError ∷ CA.JsonCodec Error -codecGotError = CA.object "Error" (CAR.record { reason: CA.string }) --- codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string }) +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 }) +codecGotPasswordRecoverySent ∷ CA.JsonCodec PasswordRecoverySent +codecGotPasswordRecoverySent = CA.object "PasswordRecoverySent" (CAR.record { user: UserPublic.codec }) +codecGotPasswordRecovered ∷ CA.JsonCodec PasswordRecovered +codecGotPasswordRecovered = CA.object "PasswordRecovered" (CAR.record { user: UserPublic.codec }) codecGotContacts ∷ CA.JsonCodec Contacts -codecGotContacts = CA.object "Contacts" (CAR.record { user: CA.int, email: CAR.optional CA.string, phone: CAR.optional CA.string }) +codecGotContacts = CA.object "Contacts" (CAR.record { user: CA.int, email: CAR.optional Email.codec, phone: CAR.optional Phone.codec }) -- All possible requests. data RequestMessage @@ -113,8 +116,8 @@ data AnswerMessage -- | GotUsersList UsersList -- 6 -- | GotPermissionCheck PermissionCheck -- 7 -- | GotPermissionSet PermissionSet -- 8 - -- | GotPasswordRecoverySent PasswordRecoverySent-- 9 - -- | GotPasswordRecovered PasswordRecovered -- 10 + | GotPasswordRecoverySent PasswordRecoverySent -- 9 + | GotPasswordRecovered PasswordRecovered -- 10 -- | GotMatchingUsers MatchingUsers -- 11 | GotContacts Contacts -- 12 @@ -149,18 +152,18 @@ decode number string = case number of 0 -> error_management codecGotError GotError 1 -> error_management codecGotToken GotToken + 9 -> error_management codecGotPasswordRecoverySent GotPasswordRecoverySent + 10 -> error_management codecGotPasswordRecovered GotPasswordRecovered 12 -> error_management codecGotContacts GotContacts _ -> Left UnknownNumber - -- 2 type User = { user :: AuthD::User::Public } - -- 3 type UserAdded = { user :: AuthD::User::Public } + -- 2 type User = { user :: UserPublic.UserPublic } + -- 3 type UserAdded = { user :: UserPublic.UserPublic } -- 4 type UserEdited = { uid :: Int32 } - -- 5 type UserValidated = { user :: AuthD::User::Public } - -- 6 type UsersList = { users :: Array(::AuthD::User::Public) } + -- 5 type UserValidated = { user :: UserPublic.UserPublic } + -- 6 type UsersList = { users :: Array(UserPublic.UserPublic) } -- 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) } + -- 11 type MatchingUsers = { users :: Array(UserPublic.UserPublic) } where -- Signature is required since the compiler's guess is wrong. error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage diff --git a/src/App/Phone.purs b/src/App/Phone.purs new file mode 100644 index 0000000..9bf66e1 --- /dev/null +++ b/src/App/Phone.purs @@ -0,0 +1,20 @@ +-- | TODO: Phone module should include at least some sort of smart +-- | constructors, rejecting invalid phone numbers. +module App.Phone where + +import Prelude + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Newtype (class Newtype) +import Data.Profunctor (wrapIso) + +newtype Phone = Phone String + +derive instance newtypePhone :: Newtype Phone _ +derive instance eqPhone :: Eq Phone +derive instance ordPhone :: Ord Phone + +-- | Phone.codec can be used to parse and encode phone numbers. +codec :: JsonCodec Phone +codec = wrapIso Phone CA.string diff --git a/src/App/UserPublic.purs b/src/App/UserPublic.purs new file mode 100644 index 0000000..f8922b6 --- /dev/null +++ b/src/App/UserPublic.purs @@ -0,0 +1,17 @@ +module App.UserPublic where + +import Prelude + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Codec.Argonaut.Record as CAR +import Data.Newtype (class Newtype) + +-- | Currently not the real type. Lacks the 'profile' attribute. +-- type UserPublic row = { login :: String, uid :: Int | row } -- profile :: JSON any +type UserPublic = { login :: String, uid :: Int } -- profile :: JSON any + +-- | UserPublic.codec can be used to parse and encode public user info, +-- | which can be exchanged in different messages. +codec :: JsonCodec UserPublic +codec = CA.object "UserPublic" (CAR.record { "login": CA.string, "uid": CA.int })