mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-07-28 23:00:08 +00:00
core: types to support xftp (#1971)
* core: types to support xftp * migration, amend types * update protocol / types * update protocol, types * update schema, simplexmq
This commit is contained in:
+6
-1
@@ -7,13 +7,18 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: e4aad7583f425765c605cd8042e3136e048bdbec
|
||||
tag: 552759018e493cf224d2451a3dabee2401ab3853
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/hs-socks.git
|
||||
tag: a30cc7a79a08d8108316094f8f2f82a0c5e1ac51
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/kazu-yamamoto/http2.git
|
||||
tag: b3b62ba36900babfde1a073c705cbccc2685f385
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/direct-sqlcipher.git
|
||||
|
||||
+1
-1
@@ -36,7 +36,7 @@ dependencies:
|
||||
- random >= 1.1 && < 1.3
|
||||
- record-hasfield == 1.0.*
|
||||
- simple-logger == 0.1.*
|
||||
- simplexmq >= 3.4
|
||||
- simplexmq >= 5.0
|
||||
- socks == 0.6.*
|
||||
- sqlcipher-simple == 0.4.*
|
||||
- stm == 2.5.*
|
||||
|
||||
@@ -1,6 +1,7 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."e4aad7583f425765c605cd8042e3136e048bdbec" = "043b0k4ivnd4h5ja5qddq8zqr91g2198sii78njwcj1nc6nnhrdd";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."552759018e493cf224d2451a3dabee2401ab3853" = "06jv5ax4482jkrfmr3alffixay1cvpjycqnhk53xkm8midhx8mg5";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/kazu-yamamoto/http2.git"."b3b62ba36900babfde1a073c705cbccc2685f385" = "076gl9mcm9gxcif5662g5ar0pd817657mc46y99ighria3z36cmz";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd";
|
||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."5e154a2aeccc33ead6c243ec07195ab673137221" = "1d1gc5wax4vqg0801ajsmx1sbwvd9y7p7b8mmskvqsmpbwgbh0m0";
|
||||
"https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp";
|
||||
|
||||
+7
-6
@@ -85,6 +85,7 @@ library
|
||||
Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
|
||||
Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
|
||||
Simplex.Chat.Migrations.M20230303_group_link_role
|
||||
Simplex.Chat.Migrations.M20230304_file_description
|
||||
Simplex.Chat.Mobile
|
||||
Simplex.Chat.Mobile.WebRTC
|
||||
Simplex.Chat.Options
|
||||
@@ -129,7 +130,7 @@ library
|
||||
, random >=1.1 && <1.3
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
@@ -177,7 +178,7 @@ executable simplex-bot
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
@@ -225,7 +226,7 @@ executable simplex-bot-advanced
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
@@ -274,7 +275,7 @@ executable simplex-broadcast-bot
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
@@ -323,7 +324,7 @@ executable simplex-chat
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
@@ -387,7 +388,7 @@ test-suite simplex-chat-test
|
||||
, record-hasfield ==1.0.*
|
||||
, simple-logger ==0.1.*
|
||||
, simplex-chat
|
||||
, simplexmq >=3.4
|
||||
, simplexmq >=5.0
|
||||
, socks ==0.6.*
|
||||
, sqlcipher-simple ==0.4.*
|
||||
, stm ==2.5.*
|
||||
|
||||
+32
-18
@@ -57,6 +57,7 @@ import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Store
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (diffInMicros, diffInSeconds)
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.Messaging.Agent as Agent
|
||||
import Simplex.Messaging.Agent.Client (AgentStatsKey (..))
|
||||
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), AgentDatabase (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
|
||||
@@ -68,7 +69,7 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (base64P)
|
||||
import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer)
|
||||
import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..), NtfServer, ProtoServerWithAuth, ProtocolType (..), ProtocolTypeI)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import qualified Simplex.Messaging.TMap as TM
|
||||
import Simplex.Messaging.Transport.Client (defaultSocksProxy)
|
||||
@@ -99,6 +100,7 @@ defaultChatConfig =
|
||||
DefaultAgentServers
|
||||
{ smp = _defaultSMPServers,
|
||||
ntf = _defaultNtfServers,
|
||||
xftp = defaultXFTPServers,
|
||||
netCfg = defaultNetworkConfig
|
||||
},
|
||||
tbqSize = 1024,
|
||||
@@ -170,21 +172,25 @@ newChatController ChatDatabase {chatStore, agentStore} user cfg@ChatConfig {agen
|
||||
let smp' = fromMaybe (smp (defaultServers :: DefaultAgentServers)) (nonEmpty smpServers)
|
||||
in defaultServers {smp = smp', netCfg = networkConfig}
|
||||
agentServers :: ChatConfig -> IO InitialAgentServers
|
||||
agentServers config@ChatConfig {defaultServers = DefaultAgentServers {smp, ntf, netCfg}} = do
|
||||
agentServers config@ChatConfig {defaultServers = defServers@DefaultAgentServers {ntf, netCfg}} = do
|
||||
users <- withTransaction chatStore getUsers
|
||||
smp' <- case users of
|
||||
[] -> pure $ M.fromList [(1, smp)]
|
||||
_ -> M.fromList <$> initialServers users
|
||||
pure InitialAgentServers {smp = smp', ntf, netCfg}
|
||||
smp' <- getUserServers users smp
|
||||
xftp' <- getUserServers users xftp
|
||||
pure InitialAgentServers {smp = smp', xftp = xftp', ntf, netCfg}
|
||||
where
|
||||
initialServers :: [User] -> IO [(UserId, NonEmpty SMPServerWithAuth)]
|
||||
initialServers = mapM $ \u -> (aUserId u,) <$> userServers u
|
||||
userServers :: User -> IO (NonEmpty SMPServerWithAuth)
|
||||
userServers user' = activeAgentServers config <$> withTransaction chatStore (`getSMPServers` user')
|
||||
getUserServers :: forall p. ProtocolTypeI p => [User] -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p)) -> IO (Map UserId (NonEmpty (ProtoServerWithAuth p)))
|
||||
getUserServers users srvSel = case users of
|
||||
[] -> pure $ M.fromList [(1, srvSel defServers)]
|
||||
_ -> M.fromList <$> initialServers
|
||||
where
|
||||
initialServers :: IO [(UserId, NonEmpty (ProtoServerWithAuth p))]
|
||||
initialServers = mapM (\u -> (aUserId u,) <$> userServers u) users
|
||||
userServers :: User -> IO (NonEmpty (ProtoServerWithAuth p))
|
||||
userServers user' = activeAgentServers config srvSel <$> withTransaction chatStore (`getProtocolServers` user')
|
||||
|
||||
activeAgentServers :: ChatConfig -> [ServerCfg] -> NonEmpty SMPServerWithAuth
|
||||
activeAgentServers ChatConfig {defaultServers = DefaultAgentServers {smp}} =
|
||||
fromMaybe smp
|
||||
activeAgentServers :: ChatConfig -> (DefaultAgentServers -> NonEmpty (ProtoServerWithAuth p)) -> [ServerCfg p] -> NonEmpty (ProtoServerWithAuth p)
|
||||
activeAgentServers ChatConfig {defaultServers} srvSel =
|
||||
fromMaybe (srvSel defaultServers)
|
||||
. nonEmpty
|
||||
. map (\ServerCfg {server} -> server)
|
||||
. filter (\ServerCfg {enabled} -> enabled)
|
||||
@@ -289,7 +295,7 @@ processChatCommand = \case
|
||||
atomically . writeTVar u $ Just user
|
||||
pure $ CRActiveUser user
|
||||
where
|
||||
chooseServers :: m (NonEmpty SMPServerWithAuth, [ServerCfg])
|
||||
chooseServers :: m (NonEmpty SMPServerWithAuth, [ServerCfg 'PSMP])
|
||||
chooseServers
|
||||
| sameServers =
|
||||
asks currentUser >>= readTVarIO >>= \case
|
||||
@@ -297,7 +303,7 @@ processChatCommand = \case
|
||||
Just user -> do
|
||||
smpServers <- withStore' (`getSMPServers` user)
|
||||
cfg <- asks config
|
||||
pure (activeAgentServers cfg smpServers, smpServers)
|
||||
pure (activeAgentServers cfg smp smpServers, smpServers)
|
||||
| otherwise = do
|
||||
DefaultAgentServers {smp} <- asks $ defaultServers . config
|
||||
pure (smp, [])
|
||||
@@ -396,7 +402,7 @@ processChatCommand = \case
|
||||
then pure (Nothing, Nothing)
|
||||
else bimap Just Just <$> withAgent (\a -> createConnection a (aUserId user) True SCMInvitation Nothing)
|
||||
let fileName = takeFileName file
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq, fileInline}
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
withStore' $ \db -> do
|
||||
ft@FileTransferMeta {fileId} <- createSndDirectFileTransfer db userId ct file fileInvitation agentConnId_ chSize
|
||||
fileStatus <- case fileInline of
|
||||
@@ -442,7 +448,7 @@ processChatCommand = \case
|
||||
setupSndFileTransfer gInfo n = forM file_ $ \file -> do
|
||||
(fileSize, chSize, fileInline) <- checkSndFile mc file $ fromIntegral n
|
||||
let fileName = takeFileName file
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing, fileInline}
|
||||
fileInvitation = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq = Nothing, fileInline, fileDescr = Nothing}
|
||||
fileStatus = if fileInline == Just IFMSent then CIFSSndTransfer else CIFSSndStored
|
||||
withStore' $ \db -> do
|
||||
ft@FileTransferMeta {fileId} <- createSndGroupFileTransfer db userId gInfo file fileInvitation chSize
|
||||
@@ -495,6 +501,7 @@ processChatCommand = \case
|
||||
MCFile _ -> False
|
||||
MCLink {} -> True
|
||||
MCImage {} -> True
|
||||
MCVideo {} -> True
|
||||
MCVoice {} -> False
|
||||
MCUnknown {} -> True
|
||||
qText = msgContentText qmc
|
||||
@@ -820,10 +827,14 @@ processChatCommand = \case
|
||||
APISetUserSMPServers userId (SMPServersConfig smpServers) -> withUserId userId $ \user -> withChatLock "setUserSMPServers" $ do
|
||||
withStore $ \db -> overwriteSMPServers db user smpServers
|
||||
cfg <- asks config
|
||||
withAgent $ \a -> setSMPServers a (aUserId user) $ activeAgentServers cfg smpServers
|
||||
withAgent $ \a -> setSMPServers a (aUserId user) $ activeAgentServers cfg smp smpServers
|
||||
ok user
|
||||
SetUserSMPServers smpServersConfig -> withUser $ \User {userId} ->
|
||||
processChatCommand $ APISetUserSMPServers userId smpServersConfig
|
||||
APIGetUserServers _ -> pure $ chatCmdError Nothing "TODO"
|
||||
GetUserServers -> pure $ chatCmdError Nothing "TODO"
|
||||
APISetUserServers _ _ -> pure $ chatCmdError Nothing "TODO"
|
||||
SetUserServers _ -> pure $ chatCmdError Nothing "TODO"
|
||||
APITestSMPServer userId smpServer -> withUserId userId $ \user ->
|
||||
CRSmpTestResult user <$> withAgent (\a -> testSMPServerConnection a (aUserId user) smpServer)
|
||||
TestSMPServer smpServer -> withUser $ \User {userId} ->
|
||||
@@ -1266,9 +1277,11 @@ processChatCommand = \case
|
||||
unless (".jpg" `isSuffixOf` f || ".jpeg" `isSuffixOf` f) $ throwChatError CEFileImageType {filePath}
|
||||
fileSize <- getFileSize filePath
|
||||
unless (fileSize <= maxImageSize) $ throwChatError CEFileImageSize {filePath}
|
||||
-- TODO include file description for preview
|
||||
processChatCommand . APISendMessage chatRef False $ ComposedMessage (Just f) Nothing (MCImage "" fixedImagePreview)
|
||||
ForwardFile chatName fileId -> forwardFile chatName fileId SendFile
|
||||
ForwardImage chatName fileId -> forwardFile chatName fileId SendImage
|
||||
SendFileDescription _chatName _f -> pure $ chatCmdError Nothing "TODO"
|
||||
ReceiveFile fileId rcvInline_ filePath_ -> withUser $ \_ ->
|
||||
withChatLock "receiveFile" . procCmd $ do
|
||||
(user, ft) <- withStore $ \db -> getRcvFileTransferById db fileId
|
||||
@@ -4105,6 +4118,7 @@ chatCommandP =
|
||||
("/image " <|> "/img ") *> (SendImage <$> chatNameP' <* A.space <*> filePath),
|
||||
("/fforward " <|> "/ff ") *> (ForwardFile <$> chatNameP' <* A.space <*> A.decimal),
|
||||
("/image_forward " <|> "/imgf ") *> (ForwardImage <$> chatNameP' <* A.space <*> A.decimal),
|
||||
("/fdescription " <|> "/fd") *> (SendFileDescription <$> chatNameP' <* A.space <*> filePath),
|
||||
("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (" inline=" *> onOffP) <*> optional (A.space *> filePath)),
|
||||
("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal),
|
||||
("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal),
|
||||
|
||||
@@ -54,7 +54,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, QueueId)
|
||||
import Simplex.Messaging.Protocol (AProtocolType, CorrId, MsgFlags, NtfServer, ProtocolType (..), QueueId, XFTPServerWithAuth)
|
||||
import Simplex.Messaging.TMap (TMap)
|
||||
import Simplex.Messaging.Transport (simplexMQVersion)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
@@ -116,6 +116,7 @@ data ChatConfig = ChatConfig
|
||||
data DefaultAgentServers = DefaultAgentServers
|
||||
{ smp :: NonEmpty SMPServerWithAuth,
|
||||
ntf :: [NtfServer],
|
||||
xftp :: NonEmpty XFTPServerWithAuth,
|
||||
netCfg :: NetworkConfig
|
||||
}
|
||||
|
||||
@@ -245,6 +246,10 @@ data ChatCommand
|
||||
| GetUserSMPServers
|
||||
| APISetUserSMPServers UserId SMPServersConfig
|
||||
| SetUserSMPServers SMPServersConfig
|
||||
| APIGetUserServers UserId
|
||||
| GetUserServers
|
||||
| APISetUserServers UserId ServersConfig
|
||||
| SetUserServers ServersConfig
|
||||
| APITestSMPServer UserId SMPServerWithAuth
|
||||
| TestSMPServer SMPServerWithAuth
|
||||
| APISetChatItemTTL UserId (Maybe Int64)
|
||||
@@ -332,6 +337,7 @@ data ChatCommand
|
||||
| SendImage ChatName FilePath
|
||||
| ForwardFile ChatName FileTransferId
|
||||
| ForwardImage ChatName FileTransferId
|
||||
| SendFileDescription ChatName FilePath
|
||||
| ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
|
||||
| CancelFile FileTransferId
|
||||
| FileStatus FileTransferId
|
||||
@@ -364,7 +370,7 @@ data ChatResponse
|
||||
| CRChatItems {user :: User, chatItems :: [AChatItem]}
|
||||
| CRChatItemId User (Maybe ChatItemId)
|
||||
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
|
||||
| CRUserSMPServers {user :: User, smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth}
|
||||
| CRUserSMPServers {user :: User, smpServers :: NonEmpty (ServerCfg 'PSMP), presetSMPServers :: NonEmpty SMPServerWithAuth}
|
||||
| CRSmpTestResult {user :: User, smpTestFailure :: Maybe SMPTestFailure}
|
||||
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
|
||||
| CRNetworkConfig {networkConfig :: NetworkConfig}
|
||||
@@ -527,7 +533,10 @@ instance ToJSON AgentQueueId where
|
||||
toJSON = strToJSON
|
||||
toEncoding = strToJEncoding
|
||||
|
||||
data SMPServersConfig = SMPServersConfig {smpServers :: [ServerCfg]}
|
||||
data SMPServersConfig = SMPServersConfig {smpServers :: [ServerCfg 'PSMP]}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
|
||||
data ServersConfig = ServersConfig {servers :: [AServerCfg]}
|
||||
deriving (Show, Generic, FromJSON)
|
||||
|
||||
data ArchiveConfig = ArchiveConfig {archivePath :: FilePath, disableCompression :: Maybe Bool, parentTempDirectory :: Maybe FilePath}
|
||||
|
||||
@@ -0,0 +1,29 @@
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
|
||||
module Simplex.Chat.Migrations.M20230304_file_description where
|
||||
|
||||
import Database.SQLite.Simple (Query)
|
||||
import Database.SQLite.Simple.QQ (sql)
|
||||
|
||||
-- this table includes file descriptions for the recipients for both sent and received files
|
||||
-- in the latter case the user is the recipient
|
||||
|
||||
m20230304_file_description :: Query
|
||||
m20230304_file_description =
|
||||
[sql|
|
||||
CREATE TABLE recipient_file_descriptions (
|
||||
file_descr_id INTEGER PRIMARY KEY AUTOINCREMENT,
|
||||
file_descr_size INTEGER NOT NULL,
|
||||
file_descr_status TEXT NOT NULL,
|
||||
file_descr_text TEXT NOT NULL
|
||||
);
|
||||
|
||||
ALTER TABLE rcv_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
|
||||
|
||||
ALTER TABLE snd_files ADD COLUMN file_descr_id INTEGER NULL
|
||||
REFERENCES recipient_file_descriptions(file_descr_id) ON DELETE RESTRICT;
|
||||
|
||||
-- this is a private file description allowing to delete the file from the server
|
||||
ALTER TABLE files ADD COLUMN snd_file_descr_text TEXT NULL;
|
||||
|]
|
||||
@@ -42,7 +42,7 @@ import Simplex.Chat.Call
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (fromTextField_, fstToLower, parseAll, sumTypeJSON)
|
||||
import Simplex.Messaging.Parsers (dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
|
||||
|
||||
data ConnectionEntity
|
||||
@@ -179,6 +179,8 @@ instance StrEncoding AChatMessage where
|
||||
|
||||
data ChatMsgEvent (e :: MsgEncoding) where
|
||||
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
|
||||
XMsgFileDescr :: {msgId :: SharedMsgId, fileDescr :: FileDescr} -> ChatMsgEvent 'Json
|
||||
XMsgFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
|
||||
XMsgUpdate :: {msgId :: SharedMsgId, content :: MsgContent, ttl :: Maybe Int, live :: Maybe Bool} -> ChatMsgEvent 'Json
|
||||
XMsgDel :: SharedMsgId -> Maybe MemberId -> ChatMsgEvent 'Json
|
||||
XMsgDeleted :: ChatMsgEvent 'Json
|
||||
@@ -264,7 +266,7 @@ cmToQuotedMsg = \case
|
||||
ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
|
||||
_ -> Nothing
|
||||
|
||||
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVoice_ | MCFile_ | MCUnknown_ Text
|
||||
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCVideo_ | MCVoice_ | MCFile_ | MCUnknown_ Text
|
||||
deriving (Eq)
|
||||
|
||||
instance StrEncoding MsgContentTag where
|
||||
@@ -272,6 +274,7 @@ instance StrEncoding MsgContentTag where
|
||||
MCText_ -> "text"
|
||||
MCLink_ -> "link"
|
||||
MCImage_ -> "image"
|
||||
MCVideo_ -> "video"
|
||||
MCFile_ -> "file"
|
||||
MCVoice_ -> "voice"
|
||||
MCUnknown_ t -> encodeUtf8 t
|
||||
@@ -279,6 +282,7 @@ instance StrEncoding MsgContentTag where
|
||||
"text" -> Right MCText_
|
||||
"link" -> Right MCLink_
|
||||
"image" -> Right MCImage_
|
||||
"video" -> Right MCVideo_
|
||||
"voice" -> Right MCVoice_
|
||||
"file" -> Right MCFile_
|
||||
t -> Right . MCUnknown_ $ safeDecodeUtf8 t
|
||||
@@ -303,7 +307,10 @@ mcExtMsgContent = \case
|
||||
MCQuote _ c -> c
|
||||
MCForward c -> c
|
||||
|
||||
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData}
|
||||
data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData, content :: Maybe LinkContent}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
data LinkContent = LCPage | LCImage | LCVideo {duration :: Maybe Int} | LCUnknown {tag :: Text, json :: J.Object}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance FromJSON LinkPreview where
|
||||
@@ -313,10 +320,26 @@ instance ToJSON LinkPreview where
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
instance FromJSON LinkContent where
|
||||
parseJSON v@(J.Object j) =
|
||||
J.genericParseJSON (taggedObjectJSON $ dropPrefix "LC") v
|
||||
<|> LCUnknown <$> j .: "type" <*> pure j
|
||||
parseJSON invalid =
|
||||
JT.prependFailure "bad LinkContent, " (JT.typeMismatch "Object" invalid)
|
||||
|
||||
instance ToJSON LinkContent where
|
||||
toJSON = \case
|
||||
LCUnknown _ j -> J.Object j
|
||||
v -> J.genericToJSON (taggedObjectJSON $ dropPrefix "LC") v
|
||||
toEncoding = \case
|
||||
LCUnknown _ j -> JE.value $ J.Object j
|
||||
v -> J.genericToEncoding (taggedObjectJSON $ dropPrefix "LC") v
|
||||
|
||||
data MsgContent
|
||||
= MCText Text
|
||||
| MCLink {text :: Text, preview :: LinkPreview}
|
||||
| MCImage {text :: Text, image :: ImageData}
|
||||
| MCVideo {text :: Text, image :: ImageData, duration :: Int}
|
||||
| MCVoice {text :: Text, duration :: Int}
|
||||
| MCFile Text
|
||||
| MCUnknown {tag :: Text, text :: Text, json :: J.Object}
|
||||
@@ -327,6 +350,7 @@ msgContentText = \case
|
||||
MCText t -> t
|
||||
MCLink {text} -> text
|
||||
MCImage {text} -> text
|
||||
MCVideo {text} -> text
|
||||
MCVoice {text, duration} ->
|
||||
if T.null text then msg else msg <> "; " <> text
|
||||
where
|
||||
@@ -352,6 +376,7 @@ msgContentTag = \case
|
||||
MCText _ -> MCText_
|
||||
MCLink {} -> MCLink_
|
||||
MCImage {} -> MCImage_
|
||||
MCVideo {} -> MCVideo_
|
||||
MCVoice {} -> MCVoice_
|
||||
MCFile {} -> MCFile_
|
||||
MCUnknown {tag} -> MCUnknown_ tag
|
||||
@@ -385,7 +410,12 @@ instance FromJSON MsgContent where
|
||||
MCImage_ -> do
|
||||
text <- v .: "text"
|
||||
image <- v .: "image"
|
||||
pure MCImage {image, text}
|
||||
pure MCImage {text, image}
|
||||
MCVideo_ -> do
|
||||
text <- v .: "text"
|
||||
image <- v .: "image"
|
||||
duration <- v .: "duration"
|
||||
pure MCVideo {text, image, duration}
|
||||
MCVoice_ -> do
|
||||
text <- v .: "text"
|
||||
duration <- v .: "duration"
|
||||
@@ -415,6 +445,7 @@ instance ToJSON MsgContent where
|
||||
MCText t -> J.object ["type" .= MCText_, "text" .= t]
|
||||
MCLink {text, preview} -> J.object ["type" .= MCLink_, "text" .= text, "preview" .= preview]
|
||||
MCImage {text, image} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image]
|
||||
MCVideo {text, image, duration} -> J.object ["type" .= MCImage_, "text" .= text, "image" .= image, "duration" .= duration]
|
||||
MCVoice {text, duration} -> J.object ["type" .= MCVoice_, "text" .= text, "duration" .= duration]
|
||||
MCFile t -> J.object ["type" .= MCFile_, "text" .= t]
|
||||
toEncoding = \case
|
||||
@@ -422,6 +453,7 @@ instance ToJSON MsgContent where
|
||||
MCText t -> J.pairs $ "type" .= MCText_ <> "text" .= t
|
||||
MCLink {text, preview} -> J.pairs $ "type" .= MCLink_ <> "text" .= text <> "preview" .= preview
|
||||
MCImage {text, image} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image
|
||||
MCVideo {text, image, duration} -> J.pairs $ "type" .= MCImage_ <> "text" .= text <> "image" .= image <> "duration" .= duration
|
||||
MCVoice {text, duration} -> J.pairs $ "type" .= MCVoice_ <> "text" .= text <> "duration" .= duration
|
||||
MCFile t -> J.pairs $ "type" .= MCFile_ <> "text" .= t
|
||||
|
||||
@@ -433,6 +465,8 @@ instance FromField MsgContent where
|
||||
|
||||
data CMEventTag (e :: MsgEncoding) where
|
||||
XMsgNew_ :: CMEventTag 'Json
|
||||
XMsgFileDescr_ :: CMEventTag 'Json
|
||||
XMsgFileCancel_ :: CMEventTag 'Json
|
||||
XMsgUpdate_ :: CMEventTag 'Json
|
||||
XMsgDel_ :: CMEventTag 'Json
|
||||
XMsgDeleted_ :: CMEventTag 'Json
|
||||
@@ -475,6 +509,8 @@ deriving instance Eq (CMEventTag e)
|
||||
instance MsgEncodingI e => StrEncoding (CMEventTag e) where
|
||||
strEncode = \case
|
||||
XMsgNew_ -> "x.msg.new"
|
||||
XMsgFileDescr_ -> "x.msg.file.descr"
|
||||
XMsgFileCancel_ -> "x.msg.file.cancel"
|
||||
XMsgUpdate_ -> "x.msg.update"
|
||||
XMsgDel_ -> "x.msg.del"
|
||||
XMsgDeleted_ -> "x.msg.deleted"
|
||||
@@ -518,6 +554,8 @@ instance StrEncoding ACMEventTag where
|
||||
((,) <$> A.peekChar' <*> A.takeTill (== ' ')) >>= \case
|
||||
('x', t) -> pure . ACMEventTag SJson $ case t of
|
||||
"x.msg.new" -> XMsgNew_
|
||||
"x.msg.file.descr" -> XMsgFileDescr_
|
||||
"x.msg.file.cancel" -> XMsgFileCancel_
|
||||
"x.msg.update" -> XMsgUpdate_
|
||||
"x.msg.del" -> XMsgDel_
|
||||
"x.msg.deleted" -> XMsgDeleted_
|
||||
@@ -557,6 +595,8 @@ instance StrEncoding ACMEventTag where
|
||||
toCMEventTag :: ChatMsgEvent e -> CMEventTag e
|
||||
toCMEventTag msg = case msg of
|
||||
XMsgNew _ -> XMsgNew_
|
||||
XMsgFileDescr _ _ -> XMsgFileDescr_
|
||||
XMsgFileCancel _ -> XMsgFileCancel_
|
||||
XMsgUpdate {} -> XMsgUpdate_
|
||||
XMsgDel {} -> XMsgDel_
|
||||
XMsgDeleted -> XMsgDeleted_
|
||||
@@ -642,6 +682,8 @@ appJsonToCM AppMessageJson {msgId, event, params} = do
|
||||
msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
|
||||
msg = \case
|
||||
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
|
||||
XMsgFileDescr_ -> XMsgFileDescr <$> p "msgId" <*> p "fileDescr"
|
||||
XMsgFileCancel_ -> XMsgFileCancel <$> p "msgId"
|
||||
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" <*> opt "ttl" <*> opt "live"
|
||||
XMsgDel_ -> XMsgDel <$> p "msgId" <*> opt "memberId"
|
||||
XMsgDeleted_ -> pure XMsgDeleted
|
||||
@@ -695,6 +737,8 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
|
||||
params :: ChatMsgEvent 'Json -> J.Object
|
||||
params = \case
|
||||
XMsgNew container -> msgContainerJSON container
|
||||
XMsgFileDescr msgId' fileDescr -> o ["msgId" .= msgId', "fileDescr" .= fileDescr]
|
||||
XMsgFileCancel msgId' -> o ["msgId" .= msgId']
|
||||
XMsgUpdate msgId' content ttl live -> o $ ("ttl" .=? ttl) $ ("live" .=? live) ["msgId" .= msgId', "content" .= content]
|
||||
XMsgDel msgId' memberId -> o $ ("memberId" .=? memberId) ["msgId" .= msgId']
|
||||
XMsgDeleted -> JM.empty
|
||||
|
||||
@@ -232,6 +232,8 @@ module Simplex.Chat.Store
|
||||
setGroupChatItemDeleteAt,
|
||||
getSMPServers,
|
||||
overwriteSMPServers,
|
||||
getProtocolServers,
|
||||
overwriteProtocolServers,
|
||||
createCall,
|
||||
deleteCalls,
|
||||
getCalls,
|
||||
@@ -343,6 +345,7 @@ import Simplex.Chat.Migrations.M20230118_recreate_smp_servers
|
||||
import Simplex.Chat.Migrations.M20230129_drop_chat_items_group_idx
|
||||
import Simplex.Chat.Migrations.M20230206_item_deleted_by_group_member_id
|
||||
import Simplex.Chat.Migrations.M20230303_group_link_role
|
||||
-- import Simplex.Chat.Migrations.M20230304_file_description
|
||||
import Simplex.Chat.Protocol
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Util (week)
|
||||
@@ -351,7 +354,7 @@ import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), pattern SMPServer)
|
||||
import Simplex.Messaging.Protocol (BasicAuth (..), ProtoServerWithAuth (..), ProtocolServer (..), ProtocolType (..), ProtocolTypeI (..), SProtocolType (..), pattern SMPServer)
|
||||
import Simplex.Messaging.Transport.Client (TransportHost)
|
||||
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8)
|
||||
import UnliftIO.STM
|
||||
@@ -410,6 +413,7 @@ schemaMigrations =
|
||||
("20230129_drop_chat_items_group_idx", m20230129_drop_chat_items_group_idx),
|
||||
("20230206_item_deleted_by_group_member_id", m20230206_item_deleted_by_group_member_id),
|
||||
("20230303_group_link_role", m20230303_group_link_role)
|
||||
-- ("20230304_file_description", m20230304_file_description)
|
||||
]
|
||||
|
||||
-- | The list of migrations in ascending order by date
|
||||
@@ -2852,7 +2856,7 @@ createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@File
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
|
||||
|
||||
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
|
||||
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
|
||||
@@ -2866,7 +2870,7 @@ createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localD
|
||||
db
|
||||
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
|
||||
(fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, currentTs, currentTs)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
|
||||
|
||||
getRcvFileTransferById :: DB.Connection -> FileTransferId -> ExceptT StoreError IO (User, RcvFileTransfer)
|
||||
getRcvFileTransferById db fileId = do
|
||||
@@ -2897,7 +2901,7 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
|
||||
ExceptT StoreError IO RcvFileTransfer
|
||||
rcvFileTransfer ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactName_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
|
||||
let fileInv = FileInvitation {fileName, fileSize, fileConnReq, fileInline}
|
||||
let fileInv = FileInvitation {fileName, fileSize, fileDigest = Nothing, fileConnReq, fileInline, fileDescr = Nothing}
|
||||
fileInfo = (filePath_, connId_, agentConnId_)
|
||||
case contactName_ <|> memberName_ of
|
||||
Nothing -> throwError $ SERcvFileInvalid fileId
|
||||
@@ -2910,7 +2914,7 @@ getRcvFileTransfer db User {userId} fileId = do
|
||||
FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
|
||||
where
|
||||
ft senderDisplayName fileInvitation fileStatus =
|
||||
RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
|
||||
RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, rcvFileDescription = Nothing, senderDisplayName, chunkSize, cancelled, grpMemberId}
|
||||
rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
|
||||
rfi_ = \case
|
||||
(Just filePath, connId, agentConnId) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
|
||||
@@ -4615,7 +4619,7 @@ toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just
|
||||
either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. fileRow) :. memberRow_ :. (quoteRow :. quotedMemberRow_) :. deletedByGroupMemberRow_)
|
||||
toGroupChatItemList _ _ _ _ = []
|
||||
|
||||
getSMPServers :: DB.Connection -> User -> IO [ServerCfg]
|
||||
getSMPServers :: DB.Connection -> User -> IO [ServerCfg 'PSMP]
|
||||
getSMPServers db User {userId} =
|
||||
map toServerCfg
|
||||
<$> DB.query
|
||||
@@ -4627,12 +4631,12 @@ getSMPServers db User {userId} =
|
||||
|]
|
||||
(Only userId)
|
||||
where
|
||||
toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg
|
||||
toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg 'PSMP
|
||||
toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
|
||||
let server = ProtoServerWithAuth (SMPServer host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
|
||||
in ServerCfg {server, preset, tested, enabled}
|
||||
|
||||
overwriteSMPServers :: DB.Connection -> User -> [ServerCfg] -> ExceptT StoreError IO ()
|
||||
overwriteSMPServers :: DB.Connection -> User -> [ServerCfg 'PSMP] -> ExceptT StoreError IO ()
|
||||
overwriteSMPServers db User {userId} servers =
|
||||
checkConstraint SEUniqueID . ExceptT $ do
|
||||
currentTs <- getCurrentTime
|
||||
@@ -4649,6 +4653,16 @@ overwriteSMPServers db User {userId} servers =
|
||||
(host, port, keyHash, safeDecodeUtf8 . unBasicAuth <$> auth_, preset, tested, enabled, userId, currentTs, currentTs)
|
||||
pure $ Right ()
|
||||
|
||||
getProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> IO [ServerCfg p]
|
||||
getProtocolServers db user = case protocolTypeI @p of
|
||||
SPSMP -> getSMPServers db user
|
||||
_ -> pure [] -- TODO read from the new table of all servers (alternatively, we could migrate data)
|
||||
|
||||
overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
|
||||
overwriteProtocolServers db user servers = case protocolTypeI @p of
|
||||
SPSMP -> overwriteSMPServers db user servers
|
||||
_ -> pure () -- TODO write the new table of all servers
|
||||
|
||||
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
|
||||
createCall db user@User {userId} Call {contactId, callId, chatItemId, callState} callTs = do
|
||||
currentTs <- getCurrentTime
|
||||
|
||||
@@ -17,6 +17,7 @@ import Simplex.Chat.Options
|
||||
import Simplex.Chat.Terminal.Input
|
||||
import Simplex.Chat.Terminal.Notification
|
||||
import Simplex.Chat.Terminal.Output
|
||||
import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
|
||||
import Simplex.Messaging.Client (defaultNetworkConfig)
|
||||
import Simplex.Messaging.Util (raceAny_)
|
||||
import System.Exit (exitFailure)
|
||||
@@ -33,6 +34,7 @@ terminalChatConfig =
|
||||
"smp://PQUV2eL0t7OStZOoAsPEV2QYWt4-xilbakvGUGOItUo=@smp6.simplex.im,bylepyau3ty4czmn77q4fglvperknl4bi2eb2fdy2bh4jxtf32kf73yd.onion"
|
||||
],
|
||||
ntf = ["ntf://FB-Uop7RTaZZEG0ZLD2CIaTjsPh-Fw0zFAnb7QyA8Ks=@ntf2.simplex.im,ntg7jdjy2i3qbib3sykiho3enekwiaqg3icctliqhtqcg6jmoh6cxiad.onion"],
|
||||
xftp = defaultXFTPServers,
|
||||
netCfg = defaultNetworkConfig
|
||||
}
|
||||
}
|
||||
|
||||
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
@@ -26,7 +26,7 @@ module Simplex.Chat.Types where
|
||||
|
||||
import Control.Applicative ((<|>))
|
||||
import Crypto.Number.Serialize (os2ip)
|
||||
import Data.Aeson (FromJSON, ToJSON)
|
||||
import Data.Aeson (FromJSON (..), ToJSON (..))
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Encoding as JE
|
||||
import qualified Data.Aeson.Types as JT
|
||||
@@ -48,10 +48,11 @@ import Database.SQLite.Simple.Ok (Ok (Ok))
|
||||
import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import GHC.Generics (Generic)
|
||||
import GHC.Records.Compat
|
||||
import Simplex.FileTransfer.Description (FileDigest)
|
||||
import Simplex.Messaging.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Protocol (SMPServerWithAuth)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, ProtoServerWithAuth, ProtocolTypeI)
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8, (<$?>))
|
||||
|
||||
class IsContact a where
|
||||
@@ -1470,8 +1471,10 @@ type FileTransferId = Int64
|
||||
data FileInvitation = FileInvitation
|
||||
{ fileName :: String,
|
||||
fileSize :: Integer,
|
||||
fileDigest :: Maybe FileDigest,
|
||||
fileConnReq :: Maybe ConnReqInvitation,
|
||||
fileInline :: Maybe InlineFileMode
|
||||
fileInline :: Maybe InlineFileMode,
|
||||
fileDescr :: Maybe FileDescr
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
@@ -1482,6 +1485,19 @@ instance ToJSON FileInvitation where
|
||||
instance FromJSON FileInvitation where
|
||||
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data FileDescr
|
||||
= FDText {fileDescrText :: Text}
|
||||
| FDInline {fileDescrSize :: Integer, fileDescrInline :: InlineFileMode}
|
||||
| FDPending
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON FileDescr where
|
||||
toEncoding = J.genericToEncoding . taggedObjectJSON $ dropPrefix "FD"
|
||||
toJSON = J.genericToJSON . taggedObjectJSON $ dropPrefix "FD"
|
||||
|
||||
instance FromJSON FileDescr where
|
||||
parseJSON = J.genericParseJSON . taggedObjectJSON $ dropPrefix "FD"
|
||||
|
||||
data InlineFileMode
|
||||
= IFMOffer -- file will be sent inline once accepted
|
||||
| IFMSent -- file is sent inline without acceptance
|
||||
@@ -1512,6 +1528,7 @@ data RcvFileTransfer = RcvFileTransfer
|
||||
fileInvitation :: FileInvitation,
|
||||
fileStatus :: RcvFileStatus,
|
||||
rcvFileInline :: Maybe InlineFileMode,
|
||||
rcvFileDescription :: Maybe RcvFileDescr,
|
||||
senderDisplayName :: ContactName,
|
||||
chunkSize :: Integer,
|
||||
cancelled :: Bool,
|
||||
@@ -1521,6 +1538,16 @@ data RcvFileTransfer = RcvFileTransfer
|
||||
|
||||
instance ToJSON RcvFileTransfer where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data RcvFileDescr = RcvFileDescr
|
||||
{ fileDescrId :: Int64,
|
||||
fileDescrStatus :: RcvFileStatus,
|
||||
fileDescrText :: Text,
|
||||
chunkSize :: Integer
|
||||
}
|
||||
deriving (Eq, Show, Generic)
|
||||
|
||||
instance ToJSON RcvFileDescr where toEncoding = J.genericToEncoding J.defaultOptions
|
||||
|
||||
data RcvFileStatus
|
||||
= RFSNew
|
||||
| RFSAccepted RcvFileInfo
|
||||
@@ -1947,17 +1974,35 @@ encodeJSON = safeDecodeUtf8 . LB.toStrict . J.encode
|
||||
decodeJSON :: FromJSON a => Text -> Maybe a
|
||||
decodeJSON = J.decode . LB.fromStrict . encodeUtf8
|
||||
|
||||
data ServerCfg = ServerCfg
|
||||
{ server :: SMPServerWithAuth,
|
||||
data ServerCfg p = ServerCfg
|
||||
{ server :: ProtoServerWithAuth p,
|
||||
preset :: Bool,
|
||||
tested :: Maybe Bool,
|
||||
enabled :: Bool
|
||||
}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON ServerCfg where
|
||||
instance ProtocolTypeI p => ToJSON (ServerCfg p) where
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
instance FromJSON ServerCfg where
|
||||
instance ProtocolTypeI p => FromJSON (ServerCfg p) where
|
||||
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
data AServerCfg = AServerCfg
|
||||
{ server :: AProtoServerWithAuth,
|
||||
preset :: Bool,
|
||||
tested :: Maybe Bool,
|
||||
enabled :: Bool
|
||||
}
|
||||
|
||||
deriving instance Show AServerCfg
|
||||
|
||||
deriving instance Generic AServerCfg
|
||||
|
||||
instance ToJSON AServerCfg where
|
||||
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
|
||||
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
instance FromJSON AServerCfg where
|
||||
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
|
||||
|
||||
@@ -45,7 +45,7 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (dropPrefix, taggedObjectJSON)
|
||||
import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..))
|
||||
import Simplex.Messaging.Protocol (AProtocolType, ProtocolServer (..), ProtocolTypeI)
|
||||
import qualified Simplex.Messaging.Protocol as SMP
|
||||
import Simplex.Messaging.Transport.Client (TransportHost (..))
|
||||
import Simplex.Messaging.Util (bshow, tshow)
|
||||
@@ -721,12 +721,13 @@ viewUserProfile Profile {displayName, fullName} =
|
||||
"(the updated profile will be sent to all your contacts)"
|
||||
]
|
||||
|
||||
viewSMPServers :: [ServerCfg] -> Bool -> [StyledString]
|
||||
viewSMPServers smpServers testView =
|
||||
-- TODO make more generic messages or split
|
||||
viewSMPServers :: ProtocolTypeI p => [ServerCfg p] -> Bool -> [StyledString]
|
||||
viewSMPServers servers testView =
|
||||
if testView
|
||||
then [customSMPServers]
|
||||
then [customServers]
|
||||
else
|
||||
[ customSMPServers,
|
||||
[ customServers,
|
||||
"",
|
||||
"use " <> highlight' "/smp test <srv>" <> " to test SMP server connection",
|
||||
"use " <> highlight' "/smp set <srv1[,srv2,...]>" <> " to switch to custom SMP servers",
|
||||
@@ -734,10 +735,10 @@ viewSMPServers smpServers testView =
|
||||
"(chat option " <> highlight' "-s" <> " (" <> highlight' "--server" <> ") has precedence over saved SMP servers for chat session)"
|
||||
]
|
||||
where
|
||||
customSMPServers =
|
||||
if null smpServers
|
||||
customServers =
|
||||
if null servers
|
||||
then "no custom SMP servers saved"
|
||||
else viewServers smpServers
|
||||
else viewServers servers
|
||||
|
||||
viewSMPTestResult :: Maybe SMPTestFailure -> [StyledString]
|
||||
viewSMPTestResult = \case
|
||||
@@ -798,7 +799,7 @@ viewConnectionStats ConnectionStats {rcvServers, sndServers} =
|
||||
["receiving messages via: " <> viewServerHosts rcvServers | not $ null rcvServers]
|
||||
<> ["sending messages via: " <> viewServerHosts sndServers | not $ null sndServers]
|
||||
|
||||
viewServers :: [ServerCfg] -> StyledString
|
||||
viewServers :: ProtocolTypeI p => [ServerCfg p] -> StyledString
|
||||
viewServers = plain . intercalate ", " . map (B.unpack . strEncode . (\ServerCfg {server} -> server))
|
||||
|
||||
viewServerHosts :: [SMPServer] -> StyledString
|
||||
|
||||
+1
-1
@@ -49,7 +49,7 @@ extra-deps:
|
||||
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
|
||||
# - ../simplexmq
|
||||
- github: simplex-chat/simplexmq
|
||||
commit: e4aad7583f425765c605cd8042e3136e048bdbec
|
||||
commit: 552759018e493cf224d2451a3dabee2401ab3853
|
||||
# - ../direct-sqlcipher
|
||||
- github: simplex-chat/direct-sqlcipher
|
||||
commit: 34309410eb2069b029b8fc1872deb1e0db123294
|
||||
|
||||
@@ -110,7 +110,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple link" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA", content = Nothing}) Nothing))
|
||||
it "x.msg.new simple image" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing))
|
||||
@@ -146,10 +146,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing Nothing (Just True)))
|
||||
it "x.msg.new simple text with file" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
|
||||
it "x.msg.new simple file with file" $
|
||||
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}"
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
#==# XMsgNew (MCSimple (extMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
|
||||
it "x.msg.new quote with file" $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
##==## ChatMessage
|
||||
@@ -159,13 +159,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
quotedMsg
|
||||
( extMsgContent
|
||||
(MCText "hello to you too")
|
||||
(Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})
|
||||
(Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})
|
||||
)
|
||||
)
|
||||
)
|
||||
it "x.msg.new forward with file" $
|
||||
"{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing})))
|
||||
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (extMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing})))
|
||||
it "x.msg.update" $
|
||||
"{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
#==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") Nothing Nothing
|
||||
@@ -177,10 +177,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XMsgDeleted
|
||||
it "x.file" $
|
||||
"{\"event\":\"x.file\",\"params\":{\"file\":{\"fileConnReq\":\"https://simplex.chat/invitation#/?v=1&smp=smp%3A%2F%2F1234-w%3D%3D%40smp.simplex.im%3A5223%2F3456-w%3D%3D%23%2F%3Fv%3D1-2%26dh%3DMCowBQYDK2VuAyEAjiswwI3O_NlS8Fk3HJUW870EY2bAwmttMBsvRB9eV3o%253D&e2e=v%3D1-2%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\",\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Just testConnReq, fileInline = Nothing}
|
||||
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Just testConnReq, fileInline = Nothing, fileDescr = Nothing}
|
||||
it "x.file without file invitation" $
|
||||
"{\"event\":\"x.file\",\"params\":{\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}"
|
||||
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}
|
||||
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileDigest = Nothing, fileConnReq = Nothing, fileInline = Nothing, fileDescr = Nothing}
|
||||
it "x.file.acpt" $
|
||||
"{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}"
|
||||
#==# XFileAcpt "photo.jpg"
|
||||
|
||||
Reference in New Issue
Block a user