core: support inline file transfers (#1187)

* core: support inline file transfers

* parameterize ChatMessage

* send files inline when accepted

* accept inline file transfers (almost works)

* db error SERcvFileInvalid

* inline file transfer works (TODO fix test)

* inline file transfer tests, change encodings

* fixture

* combine messages into x.file.acpt.inv, refactor

* inline file mode

* decide whether to receive file inline on the recipient side, not only via file invitation

* test inline files "sent" mode

* check that file was offered inline

* update schema

* enable encryption tests

* test name

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

* fix the list of rcv files to subscribe too

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin 2022-10-14 13:06:33 +01:00 committed by GitHub
parent f7da034cf1
commit fb03a119ea
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
14 changed files with 1341 additions and 814 deletions

View file

@ -55,6 +55,7 @@ library
Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
Simplex.Chat.Migrations.M20221012_inline_files
Simplex.Chat.Mobile
Simplex.Chat.Options
Simplex.Chat.ProfileGenerator

File diff suppressed because it is too large Load diff

View file

@ -67,12 +67,29 @@ data ChatConfig = ChatConfig
defaultServers :: InitialAgentServers,
tbqSize :: Natural,
fileChunkSize :: Integer,
inlineFiles :: InlineFilesConfig,
subscriptionConcurrency :: Int,
subscriptionEvents :: Bool,
hostEvents :: Bool,
testView :: Bool
}
data InlineFilesConfig = InlineFilesConfig
{ offerChunks :: Integer,
sendChunks :: Integer,
totalSendChunks :: Integer,
receiveChunks :: Integer
}
defaultInlineFilesConfig :: InlineFilesConfig
defaultInlineFilesConfig =
InlineFilesConfig
{ offerChunks = 15, -- max when chunks are offered - limited to 255 on the encoding level
sendChunks = 0, -- max per file when chunks will be sent inline without acceptance
totalSendChunks = 30, -- max per conversation when chunks will be sent inline without acceptance
receiveChunks = 5 -- max when chunks are accepted
}
data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
deriving (Eq)

View file

