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:
Evgeny Poberezkin
2023-03-09 11:01:22 +00:00
committed by GitHub
parent 5f587c2104
commit 2817306659
15 changed files with 232 additions and 66 deletions
+6 -1
View File
@@ -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
View File
@@ -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.*
+2 -1
View File
@@ -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
View File
@@ -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
View File
@@ -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),
+12 -3
View File
@@ -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;
|]
+48 -4
View File
@@ -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
+22 -8
View File
@@ -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
+2
View File
@@ -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 #-}
+52 -7
View File
@@ -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}
+10 -9
View File
@@ -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
View File
@@ -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
+7 -7
View File
@@ -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"