DNSManager messages: still WIP.
parent
6fb46022fe
commit
7f50ad1ffe
|
@ -0,0 +1,21 @@
|
||||||
|
module App.MaintenanceSubject where
|
||||||
|
|
||||||
|
import Data.Codec.Argonaut as CA
|
||||||
|
import Data.Maybe (Maybe(..))
|
||||||
|
|
||||||
|
data MaintenanceSubject
|
||||||
|
= Verbosity
|
||||||
|
|
||||||
|
-- | Codec for just encoding a single value of type `MaintenanceSubject`
|
||||||
|
codec :: CA.JsonCodec MaintenanceSubject
|
||||||
|
codec =
|
||||||
|
CA.prismaticCodec "MaintenanceSubject" from to CA.string
|
||||||
|
where
|
||||||
|
from :: String -> Maybe MaintenanceSubject
|
||||||
|
from = case _ of
|
||||||
|
"verbosity" -> Just None
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
to :: MaintenanceSubject -> String
|
||||||
|
to = case _ of
|
||||||
|
Verbosity -> "verbosity"
|
|
@ -22,16 +22,14 @@ import Data.Bifunctor (lmap)
|
||||||
|
|
||||||
import App.IPC as IPC
|
import App.IPC as IPC
|
||||||
|
|
||||||
type Password = String
|
|
||||||
|
|
||||||
{- UserID should be in a separate module with a dedicated codec. -}
|
{- UserID should be in a separate module with a dedicated codec. -}
|
||||||
type UserID = Int -- UserID is either a login or an uid number
|
type UserID = Int -- UserID is either a login or an uid number
|
||||||
|
|
||||||
|
|
||||||
{- 7 -}
|
{- 7 -}
|
||||||
-- data MaintenanceSubject = Verbosity
|
data MaintenanceSubject = Verbosity
|
||||||
-- type Maintenance = { subject :: MaintenanceSubject, value :: Maybe Int }
|
type Maintenance = { subject :: MaintenanceSubject, value :: Maybe Int }
|
||||||
-- codecMaintenance = CA.object "Maintenance" (CAR.record { subject: CA.string, value: CA.int })
|
codecMaintenance = CA.object "Maintenance" (CAR.record { subject: CA.string, value: CA.int })
|
||||||
|
|
||||||
{- 0 -}
|
{- 0 -}
|
||||||
type Login = { token :: String }
|
type Login = { token :: String }
|
||||||
|
@ -66,359 +64,113 @@ codecDeleteRR = CA.object "DeleteRR" (CAR.record { domain: CA.string, rrid: CA.i
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
{- 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
|
RESPONSES
|
||||||
-}
|
-}
|
||||||
|
|
||||||
-- TODO: note to myself: messages seem chaotic. Could be simpler. Should be simpler.
|
-- TODO: Zone actually is a complex data structure.
|
||||||
|
type DNSZone = String
|
||||||
|
|
||||||
{- 0 -}
|
{- 0 -}
|
||||||
type Error = { reason :: Maybe String }
|
-- type Error = { reason :: String | Array(String) }
|
||||||
|
type Error = { reason :: String }
|
||||||
codecGotError ∷ CA.JsonCodec Error
|
codecGotError ∷ CA.JsonCodec Error
|
||||||
codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
|
codecGotError = CA.object "Error" (CAR.record { reason: CA.string })
|
||||||
|
|
||||||
{- 1 -}
|
{- 1 -}
|
||||||
type Logged = { uid :: Int, token :: String }
|
type Success = { }
|
||||||
codecGotToken ∷ CA.JsonCodec Logged
|
codecSuccess ∷ CA.JsonCodec Success
|
||||||
codecGotToken = CA.object "Logged" (CAR.record { "uid": CA.int, "token": CA.string })
|
codecSuccess = CA.object "Success" (CAR.record { })
|
||||||
|
|
||||||
{- 2 -}
|
{- 2 -}
|
||||||
type User = { user :: UserPublic.UserPublic }
|
type ErrorInvalidToken = { }
|
||||||
codecGotUser ∷ CA.JsonCodec User
|
codecErrorInvalidToken ∷ CA.JsonCodec ErrorInvalidToken
|
||||||
codecGotUser = CA.object "User" (CAR.record { user: UserPublic.codec })
|
codecErrorInvalidToken = CA.object "ErrorInvalidToken" (CAR.record { })
|
||||||
|
|
||||||
{- 3 -}
|
{- 3 -}
|
||||||
type UserAdded = { user :: UserPublic.UserPublic }
|
type DomainAlreadyExists = { }
|
||||||
codecGotUserAdded ∷ CA.JsonCodec UserAdded
|
codecDomainAlreadyExists ∷ CA.JsonCodec DomainAlreadyExists
|
||||||
codecGotUserAdded = CA.object "UserAdded" (CAR.record { user: UserPublic.codec })
|
codecDomainAlreadyExists = CA.object "DomainAlreadyExists" (CAR.record { })
|
||||||
|
|
||||||
{- 4 -}
|
{- 10 -}
|
||||||
type UserEdited = { uid :: Int }
|
-- For now, Error is just an alias on String.
|
||||||
codecGotUserEdited ∷ CA.JsonCodec UserEdited
|
-- type InvalidZone = { errors : Array(Storage::Zone::Error) }
|
||||||
codecGotUserEdited = CA.object "UserEdited" (CAR.record { "uid": CA.int })
|
type InvalidZone = { errors :: Array String }
|
||||||
|
codecInvalidZone ∷ CA.JsonCodec InvalidZone
|
||||||
|
codecInvalidZone = CA.object "InvalidZone" (CAR.record { errors: CA.array CA.string })
|
||||||
|
|
||||||
{- 5 -}
|
{- 11 -}
|
||||||
type UserValidated = { user :: UserPublic.UserPublic }
|
type DomainChanged = { }
|
||||||
codecGotUserValidated ∷ CA.JsonCodec UserValidated
|
codecDomainChanged ∷ CA.JsonCodec DomainChanged
|
||||||
codecGotUserValidated = CA.object "UserValidated" (CAR.record { user: UserPublic.codec })
|
codecDomainChanged = CA.object "DomainChanged" (CAR.record { })
|
||||||
|
|
||||||
{- 6 -}
|
{- 12 -}
|
||||||
type UsersList = { users :: Array UserPublic.UserPublic }
|
-- TODO
|
||||||
codecGotUsersList ∷ CA.JsonCodec UsersList
|
type Zone = { zone :: DNSZone }
|
||||||
codecGotUsersList = CA.object "UsersList" (CAR.record { users: CA.array UserPublic.codec })
|
codecZone ∷ CA.JsonCodec Zone
|
||||||
|
codecZone = CA.object "Zone" (CAR.record { zone: CA.string })
|
||||||
|
|
||||||
{- 7 -}
|
{- 13 -}
|
||||||
type PermissionCheck
|
type UnknownZone = { }
|
||||||
= { user :: Int
|
codecUnknownZone ∷ CA.JsonCodec UnknownZone
|
||||||
, service :: String
|
codecUnknownZone = CA.object "UnknownZone" (CAR.record { })
|
||||||
, 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 -}
|
{- 14 -}
|
||||||
type PermissionSet
|
type DomainList = { domains :: Array String }
|
||||||
= { user :: Int
|
codecDomainList ∷ CA.JsonCodec DomainList
|
||||||
, service :: String
|
codecDomainList = CA.object "DomainList" (CAR.record { domains: CA.array CA.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 -}
|
{- 50 -}
|
||||||
type PasswordRecoverySent = { user :: UserPublic.UserPublic }
|
type UnknownUser = { }
|
||||||
codecGotPasswordRecoverySent ∷ CA.JsonCodec PasswordRecoverySent
|
codecUnknownUser ∷ CA.JsonCodec UnknownUser
|
||||||
codecGotPasswordRecoverySent
|
codecUnknownUser = CA.object "UnknownUser" (CAR.record { })
|
||||||
= CA.object "PasswordRecoverySent" (CAR.record { user: UserPublic.codec })
|
|
||||||
|
|
||||||
{- 10 -}
|
{- 51 -}
|
||||||
type PasswordRecovered = { }
|
type NoOwnership = { }
|
||||||
codecGotPasswordRecovered ∷ CA.JsonCodec PasswordRecovered
|
codecNoOwnership ∷ CA.JsonCodec NoOwnership
|
||||||
codecGotPasswordRecovered = CA.object "PasswordRecovered" (CAR.record { })
|
codecNoOwnership = CA.object "NoOwnership" (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.
|
-- All possible requests.
|
||||||
data RequestMessage
|
data RequestMessage
|
||||||
= MkLogin Login -- 0
|
= MkLogin Login -- 0
|
||||||
| MkRegister Register -- 1
|
| MkMaintenance Maintenance -- 7
|
||||||
| MkValidateUser ValidateUser -- 2
|
| MkNewDomain NewDomain -- 9
|
||||||
| MkAskPasswordRecovery AskPasswordRecovery -- 3
|
| MkAddOrUpdateZone AddOrUpdateZone -- 10
|
||||||
| MkPasswordRecovery PasswordRecovery -- 4
|
| MkDeleteZone DeleteZone -- 11
|
||||||
| MkGetUserByUID GetUserByUID -- 5
|
| MkGetZone GetZone -- 12
|
||||||
| MkGetUserByName GetUserByName -- 5 (bis)
|
| MkUserDomains UserDomains -- 13
|
||||||
| MkModUser ModUser -- 6
|
| MkAddRR AddRR -- 14
|
||||||
--| MkEditProfileContent EditProfileContent -- 7
|
| MkUpdateRR UpdateRR -- 15
|
||||||
| MkDeleteUser DeleteUser -- 8
|
| MkDeleteRR DeleteRR -- 16
|
||||||
| MkAddUser AddUser -- 9
|
|
||||||
| MkCheckPermission CheckPermission -- 10
|
|
||||||
| MkSetPermission SetPermission -- 11
|
|
||||||
| MkSearchUser SearchUser -- 12
|
|
||||||
|
|
||||||
-- All possible answers from the authentication daemon (authd).
|
-- All possible answers from the authentication daemon (authd).
|
||||||
data AnswerMessage
|
data AnswerMessage
|
||||||
= GotError Error -- 0
|
= MkError Error -- 0
|
||||||
| GotToken Logged -- 1
|
| MkSuccess Success -- 1
|
||||||
| GotUser User -- 2
|
| MkErrorInvalidToken ErrorInvalidToken -- 2
|
||||||
| GotUserAdded UserAdded -- 3
|
| MkDomainAlreadyExists DomainAlreadyExists -- 3
|
||||||
| GotUserEdited UserEdited -- 4
|
| MkInvalidZone InvalidZone -- 10
|
||||||
| GotUserValidated UserValidated -- 5
|
| MkDomainChanged DomainChanged -- 11
|
||||||
| GotUsersList UsersList -- 6
|
| MkZone Zone -- 12
|
||||||
| GotPermissionCheck PermissionCheck -- 7
|
| MkUnknownZone UnknownZone -- 13
|
||||||
| GotPermissionSet PermissionSet -- 8
|
| MkDomainList DomainList -- 14
|
||||||
| GotPasswordRecoverySent PasswordRecoverySent -- 9
|
| MkUnknownUser UnknownUser -- 50
|
||||||
| GotPasswordRecovered PasswordRecovered -- 10
|
| MkNoOwnership NoOwnership -- 51
|
||||||
| 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 ∷ RequestMessage -> Tuple UInt String
|
||||||
encode m = case m of
|
encode m = case m of
|
||||||
(MkLogin request) -> get_tuple 0 codecLogin request
|
(MkLogin request) -> get_tuple 0 codecLogin request
|
||||||
(MkRegister request) -> get_tuple 1 codecRegister request
|
(MkMaintenance request) -> get_tuple 7 codecMaintenance request
|
||||||
(MkValidateUser request) -> get_tuple 2 codecValidateUser request
|
(MkNewDomain request) -> get_tuple 9 codecNewDomain request
|
||||||
(MkAskPasswordRecovery request) -> get_tuple 3 codecAskPasswordRecovery request
|
(MkAddOrUpdateZone request) -> get_tuple 10 codecAddOrUpdateZone request
|
||||||
(MkPasswordRecovery request) -> get_tuple 4 codecPasswordRecovery request
|
(MkDeleteZone request) -> get_tuple 11 codecDeleteZone request
|
||||||
-- Both messages are actually a single message type, so they have the same number.
|
(MkGetZone request) -> get_tuple 12 codecGetZone request
|
||||||
-- TODO: change the message codec for an Either Int String.
|
(MkUserDomains request) -> get_tuple 13 codecUserDomains request
|
||||||
(MkGetUserByUID request) -> get_tuple 5 codecGetUserByUID request
|
(MkAddRR request) -> get_tuple 14 codecAddRR request
|
||||||
(MkGetUserByName request) -> get_tuple 5 codecGetUserByName request
|
(MkUpdateRR request) -> get_tuple 15 codecUpdateRR request
|
||||||
(MkModUser request) -> get_tuple 6 codecModUser request
|
(MkDeleteRR request) -> get_tuple 16 codecDeleteRR 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
|
where
|
||||||
get_tuple :: forall a. Int -> CA.JsonCodec a -> a -> Tuple UInt String
|
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)
|
get_tuple num codec request = Tuple (fromInt num) (J.stringify $ CA.encode codec request)
|
||||||
|
@ -431,34 +183,17 @@ data DecodeError
|
||||||
decode :: Int -> String -> Either DecodeError AnswerMessage
|
decode :: Int -> String -> Either DecodeError AnswerMessage
|
||||||
decode number string
|
decode number string
|
||||||
= case number of
|
= case number of
|
||||||
0 -> error_management codecGotError GotError
|
0 -> error_management codecError MkError
|
||||||
1 -> error_management codecGotToken GotToken
|
1 -> error_management codecSuccess MkSuccess
|
||||||
2 -> error_management codecGotUser GotUser
|
2 -> error_management codecErrorInvalidToken MkErrorInvalidToken
|
||||||
3 -> error_management codecGotUserAdded GotUserAdded
|
3 -> error_management codecDomainAlreadyExists MkDomainAlreadyExists
|
||||||
4 -> error_management codecGotUserEdited GotUserEdited
|
10 -> error_management codecInvalidZone MkInvalidZone
|
||||||
5 -> error_management codecGotUserValidated GotUserValidated
|
11 -> error_management codecDomainChanged MkDomainChanged
|
||||||
6 -> error_management codecGotUsersList GotUsersList
|
12 -> error_management codecZone MkZone
|
||||||
7 -> error_management codecGotPermissionCheck GotPermissionCheck
|
13 -> error_management codecUnknownZone MkUnknownZone
|
||||||
8 -> error_management codecGotPermissionSet GotPermissionSet
|
14 -> error_management codecDomainList MkDomainList
|
||||||
9 -> error_management codecGotPasswordRecoverySent GotPasswordRecoverySent
|
50 -> error_management codecUnknownUser MkUnknownUser
|
||||||
10 -> error_management codecGotPasswordRecovered GotPasswordRecovered
|
51 -> error_management codecNoOwnership MkNoOwnership
|
||||||
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
|
_ -> Left UnknownNumber
|
||||||
where
|
where
|
||||||
-- Signature is required since the compiler's guess is wrong.
|
-- Signature is required since the compiler's guess is wrong.
|
||||||
|
|
Loading…
Reference in New Issue