@ -338,6 +338,8 @@ data CIFileStatus (d :: MsgDirection) where
CIFSRcvComplete :: CIFileStatus 'MDRcv
CIFSRcvCancelled :: CIFileStatus 'MDRcv
deriving instance Eq (CIFileStatus d)
deriving instance Show (CIFileStatus d)
ciFileEnded :: CIFileStatus d -> Bool
@ -836,8 +838,8 @@ instance ChatTypeI 'CTDirect where chatTypeI = SCTDirect
instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup
data NewMessage = NewMessage
{ chatMsgEvent :: ChatMsgEvent,
data NewMessage e = NewMessage
{ chatMsgEvent :: ChatMsgEvent e,
msgBody :: MsgBody
}
deriving (Show)
@ -850,14 +852,14 @@ data SndMessage = SndMessage
data RcvMessage = RcvMessage
{ msgId :: MessageId,
chatMsgEvent :: ChatMsgEvent,
chatMsgEvent :: AChatMsgEvent,
sharedMsgId_ :: Maybe SharedMsgId,
msgBody :: MsgBody
}
data PendingGroupMessage = PendingGroupMessage
{ msgId :: MessageId,
cmEventTag :: CMEventTag,
cmEventTag :: ACMEventTag,
msgBody :: MsgBody,
introId_ :: Maybe Int64
}

View file

@ -0,0 +1,20 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20221012_inline_files where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20221012_inline_files :: Query
m20221012_inline_files =
[sql|
DROP INDEX idx_messages_direct_shared_msg_id;
ALTER TABLE files ADD COLUMN file_inline TEXT;
ALTER TABLE rcv_files ADD COLUMN rcv_file_inline TEXT;
ALTER TABLE rcv_files ADD COLUMN file_inline TEXT;
ALTER TABLE snd_files ADD COLUMN file_inline TEXT;
ALTER TABLE snd_files ADD COLUMN last_inline_msg_delivery_id INTEGER;
CREATE UNIQUE INDEX idx_snd_files_last_inline_msg_delivery_id ON snd_files(last_inline_msg_delivery_id);
|]

View file

@ -182,7 +182,8 @@ CREATE TABLE files(
chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE,
updated_at TEXT CHECK(updated_at NOT NULL),
cancelled INTEGER,
ci_file_status TEXT
ci_file_status TEXT,
file_inline TEXT
);
CREATE TABLE snd_files(
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE,
@ -191,6 +192,8 @@ CREATE TABLE snd_files(
group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL),
file_inline TEXT,
last_inline_msg_delivery_id INTEGER,
PRIMARY KEY(file_id, connection_id)
) WITHOUT ROWID;
CREATE TABLE rcv_files(
@ -200,7 +203,9 @@ CREATE TABLE rcv_files(
file_queue_info BLOB
,
created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_at NOT NULL)
updated_at TEXT CHECK(updated_at NOT NULL),
rcv_file_inline TEXT,
file_inline TEXT
);
CREATE TABLE snd_file_chunks(
file_id INTEGER NOT NULL,
@ -370,11 +375,6 @@ CREATE TABLE smp_servers(
UNIQUE(host, port)
);
CREATE INDEX idx_messages_shared_msg_id ON messages(shared_msg_id);
CREATE UNIQUE INDEX idx_messages_direct_shared_msg_id ON messages(
connection_id,
shared_msg_id_user,
shared_msg_id
);
CREATE INDEX idx_chat_items_shared_msg_id ON chat_items(shared_msg_id);
CREATE TABLE calls(
-- stores call invitations state for communicating state between NSE and app when call notification comes
@ -431,3 +431,6 @@ CREATE INDEX idx_msg_deliveries_message_id ON msg_deliveries(message_id);
CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(
group_id
);
CREATE UNIQUE INDEX idx_snd_files_last_inline_msg_delivery_id ON snd_files(
last_inline_msg_delivery_id
);

View file

@ -9,7 +9,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.Chat.Protocol where
@ -22,19 +24,25 @@ import qualified Data.Aeson.KeyMap as JM
import qualified Data.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A
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 Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime)
import Data.Type.Equality
import Data.Typeable (Typeable)
import Data.Word (Word32)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic)
import Simplex.Chat.Call
import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (fromTextField_, fstToLower, sumTypeJSON)
import Simplex.Messaging.Parsers (fromTextField_, fstToLower, parseAll, sumTypeJSON)
import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
data ConnectionEntity
@ -59,18 +67,64 @@ updateEntityConnStatus connEntity connStatus = case connEntity of
where
st c = c {connStatus}
data MsgEncoding = Binary | Json
data SMsgEncoding (e :: MsgEncoding) where
SBinary :: SMsgEncoding 'Binary
SJson :: SMsgEncoding 'Json
deriving instance Show (SMsgEncoding e)
class MsgEncodingI (e :: MsgEncoding) where
encoding :: SMsgEncoding e
instance MsgEncodingI 'Binary where encoding = SBinary
instance MsgEncodingI 'Json where encoding = SJson
data ACMEventTag = forall e. MsgEncodingI e => ACMEventTag (SMsgEncoding e) (CMEventTag e)
instance TestEquality SMsgEncoding where
testEquality SBinary SBinary = Just Refl
testEquality SJson SJson = Just Refl
testEquality _ _ = Nothing
checkEncoding :: forall t e e'. (MsgEncodingI e, MsgEncodingI e') => t e' -> Either String (t e)
checkEncoding x = case testEquality (encoding @e) (encoding @e') of
Just Refl -> Right x
Nothing -> Left "bad encoding"
data AppMessage (e :: MsgEncoding) where
AMJson :: AppMessageJson -> AppMessage 'Json
AMBinary :: AppMessageBinary -> AppMessage 'Binary
-- chat message is sent as JSON with these properties
data AppMessage = AppMessage
data AppMessageJson = AppMessageJson
{ msgId :: Maybe SharedMsgId,
event :: Text,
params :: J.Object
}
deriving (Generic, FromJSON)
instance ToJSON AppMessage where
data AppMessageBinary = AppMessageBinary
{ msgId :: Maybe SharedMsgId,
tag :: Char,
body :: ByteString
}
instance ToJSON AppMessageJson where
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
instance StrEncoding AppMessageBinary where
strEncode AppMessageBinary {tag, msgId, body} = smpEncode (tag, msgId', Tail body)
where
msgId' = maybe B.empty (\(SharedMsgId mId') -> mId') msgId
strP = do
(tag, msgId', Tail body) <- smpP
let msgId = if B.null msgId' then Nothing else Just (SharedMsgId msgId')
pure AppMessageBinary {tag, msgId, body}
newtype SharedMsgId = SharedMsgId ByteString
deriving (Eq, Show)
@ -105,51 +159,99 @@ instance ToJSON MsgRef where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
data ChatMessage = ChatMessage {msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent}
data ChatMessage e = ChatMessage {msgId :: Maybe SharedMsgId, chatMsgEvent :: ChatMsgEvent e}
deriving (Eq, Show)
instance StrEncoding ChatMessage where
strEncode = LB.toStrict . J.encode . chatToAppMessage
strDecode = appToChatMessage <=< J.eitherDecodeStrict'
strP = strDecode <$?> A.takeByteString
data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
data ChatMsgEvent
= XMsgNew MsgContainer
| XMsgUpdate SharedMsgId MsgContent
| XMsgDel SharedMsgId
| XMsgDeleted
| XFile FileInvitation -- TODO discontinue
| XFileAcpt String -- direct file protocol
| XFileAcptInv SharedMsgId ConnReqInvitation String -- group file protocol
| XFileCancel SharedMsgId
| XInfo Profile
| XContact Profile (Maybe XContactId)
| XGrpInv GroupInvitation
| XGrpAcpt MemberId
| XGrpMemNew MemberInfo
| XGrpMemIntro MemberInfo
| XGrpMemInv MemberId IntroInvitation
| XGrpMemFwd MemberInfo IntroInvitation
| XGrpMemInfo MemberId Profile
| XGrpMemRole MemberId GroupMemberRole
| XGrpMemCon MemberId -- TODO not implemented
| XGrpMemConAll MemberId -- TODO not implemented
| XGrpMemDel MemberId
| XGrpLeave
| XGrpDel
| XGrpInfo GroupProfile
| XInfoProbe Probe
| XInfoProbeCheck ProbeHash
| XInfoProbeOk Probe
| XCallInv CallId CallInvitation
| XCallOffer CallId CallOffer
| XCallAnswer CallId CallAnswer
| XCallExtra CallId CallExtraInfo
| XCallEnd CallId
| XOk
| XUnknown {event :: Text, params :: J.Object}
instance MsgEncodingI e => StrEncoding (ChatMessage e) where
strEncode msg = case chatToAppMessage msg of
AMJson m -> LB.toStrict $ J.encode m
AMBinary m -> strEncode m
strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
instance StrEncoding AChatMessage where
strEncode (ACMsg _ m) = strEncode m
strP =
A.peekChar' >>= \case
'{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
_ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
data ChatMsgEvent (e :: MsgEncoding) where
XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
XMsgUpdate :: SharedMsgId -> MsgContent -> ChatMsgEvent 'Json
XMsgDel :: SharedMsgId -> ChatMsgEvent 'Json
XMsgDeleted :: ChatMsgEvent 'Json
XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue
XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol
XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json
XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
XInfo :: Profile -> ChatMsgEvent 'Json
XContact :: Profile -> Maybe XContactId -> ChatMsgEvent 'Json
XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
XGrpMemIntro :: MemberInfo -> ChatMsgEvent 'Json
XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
XGrpMemCon :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
XGrpMemDel :: MemberId -> ChatMsgEvent 'Json
XGrpLeave :: ChatMsgEvent 'Json
XGrpDel :: ChatMsgEvent 'Json
XGrpInfo :: GroupProfile -> ChatMsgEvent 'Json
XInfoProbe :: Probe -> ChatMsgEvent 'Json
XInfoProbeCheck :: ProbeHash -> ChatMsgEvent 'Json
XInfoProbeOk :: Probe -> ChatMsgEvent 'Json
XCallInv :: CallId -> CallInvitation -> ChatMsgEvent 'Json
XCallOffer :: CallId -> CallOffer -> ChatMsgEvent 'Json
XCallAnswer :: CallId -> CallAnswer -> ChatMsgEvent 'Json
XCallExtra :: CallId -> CallExtraInfo -> ChatMsgEvent 'Json
XCallEnd :: CallId -> ChatMsgEvent 'Json
XOk :: ChatMsgEvent 'Json
XUnknown :: {event :: Text, params :: J.Object} -> ChatMsgEvent 'Json
BFileChunk :: SharedMsgId -> FileChunk -> ChatMsgEvent 'Binary
deriving instance Eq (ChatMsgEvent e)
deriving instance Show (ChatMsgEvent e)
data AChatMsgEvent = forall e. MsgEncodingI e => ACME (SMsgEncoding e) (ChatMsgEvent e)
deriving instance Show AChatMsgEvent
data FileChunk = FileChunk {chunkNo :: Integer, chunkBytes :: ByteString} | FileChunkCancel
deriving (Eq, Show)
instance Encoding FileChunk where
smpEncode = \case
FileChunk {chunkNo, chunkBytes} -> smpEncode ('F', fromIntegral chunkNo :: Word32, Tail chunkBytes)
FileChunkCancel -> smpEncode 'C'
smpP =
smpP >>= \case
'F' -> do
chunkNo <- fromIntegral <$> smpP @Word32
Tail chunkBytes <- smpP
pure FileChunk {chunkNo, chunkBytes}
'C' -> pure FileChunkCancel
_ -> fail "bad FileChunk"
newtype InlineFileChunk = IFC {unIFC :: FileChunk}
instance Encoding InlineFileChunk where
smpEncode (IFC chunk) = case chunk of
FileChunk {chunkNo, chunkBytes} -> smpEncode (w2c $ fromIntegral chunkNo, Tail chunkBytes)
FileChunkCancel -> smpEncode '\NUL'
smpP = do
c <- A.anyChar
IFC <$> case c of
'\NUL' -> pure FileChunkCancel
_ -> do
Tail chunkBytes <- smpP
pure FileChunk {chunkNo = fromIntegral $ c2w c, chunkBytes}
data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent}
deriving (Eq, Show, Generic, FromJSON)
@ -157,9 +259,9 @@ instance ToJSON QuotedMsg where
toEncoding = J.genericToEncoding J.defaultOptions
toJSON = J.genericToJSON J.defaultOptions
cmToQuotedMsg :: ChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg = \case
XMsgNew (MCQuote quotedMsg _) -> Just quotedMsg
ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
_ -> Nothing
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text
@ -273,7 +375,7 @@ msgContainerJSON = \case
where
withFile l = \case
Nothing -> l
Just f -> l <> ["file" .= fileInvitationJSON f]
Just f -> l <> ["file" .= f]
instance ToJSON MsgContent where
toJSON = \case
@ -295,44 +397,48 @@ instance ToField MsgContent where
instance FromField MsgContent where
fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8
data CMEventTag
= XMsgNew_
| XMsgUpdate_
| XMsgDel_
| XMsgDeleted_
| XFile_
| XFileAcpt_
| XFileAcptInv_
| XFileCancel_
| XInfo_
| XContact_
| XGrpInv_
| XGrpAcpt_
| XGrpMemNew_
| XGrpMemIntro_
| XGrpMemInv_
| XGrpMemFwd_
| XGrpMemInfo_
| XGrpMemRole_
| XGrpMemCon_
| XGrpMemConAll_
| XGrpMemDel_
| XGrpLeave_
| XGrpDel_
| XGrpInfo_
| XInfoProbe_
| XInfoProbeCheck_
| XInfoProbeOk_
| XCallInv_
| XCallOffer_
| XCallAnswer_
| XCallExtra_
| XCallEnd_
| XOk_
| XUnknown_ Text
deriving (Eq, Show)
data CMEventTag (e :: MsgEncoding) where
XMsgNew_ :: CMEventTag 'Json
XMsgUpdate_ :: CMEventTag 'Json
XMsgDel_ :: CMEventTag 'Json
XMsgDeleted_ :: CMEventTag 'Json
XFile_ :: CMEventTag 'Json
XFileAcpt_ :: CMEventTag 'Json
XFileAcptInv_ :: CMEventTag 'Json
XFileCancel_ :: CMEventTag 'Json
XInfo_ :: CMEventTag 'Json
XContact_ :: CMEventTag 'Json
XGrpInv_ :: CMEventTag 'Json
XGrpAcpt_ :: CMEventTag 'Json
XGrpMemNew_ :: CMEventTag 'Json
XGrpMemIntro_ :: CMEventTag 'Json
XGrpMemInv_ :: CMEventTag 'Json
XGrpMemFwd_ :: CMEventTag 'Json
XGrpMemInfo_ :: CMEventTag 'Json
XGrpMemRole_ :: CMEventTag 'Json
XGrpMemCon_ :: CMEventTag 'Json
XGrpMemConAll_ :: CMEventTag 'Json
XGrpMemDel_ :: CMEventTag 'Json
XGrpLeave_ :: CMEventTag 'Json
XGrpDel_ :: CMEventTag 'Json
XGrpInfo_ :: CMEventTag 'Json
XInfoProbe_ :: CMEventTag 'Json
XInfoProbeCheck_ :: CMEventTag 'Json
XInfoProbeOk_ :: CMEventTag 'Json
XCallInv_ :: CMEventTag 'Json
XCallOffer_ :: CMEventTag 'Json
XCallAnswer_ :: CMEventTag 'Json
XCallExtra_ :: CMEventTag 'Json
XCallEnd_ :: CMEventTag 'Json
XOk_ :: CMEventTag 'Json
XUnknown_ :: Text -> CMEventTag 'Json
BFileChunk_ :: CMEventTag 'Binary
instance StrEncoding CMEventTag where
deriving instance Show (CMEventTag e)
deriving instance Eq (CMEventTag e)
instance MsgEncodingI e => StrEncoding (CMEventTag e) where
strEncode = \case
XMsgNew_ -> "x.msg.new"
XMsgUpdate_ -> "x.msg.update"
@ -368,45 +474,54 @@ instance StrEncoding CMEventTag where
XCallEnd_ -> "x.call.end"
XOk_ -> "x.ok"
XUnknown_ t -> encodeUtf8 t
strDecode = \case
"x.msg.new" -> Right XMsgNew_
"x.msg.update" -> Right XMsgUpdate_
"x.msg.del" -> Right XMsgDel_
"x.msg.deleted" -> Right XMsgDeleted_
"x.file" -> Right XFile_
"x.file.acpt" -> Right XFileAcpt_
"x.file.acpt.inv" -> Right XFileAcptInv_
"x.file.cancel" -> Right XFileCancel_
"x.info" -> Right XInfo_
"x.contact" -> Right XContact_
"x.grp.inv" -> Right XGrpInv_
"x.grp.acpt" -> Right XGrpAcpt_
"x.grp.mem.new" -> Right XGrpMemNew_
"x.grp.mem.intro" -> Right XGrpMemIntro_
"x.grp.mem.inv" -> Right XGrpMemInv_
"x.grp.mem.fwd" -> Right XGrpMemFwd_
"x.grp.mem.info" -> Right XGrpMemInfo_
"x.grp.mem.role" -> Right XGrpMemRole_
"x.grp.mem.con" -> Right XGrpMemCon_
"x.grp.mem.con.all" -> Right XGrpMemConAll_
"x.grp.mem.del" -> Right XGrpMemDel_
"x.grp.leave" -> Right XGrpLeave_
"x.grp.del" -> Right XGrpDel_
"x.grp.info" -> Right XGrpInfo_
"x.info.probe" -> Right XInfoProbe_
"x.info.probe.check" -> Right XInfoProbeCheck_
"x.info.probe.ok" -> Right XInfoProbeOk_
"x.call.inv" -> Right XCallInv_
"x.call.offer" -> Right XCallOffer_
"x.call.answer" -> Right XCallAnswer_
"x.call.extra" -> Right XCallExtra_
"x.call.end" -> Right XCallEnd_
"x.ok" -> Right XOk_
t -> Right . XUnknown_ $ safeDecodeUtf8 t
BFileChunk_ -> "F"
strDecode = (\(ACMEventTag _ t) -> checkEncoding t) <=< strDecode
strP = strDecode <$?> A.takeTill (== ' ')
toCMEventTag :: ChatMsgEvent -> CMEventTag
toCMEventTag = \case
instance StrEncoding ACMEventTag where
strEncode (ACMEventTag _ t) = strEncode t
strP =
((,) <$> A.peekChar' <*> A.takeTill (== ' ')) >>= \case
('x', t) -> pure . ACMEventTag SJson $ case t of
"x.msg.new" -> XMsgNew_
"x.msg.update" -> XMsgUpdate_
"x.msg.del" -> XMsgDel_
"x.msg.deleted" -> XMsgDeleted_
"x.file" -> XFile_
"x.file.acpt" -> XFileAcpt_
"x.file.acpt.inv" -> XFileAcptInv_
"x.file.cancel" -> XFileCancel_
"x.info" -> XInfo_
"x.contact" -> XContact_
"x.grp.inv" -> XGrpInv_
"x.grp.acpt" -> XGrpAcpt_
"x.grp.mem.new" -> XGrpMemNew_
"x.grp.mem.intro" -> XGrpMemIntro_
"x.grp.mem.inv" -> XGrpMemInv_
"x.grp.mem.fwd" -> XGrpMemFwd_
"x.grp.mem.info" -> XGrpMemInfo_
"x.grp.mem.role" -> XGrpMemRole_
"x.grp.mem.con" -> XGrpMemCon_
"x.grp.mem.con.all" -> XGrpMemConAll_
"x.grp.mem.del" -> XGrpMemDel_
"x.grp.leave" -> XGrpLeave_
"x.grp.del" -> XGrpDel_
"x.grp.info" -> XGrpInfo_
"x.info.probe" -> XInfoProbe_
"x.info.probe.check" -> XInfoProbeCheck_
"x.info.probe.ok" -> XInfoProbeOk_
"x.call.inv" -> XCallInv_
"x.call.offer" -> XCallOffer_
"x.call.answer" -> XCallAnswer_
"x.call.extra" -> XCallExtra_
"x.call.end" -> XCallEnd_
"x.ok" -> XOk_
_ -> XUnknown_ $ safeDecodeUtf8 t
(_, "F") -> pure $ ACMEventTag SBinary BFileChunk_
_ -> fail "bad ACMEventTag"
toCMEventTag :: ChatMsgEvent e -> CMEventTag e
toCMEventTag msg = case msg of
XMsgNew _ -> XMsgNew_
XMsgUpdate _ _ -> XMsgUpdate_
XMsgDel _ -> XMsgDel_
@ -441,18 +556,25 @@ toCMEventTag = \case
XCallEnd _ -> XCallEnd_
XOk -> XOk_
XUnknown t _ -> XUnknown_ t
BFileChunk _ _ -> BFileChunk_
cmEventTagT :: Text -> Maybe CMEventTag
cmEventTagT = eitherToMaybe . strDecode . encodeUtf8
instance MsgEncodingI e => TextEncoding (CMEventTag e) where
textEncode = decodeLatin1 . strEncode
textDecode = eitherToMaybe . strDecode . encodeUtf8
serializeCMEventTag :: CMEventTag -> Text
serializeCMEventTag = decodeLatin1 . strEncode
instance TextEncoding ACMEventTag where
textEncode (ACMEventTag _ t) = textEncode t
textDecode = eitherToMaybe . strDecode . encodeUtf8
instance FromField CMEventTag where fromField = fromTextField_ cmEventTagT
instance (MsgEncodingI e, Typeable e) => FromField (CMEventTag e) where fromField = fromTextField_ textDecode
instance ToField CMEventTag where toField = toField . serializeCMEventTag
instance MsgEncodingI e => ToField (CMEventTag e) where toField = toField . textEncode
hasNotification :: CMEventTag -> Bool
instance FromField ACMEventTag where fromField = fromTextField_ textDecode
instance ToField ACMEventTag where toField = toField . textEncode
hasNotification :: CMEventTag e -> Bool
hasNotification = \case
XMsgNew_ -> True
XFile_ -> True
@ -463,8 +585,18 @@ hasNotification = \case
XCallInv_ -> True
_ -> False
appToChatMessage :: AppMessage -> Either String ChatMessage
appToChatMessage AppMessage {msgId, event, params} = do
appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appBinaryToCM AppMessageBinary {msgId, tag, body} = do
eventTag <- strDecode $ B.singleton tag
chatMsgEvent <- parseAll (msg eventTag) body
pure ChatMessage {msgId, chatMsgEvent}
where
msg :: CMEventTag 'Binary -> A.Parser (ChatMsgEvent 'Binary)
msg = \case
BFileChunk_ -> BFileChunk <$> (SharedMsgId <$> smpP) <*> (unIFC <$> smpP)
appJsonToCM :: AppMessageJson -> Either String (ChatMessage 'Json)
appJsonToCM AppMessageJson {msgId, event, params} = do
eventTag <- strDecode $ encodeUtf8 event
chatMsgEvent <- msg eventTag
pure ChatMessage {msgId, chatMsgEvent}
@ -473,6 +605,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
p key = JT.parseEither (.: key) params
opt :: FromJSON a => J.Key -> Either String (Maybe a)
opt key = JT.parseEither (.:? key) params
msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg = \case
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content"
@ -480,7 +613,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
XMsgDeleted_ -> pure XMsgDeleted
XFile_ -> XFile <$> p "file"
XFileAcpt_ -> XFileAcpt <$> p "fileName"
XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> p "fileConnReq" <*> p "fileName"
XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName"
XFileCancel_ -> XFileCancel <$> p "msgId"
XInfo_ -> XInfo <$> p "profile"
XContact_ -> XContact <$> p "profile" <*> opt "contactReqId"
@ -509,21 +642,29 @@ appToChatMessage AppMessage {msgId, event, params} = do
XOk_ -> pure XOk
XUnknown_ t -> pure $ XUnknown t params
chatToAppMessage :: ChatMessage -> AppMessage
chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, params}
chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
chatToAppMessage ChatMessage {msgId, chatMsgEvent} = case encoding @e of
SBinary ->
let (binaryMsgId, body) = toBody chatMsgEvent
in AMBinary AppMessageBinary {msgId = binaryMsgId, tag = B.head $ strEncode tag, body}
SJson -> AMJson AppMessageJson {msgId, event = textEncode tag, params = params chatMsgEvent}
where
event = serializeCMEventTag . toCMEventTag $ chatMsgEvent
tag = toCMEventTag chatMsgEvent
o :: [(J.Key, J.Value)] -> J.Object
o = JM.fromList
key .=? value = maybe id ((:) . (key .=)) value
params = case chatMsgEvent of
toBody :: ChatMsgEvent 'Binary -> (Maybe SharedMsgId, ByteString)
toBody = \case
BFileChunk (SharedMsgId msgId') chunk -> (Nothing, smpEncode (msgId', IFC chunk))
params :: ChatMsgEvent 'Json -> J.Object
params = \case
XMsgNew container -> msgContainerJSON container
XMsgUpdate msgId' content -> o ["msgId" .= msgId', "content" .= content]
XMsgDel msgId' -> o ["msgId" .= msgId']
XMsgDeleted -> JM.empty
XFile fileInv -> o ["file" .= fileInvitationJSON fileInv]
XFile fileInv -> o ["file" .= fileInv]
XFileAcpt fileName -> o ["fileName" .= fileName]
XFileAcptInv sharedMsgId fileConnReq fileName -> o ["msgId" .= sharedMsgId, "fileConnReq" .= fileConnReq, "fileName" .= fileName]
XFileAcptInv sharedMsgId fileConnReq fileName -> o $ ("fileConnReq" .=? fileConnReq) ["msgId" .= sharedMsgId, "fileName" .= fileName]
XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId]
XInfo profile -> o ["profile" .= profile]
XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["profile" .= profile]
@ -551,8 +692,3 @@ chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, p
XCallEnd callId -> o ["callId" .= callId]
XOk -> JM.empty
XUnknown _ ps -> ps
fileInvitationJSON :: FileInvitation -> J.Object
fileInvitationJSON FileInvitation {fileName, fileSize, fileConnReq} = case fileConnReq of
Nothing -> JM.fromList ["fileName" .= fileName, "fileSize" .= fileSize]
Just fConnReq -> JM.fromList ["fileName" .= fileName, "fileSize" .= fileSize, "fileConnReq" .= fConnReq]

