Codecs, Codecs everywhere!

spago.dhall

@@ -16,11 +16,12 @@
   , "foreign"
   , "halogen"
   , "halogen-subscriptions"
-  , "lists"
   , "maybe"
+  , "newtype"
   , "parsing"
   , "parsing-dataview"
   , "prelude"
+  , "profunctor"
   , "strings"
   , "transformers"
   , "tuples"

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.Argonaut.Core as J
-import Data.Codec.Argonaut as CA
+-- import Data.Codec.Argonaut as CA
 import Data.Const (Const)
 import Data.Either (Either(..))
 import Data.Maybe (Maybe(..), isJust, isNothing, maybe)

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

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 }
+  - 2 type User = { user :: UserPublic.UserPublic }
-  - 3 type UserAdded = { user :: AuthD::User::Public }
+  - 3 type UserAdded = { user :: UserPublic.UserPublic }
   - 4 type UserEdited = { uid :: Int32 }
-  - 5 type UserValidated = { user :: AuthD::User::Public }
+  - 5 type UserValidated = { user :: UserPublic.UserPublic }
-  - 6 type UsersList = { users :: Array(::AuthD::User::Public) }
+  - 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 }
+  - 11 type MatchingUsers = { users :: Array(UserPublic.UserPublic) }
-  - 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 }
-
 -}
 
 -- Basic message types.
--- type Error = { reason :: Maybe String }
+type Error = { reason :: Maybe String }
-type Error = { reason :: 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
+  | GotPasswordRecoverySent PasswordRecoverySent   -- 9
-  -- | GotPasswordRecovered    PasswordRecovered   -- 10
+  | 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 }
+    -- 2 type User = { user :: UserPublic.UserPublic }
-    -- 3 type UserAdded = { user :: AuthD::User::Public }
+    -- 3 type UserAdded = { user :: UserPublic.UserPublic }
     -- 4 type UserEdited = { uid :: Int32 }
-    -- 5 type UserValidated = { user :: AuthD::User::Public }
+    -- 5 type UserValidated = { user :: UserPublic.UserPublic }
-    -- 6 type UsersList = { users :: Array(::AuthD::User::Public) }
+    -- 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 }
+    -- 11 type MatchingUsers = { users :: Array(UserPublic.UserPublic) }
-    -- 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

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

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 })