mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-05-25 16:24:27 +00:00
core: compressed message encoding, variable vrange (#3844)
This commit is contained in:
Alexander Bondarenko
committed by
GitHub
GitHub
parent
eebf014ff7
commit
64dc758ffd
+1
-1
@@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd
|
||||
source-repository-package
|
||||
type: git
|
||||
location: https://github.com/simplex-chat/simplexmq.git
|
||||
tag: c280f942ba3d96d48db30ccc3a23d51a7b5fed41
|
||||
tag: e04705d9c5e6b3d3652f909a5176c375acf29411
|
||||
|
||||
source-repository-package
|
||||
type: git
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"https://github.com/simplex-chat/simplexmq.git"."c280f942ba3d96d48db30ccc3a23d51a7b5fed41" = "04aq4mv2q3v5yfbnj9ajylpjvq7hl1hgj5jiwg90rkc6nl3a7dvz";
|
||||
"https://github.com/simplex-chat/simplexmq.git"."317f2d5552332eb5d26a15ede87887e59408a10b" = "1dc4nv5zcbv4712sjv0ncyswdcx4igwzhgybx1rd9x6a7mwv2kr5";
|
||||
"https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38";
|
||||
"https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d";
|
||||
"https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl";
|
||||
|
||||
+131
-74
@@ -22,6 +22,7 @@ import Control.Monad
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.IO.Unlift
|
||||
import Control.Monad.Reader
|
||||
import Crypto.Random (ChaChaDRG)
|
||||
import qualified Data.Aeson as J
|
||||
import Data.Attoparsec.ByteString.Char8 (Parser)
|
||||
import qualified Data.Attoparsec.ByteString.Char8 as A
|
||||
@@ -97,9 +98,11 @@ import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
|
||||
import Simplex.Messaging.Client (defaultNetworkConfig)
|
||||
import Simplex.Messaging.Compression (withCompressCtx)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOff)
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
@@ -364,7 +367,8 @@ startChatController mainApp = do
|
||||
subscribeUsers :: forall m. ChatMonad' m => Bool -> [User] -> m ()
|
||||
subscribeUsers onlyNeeded users = do
|
||||
let (us, us') = partition activeUser users
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
subscribe vr us
|
||||
subscribe vr us'
|
||||
where
|
||||
@@ -446,7 +450,9 @@ parseChatCommand = A.parseOnly chatCommandP . B.dropWhileEnd isSpace
|
||||
|
||||
-- | Chat API commands interpreted in context of a local zone
|
||||
processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
|
||||
processChatCommand cmd = chatVersionRange >>= (`processChatCommand'` cmd)
|
||||
processChatCommand cmd =
|
||||
chatVersionRange PQEncOff -- TODO PQ this is only used to set membership version range (?)
|
||||
>>= (`processChatCommand'` cmd)
|
||||
{-# INLINE processChatCommand #-}
|
||||
|
||||
processChatCommand' :: forall m. ChatMonad m => VersionRangeChat -> ChatCommand -> m ChatResponse
|
||||
@@ -1416,8 +1422,8 @@ processChatCommand' vr = \case
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing False
|
||||
dm <- directMessage $ XInfo profileToSend
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength $ XInfo profileToSend
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm (CR.PQEncryption enablePQ) subMode
|
||||
conn <- withStore' $ \db -> createDirectConnection db user connId cReq ConnJoined (incognitoProfile $> profileToSend) subMode enablePQ
|
||||
pure $ CRSentConfirmation user conn
|
||||
@@ -2146,7 +2152,7 @@ processChatCommand' vr = \case
|
||||
where
|
||||
connect' groupLinkId cReqHash xContactId inGroup = do
|
||||
enablePQ <- (not inGroup &&) <$> (readTVarIO =<< asks pqExperimentalEnabled)
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup enablePQ
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq xContactId inGroup (CR.PQEncryption enablePQ)
|
||||
conn <- withStore' $ \db -> createConnReqConnection db userId connId cReqHash xContactId incognitoProfile groupLinkId subMode enablePQ
|
||||
pure $ CRSentInvitation user conn incognitoProfile
|
||||
connectContactViaAddress :: User -> IncognitoEnabled -> Contact -> ConnectionRequestUri 'CMContact -> m ChatResponse
|
||||
@@ -2154,18 +2160,18 @@ processChatCommand' vr = \case
|
||||
withChatLock "connectViaContact" $ do
|
||||
newXContactId <- XContactId <$> drgRandomBytes 16
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False enablePQ
|
||||
(connId, incognitoProfile, subMode) <- requestContact user incognito cReq newXContactId False (CR.PQEncryption enablePQ)
|
||||
let cReqHash = ConnReqUriHash . C.sha256Hash $ strEncode cReq
|
||||
ct' <- withStore $ \db -> createAddressContactConnection db user ct connId cReqHash newXContactId incognitoProfile subMode enablePQ
|
||||
pure $ CRSentInvitationToContact user ct' incognitoProfile
|
||||
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQFlag -> m (ConnId, Maybe Profile, SubscriptionMode)
|
||||
requestContact user incognito cReq xContactId inGroup enablePQ = do
|
||||
requestContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> XContactId -> Bool -> PQEncryption -> m (ConnId, Maybe Profile, SubscriptionMode)
|
||||
requestContact user incognito cReq xContactId inGroup pqEnc = do
|
||||
-- [incognito] generate profile to send
|
||||
incognitoProfile <- if incognito then Just <$> liftIO generateRandomProfile else pure Nothing
|
||||
let profileToSend = userProfileToSend user incognitoProfile Nothing inGroup
|
||||
dm <- directMessage (XContact profileToSend $ Just xContactId)
|
||||
dm <- directMessagePQ pqEnc maxConnInfoLength (XContact profileToSend $ Just xContactId)
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm (CR.PQEncryption enablePQ) subMode
|
||||
connId <- withAgent $ \a -> joinConnection a (aUserId user) True cReq dm pqEnc subMode
|
||||
pure (connId, incognitoProfile, subMode)
|
||||
contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
|
||||
contactMember Contact {contactId} =
|
||||
@@ -2190,15 +2196,18 @@ processChatCommand' vr = \case
|
||||
user' <- updateUser
|
||||
asks currentUser >>= atomically . (`writeTVar` Just user')
|
||||
withChatLock "updateProfile" . procCmd $ do
|
||||
let changedCts = foldr (addChangedProfileContact user') [] contacts
|
||||
idsEvts = map ctSndMsg changedCts
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
msgReqs_ <- zipWith (ctMsgReq enablePQ) changedCts <$> createSndMessages idsEvts
|
||||
(errs, cts) <- partitionEithers . zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
|
||||
createContactsSndFeatureItems user' changedCts'
|
||||
let summary =
|
||||
let changedCts_ = L.nonEmpty $ foldr (addChangedProfileContact user') [] contacts
|
||||
summary <- case changedCts_ of
|
||||
Nothing -> pure $ UserProfileUpdateSummary 0 0 []
|
||||
Just changedCts -> do
|
||||
let idsEvts = L.map ctSndMsg changedCts
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
msgReqs_ <- L.zipWith (ctMsgReq enablePQ) changedCts <$> createSndMessages idsEvts
|
||||
(errs, cts) <- partitionEithers . L.toList . L.zipWith (second . const) changedCts <$> deliverMessagesB msgReqs_
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
let changedCts' = filter (\ChangedProfileContact {ct, ct'} -> directOrUsed ct' && mergedPreferences ct' /= mergedPreferences ct) cts
|
||||
createContactsSndFeatureItems user' changedCts'
|
||||
pure
|
||||
UserProfileUpdateSummary
|
||||
{ updateSuccesses = length cts,
|
||||
updateFailures = length errs,
|
||||
@@ -2217,8 +2226,8 @@ processChatCommand' vr = \case
|
||||
mergedProfile = userProfileToSend user Nothing (Just ct) False
|
||||
ct' = updateMergedPreferences user' ct
|
||||
mergedProfile' = userProfileToSend user' Nothing (Just ct') False
|
||||
ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, ChatMsgEvent 'Json)
|
||||
ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId}} = (ConnectionId connId, XInfo mergedProfile')
|
||||
ctSndMsg :: ChangedProfileContact -> (ConnOrGroupId, PQEncryption, ChatMsgEvent 'Json)
|
||||
ctSndMsg ChangedProfileContact {mergedProfile', conn = Connection {connId, enablePQ = enablePQConn}} = (ConnectionId connId, CR.PQEncryption enablePQConn, XInfo mergedProfile')
|
||||
ctMsgReq :: PQFlag -> ChangedProfileContact -> Either ChatError SndMessage -> Either ChatError MsgReq
|
||||
ctMsgReq enablePQ ChangedProfileContact {conn = conn@Connection {enablePQ = enablePQConn}} =
|
||||
fmap $ \SndMessage {msgId, msgBody} ->
|
||||
@@ -2725,7 +2734,8 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
|
||||
unless (fileStatus == RFSNew) $ case fileStatus of
|
||||
RFSCancelled _ -> throwChatError $ CEFileCancelled fName
|
||||
_ -> throwChatError $ CEFileAlreadyReceiving fName
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
case (xftpRcvFile, fileConnReq) of
|
||||
-- direct file protocol
|
||||
(Nothing, Just connReq) -> do
|
||||
@@ -2764,7 +2774,8 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, xftpRcvFile, fileI
|
||||
acceptFile cmdFunction send = do
|
||||
filePath <- getRcvFilePath fileId filePath_ fName True
|
||||
inline <- receiveInline
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
if
|
||||
| inline -> do
|
||||
-- accepting inline
|
||||
@@ -2811,7 +2822,8 @@ receiveViaURI user@User {userId} FileDescriptionURI {description} cf@CryptoFile
|
||||
|
||||
startReceivingFile :: ChatMonad m => User -> FileTransferId -> m ()
|
||||
startReceivingFile user fileId = do
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
ci <- withStoreCtx (Just "startReceivingFile, updateRcvFileStatus ...") $ \db -> do
|
||||
liftIO $ updateRcvFileStatus db fileId FSConnected
|
||||
liftIO $ updateCIFileStatus db user fileId $ CIFSRcvTransfer 0 1
|
||||
@@ -2856,8 +2868,8 @@ acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> Maybe Incog
|
||||
acceptContactRequest user UserContactRequest {agentInvitationId = AgentInvId invId, cReqChatVRange, localDisplayName = cName, profileId, profile = cp, userContactLinkId, xContactId} incognitoProfile contactUsed = do
|
||||
subMode <- chatReadVar subscriptionMode
|
||||
let profileToSend = profileToSendOnAccept user incognitoProfile False
|
||||
dm <- directMessage $ XInfo profileToSend
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength $ XInfo profileToSend
|
||||
acId <- withAgent $ \a -> acceptContact a True invId dm (CR.PQEncryption enablePQ) subMode
|
||||
withStore' $ \db -> createAcceptedContact db user acId (fromJVersionRange cReqChatVRange) cName profileId cp userContactLinkId xContactId incognitoProfile subMode enablePQ contactUsed
|
||||
|
||||
@@ -3182,7 +3194,8 @@ deleteTimedItem user (ChatRef cType chatId, itemId) deleteAt = do
|
||||
ts <- liftIO getCurrentTime
|
||||
liftIO $ threadDelay' $ diffToMicroseconds $ diffUTCTime deleteAt ts
|
||||
waitChatStartedAndActivated
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
case cType of
|
||||
CTDirect -> do
|
||||
(ct, CChatItem _ ci) <- withStore $ \db -> (,) <$> getContact db user chatId <*> getDirectChatItem db user chatId itemId
|
||||
@@ -3203,7 +3216,8 @@ startUpdatedTimedItemThread user chatRef ci ci' =
|
||||
expireChatItems :: forall m. ChatMonad m => User -> Int64 -> Bool -> m ()
|
||||
expireChatItems user@User {userId} ttl sync = do
|
||||
currentTs <- liftIO getCurrentTime
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
let expirationDate = addUTCTime (-1 * fromIntegral ttl) currentTs
|
||||
-- this is to keep group messages created during last 12 hours even if they're expired according to item_ts
|
||||
createdAtCutoff = addUTCTime (-43200 :: NominalDiffTime) currentTs
|
||||
@@ -3250,7 +3264,8 @@ processAgentMessage _ connId (DEL_RCVQ srv qId err_) =
|
||||
processAgentMessage _ connId DEL_CONN =
|
||||
toView $ CRAgentConnDeleted (AgentConnId connId)
|
||||
processAgentMessage corrId connId msg = do
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range (?)
|
||||
vr <- chatVersionRange PQEncOff
|
||||
withStore' (`getUserByAConnId` AgentConnId connId) >>= \case
|
||||
Just user -> processAgentMessageConn vr user corrId connId msg `catchChatError` (toView . CRChatError (Just user))
|
||||
_ -> throwChatError $ CENoConnectionUser (AgentConnId connId)
|
||||
@@ -3289,7 +3304,8 @@ processAgentMsgSndFile _corrId aFileId msg =
|
||||
(ft@FileTransferMeta {fileId, xftpRedirectFor, cancelled}, sfts) <- withStore $ \db -> do
|
||||
fileId <- getXFTPSndFileDBId db user $ AgentSndFileId aFileId
|
||||
getSndFileTransfer db user fileId
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
unless cancelled $ case msg of
|
||||
SFPROG sndProgress sndTotal -> do
|
||||
let status = CIFSSndTransfer {sndProgress, sndTotal}
|
||||
@@ -3408,7 +3424,8 @@ processAgentMsgRcvFile _corrId aFileId msg =
|
||||
ft@RcvFileTransfer {fileId} <- withStore $ \db -> do
|
||||
fileId <- getXFTPRcvFileDBId db $ AgentRcvFileId aFileId
|
||||
getRcvFileTransfer db user fileId
|
||||
vr <- chatVersionRange
|
||||
-- TODO PQ this is only used to set membership version range
|
||||
vr <- chatVersionRange PQEncOff
|
||||
unless (rcvFileCompleteOrCancelled ft) $ case msg of
|
||||
RFPROG rcvProgress rcvTotal -> do
|
||||
let status = CIFSRcvTransfer {rcvProgress, rcvTotal}
|
||||
@@ -5827,7 +5844,7 @@ parseChatMessage conn s = do
|
||||
sendFileChunk :: ChatMonad m => User -> SndFileTransfer -> m ()
|
||||
sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
|
||||
unless (fileStatus == FSComplete || fileStatus == FSCancelled) $ do
|
||||
vr <- chatVersionRange
|
||||
vr <- chatVersionRange PQEncOff
|
||||
withStore' (`createSndFileChunk` ft) >>= \case
|
||||
Just chunkNo -> sendFileChunkNo ft chunkNo
|
||||
Nothing -> do
|
||||
@@ -6012,51 +6029,83 @@ contactSendConn_ ct@Contact {activeConn} = case activeConn of
|
||||
sendDirectMessage :: (MsgEncodingI e, ChatMonad m) => Connection -> CR.PQEncryption -> ChatMsgEvent e -> ConnOrGroupId -> m (SndMessage, Int64, CR.PQEncryption)
|
||||
sendDirectMessage conn pqEnc chatMsgEvent connOrGroupId = do
|
||||
when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId pqEnc
|
||||
(msgDeliveryId, pqEnc') <- deliverMessage conn pqEnc (toCMEventTag chatMsgEvent) msgBody msgId
|
||||
pure (msg, msgDeliveryId, pqEnc')
|
||||
|
||||
createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> m SndMessage
|
||||
createSndMessage chatMsgEvent connOrGroupId =
|
||||
liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, chatMsgEvent))
|
||||
createSndMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> ConnOrGroupId -> PQEncryption -> m SndMessage
|
||||
createSndMessage chatMsgEvent connOrGroupId pqEnc =
|
||||
liftEither . runIdentity =<< createSndMessages (Identity (connOrGroupId, pqEnc, chatMsgEvent))
|
||||
|
||||
createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, ChatMsgEvent e) -> m (t (Either ChatError SndMessage))
|
||||
createSndMessages :: forall e m t. (MsgEncodingI e, ChatMonad' m, Traversable t) => t (ConnOrGroupId, PQEncryption, ChatMsgEvent e) -> m (t (Either ChatError SndMessage))
|
||||
createSndMessages idsEvents = do
|
||||
gVar <- asks random
|
||||
vr <- chatVersionRange
|
||||
withStoreBatch $ \db -> fmap (uncurry (createMsg db gVar vr)) idsEvents
|
||||
g <- asks random
|
||||
ChatConfig {chatVRange = vr} <- asks config
|
||||
withStoreBatch $ \db -> fmap (createMsg db g vr) idsEvents
|
||||
where
|
||||
createMsg db gVar chatVRange connOrGroupId evnt = runExceptT $ do
|
||||
withExceptT ChatErrorStore $ createNewSndMessage db gVar connOrGroupId evnt (encodeMessage chatVRange evnt)
|
||||
encodeMessage chatVRange evnt sharedMsgId =
|
||||
encodeChatMessage ChatMessage {chatVRange, msgId = Just sharedMsgId, chatMsgEvent = evnt}
|
||||
createMsg :: DB.Connection -> TVar ChaChaDRG -> (PQEncryption -> VersionRangeChat) -> (ConnOrGroupId, PQEncryption, ChatMsgEvent e) -> IO (Either ChatError SndMessage)
|
||||
createMsg db g vr (connOrGroupId, pqEnc, evnt) = runExceptT $ do
|
||||
withExceptT ChatErrorStore $ createNewSndMessage db g connOrGroupId evnt encodeMessage
|
||||
where
|
||||
encodeMessage sharedMsgId =
|
||||
encodeChatMessage maxEncodedMsgLength ChatMessage {chatVRange = vr pqEnc, msgId = Just sharedMsgId, chatMsgEvent = evnt}
|
||||
|
||||
sendGroupMemberMessages :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> Connection -> NonEmpty (ChatMsgEvent e) -> GroupId -> m ()
|
||||
sendGroupMemberMessages user conn@Connection {connId} events groupId = do
|
||||
sendGroupMemberMessages user conn events groupId = do
|
||||
when (connDisabled conn) $ throwChatError (CEConnectionDisabled conn)
|
||||
let idsEvts = L.map (GroupId groupId,) events
|
||||
let idsEvts = L.map (GroupId groupId,PQEncOff,) events
|
||||
(errs, msgs) <- partitionEithers . L.toList <$> createSndMessages idsEvts
|
||||
unless (null errs) $ toView $ CRChatErrors (Just user) errs
|
||||
unless (null msgs) $ do
|
||||
let (errs', msgBatches) = partitionEithers $ batchMessages maxChatMsgSize msgs
|
||||
forM_ (L.nonEmpty msgs) $ \msgs' -> do
|
||||
-- TODO PQ based on version (?)
|
||||
-- let shouldCompress = False
|
||||
-- batched <- if shouldCompress then batchSndMessagesBinary msgs' else pure $ batchSndMessagesJSON msgs'
|
||||
let batched = batchSndMessagesJSON msgs'
|
||||
let (errs', msgBatches) = partitionEithers batched
|
||||
-- shouldn't happen, as large messages would have caused createNewSndMessage to throw SELargeMsg
|
||||
unless (null errs') $ toView $ CRChatErrors (Just user) errs'
|
||||
forM_ msgBatches $ \batch ->
|
||||
processBatch batch `catchChatError` (toView . CRChatError (Just user))
|
||||
where
|
||||
processBatch :: MsgBatch -> m ()
|
||||
processBatch (MsgBatch batchBody sndMsgs) = do
|
||||
(agentMsgId, _pqEnc) <- withAgent $ \a -> sendMessage a (aConnId conn) CR.PQEncOff MsgFlags {notification = True} batchBody
|
||||
let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
|
||||
void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs
|
||||
processSndMessageBatch conn batch `catchChatError` (toView . CRChatError (Just user))
|
||||
|
||||
processSndMessageBatch :: ChatMonad m => Connection -> MsgBatch -> m ()
|
||||
processSndMessageBatch conn@Connection {connId} (MsgBatch batchBody sndMsgs) = do
|
||||
(agentMsgId, _pqEnc) <- withAgent $ \a -> sendMessage a (aConnId conn) CR.PQEncOff MsgFlags {notification = True} batchBody
|
||||
let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId}
|
||||
void . withStoreBatch' $ \db -> map (\SndMessage {msgId} -> createSndMsgDelivery db sndMsgDelivery msgId) sndMsgs
|
||||
|
||||
batchSndMessagesJSON :: NonEmpty SndMessage -> [Either ChatError MsgBatch]
|
||||
batchSndMessagesJSON = batchMessages (maxEncodedMsgLength PQEncOff) . L.toList
|
||||
|
||||
-- batchSndMessagesBinary :: forall m. ChatMonad m => NonEmpty SndMessage -> m [Either ChatError MsgBatch]
|
||||
-- batchSndMessagesBinary msgs = do
|
||||
-- compressed <- liftIO $ withCompressCtx maxChatMsgSize $ \cctx -> mapM (compressForBatch cctx) msgs
|
||||
-- pure . map toMsgBatch . SMP.batchTransmissions_ (maxEncodedMsgLength PQEncOff) $ L.zip compressed msgs
|
||||
-- where
|
||||
-- compressForBatch cctx SndMessage {msgBody} = bimap (const TELargeMsg) smpEncode <$> compress cctx msgBody
|
||||
-- toMsgBatch :: SMP.TransportBatch SndMessage -> Either ChatError MsgBatch
|
||||
-- toMsgBatch = \case
|
||||
-- SMP.TBTransmissions combined _n sms -> Right $ MsgBatch (markCompressedBatch combined) sms
|
||||
-- SMP.TBError tbe SndMessage {msgId} -> Left . ChatError $ CEInternalError (show tbe <> " " <> show msgId)
|
||||
-- SMP.TBTransmission {} -> Left . ChatError $ CEInternalError "batchTransmissions_ didn't produce a batch"
|
||||
|
||||
directMessage :: (MsgEncodingI e, ChatMonad m) => ChatMsgEvent e -> m ByteString
|
||||
directMessage chatMsgEvent = do
|
||||
chatVRange <- chatVersionRange
|
||||
let r = encodeChatMessage ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
|
||||
directMessage = directMessagePQ PQEncOff maxConnInfoLength
|
||||
|
||||
-- TODO PQ check size after compression (in compressedBatchMsgBody_ ?)
|
||||
directMessagePQ :: (MsgEncodingI e, ChatMonad m) => CR.PQEncryption -> (CR.PQEncryption -> Int) -> ChatMsgEvent e -> m ByteString
|
||||
directMessagePQ pqEnc maxMsgSize chatMsgEvent = do
|
||||
chatVRange <- chatVersionRange pqEnc
|
||||
let shouldCompress = maxVersion chatVRange >= compressedBatchingVersion
|
||||
r = encodeChatMessage maxMsgSize ChatMessage {chatVRange, msgId = Nothing, chatMsgEvent}
|
||||
case r of
|
||||
ECMEncoded encodedBody -> pure encodedBody
|
||||
ECMEncoded encodedBody
|
||||
| shouldCompress -> compressedBatchMsgBody encodedBody
|
||||
| otherwise -> pure encodedBody
|
||||
ECMLarge -> throwChatError $ CEException "large message"
|
||||
where
|
||||
compressedBatchMsgBody msgBody =
|
||||
liftEitherError (ChatError . CEException . mappend "compressedBatchMsgBody: ") $
|
||||
withCompressCtx (B.length msgBody) (`compressedBatchMsgBody_` msgBody)
|
||||
|
||||
deliverMessage :: ChatMonad m => Connection -> CR.PQEncryption -> CMEventTag e -> MsgBody -> MessageId -> m (Int64, CR.PQEncryption)
|
||||
deliverMessage conn pqEnc cmEventTag msgBody msgId = do
|
||||
@@ -6065,8 +6114,8 @@ deliverMessage conn pqEnc cmEventTag msgBody msgId = do
|
||||
|
||||
deliverMessage' :: ChatMonad m => Connection -> CR.PQEncryption -> MsgFlags -> MsgBody -> MessageId -> m (Int64, CR.PQEncryption)
|
||||
deliverMessage' conn pqEnc msgFlags msgBody msgId =
|
||||
deliverMessages [(conn, pqEnc, msgFlags, msgBody, msgId)] >>= \case
|
||||
[r] -> liftEither r
|
||||
deliverMessages ((conn, pqEnc, msgFlags, msgBody, msgId) :| []) >>= \case
|
||||
r :| [] -> liftEither r
|
||||
rs -> throwChatError $ CEInternalError $ "deliverMessage: expected 1 result, got " <> show (length rs)
|
||||
|
||||
type MsgReq = (Connection, CR.PQEncryption, MsgFlags, MsgBody, MessageId)
|
||||
@@ -6076,15 +6125,23 @@ contactPQEnc Connection {enablePQ = enablePQConn} = do
|
||||
enablePQ <- readTVarIO =<< asks pqExperimentalEnabled
|
||||
pure $ CR.PQEncryption $ enablePQ && enablePQConn
|
||||
|
||||
deliverMessages :: ChatMonad' m => [MsgReq] -> m [Either ChatError (Int64, CR.PQEncryption)]
|
||||
deliverMessages = deliverMessagesB . map Right
|
||||
deliverMessages :: ChatMonad' m => NonEmpty MsgReq -> m (NonEmpty (Either ChatError (Int64, CR.PQEncryption)))
|
||||
deliverMessages msgs = deliverMessagesB $ L.map Right msgs
|
||||
|
||||
deliverMessagesB :: ChatMonad' m => [Either ChatError MsgReq] -> m [Either ChatError (Int64, CR.PQEncryption)]
|
||||
deliverMessagesB :: ChatMonad' m => NonEmpty (Either ChatError MsgReq) -> m (NonEmpty (Either ChatError (Int64, CR.PQEncryption)))
|
||||
deliverMessagesB msgReqs = do
|
||||
sent <- zipWith prepareBatch msgReqs <$> withAgent' (\a -> sendMessagesB a $ map toAgent msgReqs)
|
||||
void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights sent)
|
||||
withStoreBatch $ \db -> map (bindRight $ createDelivery db) sent
|
||||
msgReqs' <- compressBodies
|
||||
sent <- L.zipWith prepareBatch msgReqs' <$> withAgent' (`sendMessagesB` L.map toAgent msgReqs')
|
||||
void $ withStoreBatch' $ \db -> map (updatePQSndEnabled db) (rights . L.toList $ sent)
|
||||
withStoreBatch $ \db -> L.map (bindRight $ createDelivery db) sent
|
||||
where
|
||||
compressBodies = liftIO $ withCompressCtx maxRawMsgLength $ \cctx ->
|
||||
forM msgReqs $ \case
|
||||
mr@(Right (conn, pqEnc, msgFlags, msgBody, msgId))
|
||||
| pqEnc == CR.PQEncOn -> do
|
||||
bimap (ChatError . CEException) (\cBody -> (conn, pqEnc, msgFlags, cBody, msgId)) <$> compressedBatchMsgBody_ cctx msgBody
|
||||
| otherwise -> pure mr
|
||||
skip -> pure skip
|
||||
toAgent = \case
|
||||
Right (conn, pqEnc, msgFlags, msgBody, _msgId) -> Right (aConnId conn, pqEnc, msgFlags, msgBody)
|
||||
Left _ce -> Left (AP.INTERNAL "ChatError, skip") -- as long as it is Left, the agent batchers should just step over it
|
||||
@@ -6129,12 +6186,12 @@ sendGroupMessage user gInfo members chatMsgEvent = do
|
||||
|
||||
sendGroupMessage' :: (MsgEncodingI e, ChatMonad m) => User -> GroupInfo -> [GroupMember] -> ChatMsgEvent e -> m (SndMessage, [GroupMember])
|
||||
sendGroupMessage' user GroupInfo {groupId} members chatMsgEvent = do
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId)
|
||||
msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent (GroupId groupId) PQEncOff
|
||||
recipientMembers <- liftIO $ shuffleMembers (filter memberCurrent members)
|
||||
let msgFlags = MsgFlags {notification = hasNotification $ toCMEventTag chatMsgEvent}
|
||||
(toSend, pending) = foldr addMember ([], []) recipientMembers
|
||||
msgReqs = map (\(_, conn) -> (conn, CR.PQEncOff, msgFlags, msgBody, msgId)) toSend
|
||||
delivered <- deliverMessages msgReqs
|
||||
delivered <- maybe (pure []) (fmap L.toList . deliverMessages) $ L.nonEmpty msgReqs
|
||||
let errors = lefts delivered
|
||||
unless (null errors) $ toView $ CRChatErrors (Just user) errors
|
||||
stored <- withStoreBatch' $ \db -> map (\m -> createPendingGroupMessage db (groupMemberId' m) msgId Nothing) pending
|
||||
@@ -6187,7 +6244,7 @@ memberSendAction chatMsgEvent members m@GroupMember {invitedByGroupMemberId} = c
|
||||
|
||||
sendGroupMemberMessage :: forall e m. (MsgEncodingI e, ChatMonad m) => User -> GroupMember -> ChatMsgEvent e -> Int64 -> Maybe Int64 -> m () -> m ()
|
||||
sendGroupMemberMessage user m@GroupMember {groupMemberId} chatMsgEvent groupId introId_ postDeliver = do
|
||||
msg <- createSndMessage chatMsgEvent (GroupId groupId)
|
||||
msg <- createSndMessage chatMsgEvent (GroupId groupId) PQEncOff
|
||||
messageMember msg `catchChatError` (\e -> toView (CRChatError (Just user) e))
|
||||
where
|
||||
messageMember :: SndMessage -> m ()
|
||||
@@ -6359,16 +6416,16 @@ joinAgentConnectionAsync user enableNtfs cReqUri cInfo subMode = do
|
||||
pure (cmdId, connId)
|
||||
|
||||
allowAgentConnectionAsync :: (MsgEncodingI e, ChatMonad m) => User -> Connection -> ConfirmationId -> ChatMsgEvent e -> m ()
|
||||
allowAgentConnectionAsync user conn@Connection {connId} confId msg = do
|
||||
allowAgentConnectionAsync user conn@Connection {connId, enablePQ} confId msg = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user (Just connId) CFAllowConn
|
||||
dm <- directMessage msg
|
||||
dm <- directMessagePQ (CR.PQEncryption enablePQ) maxConnInfoLength msg
|
||||
withAgent $ \a -> allowConnectionAsync a (aCorrId cmdId) (aConnId conn) confId dm
|
||||
withStore' $ \db -> updateConnectionStatus db conn ConnAccepted
|
||||
|
||||
agentAcceptContactAsync :: (MsgEncodingI e, ChatMonad m) => User -> Bool -> InvitationId -> ChatMsgEvent e -> SubscriptionMode -> CR.PQEncryption -> m (CommandId, ConnId)
|
||||
agentAcceptContactAsync user enableNtfs invId msg subMode pqEnc = do
|
||||
cmdId <- withStore' $ \db -> createCommand db user Nothing CFAcceptContact
|
||||
dm <- directMessage msg
|
||||
dm <- directMessagePQ pqEnc maxConnInfoLength msg
|
||||
connId <- withAgent $ \a -> acceptContactAsync a (aCorrId cmdId) enableNtfs invId dm pqEnc subMode
|
||||
pure (cmdId, connId)
|
||||
|
||||
@@ -6603,10 +6660,10 @@ waitChatStartedAndActivated = do
|
||||
activated <- readTVar chatActivated
|
||||
unless (isJust started && activated) retry
|
||||
|
||||
chatVersionRange :: ChatMonad' m => m VersionRangeChat
|
||||
chatVersionRange = do
|
||||
chatVersionRange :: ChatMonad' m => CR.PQEncryption -> m VersionRangeChat
|
||||
chatVersionRange pqEnc = do
|
||||
ChatConfig {chatVRange} <- asks config
|
||||
pure chatVRange
|
||||
pure $ chatVRange pqEnc
|
||||
|
||||
chatCommandP :: Parser ChatCommand
|
||||
chatCommandP =
|
||||
|
||||
@@ -73,6 +73,7 @@ import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.File (CryptoFile (..))
|
||||
import qualified Simplex.Messaging.Crypto.File as CF
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), NtfTknStatus)
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, parseAll, parseString, sumTypeJSON)
|
||||
import Simplex.Messaging.Protocol (AProtoServerWithAuth, AProtocolType (..), CorrId, NtfServer, ProtoServerWithAuth, ProtocolTypeI, QueueId, SMPMsgMeta (..), SProtocolType, SubscriptionMode (..), UserProtocol, XFTPServerWithAuth, userProtocol)
|
||||
@@ -121,7 +122,7 @@ coreVersionInfo simplexmqCommit =
|
||||
|
||||
data ChatConfig = ChatConfig
|
||||
{ agentConfig :: AgentConfig,
|
||||
chatVRange :: VersionRangeChat,
|
||||
chatVRange :: CR.PQEncryption -> VersionRangeChat,
|
||||
confirmMigrations :: MigrationConfirmation,
|
||||
defaultServers :: DefaultAgentServers,
|
||||
tbqSize :: Natural,
|
||||
|
||||
@@ -7,6 +7,7 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
@@ -30,6 +31,7 @@ import Data.ByteString.Char8 (ByteString)
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.ByteString.Internal (c2w, w2c)
|
||||
import qualified Data.ByteString.Lazy.Char8 as LB
|
||||
import qualified Data.List.NonEmpty as L
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.String
|
||||
import Data.Text (Text)
|
||||
@@ -44,10 +46,13 @@ import Database.SQLite.Simple.ToField (ToField (..))
|
||||
import Simplex.Chat.Call
|
||||
import Simplex.Chat.Types
|
||||
import Simplex.Chat.Types.Util
|
||||
import Simplex.Messaging.Compression (CompressCtx, compress, decompressBatch)
|
||||
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, pattern PQEncOn, pattern PQEncOff)
|
||||
import Simplex.Messaging.Encoding
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, fromTextField_, fstToLower, parseAll, sumTypeJSON, taggedObjectJSON)
|
||||
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>))
|
||||
import Simplex.Messaging.Protocol (MsgBody)
|
||||
import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$$>), (<$?>))
|
||||
import Simplex.Messaging.Version hiding (version)
|
||||
|
||||
-- This should not be used directly in code, instead use `maxVersion chatVRange` from ChatConfig.
|
||||
@@ -57,8 +62,11 @@ currentChatVersion :: VersionChat
|
||||
currentChatVersion = VersionChat 7
|
||||
|
||||
-- This should not be used directly in code, instead use `chatVRange` from ChatConfig (see comment above)
|
||||
supportedChatVRange :: VersionRangeChat
|
||||
supportedChatVRange = mkVersionRange (VersionChat 1) currentChatVersion
|
||||
-- TODO remove parameterization in 5.7
|
||||
supportedChatVRange :: PQEncryption -> VersionRangeChat
|
||||
supportedChatVRange pq = mkVersionRange (VersionChat 1) $ case pq of
|
||||
PQEncOn -> compressedBatchingVersion
|
||||
PQEncOff -> currentChatVersion
|
||||
|
||||
-- version range that supports skipping establishing direct connections in a group
|
||||
groupNoDirectVRange :: VersionRangeChat
|
||||
@@ -88,6 +96,10 @@ groupHistoryIncludeWelcomeVRange = mkVersionRange (VersionChat 6) currentChatVer
|
||||
memberProfileUpdateVRange :: VersionRangeChat
|
||||
memberProfileUpdateVRange = mkVersionRange (VersionChat 7) currentChatVersion
|
||||
|
||||
-- version range that supports compressing messages
|
||||
compressedBatchingVersion :: VersionChat
|
||||
compressedBatchingVersion = VersionChat 8
|
||||
|
||||
data ConnectionEntity
|
||||
= RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact}
|
||||
| RcvGroupMsgConnection {entityConnection :: Connection, groupInfo :: GroupInfo, groupMember :: GroupMember}
|
||||
@@ -507,17 +519,27 @@ $(JQ.deriveJSON defaultJSON ''QuotedMsg)
|
||||
|
||||
-- this limit reserves space for metadata in forwarded messages
|
||||
-- 15780 (limit used for fileChunkSize) - 161 (x.grp.msg.forward overhead) = 15619, round to 15610
|
||||
maxChatMsgSize :: Int
|
||||
maxChatMsgSize = 15610
|
||||
maxRawMsgLength :: Int
|
||||
maxRawMsgLength = 15610
|
||||
|
||||
maxEncodedMsgLength :: PQEncryption -> Int
|
||||
maxEncodedMsgLength = \case
|
||||
PQEncOn -> 13410 -- reduced by 2200 (original message should be compressed)
|
||||
PQEncOff -> maxRawMsgLength
|
||||
|
||||
maxConnInfoLength :: PQEncryption -> Int
|
||||
maxConnInfoLength = \case
|
||||
PQEncOn -> 10902 -- reduced by 3700
|
||||
PQEncOff -> 14602 -- 15610 - delta in agent between MSG and INFO
|
||||
|
||||
data EncodedChatMessage = ECMEncoded ByteString | ECMLarge
|
||||
|
||||
encodeChatMessage :: MsgEncodingI e => ChatMessage e -> EncodedChatMessage
|
||||
encodeChatMessage msg = do
|
||||
encodeChatMessage :: MsgEncodingI e => (PQEncryption -> Int) -> ChatMessage e -> EncodedChatMessage
|
||||
encodeChatMessage getMaxSize msg = do
|
||||
case chatToAppMessage msg of
|
||||
AMJson m -> do
|
||||
let body = LB.toStrict $ J.encode m
|
||||
if B.length body > maxChatMsgSize
|
||||
if B.length body > getMaxSize PQEncOff
|
||||
then ECMLarge
|
||||
else ECMEncoded body
|
||||
AMBinary m -> ECMEncoded $ strEncode m
|
||||
@@ -529,10 +551,22 @@ parseChatMessages s = case B.head s of
|
||||
'[' -> case J.eitherDecodeStrict' s of
|
||||
Right v -> map parseItem v
|
||||
Left e -> [Left e]
|
||||
'X' -> decodeCompressed (B.drop 1 s)
|
||||
_ -> [ACMsg SBinary <$> (appBinaryToCM =<< strDecode s)]
|
||||
where
|
||||
parseItem :: J.Value -> Either String AChatMessage
|
||||
parseItem v = ACMsg SJson <$> JT.parseEither parseJSON v
|
||||
decodeCompressed :: ByteString -> [Either String AChatMessage]
|
||||
decodeCompressed s' = case smpDecode s' of
|
||||
Left e -> [Left e]
|
||||
Right compressed -> concatMap (either (pure . Left) parseChatMessages) . L.toList $ decompressBatch maxRawMsgLength compressed
|
||||
|
||||
compressedBatchMsgBody_ :: CompressCtx -> MsgBody -> IO (Either String ByteString)
|
||||
compressedBatchMsgBody_ ctx msgBody = markCompressedBatch . smpEncode . (L.:| []) <$$> compress ctx msgBody
|
||||
|
||||
markCompressedBatch :: ByteString -> ByteString
|
||||
markCompressedBatch = B.cons 'X'
|
||||
{-# INLINE markCompressedBatch #-}
|
||||
|
||||
parseMsgContainer :: J.Object -> JT.Parser MsgContainer
|
||||
parseMsgContainer v =
|
||||
|
||||
+5
-6
@@ -36,14 +36,13 @@ import Simplex.FileTransfer.Description (kb, mb)
|
||||
import Simplex.FileTransfer.Server (runXFTPServerBlocking)
|
||||
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), defaultFileExpiration)
|
||||
import Simplex.Messaging.Agent.Env.SQLite
|
||||
import Simplex.Messaging.Agent.Protocol (pattern VersionSMPA)
|
||||
import Simplex.Messaging.Agent.Protocol (supportedSMPAgentVRange, pattern VersionSMPA)
|
||||
import Simplex.Messaging.Agent.RetryInterval
|
||||
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..))
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import Simplex.Messaging.Client (ProtocolClientConfig (..), defaultNetworkConfig)
|
||||
import Simplex.Messaging.Crypto.Ratchet (pattern VersionE2E)
|
||||
import qualified Simplex.Messaging.Crypto.Ratchet as CR
|
||||
import Simplex.Messaging.Agent.Protocol (supportedSMPAgentVRange)
|
||||
import Simplex.Messaging.Server (runSMPServerBlocking)
|
||||
import Simplex.Messaging.Server.Env.STM
|
||||
import Simplex.Messaging.Transport
|
||||
@@ -160,14 +159,14 @@ testAgentCfgV1 =
|
||||
testCfgVPrev :: ChatConfig
|
||||
testCfgVPrev =
|
||||
testCfg
|
||||
{ chatVRange = prevRange $ chatVRange testCfg,
|
||||
{ chatVRange = prevRange . chatVRange testCfg,
|
||||
agentConfig = testAgentCfgVPrev
|
||||
}
|
||||
|
||||
testCfgV1 :: ChatConfig
|
||||
testCfgV1 =
|
||||
testCfg
|
||||
{ chatVRange = v1Range,
|
||||
{ chatVRange = const v1Range,
|
||||
agentConfig = testAgentCfgV1
|
||||
}
|
||||
|
||||
@@ -185,7 +184,7 @@ testCfgCreateGroupDirect =
|
||||
mkCfgCreateGroupDirect testCfg
|
||||
|
||||
mkCfgCreateGroupDirect :: ChatConfig -> ChatConfig
|
||||
mkCfgCreateGroupDirect cfg = cfg {chatVRange = groupCreateDirectVRange}
|
||||
mkCfgCreateGroupDirect cfg = cfg {chatVRange = const groupCreateDirectVRange}
|
||||
|
||||
groupCreateDirectVRange :: VersionRangeChat
|
||||
groupCreateDirectVRange = mkVersionRange (VersionChat 1) (VersionChat 1)
|
||||
@@ -195,7 +194,7 @@ testCfgGroupLinkViaContact =
|
||||
mkCfgGroupLinkViaContact testCfg
|
||||
|
||||
mkCfgGroupLinkViaContact :: ChatConfig -> ChatConfig
|
||||
mkCfgGroupLinkViaContact cfg = cfg {chatVRange = groupLinkViaContactVRange}
|
||||
mkCfgGroupLinkViaContact cfg = cfg {chatVRange = const groupLinkViaContactVRange}
|
||||
|
||||
groupLinkViaContactVRange :: VersionRangeChat
|
||||
groupLinkViaContactVRange = mkVersionRange (VersionChat 1) (VersionChat 2)
|
||||
|
||||
+18
-19
@@ -25,6 +25,7 @@ import Simplex.Chat.Protocol (supportedChatVRange)
|
||||
import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
|
||||
import Simplex.Chat.Types (VersionRangeChat, authErrDisableCount, sameVerificationCode, verificationCode, pattern VersionChat)
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff)
|
||||
import Simplex.Messaging.Util (safeDecodeUtf8)
|
||||
import Simplex.Messaging.Version
|
||||
import System.Directory (copyFile, doesDirectoryExist, doesFileExist)
|
||||
@@ -106,10 +107,8 @@ chatDirectTests = do
|
||||
it "mark group member verified" testMarkGroupMemberVerified
|
||||
describe "message errors" $ do
|
||||
it "show message decryption error" testMsgDecryptError
|
||||
skip "TODO PQ ratchet synchronization" $
|
||||
describe "TODO sporadically fail with unexpected \"post-quantum encryption enabled\" output" $ do
|
||||
it "should report ratchet de-synchronization, synchronize ratchets" testSyncRatchet
|
||||
it "synchronize ratchets, reset connection code" testSyncRatchetCodeReset
|
||||
it "should report ratchet de-synchronization, synchronize ratchets" testSyncRatchet
|
||||
it "synchronize ratchets, reset connection code" testSyncRatchetCodeReset
|
||||
describe "message reactions" $ do
|
||||
it "set message reactions" testSetMessageReactions
|
||||
describe "delivery receipts" $ do
|
||||
@@ -117,14 +116,14 @@ chatDirectTests = do
|
||||
it "should send delivery receipts depending on configuration" testConfigureDeliveryReceipts
|
||||
describe "negotiate connection peer chat protocol version range" $ do
|
||||
describe "peer version range correctly set for new connection via invitation" $ do
|
||||
testInvVRange supportedChatVRange supportedChatVRange
|
||||
testInvVRange supportedChatVRange vr11
|
||||
testInvVRange vr11 supportedChatVRange
|
||||
testInvVRange (supportedChatVRange PQEncOff) (supportedChatVRange PQEncOff)
|
||||
testInvVRange (supportedChatVRange PQEncOff) vr11
|
||||
testInvVRange vr11 (supportedChatVRange PQEncOff)
|
||||
testInvVRange vr11 vr11
|
||||
describe "peer version range correctly set for new connection via contact request" $ do
|
||||
testReqVRange supportedChatVRange supportedChatVRange
|
||||
testReqVRange supportedChatVRange vr11
|
||||
testReqVRange vr11 supportedChatVRange
|
||||
testReqVRange (supportedChatVRange PQEncOff) (supportedChatVRange PQEncOff)
|
||||
testReqVRange (supportedChatVRange PQEncOff) vr11
|
||||
testReqVRange vr11 (supportedChatVRange PQEncOff)
|
||||
testReqVRange vr11 vr11
|
||||
it "update peer version range on received messages" testUpdatePeerChatVRange
|
||||
describe "network statuses" $ do
|
||||
@@ -2661,8 +2660,8 @@ testConfigureDeliveryReceipts tmp =
|
||||
|
||||
testConnInvChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> FilePath -> IO ()
|
||||
testConnInvChatVRange ct1VRange ct2VRange tmp =
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const ct1VRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const ct2VRange} "bob" bobProfile $ \bob -> do
|
||||
connectUsers alice bob
|
||||
|
||||
alice ##> "/i bob"
|
||||
@@ -2673,8 +2672,8 @@ testConnInvChatVRange ct1VRange ct2VRange tmp =
|
||||
|
||||
testConnReqChatVRange :: HasCallStack => VersionRangeChat -> VersionRangeChat -> FilePath -> IO ()
|
||||
testConnReqChatVRange ct1VRange ct2VRange tmp =
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = ct1VRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = ct2VRange} "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const ct1VRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const ct2VRange} "bob" bobProfile $ \bob -> do
|
||||
alice ##> "/ad"
|
||||
cLink <- getContactLink alice True
|
||||
bob ##> ("/c " <> cLink)
|
||||
@@ -2701,7 +2700,7 @@ testUpdatePeerChatVRange tmp =
|
||||
contactInfoChatVRange alice vr11
|
||||
|
||||
bob ##> "/i alice"
|
||||
contactInfoChatVRange bob supportedChatVRange
|
||||
contactInfoChatVRange bob (supportedChatVRange PQEncOff)
|
||||
|
||||
withTestChat tmp "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
@@ -2710,10 +2709,10 @@ testUpdatePeerChatVRange tmp =
|
||||
alice <# "bob> hello 1"
|
||||
|
||||
alice ##> "/i bob"
|
||||
contactInfoChatVRange alice supportedChatVRange
|
||||
contactInfoChatVRange alice (supportedChatVRange PQEncOff)
|
||||
|
||||
bob ##> "/i alice"
|
||||
contactInfoChatVRange bob supportedChatVRange
|
||||
contactInfoChatVRange bob (supportedChatVRange PQEncOff)
|
||||
|
||||
withTestChatCfg tmp cfg11 "bob" $ \bob -> do
|
||||
bob <## "1 contacts connected (use /cs for the list)"
|
||||
@@ -2725,9 +2724,9 @@ testUpdatePeerChatVRange tmp =
|
||||
contactInfoChatVRange alice vr11
|
||||
|
||||
bob ##> "/i alice"
|
||||
contactInfoChatVRange bob supportedChatVRange
|
||||
contactInfoChatVRange bob (supportedChatVRange PQEncOff)
|
||||
where
|
||||
cfg11 = testCfg {chatVRange = vr11} :: ChatConfig
|
||||
cfg11 = testCfg {chatVRange = const vr11} :: ChatConfig
|
||||
|
||||
testGetNetworkStatuses :: HasCallStack => FilePath -> IO ()
|
||||
testGetNetworkStatuses tmp = do
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE PostfixOperators #-}
|
||||
|
||||
module ChatTests.Groups where
|
||||
@@ -16,6 +17,7 @@ import Simplex.Chat.Protocol (supportedChatVRange)
|
||||
import Simplex.Chat.Store (agentStoreFile, chatStoreFile)
|
||||
import Simplex.Chat.Types (GroupMemberRole (..), VersionRangeChat)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff)
|
||||
import System.Directory (copyFile)
|
||||
import System.FilePath ((</>))
|
||||
import Test.Hspec hiding (it)
|
||||
@@ -147,19 +149,19 @@ chatGroupTests = do
|
||||
it "member was blocked before joining group" testBlockForAllBeforeJoining
|
||||
it "can't repeat block, unblock" testBlockForAllCantRepeat
|
||||
where
|
||||
_0 = supportedChatVRange -- don't create direct connections
|
||||
_0 = supportedChatVRange PQEncOff -- don't create direct connections
|
||||
_1 = groupCreateDirectVRange
|
||||
-- having host configured with older version doesn't have effect in tests
|
||||
-- because host uses current code and sends version in MemberInfo
|
||||
testNoDirect vrMem2 vrMem3 noConns =
|
||||
it
|
||||
( "host "
|
||||
<> vRangeStr supportedChatVRange
|
||||
<> vRangeStr (supportedChatVRange PQEncOff)
|
||||
<> (", 2nd mem " <> vRangeStr vrMem2)
|
||||
<> (", 3rd mem " <> vRangeStr vrMem3)
|
||||
<> (if noConns then " : 2 <!!> 3" else " : 2 <##> 3")
|
||||
)
|
||||
$ testNoGroupDirectConns supportedChatVRange vrMem2 vrMem3 noConns
|
||||
$ testNoGroupDirectConns (supportedChatVRange PQEncOff) vrMem2 vrMem3 noConns
|
||||
|
||||
testGroup :: HasCallStack => FilePath -> IO ()
|
||||
testGroup =
|
||||
@@ -3581,9 +3583,9 @@ testConfigureGroupDeliveryReceipts tmp =
|
||||
|
||||
testNoGroupDirectConns :: HasCallStack => VersionRangeChat -> VersionRangeChat -> VersionRangeChat -> Bool -> FilePath -> IO ()
|
||||
testNoGroupDirectConns hostVRange mem2VRange mem3VRange noDirectConns tmp =
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = hostVRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = mem2VRange} "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = mem3VRange} "cath" cathProfile $ \cath -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const hostVRange} "alice" aliceProfile $ \alice -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const mem2VRange} "bob" bobProfile $ \bob -> do
|
||||
withNewTestChatCfg tmp testCfg {chatVRange = const mem3VRange} "cath" cathProfile $ \cath -> do
|
||||
createGroup3 "team" alice bob cath
|
||||
if noDirectConns
|
||||
then contactsDontExist bob cath
|
||||
|
||||
+14
-14
@@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module ChatTests.Utils where
|
||||
@@ -29,6 +30,7 @@ import Simplex.Chat.Types.Preferences
|
||||
import Simplex.FileTransfer.Client.Main (xftpClientCLI)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (maybeFirstRow, withTransaction)
|
||||
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
|
||||
import Simplex.Messaging.Crypto.Ratchet (pattern PQEncOff)
|
||||
import Simplex.Messaging.Encoding.String
|
||||
import Simplex.Messaging.Version
|
||||
import System.Directory (doesFileExist)
|
||||
@@ -83,23 +85,21 @@ skip = before_ . pendingWith
|
||||
versionTestMatrix2 :: (HasCallStack => TestCC -> TestCC -> IO ()) -> SpecWith FilePath
|
||||
versionTestMatrix2 runTest = do
|
||||
it "current" $ testChat2 aliceProfile bobProfile runTest
|
||||
skip "TODO PQ versioning" $ describe "TODO fails with previous version" $ do
|
||||
it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile runTest
|
||||
it "prev to curr" $ runTestCfg2 testCfg testCfgVPrev runTest
|
||||
it "curr to prev" $ runTestCfg2 testCfgVPrev testCfg runTest
|
||||
it "old (1st supported)" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest
|
||||
it "old to curr" $ runTestCfg2 testCfg testCfgV1 runTest
|
||||
it "curr to old" $ runTestCfg2 testCfgV1 testCfg runTest
|
||||
it "prev" $ testChatCfg2 testCfgVPrev aliceProfile bobProfile runTest
|
||||
it "prev to curr" $ runTestCfg2 testCfg testCfgVPrev runTest
|
||||
it "curr to prev" $ runTestCfg2 testCfgVPrev testCfg runTest
|
||||
it "old (1st supported)" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest
|
||||
it "old to curr" $ runTestCfg2 testCfg testCfgV1 runTest
|
||||
it "curr to old" $ runTestCfg2 testCfgV1 testCfg runTest
|
||||
|
||||
versionTestMatrix3 :: (HasCallStack => TestCC -> TestCC -> TestCC -> IO ()) -> SpecWith FilePath
|
||||
versionTestMatrix3 runTest = do
|
||||
it "current" $ testChat3 aliceProfile bobProfile cathProfile runTest
|
||||
skip "TODO PQ versioning" $ describe "TODO fails with previous version" $ do
|
||||
it "prev" $ testChatCfg3 testCfgVPrev aliceProfile bobProfile cathProfile runTest
|
||||
it "prev to curr" $ runTestCfg3 testCfg testCfgVPrev testCfgVPrev runTest
|
||||
it "curr+prev to curr" $ runTestCfg3 testCfg testCfg testCfgVPrev runTest
|
||||
it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
|
||||
it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest
|
||||
it "prev" $ testChatCfg3 testCfgVPrev aliceProfile bobProfile cathProfile runTest
|
||||
it "prev to curr" $ runTestCfg3 testCfg testCfgVPrev testCfgVPrev runTest
|
||||
it "curr+prev to curr" $ runTestCfg3 testCfg testCfg testCfgVPrev runTest
|
||||
it "curr to prev" $ runTestCfg3 testCfgVPrev testCfg testCfg runTest
|
||||
it "curr+prev to prev" $ runTestCfg3 testCfgVPrev testCfg testCfgVPrev runTest
|
||||
|
||||
runTestCfg2 :: ChatConfig -> ChatConfig -> (HasCallStack => TestCC -> TestCC -> IO ()) -> FilePath -> IO ()
|
||||
runTestCfg2 aliceCfg bobCfg runTest tmp =
|
||||
@@ -584,7 +584,7 @@ checkActionDeletesFile file action = do
|
||||
|
||||
currentChatVRangeInfo :: String
|
||||
currentChatVRangeInfo =
|
||||
"peer chat protocol version range: " <> vRangeStr supportedChatVRange
|
||||
"peer chat protocol version range: " <> vRangeStr (supportedChatVRange PQEncOff)
|
||||
|
||||
vRangeStr :: VersionRange v -> String
|
||||
vRangeStr (VersionRange minVer maxVer) = "(" <> show minVer <> ", " <> show maxVer <> ")"
|
||||
|
||||
@@ -17,7 +17,7 @@ import Data.Text.Encoding (encodeUtf8)
|
||||
import Simplex.Chat.Messages.Batch
|
||||
import Simplex.Chat.Controller (ChatError (..), ChatErrorType (..))
|
||||
import Simplex.Chat.Messages (SndMessage (..))
|
||||
import Simplex.Chat.Protocol (SharedMsgId (..), maxChatMsgSize)
|
||||
import Simplex.Chat.Protocol (SharedMsgId (..), maxRawMsgLength)
|
||||
import Test.Hspec
|
||||
|
||||
batchingTests :: Spec
|
||||
@@ -99,7 +99,7 @@ testImageFitsSingleBatch = do
|
||||
msg s = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = s}
|
||||
batched = "[" <> xMsgNewStr <> "," <> descrStr <> "]"
|
||||
|
||||
runBatcherTest' maxChatMsgSize [msg xMsgNewStr, msg descrStr] [] [batched]
|
||||
runBatcherTest' maxRawMsgLength [msg xMsgNewStr, msg descrStr] [] [batched]
|
||||
|
||||
runBatcherTest :: Int -> [SndMessage] -> [ChatError] -> [ByteString] -> Spec
|
||||
runBatcherTest maxLen msgs expectedErrors expectedBatches =
|
||||
|
||||
@@ -72,12 +72,12 @@ s ==## msg = do
|
||||
|
||||
(##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
|
||||
s ##== msg = do
|
||||
let r = encodeChatMessage msg
|
||||
let r = encodeChatMessage maxEncodedMsgLength msg
|
||||
case r of
|
||||
ECMEncoded encodedBody ->
|
||||
J.eitherDecodeStrict' encodedBody
|
||||
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
|
||||
ECMLarge -> expectationFailure $ "large message"
|
||||
ECMLarge -> expectationFailure "large message"
|
||||
|
||||
(##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
|
||||
s ##==## msg = do
|
||||
@@ -132,7 +132,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
##==## ChatMessage chatInitialVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new chat message with chat version range" $
|
||||
"{\"v\":\"1-7\",\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
|
||||
##==## ChatMessage supportedChatVRange (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
##==## ChatMessage (supportedChatVRange PQEncOff) (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (extMsgContent (MCText "hello") Nothing)))
|
||||
it "x.msg.new quote" $
|
||||
"{\"v\":\"1\",\"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\"}}}}"
|
||||
##==## ChatMessage
|
||||
@@ -242,13 +242,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile}
|
||||
it "x.grp.mem.new with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.new\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile}
|
||||
#==# XGrpMemNew MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile}
|
||||
it "x.grp.mem.intro" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} Nothing
|
||||
it "x.grp.mem.intro with member chat version range" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} Nothing
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile} Nothing
|
||||
it "x.grp.mem.intro with member restrictions" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.intro\",\"params\":{\"memberRestrictions\":{\"restriction\":\"blocked\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemIntro MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} (Just MemberRestrictions {restriction = MRSBlocked})
|
||||
@@ -263,7 +263,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Nothing, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Just testConnReq}
|
||||
it "x.grp.mem.fwd with member chat version range and w/t directConnReq" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.fwd\",\"params\":{\"memberIntro\":{\"groupConnReq\":\"simplex:/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%3D2-3%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"},\"memberInfo\":{\"memberRole\":\"admin\",\"memberId\":\"AQIDBA==\",\"v\":\"1-7\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}}"
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange supportedChatVRange, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
|
||||
#==# XGrpMemFwd MemberInfo {memberId = MemberId "\1\2\3\4", memberRole = GRAdmin, v = Just $ ChatVersionRange $ supportedChatVRange PQEncOff, profile = testProfile} IntroInvitation {groupConnReq = testConnReq, directConnReq = Nothing}
|
||||
it "x.grp.mem.info" $
|
||||
"{\"v\":\"1\",\"event\":\"x.grp.mem.info\",\"params\":{\"memberId\":\"AQIDBA==\",\"profile\":{\"fullName\":\"Alice\",\"displayName\":\"alice\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\",\"preferences\":{\"reactions\":{\"allow\":\"yes\"},\"voice\":{\"allow\":\"yes\"}}}}}"
|
||||
#==# XGrpMemInfo (MemberId "\1\2\3\4") testProfile
|
||||
|
||||
Reference in New Issue
Block a user