View file

@ -111,11 +111,15 @@ module Simplex.Chat.Store
matchReceivedProbeHash,
matchSentProbe,
mergeContactRecords,
createSndFileTransfer,
createSndDirectFileTransfer,
createSndDirectFTConnection,
createSndGroupFileTransfer,
createSndGroupFileTransferConnection,
createSndDirectInlineFT,
createSndGroupInlineFT,
updateSndDirectFTDelivery,
updateSndGroupFTDelivery,
getSndInlineFTViaMsgDelivery,
updateFileCancelled,
updateCIFileStatus,
getSharedMsgIdByFileId,
@ -132,6 +136,8 @@ module Simplex.Chat.Store
createRcvGroupFileTransfer,
getRcvFileTransfer,
acceptRcvFileTransfer,
acceptRcvInlineFT,
startRcvInlineFT,
updateRcvFileStatus,
createRcvFileChunk,
updatedRcvFileChunkStored,
@ -139,6 +145,7 @@ module Simplex.Chat.Store
updateFileTransferChatItemId,
getFileTransfer,
getFileTransferProgress,
getFileTransferMeta,
getSndFileTransfer,
getContactFileInfo,
getContactMaxItemTs,
@ -270,6 +277,7 @@ import Simplex.Chat.Migrations.M20221001_shared_msg_id_indices
import Simplex.Chat.Migrations.M20221003_delete_broken_integrity_error_chat_items
import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
import Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
import Simplex.Chat.Migrations.M20221012_inline_files
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@ -310,7 +318,8 @@ schemaMigrations =
("20221001_shared_msg_id_indices", m20221001_shared_msg_id_indices),
("20221003_delete_broken_integrity_error_chat_items", m20221003_delete_broken_integrity_error_chat_items),
("20221004_idx_msg_deliveries_message_id", m20221004_idx_msg_deliveries_message_id),
("20221011_user_contact_links_group_id", m20221011_user_contact_links_group_id)
("20221011_user_contact_links_group_id", m20221011_user_contact_links_group_id),
("20221012_inline_files", m20221012_inline_files)
]
-- | The list of migrations in ascending order by date
@ -570,28 +579,28 @@ deleteContactProfile_ db userId contactId =
updateUserProfile :: DB.Connection -> User -> Profile -> ExceptT StoreError IO ()
updateUserProfile db User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName}} p'@Profile {displayName = newName}
| displayName == newName =
liftIO $ updateContactProfile_ db userId profileId p'
liftIO $ updateContactProfile_ db userId profileId p'
| otherwise =
checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute
db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs
checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute
db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs
updateContactProfile :: DB.Connection -> UserId -> Contact -> Profile -> ExceptT StoreError IO Contact
updateContactProfile db userId c@Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} p'@Profile {displayName = newName}
| displayName == newName =
liftIO $ updateContactProfile_ db userId profileId p' $> (c :: Contact) {profile = toLocalProfile profileId p' localAlias}
liftIO $ updateContactProfile_ db userId profileId p' $> (c :: Contact) {profile = toLocalProfile profileId p' localAlias}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do
@ -1057,7 +1066,7 @@ getLiveSndFileTransfers db User {userId} = do
SELECT DISTINCT f.file_id
FROM files f
JOIN snd_files s
WHERE f.user_id = ? AND s.file_status IN (?, ?, ?)
WHERE f.user_id = ? AND s.file_status IN (?, ?, ?) AND s.file_inline IS NULL
|]
(userId, FSNew, FSAccepted, FSConnected)
concatMap (filter liveTransfer) . rights <$> mapM (getSndFileTransfers_ db userId) fileIds
@ -1075,7 +1084,7 @@ getLiveRcvFileTransfers db user@User {userId} = do
SELECT f.file_id
FROM files f
JOIN rcv_files r
WHERE f.user_id = ? AND r.file_status IN (?, ?)
WHERE f.user_id = ? AND r.file_status IN (?, ?) AND r.rcv_file_inline IS NULL
|]
(userId, FSAccepted, FSConnected)
rights <$> mapM (runExceptT . getRcvFileTransfer db user) fileIds
@ -1373,7 +1382,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
DB.query
db
[sql|
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, cs.local_display_name, m.local_display_name
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, cs.local_display_name, m.local_display_name
FROM snd_files s
JOIN files f USING (file_id)
LEFT JOIN contacts cs USING (contact_id)
@ -1381,10 +1390,10 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
|]
(userId, fileId, connId)
sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, contactName_, memberName_) =
sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
case contactName_ <|> memberName_ of
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, recipientDisplayName, connId, agentConnId}
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
Nothing -> Left $ SESndFileInvalid fileId
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
getUserContact_ userContactLinkId = ExceptT $ do
@ -2118,30 +2127,22 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
activeConn = toConnection connRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
createSndFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> IO Int64
createSndFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize} acId chunkSize = do
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
fileId <- insertedRowId db
Connection {connId} <- createSndFileConnection_ db userId fileId acId
let fileStatus = FSNew
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(fileId, fileStatus, connId, currentTs, currentTs)
pure fileId
createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Integer -> IO Int64
createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize} chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
insertedRowId db
forM_ acId_ $ \acId -> do
Connection {connId} <- createSndFileConnection_ db userId fileId acId
let fileStatus = FSNew
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, fileStatus, fileInline, connId, currentTs, currentTs)
pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do
@ -2153,14 +2154,15 @@ createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(fileId, FSAccepted, connId, currentTs, currentTs)
createSndGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> FilePath -> FileInvitation -> Integer -> IO Int64
createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation {fileName, fileSize} chunkSize = do
createSndGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> FilePath -> FileInvitation -> Integer -> IO FileTransferMeta
createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation {fileName, fileSize, fileInline} chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs)
insertedRowId db
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
fileId <- insertedRowId db
pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} = do
@ -2172,6 +2174,63 @@ createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId)
"INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs)
createSndDirectInlineFT :: DB.Connection -> Contact -> FileTransferMeta -> IO SndFileTransfer
createSndDirectInlineFT db Contact {localDisplayName = n, activeConn = Connection {connId, agentConnId}} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do
currentTs <- getCurrentTime
let fileStatus = FSConnected
fileInline' = Just $ fromMaybe (IFMOffer) fileInline
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, fileStatus, fileInline', connId, currentTs, currentTs)
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
createSndGroupInlineFT :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> IO SndFileTransfer
createSndGroupInlineFT db GroupMember {groupMemberId, localDisplayName = n} Connection {connId, agentConnId} FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, fileInline} = do
currentTs <- getCurrentTime
let fileStatus = FSConnected
fileInline' = Just $ fromMaybe (IFMOffer) fileInline
DB.execute
db
"INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(fileId, fileStatus, fileInline', connId, groupMemberId, currentTs, currentTs)
pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName = n, connId, agentConnId, fileStatus, fileInline = fileInline'}
updateSndDirectFTDelivery :: DB.Connection -> Contact -> FileTransferMeta -> Int64 -> IO ()
updateSndDirectFTDelivery db Contact {activeConn = Connection {connId}} FileTransferMeta {fileId} msgDeliveryId =
DB.execute
db
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
(msgDeliveryId, connId, fileId)
updateSndGroupFTDelivery :: DB.Connection -> GroupMember -> Connection -> FileTransferMeta -> Int64 -> IO ()
updateSndGroupFTDelivery db GroupMember {groupMemberId} Connection {connId} FileTransferMeta {fileId} msgDeliveryId =
DB.execute
db
"UPDATE snd_files SET last_inline_msg_delivery_id = ? WHERE group_member_id = ? AND connection_id = ? AND file_id = ? AND file_inline IS NOT NULL"
(msgDeliveryId, groupMemberId, connId, fileId)
getSndInlineFTViaMsgDelivery :: DB.Connection -> User -> Connection -> AgentMsgId -> IO (Maybe SndFileTransfer)
getSndInlineFTViaMsgDelivery db User {userId} Connection {connId, agentConnId} agentMsgId = do
(sndFileTransfer_ <=< listToMaybe)
<$> DB.query
db
[sql|
SELECT s.file_id, s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, c.local_display_name, m.local_display_name
FROM msg_deliveries d
JOIN snd_files s ON s.connection_id = d.connection_id AND s.last_inline_msg_delivery_id = d.msg_delivery_id
JOIN files f ON f.file_id = s.file_id
LEFT JOIN contacts c USING (contact_id)
LEFT JOIN group_members m USING (group_member_id)
WHERE d.connection_id = ? AND d.agent_msg_id = ? AND f.user_id = ? AND s.file_inline IS NOT NULL
|]
(connId, agentMsgId, userId)
where
sndFileTransfer_ :: (Int64, FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe ContactName, Maybe ContactName) -> Maybe SndFileTransfer
sndFileTransfer_ (fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
(\n -> SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName = n, connId, agentConnId})
<$> (contactName_ <|> memberName_)
updateFileCancelled :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateFileCancelled db User {userId} fileId ciFileStatus = do
currentTs <- getCurrentTime
@ -2308,43 +2367,44 @@ deleteSndFileChunks :: DB.Connection -> SndFileTransfer -> IO ()
deleteSndFileChunks db SndFileTransfer {fileId, connId} =
DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Integer -> IO RcvFileTransfer
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize = do
createRcvFileTransfer :: DB.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs)
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db
DB.execute
db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, created_at, updated_at) VALUES (?,?,?,?,?)"
(fileId, FSNew, fileConnReq, currentTs, currentTs)
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing}
"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}
createRcvGroupFileTransfer :: DB.Connection -> UserId -> GroupMember -> FileInvitation -> Integer -> IO RcvFileTransfer
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize = do
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
currentTs <- getCurrentTime
DB.execute
db
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs)
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, file_inline, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)"
(userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db
DB.execute
db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, FSNew, fileConnReq, groupMemberId, currentTs, currentTs)
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId}
"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}
getRcvFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer db User {userId} fileId =
ExceptT . firstRow' rcvFileTransfer (SERcvFileNotFound fileId) $
DB.query
db
[sql|
getRcvFileTransfer db user@User {userId} fileId = do
rftRow <-
ExceptT . firstRow id (SERcvFileNotFound fileId) $
DB.query
db
[sql|
SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name,
f.file_size, f.chunk_size, f.cancelled, cs.local_display_name, m.local_display_name,
f.file_path, c.connection_id, c.agent_conn_id
f.file_size, f.chunk_size, f.cancelled, cs.contact_id, cs.local_display_name, m.group_id, m.group_member_id, m.local_display_name,
f.file_path, r.file_inline, r.rcv_file_inline, c.connection_id, c.agent_conn_id
FROM rcv_files r
JOIN files f USING (file_id)
LEFT JOIN connections c ON r.file_id = c.rcv_file_id
@ -2352,35 +2412,62 @@ getRcvFileTransfer db User {userId} fileId =
LEFT JOIN group_members m USING (group_member_id)
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
(userId, fileId)
rcvFileTransfer rftRow
where
rcvFileTransfer ::
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe AgentConnId) ->
Either StoreError RcvFileTransfer
rcvFileTransfer (fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_, contactName_, memberName_, filePath_, connId_, agentConnId_) =
let fileInv = FileInvitation {fileName, fileSize, fileConnReq}
fileInfo = (filePath_, connId_, agentConnId_)
in case contactName_ <|> memberName_ of
Nothing -> Left $ SERcvFileInvalid fileId
Just name ->
case fileStatus' of
FSNew -> ft name fileInv RFSNew
FSAccepted -> ft name fileInv . RFSAccepted =<< rfi fileInfo
FSConnected -> ft name fileInv . RFSConnected =<< rfi fileInfo
FSComplete -> ft name fileInv . RFSComplete =<< rfi fileInfo
FSCancelled -> ft name fileInv . RFSCancelled $ rfi_ fileInfo
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool) :. (Maybe Int64, Maybe ContactName, Maybe Int64, Maybe Int64, Maybe ContactName, Maybe FilePath, Maybe InlineFileMode, Maybe InlineFileMode) :. (Maybe Int64, Maybe AgentConnId) ->
ExceptT StoreError IO RcvFileTransfer
rcvFileTransfer ((fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_) :. (contactId_, contactName_, groupId_, groupMemberId_, memberName_, filePath_, fileInline, rcvFileInline) :. (connId_, agentConnId_)) = do
let fileInv = FileInvitation {fileName, fileSize, fileConnReq, fileInline}
fileInfo = (filePath_, connId_, agentConnId_, contactId_, groupId_, groupMemberId_, isJust fileInline)
case contactName_ <|> memberName_ of
Nothing -> throwError $ SERcvFileInvalid fileId
Just name -> do
case fileStatus' of
FSNew -> pure $ ft name fileInv RFSNew
FSAccepted -> ft name fileInv . RFSAccepted <$> rfi fileInfo
FSConnected -> ft name fileInv . RFSConnected <$> rfi fileInfo
FSComplete -> ft name fileInv . RFSComplete <$> rfi fileInfo
FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
where
ft senderDisplayName fileInvitation fileStatus =
Right RcvFileTransfer {fileId, fileInvitation, fileStatus, senderDisplayName, chunkSize, cancelled, grpMemberId}
rfi fileInfo = maybe (Left $ SERcvFileInvalid fileId) Right $ rfi_ fileInfo
RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
rfi_ = \case
(Just filePath, Just connId, Just agentConnId) -> Just RcvFileInfo {filePath, connId, agentConnId}
_ -> Nothing
(Just filePath, Just connId, Just agentConnId, _, _, _, _) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
(Just filePath, Nothing, Nothing, Just contactId, _, _, True) -> do
Contact {activeConn = Connection {connId, agentConnId}} <- getContact db userId contactId
pure $ Just RcvFileInfo {filePath, connId, agentConnId}
(Just filePath, Nothing, Nothing, _, Just groupId, Just groupMemberId, True) -> do
getGroupMember db user groupId groupMemberId >>= \case
GroupMember {activeConn = Just Connection {connId, agentConnId}} ->
pure $ Just RcvFileInfo {filePath, connId, agentConnId}
_ -> pure Nothing
_ -> pure Nothing
cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> ConnId -> ConnStatus -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db user@User {userId} fileId agentConnId connStatus filePath = ExceptT $ do
currentTs <- getCurrentTime
acceptRcvFT_ db user fileId filePath currentTs
DB.execute
db
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(agentConnId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs)
runExceptT $ getChatItemByFileId db user fileId
acceptRcvInlineFT :: DB.Connection -> User -> Int64 -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvInlineFT db user fileId filePath = do
liftIO $ acceptRcvFT_ db user fileId filePath =<< getCurrentTime
getChatItemByFileId db user fileId
startRcvInlineFT :: DB.Connection -> User -> RcvFileTransfer -> FilePath -> IO ()
startRcvInlineFT db user RcvFileTransfer {fileId} filePath =
acceptRcvFT_ db user fileId filePath =<< getCurrentTime
acceptRcvFT_ :: DB.Connection -> User -> Int64 -> FilePath -> UTCTime -> IO ()
acceptRcvFT_ db User {userId} fileId filePath currentTs = do
DB.execute
db
"UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?"
@ -2389,11 +2476,6 @@ acceptRcvFileTransfer db user@User {userId} fileId agentConnId connStatus filePa
db
"UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?"
(FSAccepted, currentTs, fileId)
DB.execute
db
"INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(agentConnId, connStatus, ConnRcvFile, fileId, userId, currentTs, currentTs)
runExceptT $ getChatItemByFileId db user fileId
updateRcvFileStatus :: DB.Connection -> RcvFileTransfer -> FileStatus -> IO ()
updateRcvFileStatus db RcvFileTransfer {fileId} status = do
@ -2416,20 +2498,20 @@ createRcvFileChunk db RcvFileTransfer {fileId, fileInvitation = FileInvitation {
pure $ case map fromOnly ns of
[]
| chunkNo == 1 ->
if chunkSize >= fileSize
then RcvChunkFinal
else RcvChunkOk
if chunkSize >= fileSize
then RcvChunkFinal
else RcvChunkOk
| otherwise -> RcvChunkError
n : _
| chunkNo == n -> RcvChunkDuplicate
| chunkNo == n + 1 ->
let prevSize = n * chunkSize
in if prevSize >= fileSize
then RcvChunkError
else
if prevSize + chunkSize >= fileSize
then RcvChunkFinal
else RcvChunkOk
let prevSize = n * chunkSize
in if prevSize >= fileSize
then RcvChunkError
else
if prevSize + chunkSize >= fileSize
then RcvChunkFinal
else RcvChunkOk
| otherwise -> RcvChunkError
updatedRcvFileChunkStored :: DB.Connection -> RcvFileTransfer -> Integer -> IO ()
@ -2485,18 +2567,18 @@ getFileTransfer db user@User {userId} fileId =
(userId, fileId)
getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer db User {userId} fileId = do
fileTransferMeta <- ExceptT $ getFileTransferMeta_ db userId fileId
getSndFileTransfer db user@User {userId} fileId = do
fileTransferMeta <- getFileTransferMeta db user fileId
sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId
pure (fileTransferMeta, sndFileTransfers)
getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ db userId fileId =
sndFileTransfers
mapM sndFileTransfer
<$> DB.query
db
[sql|
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.connection_id, c.agent_conn_id,
SELECT s.file_status, f.file_name, f.file_size, f.chunk_size, f.file_path, s.file_inline, s.connection_id, c.agent_conn_id,
cs.local_display_name, m.local_display_name
FROM snd_files s
JOIN files f USING (file_id)
@ -2507,29 +2589,27 @@ getSndFileTransfers_ db userId fileId =
|]
(userId, fileId)
where
sndFileTransfers :: [(FileStatus, String, Integer, Integer, FilePath, Int64, AgentConnId, Maybe ContactName, Maybe ContactName)] -> Either StoreError [SndFileTransfer]
sndFileTransfers [] = Right []
sndFileTransfers fts = mapM sndFileTransfer fts
sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, connId, agentConnId, contactName_, memberName_) =
sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, connId, agentConnId, contactName_, memberName_) =
case contactName_ <|> memberName_ of
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, recipientDisplayName, connId, agentConnId}
Just recipientDisplayName -> Right SndFileTransfer {fileId, fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, recipientDisplayName, connId, agentConnId}
Nothing -> Left $ SESndFileInvalid fileId
getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError FileTransferMeta)
getFileTransferMeta_ db userId fileId =
firstRow fileTransferMeta (SEFileNotFound fileId) $
getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta db User {userId} fileId =
ExceptT . firstRow fileTransferMeta (SEFileNotFound fileId) $
DB.query
db
[sql|
SELECT f.file_name, f.file_size, f.chunk_size, f.file_path, f.cancelled
SELECT f.file_name, f.file_size, f.chunk_size, f.file_path, f.file_inline, f.cancelled
FROM files f
WHERE f.user_id = ? AND f.file_id = ?
|]
(userId, fileId)
where
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe Bool) -> FileTransferMeta
fileTransferMeta (fileName, fileSize, chunkSize, filePath, cancelled_) =
FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, cancelled = fromMaybe False cancelled_}
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe Bool) -> FileTransferMeta
fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, cancelled_) =
FileTransferMeta {fileId, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo db User {userId} Contact {contactId} =
@ -2601,7 +2681,7 @@ updateGroupTs db User {userId} GroupInfo {groupId} updatedAt =
"UPDATE groups SET updated_at = ? WHERE user_id = ? AND group_id = ?"
(updatedAt, userId, groupId)
createNewSndMessage :: DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> NewMessage) -> ExceptT StoreError IO SndMessage
createNewSndMessage :: MsgEncodingI e => DB.Connection -> TVar ChaChaDRG -> ConnOrGroupId -> (SharedMsgId -> NewMessage e) -> ExceptT StoreError IO SndMessage
createNewSndMessage db gVar connOrGroupId mkMessage =
createWithRandomId gVar $ \sharedMsgId -> do
let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
@ -2622,13 +2702,14 @@ createNewSndMessage db gVar connOrGroupId mkMessage =
ConnectionId connId -> (Just connId, Nothing)
GroupId groupId -> (Nothing, Just groupId)
createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO ()
createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
createSndMsgDelivery db sndMsgDelivery messageId = do
currentTs <- getCurrentTime
msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs
createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent currentTs
pure msgDeliveryId
createNewMessageAndRcvMsgDelivery :: DB.Connection -> ConnOrGroupId -> NewMessage -> Maybe SharedMsgId -> RcvMsgDelivery -> IO RcvMessage
createNewMessageAndRcvMsgDelivery :: forall e. MsgEncodingI e => DB.Connection -> ConnOrGroupId -> NewMessage e -> Maybe SharedMsgId -> RcvMsgDelivery -> IO RcvMessage
createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} = do
currentTs <- getCurrentTime
DB.execute
@ -2642,7 +2723,7 @@ createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msg
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
msgDeliveryId <- insertedRowId db
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
pure RcvMessage {msgId, chatMsgEvent, sharedMsgId_, msgBody}
pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody}
where
(connId_, groupId_) = case connOrGroupId of
ConnectionId connId' -> (Just connId', Nothing)
@ -3382,14 +3463,14 @@ getGroupInfo db User {userId, userContactId} groupId =
updateGroupProfile :: DB.Connection -> User -> GroupInfo -> GroupProfile -> ExceptT StoreError IO GroupInfo
updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, image}
| displayName == newName = liftIO $ do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs
updateGroup_ ldn currentTs
pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p'}
updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs
updateGroup_ ldn currentTs
pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p'}
where
updateGroupProfile_ currentTs =
DB.execute

