DNSManager network: WIP
This commit is contained in:
parent
d7f6bd225a
commit
6fb46022fe
489
src/App/Messages/DNSManagerDaemon.purs
Normal file
489
src/App/Messages/DNSManagerDaemon.purs
Normal file
@ -0,0 +1,489 @@
|
||||
module App.Messages.DNSManagerDaemon where
|
||||
|
||||
import Prelude (bind, pure, show, ($))
|
||||
|
||||
import Effect (Effect)
|
||||
|
||||
import Data.Argonaut.Core as J
|
||||
import Data.Codec.Argonaut as CA
|
||||
import Data.Maybe (Maybe)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Codec.Argonaut.Record as CAR
|
||||
import Data.UInt (fromInt, toInt, UInt)
|
||||
|
||||
import Data.Tuple (Tuple(..))
|
||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||
|
||||
-- import App.PermissionLevel as PermissionLevel
|
||||
|
||||
import Effect.Class (liftEffect)
|
||||
import Data.Argonaut.Parser as JSONParser
|
||||
import Data.Bifunctor (lmap)
|
||||
|
||||
import App.IPC as IPC
|
||||
|
||||
type Password = String
|
||||
|
||||
{- UserID should be in a separate module with a dedicated codec. -}
|
||||
type UserID = Int -- UserID is either a login or an uid number
|
||||
|
||||
|
||||
{- 7 -}
|
||||
-- data MaintenanceSubject = Verbosity
|
||||
-- type Maintenance = { subject :: MaintenanceSubject, value :: Maybe Int }
|
||||
-- codecMaintenance = CA.object "Maintenance" (CAR.record { subject: CA.string, value: CA.int })
|
||||
|
||||
{- 0 -}
|
||||
type Login = { token :: String }
|
||||
codecLogin = CA.object "Login" (CAR.record { token: CA.string })
|
||||
|
||||
{- 10 -}
|
||||
-- type AddOrUpdateZone = { zone :: DNSManager::Storage::Zone }
|
||||
|
||||
{- 11 -}
|
||||
type DeleteZone = { domain :: String }
|
||||
codecDeleteZone = CA.object "DeleteZone" (CAR.record { domain: CA.string })
|
||||
|
||||
{- 12 -}
|
||||
type GetZone = { domain :: String }
|
||||
codecGetZone = CA.object "GetZone" (CAR.record { domain: CA.string })
|
||||
|
||||
{- 13 -}
|
||||
type UserDomains = {}
|
||||
codecUserDomains = CA.object "UserDomains" (CAR.record {})
|
||||
|
||||
{- 14 -}
|
||||
-- type AddRR = { domain :: String, rr :: DNSManager::Storage::Zone::ResourceRecord }
|
||||
-- codecAddRR = CA.object "AddRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec })
|
||||
|
||||
{- 15 -}
|
||||
-- type UpdateRR = { domain :: String, rr :: DNSManager::Storage::Zone::ResourceRecord }
|
||||
-- codecUpdateRR = CA.object "UpdateRR" (CAR.record { domain: CA.string, rr: ResourceRecord.codec })
|
||||
|
||||
{- 16 -}
|
||||
type DeleteRR = { domain :: String, rrid :: Int }
|
||||
codecDeleteRR = CA.object "DeleteRR" (CAR.record { domain: CA.string, rrid: CA.int })
|
||||
|
||||
|
||||
|
||||
|
||||
{- 0 -}
|
||||
type Login = { login :: String, password :: String }
|
||||
codecLogin ∷ CA.JsonCodec Login
|
||||
codecLogin = CA.object "Login" (CAR.record { login: CA.string, password: CA.string })
|
||||
|
||||
{- 1 -}
|
||||
type Register = { login :: String
|
||||
, password :: Password
|
||||
, email :: Maybe Email.Email
|
||||
{-, profile :: Maybe Hash(String, JSON::Any) -} }
|
||||
codecRegister ∷ CA.JsonCodec Register
|
||||
codecRegister
|
||||
= CA.object "Register" (CAR.record
|
||||
{ login: CA.string
|
||||
, password: CA.string
|
||||
, email: CAR.optional Email.codec })
|
||||
|
||||
{- 2 -}
|
||||
type ValidateUser = { user :: UserID, activation_key :: String }
|
||||
codecValidateUser ∷ CA.JsonCodec ValidateUser
|
||||
codecValidateUser
|
||||
= CA.object "ValidateUser" (CAR.record
|
||||
{ user: CA.int
|
||||
, activation_key: CA.string })
|
||||
|
||||
{- NOTE: "user" attribute for both PasswordRecovery and AskPasswordRecovery could be UserID,
|
||||
but they'll be used as login since the user has to type it. -}
|
||||
{- 3 -}
|
||||
type AskPasswordRecovery = { user :: String }
|
||||
codecAskPasswordRecovery ∷ CA.JsonCodec AskPasswordRecovery
|
||||
codecAskPasswordRecovery = CA.object "AskPasswordRecovery" (CAR.record { user: CA.string })
|
||||
|
||||
{- 4 -}
|
||||
type PasswordRecovery = { user :: String
|
||||
, password_renew_key :: String
|
||||
, new_password :: Password }
|
||||
codecPasswordRecovery ∷ CA.JsonCodec PasswordRecovery
|
||||
codecPasswordRecovery
|
||||
= CA.object "PasswordRecovery" (CAR.record
|
||||
{ user: CA.string
|
||||
, password_renew_key: CA.string
|
||||
, new_password: CA.string })
|
||||
|
||||
{- 5 -}
|
||||
-- I'll split a message in two: either get a user by UID or by name.
|
||||
-- TODO: change it for an Either Int String type.
|
||||
type GetUserByUID = { user :: Int }
|
||||
type GetUserByName = { user :: String }
|
||||
codecGetUserByUID ∷ CA.JsonCodec GetUserByUID
|
||||
codecGetUserByUID = CA.object "GetUserByUID" (CAR.record { user: CA.int })
|
||||
codecGetUserByName ∷ CA.JsonCodec GetUserByName
|
||||
codecGetUserByName = CA.object "GetUserByName" (CAR.record { user: CA.string })
|
||||
|
||||
{- 6 -}
|
||||
type ModUser = { user :: Maybe UserID
|
||||
, admin :: Maybe Boolean
|
||||
, password :: Maybe Password
|
||||
, email :: Maybe Email.Email }
|
||||
codecModUser ∷ CA.JsonCodec ModUser
|
||||
codecModUser
|
||||
= CA.object "ModUser" (CAR.record
|
||||
{ user: CAR.optional CA.int
|
||||
, admin: CAR.optional CA.boolean
|
||||
, password: CAR.optional CA.string
|
||||
, email: CAR.optional Email.codec })
|
||||
|
||||
{- 7 -}
|
||||
{- type EditProfileEntries = { user :: Maybe UserID
|
||||
, new_profile_entries :: Hash(String, JSON::Any) } -}
|
||||
|
||||
{- 8 -}
|
||||
type DeleteUser = { user :: Maybe UserID }
|
||||
codecDeleteUser ∷ CA.JsonCodec DeleteUser
|
||||
codecDeleteUser = CA.object "DeleteUser" (CAR.record { user: CAR.optional CA.int })
|
||||
|
||||
{- 9 -}
|
||||
type AddUser = { login :: String
|
||||
, password :: Password
|
||||
, admin :: Boolean
|
||||
, email :: Maybe Email.Email
|
||||
{-, profile :: Maybe Hash(String, JSON::Any) -} }
|
||||
codecAddUser ∷ CA.JsonCodec AddUser
|
||||
codecAddUser
|
||||
= CA.object "AddUser" (CAR.record
|
||||
{ login: CA.string
|
||||
, password: CA.string
|
||||
, admin: CA.boolean
|
||||
, email: CAR.optional Email.codec
|
||||
{-, profile :: Maybe Hash(String, JSON::Any) -} })
|
||||
|
||||
{- 10 -}
|
||||
type CheckPermission = { user :: Maybe UserID, service :: String, resource :: String }
|
||||
codecCheckPermission ∷ CA.JsonCodec CheckPermission
|
||||
codecCheckPermission
|
||||
= CA.object "CheckPermission" (CAR.record
|
||||
{ user: CAR.optional CA.int
|
||||
, service: CA.string
|
||||
, resource: CA.string })
|
||||
|
||||
{- 11 -}
|
||||
type SetPermission = { user :: UserID
|
||||
, service :: String
|
||||
, resource :: String
|
||||
, permission :: PermissionLevel.PermissionLevel }
|
||||
codecSetPermission ∷ CA.JsonCodec SetPermission
|
||||
codecSetPermission
|
||||
= CA.object "SetPermission" (CAR.record
|
||||
{ user: CA.int
|
||||
, service: CA.string
|
||||
, resource: CA.string
|
||||
, permission: PermissionLevel.codec })
|
||||
|
||||
{- 12 -}
|
||||
type SearchUser = { regex :: Maybe String, offset :: Maybe Int }
|
||||
codecSearchUser ∷ CA.JsonCodec SearchUser
|
||||
codecSearchUser
|
||||
= CA.object "SearchUser" (CAR.record
|
||||
{ regex: CAR.optional CA.string
|
||||
, offset: CAR.optional CA.int })
|
||||
|
||||
|
||||
{-
|
||||
RESPONSES
|
||||
-}
|
||||
|
||||
-- TODO: note to myself: messages seem chaotic. Could be simpler. Should be simpler.
|
||||
{- 0 -}
|
||||
type Error = { reason :: Maybe String }
|
||||
codecGotError ∷ CA.JsonCodec Error
|
||||
codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
|
||||
|
||||
{- 1 -}
|
||||
type Logged = { uid :: Int, token :: String }
|
||||
codecGotToken ∷ CA.JsonCodec Logged
|
||||
codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int, "token": CA.string })
|
||||
|
||||
{- 2 -}
|
||||
type User = { user :: UserPublic.UserPublic }
|
||||
codecGotUser ∷ CA.JsonCodec User
|
||||
codecGotUser = CA.object "User" (CAR.record { user: UserPublic.codec })
|
||||
|
||||
{- 3 -}
|
||||
type UserAdded = { user :: UserPublic.UserPublic }
|
||||
codecGotUserAdded ∷ CA.JsonCodec UserAdded
|
||||
codecGotUserAdded = CA.object "UserAdded" (CAR.record { user: UserPublic.codec })
|
||||
|
||||
{- 4 -}
|
||||
type UserEdited = { uid :: Int }
|
||||
codecGotUserEdited ∷ CA.JsonCodec UserEdited
|
||||
codecGotUserEdited = CA.object "UserEdited" (CAR.record { "uid": CA.int })
|
||||
|
||||
{- 5 -}
|
||||
type UserValidated = { user :: UserPublic.UserPublic }
|
||||
codecGotUserValidated ∷ CA.JsonCodec UserValidated
|
||||
codecGotUserValidated = CA.object "UserValidated" (CAR.record { user: UserPublic.codec })
|
||||
|
||||
{- 6 -}
|
||||
type UsersList = { users :: Array UserPublic.UserPublic }
|
||||
codecGotUsersList ∷ CA.JsonCodec UsersList
|
||||
codecGotUsersList = CA.object "UsersList" (CAR.record { users: CA.array UserPublic.codec })
|
||||
|
||||
{- 7 -}
|
||||
type PermissionCheck
|
||||
= { user :: Int
|
||||
, service :: String
|
||||
, resource :: String
|
||||
, permission :: PermissionLevel.PermissionLevel }
|
||||
codecGotPermissionCheck :: CA.JsonCodec PermissionCheck
|
||||
codecGotPermissionCheck
|
||||
= CA.object "PermissionCheck" (CAR.record
|
||||
{ user: CA.int
|
||||
, service: CA.string
|
||||
, resource: CA.string
|
||||
, permission: PermissionLevel.codec })
|
||||
|
||||
{- 8 -}
|
||||
type PermissionSet
|
||||
= { user :: Int
|
||||
, service :: String
|
||||
, resource :: String
|
||||
, permission :: PermissionLevel.PermissionLevel }
|
||||
codecGotPermissionSet :: CA.JsonCodec PermissionSet
|
||||
codecGotPermissionSet
|
||||
= CA.object "PermissionSet" (CAR.record
|
||||
{ user: CA.int
|
||||
, service: CA.string
|
||||
, resource: CA.string
|
||||
, permission: PermissionLevel.codec })
|
||||
|
||||
{- 9 -}
|
||||
type PasswordRecoverySent = { user :: UserPublic.UserPublic }
|
||||
codecGotPasswordRecoverySent ∷ CA.JsonCodec PasswordRecoverySent
|
||||
codecGotPasswordRecoverySent
|
||||
= CA.object "PasswordRecoverySent" (CAR.record { user: UserPublic.codec })
|
||||
|
||||
{- 10 -}
|
||||
type PasswordRecovered = { }
|
||||
codecGotPasswordRecovered ∷ CA.JsonCodec PasswordRecovered
|
||||
codecGotPasswordRecovered = CA.object "PasswordRecovered" (CAR.record { })
|
||||
|
||||
{- 11 -}
|
||||
type MatchingUsers = { users :: Array UserPublic.UserPublic }
|
||||
codecGotMatchingUsers ∷ CA.JsonCodec MatchingUsers
|
||||
codecGotMatchingUsers = CA.object "MatchingUsers" (CAR.record { users: CA.array UserPublic.codec })
|
||||
|
||||
{- 12 -}
|
||||
type UserDeleted = { uid :: Int }
|
||||
codecGotUserDeleted ∷ CA.JsonCodec UserDeleted
|
||||
codecGotUserDeleted = CA.object "UserDeleted" (CAR.record { uid: CA.int })
|
||||
|
||||
{- 20 -}
|
||||
type ErrorMustBeAuthenticated = {}
|
||||
codecGotErrorMustBeAuthenticated :: CA.JsonCodec ErrorMustBeAuthenticated
|
||||
codecGotErrorMustBeAuthenticated = CA.object "ErrorMustBeAuthenticated" (CAR.record {})
|
||||
|
||||
{- 21 -}
|
||||
type ErrorAlreadyUsedLogin = {}
|
||||
codecGotErrorAlreadyUsedLogin :: CA.JsonCodec ErrorAlreadyUsedLogin
|
||||
codecGotErrorAlreadyUsedLogin = CA.object "ErrorAlreadyUsedLogin" (CAR.record {})
|
||||
|
||||
{- 22 -}
|
||||
type ErrorMailRequired = {}
|
||||
codecGotErrorMailRequired :: CA.JsonCodec ErrorMailRequired
|
||||
codecGotErrorMailRequired = CA.object "ErrorMailRequired" (CAR.record {})
|
||||
|
||||
{- 23 -}
|
||||
type ErrorUserNotFound = {}
|
||||
codecGotErrorUserNotFound :: CA.JsonCodec ErrorUserNotFound
|
||||
codecGotErrorUserNotFound = CA.object "ErrorUserNotFound" (CAR.record {})
|
||||
|
||||
{- 24 -}
|
||||
type ErrorPasswordTooShort = {}
|
||||
codecGotErrorPasswordTooShort :: CA.JsonCodec ErrorPasswordTooShort
|
||||
codecGotErrorPasswordTooShort = CA.object "ErrorPasswordTooShort" (CAR.record {})
|
||||
|
||||
{- 25 -}
|
||||
type ErrorInvalidCredentials = {}
|
||||
codecGotErrorInvalidCredentials :: CA.JsonCodec ErrorInvalidCredentials
|
||||
codecGotErrorInvalidCredentials = CA.object "ErrorInvalidCredentials" (CAR.record {})
|
||||
|
||||
{- 26 -}
|
||||
type ErrorRegistrationsClosed = {}
|
||||
codecGotErrorRegistrationsClosed :: CA.JsonCodec ErrorRegistrationsClosed
|
||||
codecGotErrorRegistrationsClosed = CA.object "ErrorRegistrationsClosed" (CAR.record {})
|
||||
|
||||
{- 27 -}
|
||||
type ErrorInvalidLoginFormat = {}
|
||||
codecGotErrorInvalidLoginFormat :: CA.JsonCodec ErrorInvalidLoginFormat
|
||||
codecGotErrorInvalidLoginFormat = CA.object "ErrorInvalidLoginFormat" (CAR.record {})
|
||||
|
||||
{- 28 -}
|
||||
type ErrorInvalidEmailFormat = {}
|
||||
codecGotErrorInvalidEmailFormat :: CA.JsonCodec ErrorInvalidEmailFormat
|
||||
codecGotErrorInvalidEmailFormat = CA.object "ErrorInvalidEmailFormat" (CAR.record {})
|
||||
|
||||
{- 29 -}
|
||||
type ErrorAlreadyUsersInDB = {}
|
||||
codecGotErrorAlreadyUsersInDB :: CA.JsonCodec ErrorAlreadyUsersInDB
|
||||
codecGotErrorAlreadyUsersInDB = CA.object "ErrorAlreadyUsersInDB" (CAR.record {})
|
||||
|
||||
{- 30 -}
|
||||
type ErrorReadOnlyProfileKeys = { read_only_keys :: Array String }
|
||||
codecGotErrorReadOnlyProfileKeys :: CA.JsonCodec ErrorReadOnlyProfileKeys
|
||||
codecGotErrorReadOnlyProfileKeys
|
||||
= CA.object "ErrorReadOnlyProfileKeys" (CAR.record { read_only_keys: CA.array CA.string })
|
||||
|
||||
{- 31 -}
|
||||
type ErrorInvalidActivationKey = {}
|
||||
codecGotErrorInvalidActivationKey :: CA.JsonCodec ErrorInvalidActivationKey
|
||||
codecGotErrorInvalidActivationKey = CA.object "ErrorInvalidActivationKey" (CAR.record {})
|
||||
|
||||
{- 32 -}
|
||||
type ErrorUserAlreadyValidated = {}
|
||||
codecGotErrorUserAlreadyValidated :: CA.JsonCodec ErrorUserAlreadyValidated
|
||||
codecGotErrorUserAlreadyValidated = CA.object "ErrorUserAlreadyValidated" (CAR.record {})
|
||||
|
||||
{- 33 -}
|
||||
type ErrorCannotContactUser = {}
|
||||
codecGotErrorCannotContactUser :: CA.JsonCodec ErrorCannotContactUser
|
||||
codecGotErrorCannotContactUser = CA.object "ErrorCannotContactUser" (CAR.record {})
|
||||
|
||||
{- 34 -}
|
||||
type ErrorInvalidRenewKey = {}
|
||||
codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey
|
||||
codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {})
|
||||
|
||||
-- All possible requests.
|
||||
data RequestMessage
|
||||
= MkLogin Login -- 0
|
||||
| MkRegister Register -- 1
|
||||
| MkValidateUser ValidateUser -- 2
|
||||
| MkAskPasswordRecovery AskPasswordRecovery -- 3
|
||||
| MkPasswordRecovery PasswordRecovery -- 4
|
||||
| MkGetUserByUID GetUserByUID -- 5
|
||||
| MkGetUserByName GetUserByName -- 5 (bis)
|
||||
| MkModUser ModUser -- 6
|
||||
--| MkEditProfileContent EditProfileContent -- 7
|
||||
| MkDeleteUser DeleteUser -- 8
|
||||
| MkAddUser AddUser -- 9
|
||||
| MkCheckPermission CheckPermission -- 10
|
||||
| MkSetPermission SetPermission -- 11
|
||||
| MkSearchUser SearchUser -- 12
|
||||
|
||||
-- All possible answers from the authentication daemon (authd).
|
||||
data AnswerMessage
|
||||
= GotError Error -- 0
|
||||
| GotToken Logged -- 1
|
||||
| GotUser User -- 2
|
||||
| GotUserAdded UserAdded -- 3
|
||||
| GotUserEdited UserEdited -- 4
|
||||
| GotUserValidated UserValidated -- 5
|
||||
| GotUsersList UsersList -- 6
|
||||
| GotPermissionCheck PermissionCheck -- 7
|
||||
| GotPermissionSet PermissionSet -- 8
|
||||
| GotPasswordRecoverySent PasswordRecoverySent -- 9
|
||||
| GotPasswordRecovered PasswordRecovered -- 10
|
||||
| GotMatchingUsers MatchingUsers -- 11
|
||||
| GotUserDeleted UserDeleted -- 12
|
||||
| GotErrorMustBeAuthenticated ErrorMustBeAuthenticated -- 20
|
||||
| GotErrorAlreadyUsedLogin ErrorAlreadyUsedLogin -- 21
|
||||
| GotErrorMailRequired ErrorMailRequired -- 22
|
||||
| GotErrorUserNotFound ErrorUserNotFound -- 23
|
||||
| GotErrorPasswordTooShort ErrorPasswordTooShort -- 24
|
||||
| GotErrorInvalidCredentials ErrorInvalidCredentials -- 25
|
||||
| GotErrorRegistrationsClosed ErrorRegistrationsClosed -- 26
|
||||
| GotErrorInvalidLoginFormat ErrorInvalidLoginFormat -- 27
|
||||
| GotErrorInvalidEmailFormat ErrorInvalidEmailFormat -- 28
|
||||
| GotErrorAlreadyUsersInDB ErrorAlreadyUsersInDB -- 29
|
||||
| GotErrorReadOnlyProfileKeys ErrorReadOnlyProfileKeys -- 30
|
||||
| GotErrorInvalidActivationKey ErrorInvalidActivationKey -- 31
|
||||
| GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
|
||||
| GotErrorCannotContactUser ErrorCannotContactUser -- 33
|
||||
| GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
encode m = case m of
|
||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||
(MkRegister request) -> get_tuple 1 codecRegister request
|
||||
(MkValidateUser request) -> get_tuple 2 codecValidateUser request
|
||||
(MkAskPasswordRecovery request) -> get_tuple 3 codecAskPasswordRecovery request
|
||||
(MkPasswordRecovery request) -> get_tuple 4 codecPasswordRecovery request
|
||||
-- Both messages are actually a single message type, so they have the same number.
|
||||
-- TODO: change the message codec for an Either Int String.
|
||||
(MkGetUserByUID request) -> get_tuple 5 codecGetUserByUID request
|
||||
(MkGetUserByName request) -> get_tuple 5 codecGetUserByName request
|
||||
(MkModUser request) -> get_tuple 6 codecModUser request
|
||||
-- 7 MkEditProfileContent
|
||||
(MkDeleteUser request) -> get_tuple 8 codecDeleteUser request
|
||||
(MkAddUser request) -> get_tuple 9 codecAddUser request
|
||||
(MkCheckPermission request) -> get_tuple 10 codecCheckPermission request
|
||||
(MkSetPermission request) -> get_tuple 11 codecSetPermission request
|
||||
(MkSearchUser request) -> get_tuple 12 codecSearchUser request
|
||||
where
|
||||
get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String
|
||||
get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request)
|
||||
|
||||
data DecodeError
|
||||
= JSONERROR String
|
||||
| UnknownError String
|
||||
| UnknownNumber
|
||||
|
||||
decode :: Int -> String -> Either DecodeError AnswerMessage
|
||||
decode number string
|
||||
= case number of
|
||||
0 -> error_management codecGotError GotError
|
||||
1 -> error_management codecGotToken GotToken
|
||||
2 -> error_management codecGotUser GotUser
|
||||
3 -> error_management codecGotUserAdded GotUserAdded
|
||||
4 -> error_management codecGotUserEdited GotUserEdited
|
||||
5 -> error_management codecGotUserValidated GotUserValidated
|
||||
6 -> error_management codecGotUsersList GotUsersList
|
||||
7 -> error_management codecGotPermissionCheck GotPermissionCheck
|
||||
8 -> error_management codecGotPermissionSet GotPermissionSet
|
||||
9 -> error_management codecGotPasswordRecoverySent GotPasswordRecoverySent
|
||||
10 -> error_management codecGotPasswordRecovered GotPasswordRecovered
|
||||
11 -> error_management codecGotMatchingUsers GotMatchingUsers
|
||||
12 -> error_management codecGotUserDeleted GotUserDeleted
|
||||
20 -> error_management codecGotErrorMustBeAuthenticated GotErrorMustBeAuthenticated
|
||||
21 -> error_management codecGotErrorAlreadyUsedLogin GotErrorAlreadyUsedLogin
|
||||
22 -> error_management codecGotErrorMailRequired GotErrorMailRequired
|
||||
23 -> error_management codecGotErrorUserNotFound GotErrorUserNotFound
|
||||
24 -> error_management codecGotErrorPasswordTooShort GotErrorPasswordTooShort
|
||||
25 -> error_management codecGotErrorInvalidCredentials GotErrorInvalidCredentials
|
||||
26 -> error_management codecGotErrorRegistrationsClosed GotErrorRegistrationsClosed
|
||||
27 -> error_management codecGotErrorInvalidLoginFormat GotErrorInvalidLoginFormat
|
||||
28 -> error_management codecGotErrorInvalidEmailFormat GotErrorInvalidEmailFormat
|
||||
29 -> error_management codecGotErrorAlreadyUsersInDB GotErrorAlreadyUsersInDB
|
||||
30 -> error_management codecGotErrorReadOnlyProfileKeys GotErrorReadOnlyProfileKeys
|
||||
31 -> error_management codecGotErrorInvalidActivationKey GotErrorInvalidActivationKey
|
||||
32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
|
||||
33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser
|
||||
34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey
|
||||
_ -> 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 (parseDecodeJSON codec string) of
|
||||
(Left err) -> Left (JSONERROR err)
|
||||
(Right v) -> Right (f v)
|
||||
|
||||
parseDecodeJSON :: forall a. CA.JsonCodec a -> String -> Either String a
|
||||
parseDecodeJSON codec str = do
|
||||
json <- JSONParser.jsonParser str
|
||||
lmap CA.printJsonDecodeError (CA.decode codec json)
|
||||
|
||||
serialize :: RequestMessage -> Effect ArrayBuffer
|
||||
serialize request
|
||||
= case (encode request) of
|
||||
(Tuple messageTypeNumber string) -> IPC.toTypedIPC messageTypeNumber string
|
||||
|
||||
deserialize :: ArrayBuffer -> Effect (Either DecodeError AnswerMessage)
|
||||
deserialize arraybuffer
|
||||
= do
|
||||
value <- liftEffect $ IPC.fromTypedIPC arraybuffer
|
||||
pure $ case (value) of
|
||||
Left err -> Left (UnknownError $ show err)
|
||||
Right (Tuple messageTypeNumber string) -> case (decode (toInt messageTypeNumber) string) of
|
||||
Left parsingError -> Left parsingError
|
||||
Right answerMessage -> Right answerMessage
|
||||
Loading…
Reference in New Issue
Block a user