karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Codecs, Codecs everywhere!

Browse Source
This commit is contained in:
Philippe Pittoli 2023-05-26 01:39:50 +02:00
parent 2d269d088c
commit e80b71c0cd
6 changed files with 92 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
spago.dhall
View File

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

4
src/App/AuthenticationForm.purs
View File

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

20
src/App/Email.purs Normal file
View File

@ -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

59
src/App/Messages/AuthenticationDaemon.purs
View File

@ -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

20
src/App/Phone.purs Normal file
View File

@ -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

17
src/App/UserPublic.purs Normal file
View File

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