View file

@ -613,7 +613,8 @@ data SndFileTransfer = SndFileTransfer
recipientDisplayName :: ContactName,
connId :: Int64,
agentConnId :: AgentConnId,
fileStatus :: FileStatus
fileStatus :: FileStatus,
fileInline :: Maybe InlineFileMode
}
deriving (Eq, Show, Generic)
@ -627,16 +628,48 @@ type FileTransferId = Int64
data FileInvitation = FileInvitation
{ fileName :: String,
fileSize :: Integer,
fileConnReq :: Maybe ConnReqInvitation
fileConnReq :: Maybe ConnReqInvitation,
fileInline :: Maybe InlineFileMode
}
deriving (Eq, Show, Generic, FromJSON)
deriving (Eq, Show, Generic)
instance ToJSON FileInvitation where toEncoding = J.genericToEncoding J.defaultOptions
instance ToJSON FileInvitation where
toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
instance FromJSON FileInvitation where
parseJSON = J.genericParseJSON J.defaultOptions {J.omitNothingFields = True}
data InlineFileMode
= IFMOffer -- file will be sent inline once accepted
| IFMSent -- file is sent inline without acceptance
deriving (Eq, Show, Generic)
instance TextEncoding InlineFileMode where
textEncode = \case
IFMOffer -> "offer"
IFMSent -> "sent"
textDecode = \case
"offer" -> Just IFMOffer
"sent" -> Just IFMSent
_ -> Nothing
instance FromField InlineFileMode where fromField = fromTextField_ textDecode
instance ToField InlineFileMode where toField = toField . textEncode
instance FromJSON InlineFileMode where
parseJSON = J.withText "InlineFileMode" $ maybe (fail "bad InlineFileMode") pure . textDecode
instance ToJSON InlineFileMode where
toJSON = J.String . textEncode
toEncoding = JE.text . textEncode
data RcvFileTransfer = RcvFileTransfer
{ fileId :: FileTransferId,
fileInvitation :: FileInvitation,
fileStatus :: RcvFileStatus,
rcvFileInline :: Maybe InlineFileMode,
senderDisplayName :: ContactName,
chunkSize :: Integer,
cancelled :: Bool,
@ -724,6 +757,7 @@ data FileTransferMeta = FileTransferMeta
fileName :: String,
filePath :: String,
fileSize :: Integer,
fileInline :: Maybe InlineFileMode,
chunkSize :: Integer,
cancelled :: Bool
}

