core: update servers API to include XFTP servers, ios: generalize UI to manage servers (#2140)

* core: update servers API to include XFTP servers, ios: generalize UI to manage servers

* add test

* update migrations to pass tests

* fix readme

* update simplexmq
This commit is contained in:
Evgeny Poberezkin
2023-04-05 21:59:12 +01:00
committed by GitHub
parent 1e280fb7e1
commit 1a3f0bed47
25 changed files with 347 additions and 234 deletions
+38 -18
View File
@@ -4,9 +4,11 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -45,7 +47,7 @@ import Simplex.Chat.Protocol
import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink)
import Simplex.Chat.Types
import Simplex.Messaging.Agent (AgentClient)
import Simplex.Messaging.Agent.Client (AgentLocks, SMPTestFailure)
import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
import Simplex.Messaging.Agent.Lock
import Simplex.Messaging.Agent.Protocol
@@ -54,7 +56,7 @@ import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags, NtfServer, ProtocolType (..), QueueId, XFTPServerWithAuth)
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType, CorrId, MsgFlags, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SProtocolType, UserProtocol, XFTPServerWithAuth)
import Simplex.Messaging.TMap (TMap)
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost)
@@ -258,16 +260,12 @@ data ChatCommand
| APIGroupLinkMemberRole GroupId GroupMemberRole
| APIDeleteGroupLink GroupId
| APIGetGroupLink GroupId
| APIGetUserSMPServers UserId
| GetUserSMPServers
| APISetUserSMPServers UserId SMPServersConfig
| SetUserSMPServers SMPServersConfig
| APIGetUserServers UserId
| GetUserServers
| APISetUserServers UserId ServersConfig
| SetUserServers ServersConfig
| APITestSMPServer UserId SMPServerWithAuth
| TestSMPServer SMPServerWithAuth
| APIGetUserProtoServers UserId AProtocolType
| GetUserProtoServers AProtocolType
| APISetUserProtoServers UserId AProtoServersConfig
| SetUserProtoServers AProtoServersConfig
| APITestProtoServer UserId AProtoServerWithAuth
| TestProtoServer AProtoServerWithAuth
| APISetChatItemTTL UserId (Maybe Int64)
| SetChatItemTTL (Maybe Int64)
| APIGetChatItemTTL UserId
@@ -386,8 +384,8 @@ data ChatResponse
| CRChatItems {user :: User, chatItems :: [AChatItem]}
| CRChatItemId User (Maybe ChatItemId)
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
| CRUserSMPServers {user :: User, smpServers :: NonEmpty (ServerCfg 'PSMP), presetSMPServers :: NonEmpty SMPServerWithAuth}
| CRSmpTestResult {user :: User, smpTestFailure :: Maybe SMPTestFailure}
| CRUserProtoServers {user :: User, servers :: AUserProtoServers}
| CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure}
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
| CRNetworkConfig {networkConfig :: NetworkConfig}
| CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
@@ -566,11 +564,31 @@ instance ToJSON AgentQueueId where
toJSON = strToJSON
toEncoding = strToJEncoding
data SMPServersConfig = SMPServersConfig {smpServers :: [ServerCfg 'PSMP]}
data ProtoServersConfig p = ProtoServersConfig {servers :: [ServerCfg p]}
deriving (Show, Generic, FromJSON)
data ServersConfig = ServersConfig {servers :: [AServerCfg]}
deriving (Show, Generic, FromJSON)
data AProtoServersConfig = forall p. ProtocolTypeI p => APSC (SProtocolType p) (ProtoServersConfig p)
deriving instance Show AProtoServersConfig
data UserProtoServers p = UserProtoServers
{ serverProtocol :: SProtocolType p,
protoServers :: NonEmpty (ServerCfg p),
presetServers :: NonEmpty (ProtoServerWithAuth p)
}
deriving (Show, Generic)
instance ProtocolTypeI p => ToJSON (UserProtoServers p) where
toJSON = J.genericToJSON J.defaultOptions
toEncoding = J.genericToEncoding J.defaultOptions
data AUserProtoServers = forall p. (ProtocolTypeI p, UserProtocol p) => AUPS (UserProtoServers p)
instance ToJSON AUserProtoServers where
toJSON (AUPS s) = J.genericToJSON J.defaultOptions s
toEncoding (AUPS s) = J.genericToEncoding J.defaultOptions s
deriving instance Show AUserProtoServers
data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
deriving (Show, Generic, FromJSON)
@@ -679,7 +697,8 @@ data ParsedServerAddress = ParsedServerAddress
instance ToJSON ParsedServerAddress where toEncoding = J.genericToEncoding J.defaultOptions
data ServerAddress = ServerAddress
{ hostnames :: NonEmpty String,
{ protocol :: AProtocolType,
hostnames :: NonEmpty String,
port :: String,
keyHash :: String,
basicAuth :: String
@@ -794,6 +813,7 @@ data ChatErrorType
| CEAgentVersion
| CEAgentNoSubResult {agentConnId :: AgentConnId}
| CECommandError {message :: String}
| CEServerProtocol {serverProtocol :: AProtocolType}
| CEAgentCommandError {message :: String}
| CEInvalidFileDescription {message :: String}
| CEInternalError {message :: String}