View file

@ -241,7 +241,7 @@ showSMPServer = B.unpack . strEncode . host
viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h)
viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString]
viewChatItem :: forall c d. MsgDirectionI d => ChatInfo c -> ChatItem c d -> Bool -> [StyledString]
viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of
DirectChat c -> case chatDir of
CIDirectSnd -> case content of
@ -714,9 +714,9 @@ viewContactUpdated
| n == n' && fullName == fullName' = []
| n == n' = ["contact " <> ttyContact n <> fullNameUpdate]
| otherwise =
[ "contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName',
"use " <> ttyToContact n' <> highlight' "<message>" <> " to send messages"
]
[ "contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName',
"use " <> ttyToContact n' <> highlight' "<message>" <> " to send messages"
]
where
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName'
@ -748,9 +748,14 @@ viewSentBroadcast :: MsgContent -> Int -> ZonedTime -> [StyledString]
viewSentBroadcast mc n ts = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts <> " ") (ttyMsgContent mc)
viewSentFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString]
viewSentFileInvitation to CIFile {fileId, filePath} = case filePath of
Just fPath -> sentWithTime_ $ ttySentFile to fileId fPath
viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} = case filePath of
Just fPath -> sentWithTime_ $ ttySentFile fPath
_ -> const []
where
ttySentFile fPath = ["/f " <> to <> ttyFilePath fPath] <> cancelSending
cancelSending = case fileStatus of
CIFSSndTransfer -> []
_ -> ["use " <> highlight ("/fc " <> show fileId) <> " to cancel sending"]
sentWithTime_ :: [StyledString] -> CIMeta d -> [StyledString]
sentWithTime_ styledMsg CIMeta {localItemTs} =
@ -762,9 +767,6 @@ ttyMsgTime = styleTime . formatTime defaultTimeLocale "%H:%M"
ttyMsgContent :: MsgContent -> [StyledString]
ttyMsgContent = msgPlain . msgContentText
ttySentFile :: StyledString -> FileTransferId -> FilePath -> [StyledString]
ttySentFile to fId fPath = ["/f " <> to <> ttyFilePath fPath, "use " <> highlight ("/fc " <> show fId) <> " to cancel sending"]
prependFirst :: StyledString -> [StyledString] -> [StyledString]
prependFirst s [] = [s]
prependFirst s (s' : ss) = (s <> s') : ss
@ -793,21 +795,11 @@ viewReceivedFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledStr
viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file)
receivedFileInvitation_ :: CIFile d -> [StyledString]
receivedFileInvitation_ CIFile {fileId, fileName, fileSize} =
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
-- below is printed for auto-accepted files as well; auto-accept is disabled in terminal though so in reality it never happens
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
]
-- TODO remove
viewReceivedFileInvitation' :: StyledString -> RcvFileTransfer -> CIMeta d -> [StyledString]
viewReceivedFileInvitation' from RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} meta = receivedWithTime_ from [] meta (receivedFileInvitation_' fileId fileName fileSize)
receivedFileInvitation_' :: Int64 -> String -> Integer -> [StyledString]
receivedFileInvitation_' fileId fileName fileSize =
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)",
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"
]
receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} =
["sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)"]
<> case fileStatus of
CIFSRcvAccepted -> []
_ -> ["use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it"]
humanReadableSize :: Integer -> StyledString
humanReadableSize size
@ -849,9 +841,8 @@ fileTransferStr fileId fileName = "file " <> sShow fileId <> " (" <> ttyFilePath
viewFileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
viewFileTransferStatus (FTSnd FileTransferMeta {fileId, fileName, cancelled} [], _) =
[ "sending " <> fileTransferStr fileId fileName <> ": no file transfers"
<> if cancelled then ", file transfer cancelled" else ""
]
["sending " <> fileTransferStr fileId fileName <> ": no file transfers"]
<> ["file transfer cancelled" | cancelled]
viewFileTransferStatus (FTSnd FileTransferMeta {cancelled} fts@(ft : _), chunksNum) =
recipientStatuses <> ["file transfer cancelled" | cancelled]
where
@ -978,7 +969,7 @@ viewChatError = \case
CEGroupCantResendInvitation g c -> viewCannotResendInvitation g c
CEGroupInternal s -> ["chat group bug: " <> plain s]
CEFileNotFound f -> ["file not found: " <> plain f]
CEFileAlreadyReceiving f -> ["file is already accepted: " <> plain f]
CEFileAlreadyReceiving f -> ["file is already being received: " <> plain f]
CEFileCancelled f -> ["file cancelled: " <> plain f]
CEFileAlreadyExists f -> ["file already exists: " <> plain f]
CEFileRead f e -> ["cannot read file " <> plain f, sShow e]

View file

@ -13,6 +13,7 @@ import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Exception (bracket, bracket_)
import Control.Monad.Except
import Data.Functor (($>))
import Data.List (dropWhileEnd, find)
import Data.Maybe (fromJust, isNothing)
import qualified Data.Text as T
@ -145,7 +146,11 @@ withNewTestChatOpts :: ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
withNewTestChatOpts = withNewTestChatCfgOpts testCfg
withNewTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
withNewTestChatCfgOpts cfg opts dbPrefix profile = bracket (createTestChat cfg opts dbPrefix profile) (\cc -> cc <// 100000 >> stopTestChat cc)
withNewTestChatCfgOpts cfg opts dbPrefix profile runTest =
bracket
(createTestChat cfg opts dbPrefix profile)
stopTestChat
(\cc -> runTest cc >>= ((cc <// 100000) $>))
withTestChatV1 :: String -> (TestCC -> IO a) -> IO a
withTestChatV1 = withTestChatCfg testCfgV1

View file

@ -1,7 +1,9 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ChatTests where
@ -9,15 +11,18 @@ import ChatClient
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_)
import Control.Concurrent.STM
import Control.Monad (forM_, when)
import Control.Monad (forM_, unless, when)
import Data.Aeson (ToJSON)
import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (isDigit)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.String
import qualified Data.Text as T
import Simplex.Chat.Call
import Simplex.Chat.Controller (ChatController (..))
import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig)
import Simplex.Chat.Options (ChatOpts (..))
import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), ImageData (..), LocalProfile (..), Profile (..), User (..))
import Simplex.Messaging.Encoding.String
@ -66,15 +71,17 @@ chatTests = do
it "update user profiles and notify contacts" testUpdateProfile
it "update user profile with image" testUpdateProfileImage
describe "sending and receiving files" $ do
it "send and receive file" testFileTransfer
it "send and receive a small file" testSmallFileTransfer
it "sender cancelled file transfer before transfer" testFileSndCancelBeforeTransfer
describe "send and receive file" $ fileTestMatrix2 runTestFileTransfer
it "send and receive file inline (without accepting)" testInlineFileTransfer
describe "send and receive a small file" $ fileTestMatrix2 runTestSmallFileTransfer
describe "sender cancelled file transfer before transfer" $ fileTestMatrix2 runTestFileSndCancelBeforeTransfer
it "sender cancelled file transfer during transfer" testFileSndCancelDuringTransfer
it "recipient cancelled file transfer" testFileRcvCancel
it "send and receive file to group" testGroupFileTransfer
it "sender cancelled group file transfer before transfer" testGroupFileSndCancelBeforeTransfer
describe "send and receive file to group" $ fileTestMatrix3 runTestGroupFileTransfer
it "send and receive file inline to group (without accepting)" testInlineGroupFileTransfer
describe "sender cancelled group file transfer before transfer" $ fileTestMatrix3 runTestGroupFileSndCancelBeforeTransfer
describe "messages with files" $ do
it "send and receive message with file" testMessageWithFile
describe "send and receive message with file" $ fileTestMatrix2 runTestMessageWithFile
it "send and receive image" testSendImage
it "files folder: send and receive image" testFilesFoldersSendImage
it "files folder: sender deleted file during transfer" testFilesFoldersImageSndDelete
@ -133,40 +140,56 @@ versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
versionTestMatrix2 runTest = do
it "v2" $ testChat2 aliceProfile bobProfile runTest
it "v1" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest
it "v1 to v2" . withTmpFiles $
withNewTestChat "alice" aliceProfile $ \alice ->
withNewTestChatV1 "bob" bobProfile $ \bob ->
runTest alice bob
it "v2 to v1" . withTmpFiles $
withNewTestChatV1 "alice" aliceProfile $ \alice ->
withNewTestChat "bob" bobProfile $ \bob ->
runTest alice bob
it "v1 to v2" $ runTestCfg2 testCfg testCfgV1 runTest
it "v2 to v1" $ runTestCfg2 testCfgV1 testCfg runTest
versionTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec
versionTestMatrix3 runTest = do
it "v2" $ testChat3 aliceProfile bobProfile cathProfile runTest
-- it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile runTest
-- it "v1 to v2" . withTmpFiles $
-- withNewTestChat "alice" aliceProfile $ \alice ->
-- withNewTestChatV1 "bob" bobProfile $ \bob ->
-- withNewTestChatV1 "cath" cathProfile $ \cath ->
-- runTest alice bob cath
-- it "v2+v1 to v2" . withTmpFiles $
-- withNewTestChat "alice" aliceProfile $ \alice ->
-- withNewTestChat "bob" bobProfile $ \bob ->
-- withNewTestChatV1 "cath" cathProfile $ \cath ->
-- runTest alice bob cath
-- it "v2 to v1" . withTmpFiles $
-- withNewTestChatV1 "alice" aliceProfile $ \alice ->
-- withNewTestChat "bob" bobProfile $ \bob ->
-- withNewTestChat "cath" cathProfile $ \cath ->
-- runTest alice bob cath
-- it "v2+v1 to v1" . withTmpFiles $
-- withNewTestChatV1 "alice" aliceProfile $ \alice ->
-- withNewTestChat "bob" bobProfile $ \bob ->
-- withNewTestChatV1 "cath" cathProfile $ \cath ->
-- runTest alice bob cath
-- it "v1 to v2" $ runTestCfg3 testCfg testCfgV1 testCfgV1 runTest
-- it "v2+v1 to v2" $ runTestCfg3 testCfg testCfg testCfgV1 runTest
-- it "v2 to v1" $ runTestCfg3 testCfgV1 testCfg testCfg runTest
-- it "v2+v1 to v1" $ runTestCfg3 testCfgV1 testCfg testCfgV1 runTest
inlineCfg :: Integer -> ChatConfig
inlineCfg n = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = n, receiveChunks = n}}
fileTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
fileTestMatrix2 runTest = do
it "via connection" $ runTestCfg2 viaConn viaConn runTest
it "inline (accepting)" $ runTestCfg2 inline inline runTest
it "via connection (inline offered)" $ runTestCfg2 inline viaConn runTest
it "via connection (inline supported)" $ runTestCfg2 viaConn inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
fileTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec
fileTestMatrix3 runTest = do
it "via connection" $ runTestCfg3 viaConn viaConn viaConn runTest
it "inline" $ runTestCfg3 inline inline inline runTest
it "via connection (inline offered)" $ runTestCfg3 inline viaConn viaConn runTest
it "via connection (inline supported)" $ runTestCfg3 viaConn inline inline runTest
where
inline = inlineCfg 100
viaConn = inlineCfg 0
runTestCfg2 :: ChatConfig -> ChatConfig -> (TestCC -> TestCC -> IO ()) -> IO ()
runTestCfg2 aliceCfg bobCfg runTest =
withTmpFiles $
withNewTestChatCfg aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg bobCfg "bob" bobProfile $ \bob ->
runTest alice bob
runTestCfg3 :: ChatConfig -> ChatConfig -> ChatConfig -> (TestCC -> TestCC -> TestCC -> IO ()) -> IO ()
runTestCfg3 aliceCfg bobCfg cathCfg runTest =
withTmpFiles $
withNewTestChatCfg aliceCfg "alice" aliceProfile $ \alice ->
withNewTestChatCfg bobCfg "bob" bobProfile $ \bob ->
withNewTestChatCfg cathCfg "cath" cathProfile $ \cath ->
runTest alice bob cath
testAddContact :: Spec
testAddContact = versionTestMatrix2 runTestAddContact
@ -1351,68 +1374,88 @@ testUpdateProfileImage =
bob <## "use @alice2 <message> to send messages"
(bob </)
testFileTransfer :: IO ()
testFileTransfer =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
startFileTransfer alice bob
concurrentlyN_
[ do
bob #> "@alice receiving here..."
bob <## "completed receiving file 1 (test.jpg) from alice",
do
alice <# "bob> receiving here..."
alice <## "completed sending file 1 (test.jpg) to bob"
]
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
runTestFileTransfer :: TestCC -> TestCC -> IO ()
runTestFileTransfer alice bob = do
connectUsers alice bob
startFileTransfer' alice bob "test.pdf" "266.0 KiB / 272376 bytes"
concurrentlyN_
[ do
bob #> "@alice receiving here..."
bob <## "completed receiving file 1 (test.pdf) from alice",
alice
<### [ WithTime "bob> receiving here...",
"completed sending file 1 (test.pdf) to bob"
]
]
src <- B.readFile "./tests/fixtures/test.pdf"
dest <- B.readFile "./tests/tmp/test.pdf"
dest `shouldBe` src
testSmallFileTransfer :: IO ()
testSmallFileTransfer =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.txt"
concurrentlyN_
[ do
bob <## "started receiving file 1 (test.txt) from alice"
bob <## "completed receiving file 1 (test.txt) from alice",
do
alice <## "started sending file 1 (test.txt) to bob"
alice <## "completed sending file 1 (test.txt) to bob"
]
src <- B.readFile "./tests/fixtures/test.txt"
dest <- B.readFile "./tests/tmp/test.txt"
dest `shouldBe` src
testInlineFileTransfer :: IO ()
testInlineFileTransfer =
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
connectUsers alice bob
bob ##> "/_files_folder ./tests/tmp/"
bob <## "ok"
alice #> "/f @bob ./tests/fixtures/test.jpg"
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
-- below is not shown in "sent" mode
-- bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <## "started receiving file 1 (test.jpg) from alice"
concurrently_
(alice <## "completed sending file 1 (test.jpg) to bob")
(bob <## "completed receiving file 1 (test.jpg) from alice")
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
where
cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}}
testFileSndCancelBeforeTransfer :: IO ()
testFileSndCancelBeforeTransfer =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
alice ##> "/fc 1"
concurrentlyN_
[ alice <## "cancelled sending file 1 (test.txt) to bob",
bob <## "alice cancelled sending file 1 (test.txt)"
]
alice ##> "/fs 1"
alice <## "sending file 1 (test.txt) cancelled: bob"
alice <## "file transfer cancelled"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.txt) cancelled"
bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.txt"
runTestSmallFileTransfer :: TestCC -> TestCC -> IO ()
runTestSmallFileTransfer alice bob = do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.txt"
concurrentlyN_
[ do
bob <## "started receiving file 1 (test.txt) from alice"
bob <## "completed receiving file 1 (test.txt) from alice",
do
alice <## "started sending file 1 (test.txt) to bob"
alice <## "completed sending file 1 (test.txt) to bob"
]
src <- B.readFile "./tests/fixtures/test.txt"
dest <- B.readFile "./tests/tmp/test.txt"
dest `shouldBe` src
runTestFileSndCancelBeforeTransfer :: TestCC -> TestCC -> IO ()
runTestFileSndCancelBeforeTransfer alice bob = do
connectUsers alice bob
alice #> "/f @bob ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
alice ##> "/fc 1"
concurrentlyN_
[ alice <##. "cancelled sending file 1 (test.txt)",
bob <## "alice cancelled sending file 1 (test.txt)"
]
alice ##> "/fs 1"
alice
<##.. [ "sending file 1 (test.txt): no file transfers",
"sending file 1 (test.txt) cancelled: bob"
]
alice <## "file transfer cancelled"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.txt) cancelled"
bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.txt"
testFileSndCancelDuringTransfer :: IO ()
testFileSndCancelDuringTransfer =
@ -1456,101 +1499,138 @@ testFileRcvCancel =
]
checkPartialTransfer "test.jpg"
testGroupFileTransfer :: IO ()
testGroupFileTransfer =
testChat3 aliceProfile bobProfile cathProfile $
runTestGroupFileTransfer :: TestCC -> TestCC -> TestCC -> IO ()
runTestGroupFileTransfer alice bob cath = do
createGroup3 "team" alice bob cath
alice #> "/f #team ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
do
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg): no file transfers")
bob ##> "/fr 1 ./tests/tmp/"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
concurrentlyN_
[ do
alice <## "started sending file 1 (test.jpg) to bob"
alice <## "completed sending file 1 (test.jpg) to bob"
alice ##> "/fs 1"
alice <## "sending file 1 (test.jpg) complete: bob",
do
bob <## "started receiving file 1 (test.jpg) from alice"
bob <## "completed receiving file 1 (test.jpg) from alice"
]
cath ##> "/fr 1 ./tests/tmp/"
cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
concurrentlyN_
[ do
alice <## "started sending file 1 (test.jpg) to cath"
alice <## "completed sending file 1 (test.jpg) to cath"
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) complete"),
do
cath <## "started receiving file 1 (test.jpg) from alice"
cath <## "completed receiving file 1 (test.jpg) from alice"
]
src <- B.readFile "./tests/fixtures/test.jpg"
dest1 <- B.readFile "./tests/tmp/test.jpg"
dest2 <- B.readFile "./tests/tmp/test_1.jpg"
dest1 `shouldBe` src
dest2 `shouldBe` src
testInlineGroupFileTransfer :: IO ()
testInlineGroupFileTransfer =
testChatCfg3 cfg aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
bob ##> "/_files_folder ./tests/tmp/bob/"
bob <## "ok"
cath ##> "/_files_folder ./tests/tmp/cath/"
cath <## "ok"
alice #> "/f #team ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
-- below is not shown in "sent" mode
-- alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
alice
<### [ "completed sending file 1 (test.jpg) to bob",
"completed sending file 1 (test.jpg) to cath"
]
alice ##> "/fs 1"
alice <##. "sending file 1 (test.jpg) complete",
do
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
bob <## "started receiving file 1 (test.jpg) from alice"
bob <## "completed receiving file 1 (test.jpg) from alice",
do
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg): no file transfers")
bob ##> "/fr 1 ./tests/tmp/"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
concurrentlyN_
[ do
alice <## "started sending file 1 (test.jpg) to bob"
alice <## "completed sending file 1 (test.jpg) to bob"
alice ##> "/fs 1"
alice <## "sending file 1 (test.jpg) complete: bob",
do
bob <## "started receiving file 1 (test.jpg) from alice"
bob <## "completed receiving file 1 (test.jpg) from alice"
]
cath ##> "/fr 1 ./tests/tmp/"
cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg"
concurrentlyN_
[ do
alice <## "started sending file 1 (test.jpg) to cath"
alice <## "completed sending file 1 (test.jpg) to cath"
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) complete"),
do
cath <## "started receiving file 1 (test.jpg) from alice"
cath <## "completed receiving file 1 (test.jpg) from alice"
]
testGroupFileSndCancelBeforeTransfer :: IO ()
testGroupFileSndCancelBeforeTransfer =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
alice #> "/f #team ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
bob <# "#team alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
do
cath <# "#team alice> sends file test.txt (11 bytes / 11 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fc 1"
concurrentlyN_
[ alice <## "cancelled sending file 1 (test.txt)",
bob <## "alice cancelled sending file 1 (test.txt)",
cath <## "alice cancelled sending file 1 (test.txt)"
]
alice ##> "/fs 1"
alice <## "sending file 1 (test.txt): no file transfers, file transfer cancelled"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.txt) cancelled"
bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.txt"
testMessageWithFile :: IO ()
testMessageWithFile =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
alice <# "@bob hi, sending a file"
alice <# "/f @bob ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> hi, sending a file"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
concurrently_
(bob <## "started receiving file 1 (test.jpg) from alice")
(alice <## "started sending file 1 (test.jpg) to bob")
concurrently_
(bob <## "completed receiving file 1 (test.jpg) from alice")
(alice <## "completed sending file 1 (test.jpg) to bob")
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
alice #$> ("/_get chat @2 count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat @2 count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
dest1 <- B.readFile "./tests/tmp/bob/test.jpg"
dest2 <- B.readFile "./tests/tmp/cath/test.jpg"
dest1 `shouldBe` src
dest2 `shouldBe` src
where
cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, totalSendChunks = 100, receiveChunks = 100}}
runTestGroupFileSndCancelBeforeTransfer :: TestCC -> TestCC -> TestCC -> IO ()
runTestGroupFileSndCancelBeforeTransfer alice bob cath = do
createGroup3 "team" alice bob cath
alice #> "/f #team ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
concurrentlyN_
[ do
bob <# "#team alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
do
cath <# "#team alice> sends file test.txt (11 bytes / 11 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fc 1"
concurrentlyN_
[ alice <## "cancelled sending file 1 (test.txt)",
bob <## "alice cancelled sending file 1 (test.txt)",
cath <## "alice cancelled sending file 1 (test.txt)"
]
alice ##> "/fs 1"
alice <## "sending file 1 (test.txt): no file transfers"
alice <## "file transfer cancelled"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.txt) cancelled"
bob ##> "/fr 1 ./tests/tmp"
bob <## "file cancelled: test.txt"
runTestMessageWithFile :: TestCC -> TestCC -> IO ()
runTestMessageWithFile alice bob = do
connectUsers alice bob
alice ##> "/_send @2 json {\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}"
alice <# "@bob hi, sending a file"
alice <# "/f @bob ./tests/fixtures/test.jpg"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> hi, sending a file"
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
concurrently_
(bob <## "started receiving file 1 (test.jpg) from alice")
(alice <## "started sending file 1 (test.jpg) to bob")
concurrently_
(bob <## "completed receiving file 1 (test.jpg) from alice")
(alice <## "completed sending file 1 (test.jpg) to bob")
src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg"
dest `shouldBe` src
alice #$> ("/_get chat @2 count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
bob #$> ("/_get chat @2 count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
testSendImage :: IO ()
testSendImage =
@ -2278,7 +2358,7 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
do
dan <## "#secret_club: you joined the group"
dan
<### [ "#secret_club: member " <> cathIncognito <> " is connected",
<### [ ConsoleString $ "#secret_club: member " <> cathIncognito <> " is connected",
"#secret_club: member bob_1 (Bob) is connected",
"contact bob_1 is merged into bob",
"use @bob <message> to send messages"
@ -2338,28 +2418,28 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
alice
<### [ "alice (Alice): owner, you, created group",
"bob (Bob): admin, invited, connected",
cathIncognito <> ": admin, invited, connected",
ConsoleString $ cathIncognito <> ": admin, invited, connected",
"dan (Daniel): admin, invited, connected"
]
bob ##> "/ms secret_club"
bob
<### [ "alice (Alice): owner, host, connected",
"bob (Bob): admin, you, connected",
cathIncognito <> ": admin, connected",
ConsoleString $ cathIncognito <> ": admin, connected",
"dan (Daniel): admin, connected"
]
cath ##> "/ms secret_club"
cath
<### [ "alice (Alice): owner, host, connected",
"bob_1 (Bob): admin, connected",
"i " <> cathIncognito <> ": admin, you, connected",
ConsoleString $ "i " <> cathIncognito <> ": admin, you, connected",
"dan_1 (Daniel): admin, connected"
]
dan ##> "/ms secret_club"
dan
<### [ "alice (Alice): owner, host, connected",
"bob (Bob): admin, connected",
cathIncognito <> ": admin, connected",
ConsoleString $ cathIncognito <> ": admin, connected",
"dan (Daniel): admin, you, connected"
]
-- remove member
@ -3456,18 +3536,44 @@ cc <## line = do
when (l /= line) $ print ("expected: " <> line, ", got: " <> l)
l `shouldBe` line
getInAnyOrder :: (String -> String) -> TestCC -> [String] -> Expectation
(<##.) :: TestCC -> String -> Expectation
cc <##. line = do
l <- getTermLine cc
let prefix = line `isPrefixOf` l
unless prefix $ print ("expected to start from: " <> line, ", got: " <> l)
prefix `shouldBe` True
(<##..) :: TestCC -> [String] -> Expectation
cc <##.. ls = do
l <- getTermLine cc
let prefix = any (`isPrefixOf` l) ls
unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l)
prefix `shouldBe` True
data ConsoleResponse = ConsoleString String | WithTime String
deriving (Show)
instance IsString ConsoleResponse where fromString = ConsoleString
-- this assumes that the string can only match one option
getInAnyOrder :: (String -> String) -> TestCC -> [ConsoleResponse] -> Expectation
getInAnyOrder _ _ [] = pure ()
getInAnyOrder f cc ls = do
line <- f <$> getTermLine cc
if line `elem` ls
then getInAnyOrder f cc $ filter (/= line) ls
let rest = filter (not . expected line) ls
if length rest < length ls
then getInAnyOrder f cc rest
else error $ "unexpected output: " <> line
where
expected :: String -> ConsoleResponse -> Bool
expected l = \case
ConsoleString s -> l == s
WithTime s -> dropTime_ l == Just s
(<###) :: TestCC -> [String] -> Expectation
(<###) :: TestCC -> [ConsoleResponse] -> Expectation
(<###) = getInAnyOrder id
(<##?) :: TestCC -> [String] -> Expectation
(<##?) :: TestCC -> [ConsoleResponse] -> Expectation
(<##?) = getInAnyOrder dropTime
(<#) :: TestCC -> String -> Expectation
@ -3489,13 +3595,16 @@ cc1 <#? cc2 = do
cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")
dropTime :: String -> String
dropTime msg = case splitAt 6 msg of
([m, m', ':', s, s', ' '], text) ->
if all isDigit [m, m', s, s'] then text else err
_ -> err
dropTime msg = fromMaybe err $ dropTime_ msg
where
err = error $ "invalid time: " <> msg
dropTime_ :: String -> Maybe String
dropTime_ msg = case splitAt 6 msg of
([m, m', ':', s, s', ' '], text) ->
if all isDigit [m, m', s, s'] then Just text else Nothing
_ -> Nothing
getInvitation :: TestCC -> IO String
getInvitation cc = do
cc <## "pass this invitation link to your contact (via another channel):"

View file

@ -52,28 +52,28 @@ testE2ERatchetParams = E2ERatchetParamsUri e2eEncryptVRange testDhPubKey testDhP
testConnReq :: ConnectionRequestUri 'CMInvitation
testConnReq = CRInvitationUri connReqData testE2ERatchetParams
(==##) :: ByteString -> ChatMessage -> Expectation
(==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ==## msg = do
strDecode s `shouldBe` Right msg
parseAll strP s `shouldBe` Right msg
(##==) :: ByteString -> ChatMessage -> Expectation
(##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##== msg =
J.eitherDecodeStrict' (strEncode msg)
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
(##==##) :: ByteString -> ChatMessage -> Expectation
(##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##==## msg = do
s ##== msg
s ==## msg
(==#) :: ByteString -> ChatMsgEvent -> Expectation
(==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s ==# msg = s ==## ChatMessage Nothing msg
(#==) :: ByteString -> ChatMsgEvent -> Expectation
(#==) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s #== msg = s ##== ChatMessage Nothing msg
(#==#) :: ByteString -> ChatMsgEvent -> Expectation
(#==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s #==# msg = do
s #== msg
s ==# msg
@ -122,10 +122,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing))
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})))
#==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = 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})))
#==# XMsgNew (MCSimple (ExtMsgContent (MCFile "") (Just FileInvitation {fileName = "file.txt", fileSize = 12345, fileConnReq = Nothing, fileInline = 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
@ -138,13 +138,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
)
( ExtMsgContent
(MCText "hello to you too")
(Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing})
(Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = 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})))
##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = 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")
@ -156,16 +156,19 @@ 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%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}
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Just testConnReq, fileInline = 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}
#==# XFile FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing, fileInline = Nothing}
it "x.file.acpt" $
"{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}"
#==# XFileAcpt "photo.jpg"
it "x.file.acpt.inv" $
"{\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\",\"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%26x3dh%3DMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D%2CMEIwBQYDK2VvAzkAmKuSYeQ_m0SixPDS8Wq8VBaTS1cW-Lp0n0h4Diu-kUpR-qXx4SDJ32YGEFoGFGSbGPry5Ychr6U%3D\"}}"
#==# XFileAcptInv (SharedMsgId "\1\2\3\4") testConnReq "photo.jpg"
#==# XFileAcptInv (SharedMsgId "\1\2\3\4") (Just testConnReq) "photo.jpg"
it "x.file.acpt.inv" $
"{\"event\":\"x.file.acpt.inv\",\"params\":{\"msgId\":\"AQIDBA==\",\"fileName\":\"photo.jpg\"}}"
#==# XFileAcptInv (SharedMsgId "\1\2\3\4") Nothing "photo.jpg"
it "x.file.cancel" $
"{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}"
#==# XFileCancel (SharedMsgId "\1\2\3\4")

BIN
tests/fixtures/test.pdf vendored Normal file

Binary file not shown.