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.M20221003_delete_broken_integrity_error_chat_items
Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
Simplex.Chat.Migrations.M20221011_user_contact_links_group_id Simplex.Chat.Migrations.M20221011_user_contact_links_group_id
Simplex.Chat.Migrations.M20221012_inline_files
Simplex.Chat.Mobile Simplex.Chat.Mobile
Simplex.Chat.Options Simplex.Chat.Options
Simplex.Chat.ProfileGenerator Simplex.Chat.ProfileGenerator

File diff suppressed because it is too large Load diff

View file

@ -67,12 +67,29 @@ data ChatConfig = ChatConfig
defaultServers :: InitialAgentServers, defaultServers :: InitialAgentServers,
tbqSize :: Natural, tbqSize :: Natural,
fileChunkSize :: Integer, fileChunkSize :: Integer,
inlineFiles :: InlineFilesConfig,
subscriptionConcurrency :: Int, subscriptionConcurrency :: Int,
subscriptionEvents :: Bool, subscriptionEvents :: Bool,
hostEvents :: Bool, hostEvents :: Bool,
testView :: 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 data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
deriving (Eq) deriving (Eq)

View file

@ -338,6 +338,8 @@ data CIFileStatus (d :: MsgDirection) where
CIFSRcvComplete :: CIFileStatus 'MDRcv CIFSRcvComplete :: CIFileStatus 'MDRcv
CIFSRcvCancelled :: CIFileStatus 'MDRcv CIFSRcvCancelled :: CIFileStatus 'MDRcv
deriving instance Eq (CIFileStatus d)
deriving instance Show (CIFileStatus d) deriving instance Show (CIFileStatus d)
ciFileEnded :: CIFileStatus d -> Bool ciFileEnded :: CIFileStatus d -> Bool
@ -836,8 +838,8 @@ instance ChatTypeI 'CTDirect where chatTypeI = SCTDirect
instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup
data NewMessage = NewMessage data NewMessage e = NewMessage
{ chatMsgEvent :: ChatMsgEvent, { chatMsgEvent :: ChatMsgEvent e,
msgBody :: MsgBody msgBody :: MsgBody
} }
deriving (Show) deriving (Show)
@ -850,14 +852,14 @@ data SndMessage = SndMessage
data RcvMessage = RcvMessage data RcvMessage = RcvMessage
{ msgId :: MessageId, { msgId :: MessageId,
chatMsgEvent :: ChatMsgEvent, chatMsgEvent :: AChatMsgEvent,
sharedMsgId_ :: Maybe SharedMsgId, sharedMsgId_ :: Maybe SharedMsgId,
msgBody :: MsgBody msgBody :: MsgBody
} }
data PendingGroupMessage = PendingGroupMessage data PendingGroupMessage = PendingGroupMessage
{ msgId :: MessageId, { msgId :: MessageId,
cmEventTag :: CMEventTag, cmEventTag :: ACMEventTag,
msgBody :: MsgBody, msgBody :: MsgBody,
introId_ :: Maybe Int64 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, chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE,
updated_at TEXT CHECK(updated_at NOT NULL), updated_at TEXT CHECK(updated_at NOT NULL),
cancelled INTEGER, cancelled INTEGER,
ci_file_status TEXT ci_file_status TEXT,
file_inline TEXT
); );
CREATE TABLE snd_files( CREATE TABLE snd_files(
file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, 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, group_member_id INTEGER REFERENCES group_members ON DELETE CASCADE,
created_at TEXT CHECK(created_at NOT NULL), created_at TEXT CHECK(created_at NOT NULL),
updated_at TEXT CHECK(updated_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) PRIMARY KEY(file_id, connection_id)
) WITHOUT ROWID; ) WITHOUT ROWID;
CREATE TABLE rcv_files( CREATE TABLE rcv_files(
@ -200,7 +203,9 @@ CREATE TABLE rcv_files(
file_queue_info BLOB file_queue_info BLOB
, ,
created_at TEXT CHECK(created_at NOT NULL), 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( CREATE TABLE snd_file_chunks(
file_id INTEGER NOT NULL, file_id INTEGER NOT NULL,
@ -370,11 +375,6 @@ CREATE TABLE smp_servers(
UNIQUE(host, port) UNIQUE(host, port)
); );
CREATE INDEX idx_messages_shared_msg_id ON messages(shared_msg_id); 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 INDEX idx_chat_items_shared_msg_id ON chat_items(shared_msg_id);
CREATE TABLE calls( CREATE TABLE calls(
-- stores call invitations state for communicating state between NSE and app when call notification comes -- 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( CREATE UNIQUE INDEX idx_user_contact_links_group_id ON user_contact_links(
group_id 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 OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE StrictData #-} {-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
module Simplex.Chat.Protocol where 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.Aeson.Types as JT
import qualified Data.Attoparsec.ByteString.Char8 as A import qualified Data.Attoparsec.ByteString.Char8 as A
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Text.Encoding (decodeLatin1, encodeUtf8)
import Data.Time.Clock (UTCTime) 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.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..)) import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Simplex.Chat.Call import Simplex.Chat.Call
import Simplex.Chat.Types import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Encoding
import Simplex.Messaging.Encoding.String 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, (<$?>)) import Simplex.Messaging.Util (eitherToMaybe, (<$?>))
data ConnectionEntity data ConnectionEntity
@ -59,18 +67,64 @@ updateEntityConnStatus connEntity connStatus = case connEntity of
where where
st c = c {connStatus} 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 -- chat message is sent as JSON with these properties
data AppMessage = AppMessage data AppMessageJson = AppMessageJson
{ msgId :: Maybe SharedMsgId, { msgId :: Maybe SharedMsgId,
event :: Text, event :: Text,
params :: J.Object params :: J.Object
} }
deriving (Generic, FromJSON) 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} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
toJSON = J.genericToJSON 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 newtype SharedMsgId = SharedMsgId ByteString
deriving (Eq, Show) deriving (Eq, Show)
@ -105,51 +159,99 @@ instance ToJSON MsgRef where
toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
toEncoding = J.genericToEncoding 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) deriving (Eq, Show)
instance StrEncoding ChatMessage where data AChatMessage = forall e. MsgEncodingI e => ACMsg (SMsgEncoding e) (ChatMessage e)
strEncode = LB.toStrict . J.encode . chatToAppMessage
strDecode = appToChatMessage <=< J.eitherDecodeStrict'
strP = strDecode <$?> A.takeByteString
data ChatMsgEvent instance MsgEncodingI e => StrEncoding (ChatMessage e) where
= XMsgNew MsgContainer strEncode msg = case chatToAppMessage msg of
| XMsgUpdate SharedMsgId MsgContent AMJson m -> LB.toStrict $ J.encode m
| XMsgDel SharedMsgId AMBinary m -> strEncode m
| XMsgDeleted strP = (\(ACMsg _ m) -> checkEncoding m) <$?> strP
| XFile FileInvitation -- TODO discontinue
| XFileAcpt String -- direct file protocol instance StrEncoding AChatMessage where
| XFileAcptInv SharedMsgId ConnReqInvitation String -- group file protocol strEncode (ACMsg _ m) = strEncode m
| XFileCancel SharedMsgId strP =
| XInfo Profile A.peekChar' >>= \case
| XContact Profile (Maybe XContactId) '{' -> ACMsg SJson <$> ((appJsonToCM <=< J.eitherDecodeStrict') <$?> A.takeByteString)
| XGrpInv GroupInvitation _ -> ACMsg SBinary <$> (appBinaryToCM <$?> strP)
| XGrpAcpt MemberId
| XGrpMemNew MemberInfo data ChatMsgEvent (e :: MsgEncoding) where
| XGrpMemIntro MemberInfo XMsgNew :: MsgContainer -> ChatMsgEvent 'Json
| XGrpMemInv MemberId IntroInvitation XMsgUpdate :: SharedMsgId -> MsgContent -> ChatMsgEvent 'Json
| XGrpMemFwd MemberInfo IntroInvitation XMsgDel :: SharedMsgId -> ChatMsgEvent 'Json
| XGrpMemInfo MemberId Profile XMsgDeleted :: ChatMsgEvent 'Json
| XGrpMemRole MemberId GroupMemberRole XFile :: FileInvitation -> ChatMsgEvent 'Json -- TODO discontinue
| XGrpMemCon MemberId -- TODO not implemented XFileAcpt :: String -> ChatMsgEvent 'Json -- direct file protocol
| XGrpMemConAll MemberId -- TODO not implemented XFileAcptInv :: SharedMsgId -> Maybe ConnReqInvitation -> String -> ChatMsgEvent 'Json
| XGrpMemDel MemberId XFileCancel :: SharedMsgId -> ChatMsgEvent 'Json
| XGrpLeave XInfo :: Profile -> ChatMsgEvent 'Json
| XGrpDel XContact :: Profile -> Maybe XContactId -> ChatMsgEvent 'Json
| XGrpInfo GroupProfile XGrpInv :: GroupInvitation -> ChatMsgEvent 'Json
| XInfoProbe Probe XGrpAcpt :: MemberId -> ChatMsgEvent 'Json
| XInfoProbeCheck ProbeHash XGrpMemNew :: MemberInfo -> ChatMsgEvent 'Json
| XInfoProbeOk Probe XGrpMemIntro :: MemberInfo -> ChatMsgEvent 'Json
| XCallInv CallId CallInvitation XGrpMemInv :: MemberId -> IntroInvitation -> ChatMsgEvent 'Json
| XCallOffer CallId CallOffer XGrpMemFwd :: MemberInfo -> IntroInvitation -> ChatMsgEvent 'Json
| XCallAnswer CallId CallAnswer XGrpMemInfo :: MemberId -> Profile -> ChatMsgEvent 'Json
| XCallExtra CallId CallExtraInfo XGrpMemRole :: MemberId -> GroupMemberRole -> ChatMsgEvent 'Json
| XCallEnd CallId XGrpMemCon :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
| XOk XGrpMemConAll :: MemberId -> ChatMsgEvent 'Json -- TODO not implemented
| XUnknown {event :: Text, params :: J.Object} 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) 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} data QuotedMsg = QuotedMsg {msgRef :: MsgRef, content :: MsgContent}
deriving (Eq, Show, Generic, FromJSON) deriving (Eq, Show, Generic, FromJSON)
@ -157,9 +259,9 @@ instance ToJSON QuotedMsg where
toEncoding = J.genericToEncoding J.defaultOptions toEncoding = J.genericToEncoding J.defaultOptions
toJSON = J.genericToJSON J.defaultOptions toJSON = J.genericToJSON J.defaultOptions
cmToQuotedMsg :: ChatMsgEvent -> Maybe QuotedMsg cmToQuotedMsg :: AChatMsgEvent -> Maybe QuotedMsg
cmToQuotedMsg = \case cmToQuotedMsg = \case
XMsgNew (MCQuote quotedMsg _) -> Just quotedMsg ACME _ (XMsgNew (MCQuote quotedMsg _)) -> Just quotedMsg
_ -> Nothing _ -> Nothing
data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text data MsgContentTag = MCText_ | MCLink_ | MCImage_ | MCFile_ | MCUnknown_ Text
@ -273,7 +375,7 @@ msgContainerJSON = \case
where where
withFile l = \case withFile l = \case
Nothing -> l Nothing -> l
Just f -> l <> ["file" .= fileInvitationJSON f] Just f -> l <> ["file" .= f]
instance ToJSON MsgContent where instance ToJSON MsgContent where
toJSON = \case toJSON = \case
@ -295,44 +397,48 @@ instance ToField MsgContent where
instance FromField MsgContent where instance FromField MsgContent where
fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8 fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8
data CMEventTag data CMEventTag (e :: MsgEncoding) where
= XMsgNew_ XMsgNew_ :: CMEventTag 'Json
| XMsgUpdate_ XMsgUpdate_ :: CMEventTag 'Json
| XMsgDel_ XMsgDel_ :: CMEventTag 'Json
| XMsgDeleted_ XMsgDeleted_ :: CMEventTag 'Json
| XFile_ XFile_ :: CMEventTag 'Json
| XFileAcpt_ XFileAcpt_ :: CMEventTag 'Json
| XFileAcptInv_ XFileAcptInv_ :: CMEventTag 'Json
| XFileCancel_ XFileCancel_ :: CMEventTag 'Json
| XInfo_ XInfo_ :: CMEventTag 'Json
| XContact_ XContact_ :: CMEventTag 'Json
| XGrpInv_ XGrpInv_ :: CMEventTag 'Json
| XGrpAcpt_ XGrpAcpt_ :: CMEventTag 'Json
| XGrpMemNew_ XGrpMemNew_ :: CMEventTag 'Json
| XGrpMemIntro_ XGrpMemIntro_ :: CMEventTag 'Json
| XGrpMemInv_ XGrpMemInv_ :: CMEventTag 'Json
| XGrpMemFwd_ XGrpMemFwd_ :: CMEventTag 'Json
| XGrpMemInfo_ XGrpMemInfo_ :: CMEventTag 'Json
| XGrpMemRole_ XGrpMemRole_ :: CMEventTag 'Json
| XGrpMemCon_ XGrpMemCon_ :: CMEventTag 'Json
| XGrpMemConAll_ XGrpMemConAll_ :: CMEventTag 'Json
| XGrpMemDel_ XGrpMemDel_ :: CMEventTag 'Json
| XGrpLeave_ XGrpLeave_ :: CMEventTag 'Json
| XGrpDel_ XGrpDel_ :: CMEventTag 'Json
| XGrpInfo_ XGrpInfo_ :: CMEventTag 'Json
| XInfoProbe_ XInfoProbe_ :: CMEventTag 'Json
| XInfoProbeCheck_ XInfoProbeCheck_ :: CMEventTag 'Json
| XInfoProbeOk_ XInfoProbeOk_ :: CMEventTag 'Json
| XCallInv_ XCallInv_ :: CMEventTag 'Json
| XCallOffer_ XCallOffer_ :: CMEventTag 'Json
| XCallAnswer_ XCallAnswer_ :: CMEventTag 'Json
| XCallExtra_ XCallExtra_ :: CMEventTag 'Json
| XCallEnd_ XCallEnd_ :: CMEventTag 'Json
| XOk_ XOk_ :: CMEventTag 'Json
| XUnknown_ Text XUnknown_ :: Text -> CMEventTag 'Json
deriving (Eq, Show) 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 strEncode = \case
XMsgNew_ -> "x.msg.new" XMsgNew_ -> "x.msg.new"
XMsgUpdate_ -> "x.msg.update" XMsgUpdate_ -> "x.msg.update"
@ -368,45 +474,54 @@ instance StrEncoding CMEventTag where
XCallEnd_ -> "x.call.end" XCallEnd_ -> "x.call.end"
XOk_ -> "x.ok" XOk_ -> "x.ok"
XUnknown_ t -> encodeUtf8 t XUnknown_ t -> encodeUtf8 t
strDecode = \case BFileChunk_ -> "F"
"x.msg.new" -> Right XMsgNew_ strDecode = (\(ACMEventTag _ t) -> checkEncoding t) <=< strDecode
"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
strP = strDecode <$?> A.takeTill (== ' ') strP = strDecode <$?> A.takeTill (== ' ')
toCMEventTag :: ChatMsgEvent -> CMEventTag instance StrEncoding ACMEventTag where
toCMEventTag = \case 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_ XMsgNew _ -> XMsgNew_
XMsgUpdate _ _ -> XMsgUpdate_ XMsgUpdate _ _ -> XMsgUpdate_
XMsgDel _ -> XMsgDel_ XMsgDel _ -> XMsgDel_
@ -441,18 +556,25 @@ toCMEventTag = \case
XCallEnd _ -> XCallEnd_ XCallEnd _ -> XCallEnd_
XOk -> XOk_ XOk -> XOk_
XUnknown t _ -> XUnknown_ t XUnknown t _ -> XUnknown_ t
BFileChunk _ _ -> BFileChunk_
cmEventTagT :: Text -> Maybe CMEventTag instance MsgEncodingI e => TextEncoding (CMEventTag e) where
cmEventTagT = eitherToMaybe . strDecode . encodeUtf8 textEncode = decodeLatin1 . strEncode
textDecode = eitherToMaybe . strDecode . encodeUtf8
serializeCMEventTag :: CMEventTag -> Text instance TextEncoding ACMEventTag where
serializeCMEventTag = decodeLatin1 . strEncode 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 hasNotification = \case
XMsgNew_ -> True XMsgNew_ -> True
XFile_ -> True XFile_ -> True
@ -463,8 +585,18 @@ hasNotification = \case
XCallInv_ -> True XCallInv_ -> True
_ -> False _ -> False
appToChatMessage :: AppMessage -> Either String ChatMessage appBinaryToCM :: AppMessageBinary -> Either String (ChatMessage 'Binary)
appToChatMessage AppMessage {msgId, event, params} = do 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 eventTag <- strDecode $ encodeUtf8 event
chatMsgEvent <- msg eventTag chatMsgEvent <- msg eventTag
pure ChatMessage {msgId, chatMsgEvent} pure ChatMessage {msgId, chatMsgEvent}
@ -473,6 +605,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
p key = JT.parseEither (.: key) params p key = JT.parseEither (.: key) params
opt :: FromJSON a => J.Key -> Either String (Maybe a) opt :: FromJSON a => J.Key -> Either String (Maybe a)
opt key = JT.parseEither (.:? key) params opt key = JT.parseEither (.:? key) params
msg :: CMEventTag 'Json -> Either String (ChatMsgEvent 'Json)
msg = \case msg = \case
XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params XMsgNew_ -> XMsgNew <$> JT.parseEither parseMsgContainer params
XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content" XMsgUpdate_ -> XMsgUpdate <$> p "msgId" <*> p "content"
@ -480,7 +613,7 @@ appToChatMessage AppMessage {msgId, event, params} = do
XMsgDeleted_ -> pure XMsgDeleted XMsgDeleted_ -> pure XMsgDeleted
XFile_ -> XFile <$> p "file" XFile_ -> XFile <$> p "file"
XFileAcpt_ -> XFileAcpt <$> p "fileName" XFileAcpt_ -> XFileAcpt <$> p "fileName"
XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> p "fileConnReq" <*> p "fileName" XFileAcptInv_ -> XFileAcptInv <$> p "msgId" <*> opt "fileConnReq" <*> p "fileName"
XFileCancel_ -> XFileCancel <$> p "msgId" XFileCancel_ -> XFileCancel <$> p "msgId"
XInfo_ -> XInfo <$> p "profile" XInfo_ -> XInfo <$> p "profile"
XContact_ -> XContact <$> p "profile" <*> opt "contactReqId" XContact_ -> XContact <$> p "profile" <*> opt "contactReqId"
@ -509,21 +642,29 @@ appToChatMessage AppMessage {msgId, event, params} = do
XOk_ -> pure XOk XOk_ -> pure XOk
XUnknown_ t -> pure $ XUnknown t params XUnknown_ t -> pure $ XUnknown t params
chatToAppMessage :: ChatMessage -> AppMessage chatToAppMessage :: forall e. MsgEncodingI e => ChatMessage e -> AppMessage e
chatToAppMessage ChatMessage {msgId, chatMsgEvent} = AppMessage {msgId, event, params} 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 where
event = serializeCMEventTag . toCMEventTag $ chatMsgEvent tag = toCMEventTag chatMsgEvent
o :: [(J.Key, J.Value)] -> J.Object o :: [(J.Key, J.Value)] -> J.Object
o = JM.fromList o = JM.fromList
key .=? value = maybe id ((:) . (key .=)) value 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 XMsgNew container -> msgContainerJSON container
XMsgUpdate msgId' content -> o ["msgId" .= msgId', "content" .= content] XMsgUpdate msgId' content -> o ["msgId" .= msgId', "content" .= content]
XMsgDel msgId' -> o ["msgId" .= msgId'] XMsgDel msgId' -> o ["msgId" .= msgId']
XMsgDeleted -> JM.empty XMsgDeleted -> JM.empty
XFile fileInv -> o ["file" .= fileInvitationJSON fileInv] XFile fileInv -> o ["file" .= fileInv]
XFileAcpt fileName -> o ["fileName" .= fileName] 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] XFileCancel sharedMsgId -> o ["msgId" .= sharedMsgId]
XInfo profile -> o ["profile" .= profile] XInfo profile -> o ["profile" .= profile]
XContact profile xContactId -> o $ ("contactReqId" .=? xContactId) ["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] XCallEnd callId -> o ["callId" .= callId]
XOk -> JM.empty XOk -> JM.empty
XUnknown _ ps -> ps 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, matchReceivedProbeHash,
matchSentProbe, matchSentProbe,
mergeContactRecords, mergeContactRecords,
createSndFileTransfer,
createSndDirectFileTransfer, createSndDirectFileTransfer,
createSndDirectFTConnection, createSndDirectFTConnection,
createSndGroupFileTransfer, createSndGroupFileTransfer,
createSndGroupFileTransferConnection, createSndGroupFileTransferConnection,
createSndDirectInlineFT,
createSndGroupInlineFT,
updateSndDirectFTDelivery,
updateSndGroupFTDelivery,
getSndInlineFTViaMsgDelivery,
updateFileCancelled, updateFileCancelled,
updateCIFileStatus, updateCIFileStatus,
getSharedMsgIdByFileId, getSharedMsgIdByFileId,
@ -132,6 +136,8 @@ module Simplex.Chat.Store
createRcvGroupFileTransfer, createRcvGroupFileTransfer,
getRcvFileTransfer, getRcvFileTransfer,
acceptRcvFileTransfer, acceptRcvFileTransfer,
acceptRcvInlineFT,
startRcvInlineFT,
updateRcvFileStatus, updateRcvFileStatus,
createRcvFileChunk, createRcvFileChunk,
updatedRcvFileChunkStored, updatedRcvFileChunkStored,
@ -139,6 +145,7 @@ module Simplex.Chat.Store
updateFileTransferChatItemId, updateFileTransferChatItemId,
getFileTransfer, getFileTransfer,
getFileTransferProgress, getFileTransferProgress,
getFileTransferMeta,
getSndFileTransfer, getSndFileTransfer,
getContactFileInfo, getContactFileInfo,
getContactMaxItemTs, 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.M20221003_delete_broken_integrity_error_chat_items
import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id import Simplex.Chat.Migrations.M20221004_idx_msg_deliveries_message_id
import Simplex.Chat.Migrations.M20221011_user_contact_links_group_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.Protocol
import Simplex.Chat.Types import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (ACorrId, AgentMsgId, ConnId, InvitationId, MsgMeta (..)) 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), ("20221001_shared_msg_id_indices", m20221001_shared_msg_id_indices),
("20221003_delete_broken_integrity_error_chat_items", m20221003_delete_broken_integrity_error_chat_items), ("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), ("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 -- | 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.Connection -> User -> Profile -> ExceptT StoreError IO ()
updateUserProfile db User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName}} p'@Profile {displayName = newName} updateUserProfile db User {userId, userContactId, localDisplayName, profile = LocalProfile {profileId, displayName}} p'@Profile {displayName = newName}
| displayName == newName = | displayName == newName =
liftIO $ updateContactProfile_ db userId profileId p' liftIO $ updateContactProfile_ db userId profileId p'
| otherwise = | otherwise =
checkConstraint SEDuplicateName . liftIO $ do checkConstraint SEDuplicateName . liftIO $ do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId) DB.execute db "UPDATE users SET local_display_name = ?, updated_at = ? WHERE user_id = ?" (newName, currentTs, userId)
DB.execute DB.execute
db db
"INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)" "INSERT INTO display_names (local_display_name, ldn_base, user_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(newName, newName, userId, currentTs, currentTs) (newName, newName, userId, currentTs, currentTs)
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId userContactId localDisplayName newName currentTs updateContact_ db userId userContactId localDisplayName newName currentTs
updateContactProfile :: DB.Connection -> UserId -> Contact -> Profile -> ExceptT StoreError IO Contact 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} updateContactProfile db userId c@Contact {contactId, localDisplayName, profile = LocalProfile {profileId, displayName, localAlias}} p'@Profile {displayName = newName}
| 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 = | otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateContactProfile_' db userId profileId p' currentTs updateContactProfile_' db userId profileId p' currentTs
updateContact_ db userId contactId localDisplayName ldn currentTs updateContact_ db userId contactId localDisplayName ldn currentTs
pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias} pure . Right $ (c :: Contact) {localDisplayName = ldn, profile = toLocalProfile profileId p' localAlias}
updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact updateContactAlias :: DB.Connection -> UserId -> Contact -> LocalAlias -> IO Contact
updateContactAlias db userId c@Contact {profile = lp@LocalProfile {profileId}} localAlias = do 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 SELECT DISTINCT f.file_id
FROM files f FROM files f
JOIN snd_files s 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) (userId, FSNew, FSAccepted, FSConnected)
concatMap (filter liveTransfer) . rights <$> mapM (getSndFileTransfers_ db userId) fileIds concatMap (filter liveTransfer) . rights <$> mapM (getSndFileTransfers_ db userId) fileIds
@ -1075,7 +1084,7 @@ getLiveRcvFileTransfers db user@User {userId} = do
SELECT f.file_id SELECT f.file_id
FROM files f FROM files f
JOIN rcv_files r 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) (userId, FSAccepted, FSConnected)
rights <$> mapM (runExceptT . getRcvFileTransfer db user) fileIds rights <$> mapM (runExceptT . getRcvFileTransfer db user) fileIds
@ -1373,7 +1382,7 @@ getConnectionEntity db user@User {userId, userContactId} agentConnId = do
DB.query DB.query
db db
[sql| [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 FROM snd_files s
JOIN files f USING (file_id) JOIN files f USING (file_id)
LEFT JOIN contacts cs USING (contact_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 = ? WHERE f.user_id = ? AND f.file_id = ? AND s.connection_id = ?
|] |]
(userId, fileId, connId) (userId, fileId, connId)
sndFileTransfer_ :: Int64 -> Int64 -> (FileStatus, String, Integer, Integer, FilePath, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer 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, contactName_, memberName_) = sndFileTransfer_ fileId connId (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, contactName_, memberName_) =
case contactName_ <|> memberName_ of 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 Nothing -> Left $ SESndFileInvalid fileId
getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact getUserContact_ :: Int64 -> ExceptT StoreError IO UserContact
getUserContact_ userContactLinkId = ExceptT $ do getUserContact_ userContactLinkId = ExceptT $ do
@ -2118,30 +2127,22 @@ getViaGroupContact db User {userId} GroupMember {groupMemberId} =
activeConn = toConnection connRow activeConn = toConnection connRow
in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt} in Contact {contactId, localDisplayName, profile, activeConn, viaGroup, chatSettings, createdAt, updatedAt}
createSndFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> IO Int64 createSndDirectFileTransfer :: DB.Connection -> UserId -> Contact -> FilePath -> FileInvitation -> Maybe ConnId -> Integer -> IO FileTransferMeta
createSndFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize} acId chunkSize = do createSndDirectFileTransfer db userId Contact {contactId} filePath FileInvitation {fileName, fileSize, fileInline} acId_ chunkSize = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
db db
"INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" "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, CIFSSndStored, currentTs, currentTs) (userId, contactId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
fileId <- insertedRowId db fileId <- insertedRowId db
Connection {connId} <- createSndFileConnection_ db userId fileId acId forM_ acId_ $ \acId -> do
let fileStatus = FSNew Connection {connId} <- createSndFileConnection_ db userId fileId acId
DB.execute let fileStatus = FSNew
db DB.execute
"INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)" db
(fileId, fileStatus, connId, currentTs, currentTs) "INSERT INTO snd_files (file_id, file_status, file_inline, connection_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
pure fileId (fileId, fileStatus, fileInline, connId, currentTs, currentTs)
pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
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
createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO () createSndDirectFTConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> IO ()
createSndDirectFTConnection db user@User {userId} fileId (cmdId, acId) = do 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 (?,?,?,?,?)" "INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)"
(fileId, FSAccepted, connId, currentTs, currentTs) (fileId, FSAccepted, connId, currentTs, currentTs)
createSndGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> FilePath -> FileInvitation -> Integer -> IO Int64 createSndGroupFileTransfer :: DB.Connection -> UserId -> GroupInfo -> FilePath -> FileInvitation -> Integer -> IO FileTransferMeta
createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation {fileName, fileSize} chunkSize = do createSndGroupFileTransfer db userId GroupInfo {groupId} filePath FileInvitation {fileName, fileSize, fileInline} chunkSize = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
db db
"INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" "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, CIFSSndStored, currentTs, currentTs) (userId, groupId, fileName, filePath, fileSize, chunkSize, fileInline, CIFSSndStored, currentTs, currentTs)
insertedRowId db fileId <- insertedRowId db
pure FileTransferMeta {fileId, fileName, filePath, fileSize, fileInline, chunkSize, cancelled = False}
createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO () createSndGroupFileTransferConnection :: DB.Connection -> User -> Int64 -> (CommandId, ConnId) -> GroupMember -> IO ()
createSndGroupFileTransferConnection db user@User {userId} fileId (cmdId, acId) GroupMember {groupMemberId} = do 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 (?,?,?,?,?,?)" "INSERT INTO snd_files (file_id, file_status, connection_id, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)"
(fileId, FSAccepted, connId, groupMemberId, currentTs, currentTs) (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 :: MsgDirectionI d => DB.Connection -> User -> Int64 -> CIFileStatus d -> IO ()
updateFileCancelled db User {userId} fileId ciFileStatus = do updateFileCancelled db User {userId} fileId ciFileStatus = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
@ -2308,43 +2367,44 @@ deleteSndFileChunks :: DB.Connection -> SndFileTransfer -> IO ()
deleteSndFileChunks db SndFileTransfer {fileId, connId} = deleteSndFileChunks db SndFileTransfer {fileId, connId} =
DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (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.Connection -> UserId -> Contact -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize = do createRcvFileTransfer db userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
db db
"INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" "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, CIFSRcvInvitation, currentTs, currentTs) (userId, contactId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db fileId <- insertedRowId db
DB.execute DB.execute
db db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, created_at, updated_at) VALUES (?,?,?,?,?)" "INSERT INTO rcv_files (file_id, file_status, file_queue_info, file_inline, rcv_file_inline, created_at, updated_at) VALUES (?,?,?,?,?,?,?)"
(fileId, FSNew, fileConnReq, currentTs, currentTs) (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, currentTs, currentTs)
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Nothing} 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.Connection -> UserId -> GroupMember -> FileInvitation -> Maybe InlineFileMode -> Integer -> IO RcvFileTransfer
createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize = do createRcvGroupFileTransfer db userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq, fileInline} rcvFileInline chunkSize = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
db db
"INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" "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, CIFSRcvInvitation, currentTs, currentTs) (userId, groupId, fileName, fileSize, chunkSize, fileInline, CIFSRcvInvitation, currentTs, currentTs)
fileId <- insertedRowId db fileId <- insertedRowId db
DB.execute DB.execute
db db
"INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id, created_at, updated_at) VALUES (?,?,?,?,?,?)" "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, groupMemberId, currentTs, currentTs) (fileId, FSNew, fileConnReq, fileInline, rcvFileInline, groupMemberId, currentTs, currentTs)
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize, cancelled = False, grpMemberId = Just groupMemberId} 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.Connection -> User -> Int64 -> ExceptT StoreError IO RcvFileTransfer
getRcvFileTransfer db User {userId} fileId = getRcvFileTransfer db user@User {userId} fileId = do
ExceptT . firstRow' rcvFileTransfer (SERcvFileNotFound fileId) $ rftRow <-
DB.query ExceptT . firstRow id (SERcvFileNotFound fileId) $
db DB.query
[sql| db
[sql|
SELECT r.file_status, r.file_queue_info, r.group_member_id, f.file_name, 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_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, c.connection_id, c.agent_conn_id f.file_path, r.file_inline, r.rcv_file_inline, c.connection_id, c.agent_conn_id
FROM rcv_files r FROM rcv_files r
JOIN files f USING (file_id) JOIN files f USING (file_id)
LEFT JOIN connections c ON r.file_id = c.rcv_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) LEFT JOIN group_members m USING (group_member_id)
WHERE f.user_id = ? AND f.file_id = ? WHERE f.user_id = ? AND f.file_id = ?
|] |]
(userId, fileId) (userId, fileId)
rcvFileTransfer rftRow
where where
rcvFileTransfer :: rcvFileTransfer ::
(FileStatus, Maybe ConnReqInvitation, Maybe Int64, String, Integer, Integer, Maybe Bool, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe AgentConnId) -> (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) ->
Either StoreError RcvFileTransfer ExceptT StoreError IO RcvFileTransfer
rcvFileTransfer (fileStatus', fileConnReq, grpMemberId, fileName, fileSize, chunkSize, cancelled_, contactName_, memberName_, filePath_, connId_, agentConnId_) = 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} let fileInv = FileInvitation {fileName, fileSize, fileConnReq, fileInline}
fileInfo = (filePath_, connId_, agentConnId_) fileInfo = (filePath_, connId_, agentConnId_, contactId_, groupId_, groupMemberId_, isJust fileInline)
in case contactName_ <|> memberName_ of case contactName_ <|> memberName_ of
Nothing -> Left $ SERcvFileInvalid fileId Nothing -> throwError $ SERcvFileInvalid fileId
Just name -> Just name -> do
case fileStatus' of case fileStatus' of
FSNew -> ft name fileInv RFSNew FSNew -> pure $ ft name fileInv RFSNew
FSAccepted -> ft name fileInv . RFSAccepted =<< rfi fileInfo FSAccepted -> ft name fileInv . RFSAccepted <$> rfi fileInfo
FSConnected -> ft name fileInv . RFSConnected =<< rfi fileInfo FSConnected -> ft name fileInv . RFSConnected <$> rfi fileInfo
FSComplete -> ft name fileInv . RFSComplete =<< rfi fileInfo FSComplete -> ft name fileInv . RFSComplete <$> rfi fileInfo
FSCancelled -> ft name fileInv . RFSCancelled $ rfi_ fileInfo FSCancelled -> ft name fileInv . RFSCancelled <$> rfi_ fileInfo
where where
ft senderDisplayName fileInvitation fileStatus = ft senderDisplayName fileInvitation fileStatus =
Right RcvFileTransfer {fileId, fileInvitation, fileStatus, senderDisplayName, chunkSize, cancelled, grpMemberId} RcvFileTransfer {fileId, fileInvitation, fileStatus, rcvFileInline, senderDisplayName, chunkSize, cancelled, grpMemberId}
rfi fileInfo = maybe (Left $ SERcvFileInvalid fileId) Right $ rfi_ fileInfo rfi fileInfo = maybe (throwError $ SERcvFileInvalid fileId) pure =<< rfi_ fileInfo
rfi_ = \case rfi_ = \case
(Just filePath, Just connId, Just agentConnId) -> Just RcvFileInfo {filePath, connId, agentConnId} (Just filePath, Just connId, Just agentConnId, _, _, _, _) -> pure $ Just RcvFileInfo {filePath, connId, agentConnId}
_ -> Nothing (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_ cancelled = fromMaybe False cancelled_
acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> ConnId -> ConnStatus -> FilePath -> ExceptT StoreError IO AChatItem acceptRcvFileTransfer :: DB.Connection -> User -> Int64 -> ConnId -> ConnStatus -> FilePath -> ExceptT StoreError IO AChatItem
acceptRcvFileTransfer db user@User {userId} fileId agentConnId connStatus filePath = ExceptT $ do acceptRcvFileTransfer db user@User {userId} fileId agentConnId connStatus filePath = ExceptT $ do
currentTs <- getCurrentTime 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.execute
db db
"UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" "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 db
"UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?"
(FSAccepted, currentTs, fileId) (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.Connection -> RcvFileTransfer -> FileStatus -> IO ()
updateRcvFileStatus db RcvFileTransfer {fileId} status = do updateRcvFileStatus db RcvFileTransfer {fileId} status = do
@ -2416,20 +2498,20 @@ createRcvFileChunk db RcvFileTransfer {fileId, fileInvitation = FileInvitation {
pure $ case map fromOnly ns of pure $ case map fromOnly ns of
[] []
| chunkNo == 1 -> | chunkNo == 1 ->
if chunkSize >= fileSize if chunkSize >= fileSize
then RcvChunkFinal then RcvChunkFinal
else RcvChunkOk else RcvChunkOk
| otherwise -> RcvChunkError | otherwise -> RcvChunkError
n : _ n : _
| chunkNo == n -> RcvChunkDuplicate | chunkNo == n -> RcvChunkDuplicate
| chunkNo == n + 1 -> | chunkNo == n + 1 ->
let prevSize = n * chunkSize let prevSize = n * chunkSize
in if prevSize >= fileSize in if prevSize >= fileSize
then RcvChunkError then RcvChunkError
else else
if prevSize + chunkSize >= fileSize if prevSize + chunkSize >= fileSize
then RcvChunkFinal then RcvChunkFinal
else RcvChunkOk else RcvChunkOk
| otherwise -> RcvChunkError | otherwise -> RcvChunkError
updatedRcvFileChunkStored :: DB.Connection -> RcvFileTransfer -> Integer -> IO () updatedRcvFileChunkStored :: DB.Connection -> RcvFileTransfer -> Integer -> IO ()
@ -2485,18 +2567,18 @@ getFileTransfer db user@User {userId} fileId =
(userId, fileId) (userId, fileId)
getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer]) getSndFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO (FileTransferMeta, [SndFileTransfer])
getSndFileTransfer db User {userId} fileId = do getSndFileTransfer db user@User {userId} fileId = do
fileTransferMeta <- ExceptT $ getFileTransferMeta_ db userId fileId fileTransferMeta <- getFileTransferMeta db user fileId
sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId sndFileTransfers <- ExceptT $ getSndFileTransfers_ db userId fileId
pure (fileTransferMeta, sndFileTransfers) pure (fileTransferMeta, sndFileTransfers)
getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer]) getSndFileTransfers_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError [SndFileTransfer])
getSndFileTransfers_ db userId fileId = getSndFileTransfers_ db userId fileId =
sndFileTransfers mapM sndFileTransfer
<$> DB.query <$> DB.query
db db
[sql| [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 cs.local_display_name, m.local_display_name
FROM snd_files s FROM snd_files s
JOIN files f USING (file_id) JOIN files f USING (file_id)
@ -2507,29 +2589,27 @@ getSndFileTransfers_ db userId fileId =
|] |]
(userId, fileId) (userId, fileId)
where where
sndFileTransfers :: [(FileStatus, String, Integer, Integer, FilePath, Int64, AgentConnId, Maybe ContactName, Maybe ContactName)] -> Either StoreError [SndFileTransfer] sndFileTransfer :: (FileStatus, String, Integer, Integer, FilePath, Maybe InlineFileMode, Int64, AgentConnId, Maybe ContactName, Maybe ContactName) -> Either StoreError SndFileTransfer
sndFileTransfers [] = Right [] sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, fileInline, connId, agentConnId, contactName_, memberName_) =
sndFileTransfers fts = mapM sndFileTransfer fts
sndFileTransfer (fileStatus, fileName, fileSize, chunkSize, filePath, connId, agentConnId, contactName_, memberName_) =
case contactName_ <|> memberName_ of 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 Nothing -> Left $ SESndFileInvalid fileId
getFileTransferMeta_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError FileTransferMeta) getFileTransferMeta :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileTransferMeta
getFileTransferMeta_ db userId fileId = getFileTransferMeta db User {userId} fileId =
firstRow fileTransferMeta (SEFileNotFound fileId) $ ExceptT . firstRow fileTransferMeta (SEFileNotFound fileId) $
DB.query DB.query
db db
[sql| [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 FROM files f
WHERE f.user_id = ? AND f.file_id = ? WHERE f.user_id = ? AND f.file_id = ?
|] |]
(userId, fileId) (userId, fileId)
where where
fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe Bool) -> FileTransferMeta fileTransferMeta :: (String, Integer, Integer, FilePath, Maybe InlineFileMode, Maybe Bool) -> FileTransferMeta
fileTransferMeta (fileName, fileSize, chunkSize, filePath, cancelled_) = fileTransferMeta (fileName, fileSize, chunkSize, filePath, fileInline, cancelled_) =
FileTransferMeta {fileId, fileName, filePath, fileSize, chunkSize, cancelled = fromMaybe False cancelled_} FileTransferMeta {fileId, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_}
getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo] getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo]
getContactFileInfo db User {userId} Contact {contactId} = 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 = ?" "UPDATE groups SET updated_at = ? WHERE user_id = ? AND group_id = ?"
(updatedAt, userId, groupId) (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 = createNewSndMessage db gVar connOrGroupId mkMessage =
createWithRandomId gVar $ \sharedMsgId -> do createWithRandomId gVar $ \sharedMsgId -> do
let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId let NewMessage {chatMsgEvent, msgBody} = mkMessage $ SharedMsgId sharedMsgId
@ -2622,13 +2702,14 @@ createNewSndMessage db gVar connOrGroupId mkMessage =
ConnectionId connId -> (Just connId, Nothing) ConnectionId connId -> (Just connId, Nothing)
GroupId groupId -> (Nothing, Just groupId) GroupId groupId -> (Nothing, Just groupId)
createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO () createSndMsgDelivery :: DB.Connection -> SndMsgDelivery -> MessageId -> IO Int64
createSndMsgDelivery db sndMsgDelivery messageId = do createSndMsgDelivery db sndMsgDelivery messageId = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs msgDeliveryId <- createSndMsgDelivery_ db sndMsgDelivery messageId currentTs
createMsgDeliveryEvent_ db msgDeliveryId MDSSndAgent 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 createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msgBody} sharedMsgId_ RcvMsgDelivery {connId, agentMsgId, agentMsgMeta, agentAckCmdId} = do
currentTs <- getCurrentTime currentTs <- getCurrentTime
DB.execute DB.execute
@ -2642,7 +2723,7 @@ createNewMessageAndRcvMsgDelivery db connOrGroupId NewMessage {chatMsgEvent, msg
(msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs) (msgId, connId, agentMsgId, msgMetaJson agentMsgMeta, agentAckCmdId, snd $ broker agentMsgMeta, currentTs, currentTs)
msgDeliveryId <- insertedRowId db msgDeliveryId <- insertedRowId db
createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs createMsgDeliveryEvent_ db msgDeliveryId MDSRcvAgent currentTs
pure RcvMessage {msgId, chatMsgEvent, sharedMsgId_, msgBody} pure RcvMessage {msgId, chatMsgEvent = ACME (encoding @e) chatMsgEvent, sharedMsgId_, msgBody}
where where
(connId_, groupId_) = case connOrGroupId of (connId_, groupId_) = case connOrGroupId of
ConnectionId connId' -> (Just connId', Nothing) 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.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} updateGroupProfile db User {userId} g@GroupInfo {groupId, localDisplayName, groupProfile = GroupProfile {displayName}} p'@GroupProfile {displayName = newName, fullName, image}
| displayName == newName = liftIO $ do | displayName == newName = liftIO $ do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
| otherwise =
ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime currentTs <- getCurrentTime
updateGroupProfile_ currentTs updateGroupProfile_ currentTs $> (g :: GroupInfo) {groupProfile = p'}
updateGroup_ ldn currentTs | otherwise =
pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p'} ExceptT . withLocalDisplayName db userId newName $ \ldn -> do
currentTs <- getCurrentTime
updateGroupProfile_ currentTs
updateGroup_ ldn currentTs
pure . Right $ (g :: GroupInfo) {localDisplayName = ldn, groupProfile = p'}
where where
updateGroupProfile_ currentTs = updateGroupProfile_ currentTs =
DB.execute DB.execute

View file

@ -613,7 +613,8 @@ data SndFileTransfer = SndFileTransfer
recipientDisplayName :: ContactName, recipientDisplayName :: ContactName,
connId :: Int64, connId :: Int64,
agentConnId :: AgentConnId, agentConnId :: AgentConnId,
fileStatus :: FileStatus fileStatus :: FileStatus,
fileInline :: Maybe InlineFileMode
} }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic)
@ -627,16 +628,48 @@ type FileTransferId = Int64
data FileInvitation = FileInvitation data FileInvitation = FileInvitation
{ fileName :: String, { fileName :: String,
fileSize :: Integer, 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 data RcvFileTransfer = RcvFileTransfer
{ fileId :: FileTransferId, { fileId :: FileTransferId,
fileInvitation :: FileInvitation, fileInvitation :: FileInvitation,
fileStatus :: RcvFileStatus, fileStatus :: RcvFileStatus,
rcvFileInline :: Maybe InlineFileMode,
senderDisplayName :: ContactName, senderDisplayName :: ContactName,
chunkSize :: Integer, chunkSize :: Integer,
cancelled :: Bool, cancelled :: Bool,
@ -724,6 +757,7 @@ data FileTransferMeta = FileTransferMeta
fileName :: String, fileName :: String,
filePath :: String, filePath :: String,
fileSize :: Integer, fileSize :: Integer,
fileInline :: Maybe InlineFileMode,
chunkSize :: Integer, chunkSize :: Integer,
cancelled :: Bool cancelled :: Bool
} }

View file

@ -241,7 +241,7 @@ showSMPServer = B.unpack . strEncode . host
viewHostEvent :: AProtocolType -> TransportHost -> String viewHostEvent :: AProtocolType -> TransportHost -> String
viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack (strEncode h) 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 viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} doShow = case chat of
DirectChat c -> case chatDir of DirectChat c -> case chatDir of
CIDirectSnd -> case content of CIDirectSnd -> case content of
@ -714,9 +714,9 @@ viewContactUpdated
| n == n' && fullName == fullName' = [] | n == n' && fullName == fullName' = []
| n == n' = ["contact " <> ttyContact n <> fullNameUpdate] | n == n' = ["contact " <> ttyContact n <> fullNameUpdate]
| otherwise = | otherwise =
[ "contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName', [ "contact " <> ttyContact n <> " changed to " <> ttyFullName n' fullName',
"use " <> ttyToContact n' <> highlight' "<message>" <> " to send messages" "use " <> ttyToContact n' <> highlight' "<message>" <> " to send messages"
] ]
where where
fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName' 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) viewSentBroadcast mc n ts = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts <> " ") (ttyMsgContent mc)
viewSentFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString] viewSentFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString]
viewSentFileInvitation to CIFile {fileId, filePath} = case filePath of viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} = case filePath of
Just fPath -> sentWithTime_ $ ttySentFile to fileId fPath Just fPath -> sentWithTime_ $ ttySentFile fPath
_ -> const [] _ -> 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_ :: [StyledString] -> CIMeta d -> [StyledString]
sentWithTime_ styledMsg CIMeta {localItemTs} = sentWithTime_ styledMsg CIMeta {localItemTs} =
@ -762,9 +767,6 @@ ttyMsgTime = styleTime . formatTime defaultTimeLocale "%H:%M"
ttyMsgContent :: MsgContent -> [StyledString] ttyMsgContent :: MsgContent -> [StyledString]
ttyMsgContent = msgPlain . msgContentText 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 :: StyledString -> [StyledString] -> [StyledString]
prependFirst s [] = [s] prependFirst s [] = [s]
prependFirst s (s' : ss) = (s <> s') : ss 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) viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file)
receivedFileInvitation_ :: CIFile d -> [StyledString] receivedFileInvitation_ :: CIFile d -> [StyledString]
receivedFileInvitation_ CIFile {fileId, fileName, fileSize} = receivedFileInvitation_ CIFile {fileId, fileName, fileSize, fileStatus} =
[ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)", ["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 <> case fileStatus of
"use " <> highlight ("/fr " <> show fileId <> " [<dir>/ | <path>]") <> " to receive it" CIFSRcvAccepted -> []
] _ -> ["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"
]
humanReadableSize :: Integer -> StyledString humanReadableSize :: Integer -> StyledString
humanReadableSize size humanReadableSize size
@ -849,9 +841,8 @@ fileTransferStr fileId fileName = "file " <> sShow fileId <> " (" <> ttyFilePath
viewFileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString] viewFileTransferStatus :: (FileTransfer, [Integer]) -> [StyledString]
viewFileTransferStatus (FTSnd FileTransferMeta {fileId, fileName, cancelled} [], _) = viewFileTransferStatus (FTSnd FileTransferMeta {fileId, fileName, cancelled} [], _) =
[ "sending " <> fileTransferStr fileId fileName <> ": no file transfers" ["sending " <> fileTransferStr fileId fileName <> ": no file transfers"]
<> if cancelled then ", file transfer cancelled" else "" <> ["file transfer cancelled" | cancelled]
]
viewFileTransferStatus (FTSnd FileTransferMeta {cancelled} fts@(ft : _), chunksNum) = viewFileTransferStatus (FTSnd FileTransferMeta {cancelled} fts@(ft : _), chunksNum) =
recipientStatuses <> ["file transfer cancelled" | cancelled] recipientStatuses <> ["file transfer cancelled" | cancelled]
where where
@ -978,7 +969,7 @@ viewChatError = \case
CEGroupCantResendInvitation g c -> viewCannotResendInvitation g c CEGroupCantResendInvitation g c -> viewCannotResendInvitation g c
CEGroupInternal s -> ["chat group bug: " <> plain s] CEGroupInternal s -> ["chat group bug: " <> plain s]
CEFileNotFound f -> ["file not found: " <> plain f] 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] CEFileCancelled f -> ["file cancelled: " <> plain f]
CEFileAlreadyExists f -> ["file already exists: " <> plain f] CEFileAlreadyExists f -> ["file already exists: " <> plain f]
CEFileRead f e -> ["cannot read file " <> plain f, sShow e] 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.Concurrent.STM
import Control.Exception (bracket, bracket_) import Control.Exception (bracket, bracket_)
import Control.Monad.Except import Control.Monad.Except
import Data.Functor (($>))
import Data.List (dropWhileEnd, find) import Data.List (dropWhileEnd, find)
import Data.Maybe (fromJust, isNothing) import Data.Maybe (fromJust, isNothing)
import qualified Data.Text as T import qualified Data.Text as T
@ -145,7 +146,11 @@ withNewTestChatOpts :: ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a
withNewTestChatOpts = withNewTestChatCfgOpts testCfg withNewTestChatOpts = withNewTestChatCfgOpts testCfg
withNewTestChatCfgOpts :: ChatConfig -> ChatOpts -> String -> Profile -> (TestCC -> IO a) -> IO a 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 :: String -> (TestCC -> IO a) -> IO a
withTestChatV1 = withTestChatCfg testCfgV1 withTestChatV1 = withTestChatCfg testCfgV1

View file

@ -1,7 +1,9 @@
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PostfixOperators #-} {-# LANGUAGE PostfixOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
module ChatTests where module ChatTests where
@ -9,15 +11,18 @@ import ChatClient
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (concurrently_) import Control.Concurrent.Async (concurrently_)
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Monad (forM_, when) import Control.Monad (forM_, unless, when)
import Data.Aeson (ToJSON) import Data.Aeson (ToJSON)
import qualified Data.Aeson as J import qualified Data.Aeson as J
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (isDigit) import Data.Char (isDigit)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.String
import qualified Data.Text as T import qualified Data.Text as T
import Simplex.Chat.Call 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.Options (ChatOpts (..))
import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), ImageData (..), LocalProfile (..), Profile (..), User (..)) import Simplex.Chat.Types (ConnStatus (..), GroupMemberRole (..), ImageData (..), LocalProfile (..), Profile (..), User (..))
import Simplex.Messaging.Encoding.String import Simplex.Messaging.Encoding.String
@ -66,15 +71,17 @@ chatTests = do
it "update user profiles and notify contacts" testUpdateProfile it "update user profiles and notify contacts" testUpdateProfile
it "update user profile with image" testUpdateProfileImage it "update user profile with image" testUpdateProfileImage
describe "sending and receiving files" $ do describe "sending and receiving files" $ do
it "send and receive file" testFileTransfer describe "send and receive file" $ fileTestMatrix2 runTestFileTransfer
it "send and receive a small file" testSmallFileTransfer it "send and receive file inline (without accepting)" testInlineFileTransfer
it "sender cancelled file transfer before transfer" testFileSndCancelBeforeTransfer 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 "sender cancelled file transfer during transfer" testFileSndCancelDuringTransfer
it "recipient cancelled file transfer" testFileRcvCancel it "recipient cancelled file transfer" testFileRcvCancel
it "send and receive file to group" testGroupFileTransfer describe "send and receive file to group" $ fileTestMatrix3 runTestGroupFileTransfer
it "sender cancelled group file transfer before transfer" testGroupFileSndCancelBeforeTransfer 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 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 "send and receive image" testSendImage
it "files folder: send and receive image" testFilesFoldersSendImage it "files folder: send and receive image" testFilesFoldersSendImage
it "files folder: sender deleted file during transfer" testFilesFoldersImageSndDelete it "files folder: sender deleted file during transfer" testFilesFoldersImageSndDelete
@ -133,40 +140,56 @@ versionTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
versionTestMatrix2 runTest = do versionTestMatrix2 runTest = do
it "v2" $ testChat2 aliceProfile bobProfile runTest it "v2" $ testChat2 aliceProfile bobProfile runTest
it "v1" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest it "v1" $ testChatCfg2 testCfgV1 aliceProfile bobProfile runTest
it "v1 to v2" . withTmpFiles $ it "v1 to v2" $ runTestCfg2 testCfg testCfgV1 runTest
withNewTestChat "alice" aliceProfile $ \alice -> it "v2 to v1" $ runTestCfg2 testCfgV1 testCfg runTest
withNewTestChatV1 "bob" bobProfile $ \bob ->
runTest alice bob
it "v2 to v1" . withTmpFiles $
withNewTestChatV1 "alice" aliceProfile $ \alice ->
withNewTestChat "bob" bobProfile $ \bob ->
runTest alice bob
versionTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec versionTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec
versionTestMatrix3 runTest = do versionTestMatrix3 runTest = do
it "v2" $ testChat3 aliceProfile bobProfile cathProfile runTest it "v2" $ testChat3 aliceProfile bobProfile cathProfile runTest
-- it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile runTest -- it "v1" $ testChatCfg3 testCfgV1 aliceProfile bobProfile cathProfile runTest
-- it "v1 to v2" . withTmpFiles $ -- it "v1 to v2" $ runTestCfg3 testCfg testCfgV1 testCfgV1 runTest
-- withNewTestChat "alice" aliceProfile $ \alice -> -- it "v2+v1 to v2" $ runTestCfg3 testCfg testCfg testCfgV1 runTest
-- withNewTestChatV1 "bob" bobProfile $ \bob -> -- it "v2 to v1" $ runTestCfg3 testCfgV1 testCfg testCfg runTest
-- withNewTestChatV1 "cath" cathProfile $ \cath -> -- it "v2+v1 to v1" $ runTestCfg3 testCfgV1 testCfg testCfgV1 runTest
-- runTest alice bob cath
-- it "v2+v1 to v2" . withTmpFiles $ inlineCfg :: Integer -> ChatConfig
-- withNewTestChat "alice" aliceProfile $ \alice -> inlineCfg n = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = n, receiveChunks = n}}
-- withNewTestChat "bob" bobProfile $ \bob ->
-- withNewTestChatV1 "cath" cathProfile $ \cath -> fileTestMatrix2 :: (TestCC -> TestCC -> IO ()) -> Spec
-- runTest alice bob cath fileTestMatrix2 runTest = do
-- it "v2 to v1" . withTmpFiles $ it "via connection" $ runTestCfg2 viaConn viaConn runTest
-- withNewTestChatV1 "alice" aliceProfile $ \alice -> it "inline (accepting)" $ runTestCfg2 inline inline runTest
-- withNewTestChat "bob" bobProfile $ \bob -> it "via connection (inline offered)" $ runTestCfg2 inline viaConn runTest
-- withNewTestChat "cath" cathProfile $ \cath -> it "via connection (inline supported)" $ runTestCfg2 viaConn inline runTest
-- runTest alice bob cath where
-- it "v2+v1 to v1" . withTmpFiles $ inline = inlineCfg 100
-- withNewTestChatV1 "alice" aliceProfile $ \alice -> viaConn = inlineCfg 0
-- withNewTestChat "bob" bobProfile $ \bob ->
-- withNewTestChatV1 "cath" cathProfile $ \cath -> fileTestMatrix3 :: (TestCC -> TestCC -> TestCC -> IO ()) -> Spec
-- runTest alice bob cath 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 :: Spec
testAddContact = versionTestMatrix2 runTestAddContact testAddContact = versionTestMatrix2 runTestAddContact
@ -1351,68 +1374,88 @@ testUpdateProfileImage =
bob <## "use @alice2 <message> to send messages" bob <## "use @alice2 <message> to send messages"
(bob </) (bob </)
testFileTransfer :: IO () runTestFileTransfer :: TestCC -> TestCC -> IO ()
testFileTransfer = runTestFileTransfer alice bob = do
testChat2 aliceProfile bobProfile $ connectUsers alice bob
\alice bob -> do startFileTransfer' alice bob "test.pdf" "266.0 KiB / 272376 bytes"
connectUsers alice bob concurrentlyN_
startFileTransfer alice bob [ do
concurrentlyN_ bob #> "@alice receiving here..."
[ do bob <## "completed receiving file 1 (test.pdf) from alice",
bob #> "@alice receiving here..." alice
bob <## "completed receiving file 1 (test.jpg) from alice", <### [ WithTime "bob> receiving here...",
do "completed sending file 1 (test.pdf) to bob"
alice <# "bob> receiving here..." ]
alice <## "completed sending file 1 (test.jpg) to bob" ]
] src <- B.readFile "./tests/fixtures/test.pdf"
src <- B.readFile "./tests/fixtures/test.jpg" dest <- B.readFile "./tests/tmp/test.pdf"
dest <- B.readFile "./tests/tmp/test.jpg" dest `shouldBe` src
dest `shouldBe` src
testSmallFileTransfer :: IO () testInlineFileTransfer :: IO ()
testSmallFileTransfer = testInlineFileTransfer =
testChat2 aliceProfile bobProfile $ testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
\alice bob -> do connectUsers alice bob
connectUsers alice bob bob ##> "/_files_folder ./tests/tmp/"
alice #> "/f @bob ./tests/fixtures/test.txt" bob <## "ok"
alice <## "use /fc 1 to cancel sending" alice #> "/f @bob ./tests/fixtures/test.jpg"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)" -- below is not shown in "sent" mode
bob <## "use /fr 1 [<dir>/ | <path>] to receive it" -- alice <## "use /fc 1 to cancel sending"
bob ##> "/fr 1 ./tests/tmp" bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
bob <## "saving file 1 from alice to ./tests/tmp/test.txt" -- below is not shown in "sent" mode
concurrentlyN_ -- bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
[ do bob <## "started receiving file 1 (test.jpg) from alice"
bob <## "started receiving file 1 (test.txt) from alice" concurrently_
bob <## "completed receiving file 1 (test.txt) from alice", (alice <## "completed sending file 1 (test.jpg) to bob")
do (bob <## "completed receiving file 1 (test.jpg) from alice")
alice <## "started sending file 1 (test.txt) to bob" src <- B.readFile "./tests/fixtures/test.jpg"
alice <## "completed sending file 1 (test.txt) to bob" dest <- B.readFile "./tests/tmp/test.jpg"
] dest `shouldBe` src
src <- B.readFile "./tests/fixtures/test.txt" where
dest <- B.readFile "./tests/tmp/test.txt" cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}}
dest `shouldBe` src
testFileSndCancelBeforeTransfer :: IO () runTestSmallFileTransfer :: TestCC -> TestCC -> IO ()
testFileSndCancelBeforeTransfer = runTestSmallFileTransfer alice bob = do
testChat2 aliceProfile bobProfile $ connectUsers alice bob
\alice bob -> do alice #> "/f @bob ./tests/fixtures/test.txt"
connectUsers alice bob alice <## "use /fc 1 to cancel sending"
alice #> "/f @bob ./tests/fixtures/test.txt" bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
alice <## "use /fc 1 to cancel sending" bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)" bob ##> "/fr 1 ./tests/tmp"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it" bob <## "saving file 1 from alice to ./tests/tmp/test.txt"
alice ##> "/fc 1" concurrentlyN_
concurrentlyN_ [ do
[ alice <## "cancelled sending file 1 (test.txt) to bob", bob <## "started receiving file 1 (test.txt) from alice"
bob <## "alice cancelled sending file 1 (test.txt)" bob <## "completed receiving file 1 (test.txt) from alice",
] do
alice ##> "/fs 1" alice <## "started sending file 1 (test.txt) to bob"
alice <## "sending file 1 (test.txt) cancelled: bob" alice <## "completed sending file 1 (test.txt) to bob"
alice <## "file transfer cancelled" ]
bob ##> "/fs 1" src <- B.readFile "./tests/fixtures/test.txt"
bob <## "receiving file 1 (test.txt) cancelled" dest <- B.readFile "./tests/tmp/test.txt"
bob ##> "/fr 1 ./tests/tmp" dest `shouldBe` src
bob <## "file cancelled: test.txt"
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 :: IO ()
testFileSndCancelDuringTransfer = testFileSndCancelDuringTransfer =
@ -1456,101 +1499,138 @@ testFileRcvCancel =
] ]
checkPartialTransfer "test.jpg" checkPartialTransfer "test.jpg"
testGroupFileTransfer :: IO () runTestGroupFileTransfer :: TestCC -> TestCC -> TestCC -> IO ()
testGroupFileTransfer = runTestGroupFileTransfer alice bob cath = do
testChat3 aliceProfile bobProfile cathProfile $ 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 \alice bob cath -> do
createGroup3 "team" alice bob cath 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 #> "/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_ concurrentlyN_
[ do [ 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 <# "#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 do
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" 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 <## "started receiving file 1 (test.jpg) from alice"
cath <## "completed 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" src <- B.readFile "./tests/fixtures/test.jpg"
dest <- B.readFile "./tests/tmp/test.jpg" dest1 <- B.readFile "./tests/tmp/bob/test.jpg"
dest `shouldBe` src dest2 <- B.readFile "./tests/tmp/cath/test.jpg"
alice #$> ("/_get chat @2 count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")]) dest1 `shouldBe` src
bob #$> ("/_get chat @2 count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")]) 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 :: IO ()
testSendImage = testSendImage =
@ -2278,7 +2358,7 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
do do
dan <## "#secret_club: you joined the group" dan <## "#secret_club: you joined the group"
dan dan
<### [ "#secret_club: member " <> cathIncognito <> " is connected", <### [ ConsoleString $ "#secret_club: member " <> cathIncognito <> " is connected",
"#secret_club: member bob_1 (Bob) is connected", "#secret_club: member bob_1 (Bob) is connected",
"contact bob_1 is merged into bob", "contact bob_1 is merged into bob",
"use @bob <message> to send messages" "use @bob <message> to send messages"
@ -2338,28 +2418,28 @@ testJoinGroupIncognito = testChat4 aliceProfile bobProfile cathProfile danProfil
alice alice
<### [ "alice (Alice): owner, you, created group", <### [ "alice (Alice): owner, you, created group",
"bob (Bob): admin, invited, connected", "bob (Bob): admin, invited, connected",
cathIncognito <> ": admin, invited, connected", ConsoleString $ cathIncognito <> ": admin, invited, connected",
"dan (Daniel): admin, invited, connected" "dan (Daniel): admin, invited, connected"
] ]
bob ##> "/ms secret_club" bob ##> "/ms secret_club"
bob bob
<### [ "alice (Alice): owner, host, connected", <### [ "alice (Alice): owner, host, connected",
"bob (Bob): admin, you, connected", "bob (Bob): admin, you, connected",
cathIncognito <> ": admin, connected", ConsoleString $ cathIncognito <> ": admin, connected",
"dan (Daniel): admin, connected" "dan (Daniel): admin, connected"
] ]
cath ##> "/ms secret_club" cath ##> "/ms secret_club"
cath cath
<### [ "alice (Alice): owner, host, connected", <### [ "alice (Alice): owner, host, connected",
"bob_1 (Bob): admin, connected", "bob_1 (Bob): admin, connected",
"i " <> cathIncognito <> ": admin, you, connected", ConsoleString $ "i " <> cathIncognito <> ": admin, you, connected",
"dan_1 (Daniel): admin, connected" "dan_1 (Daniel): admin, connected"
] ]
dan ##> "/ms secret_club" dan ##> "/ms secret_club"
dan dan
<### [ "alice (Alice): owner, host, connected", <### [ "alice (Alice): owner, host, connected",
"bob (Bob): admin, connected", "bob (Bob): admin, connected",
cathIncognito <> ": admin, connected", ConsoleString $ cathIncognito <> ": admin, connected",
"dan (Daniel): admin, you, connected" "dan (Daniel): admin, you, connected"
] ]
-- remove member -- remove member
@ -3456,18 +3536,44 @@ cc <## line = do
when (l /= line) $ print ("expected: " <> line, ", got: " <> l) when (l /= line) $ print ("expected: " <> line, ", got: " <> l)
l `shouldBe` line 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 _ _ [] = pure ()
getInAnyOrder f cc ls = do getInAnyOrder f cc ls = do
line <- f <$> getTermLine cc line <- f <$> getTermLine cc
if line `elem` ls let rest = filter (not . expected line) ls
then getInAnyOrder f cc $ filter (/= line) ls if length rest < length ls
then getInAnyOrder f cc rest
else error $ "unexpected output: " <> line 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 (<###) = getInAnyOrder id
(<##?) :: TestCC -> [String] -> Expectation (<##?) :: TestCC -> [ConsoleResponse] -> Expectation
(<##?) = getInAnyOrder dropTime (<##?) = getInAnyOrder dropTime
(<#) :: TestCC -> String -> Expectation (<#) :: TestCC -> String -> Expectation
@ -3489,13 +3595,16 @@ cc1 <#? cc2 = do
cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)") cc1 <## ("to reject: /rc " <> name <> " (the sender will NOT be notified)")
dropTime :: String -> String dropTime :: String -> String
dropTime msg = case splitAt 6 msg of dropTime msg = fromMaybe err $ dropTime_ msg
([m, m', ':', s, s', ' '], text) ->
if all isDigit [m, m', s, s'] then text else err
_ -> err
where where
err = error $ "invalid time: " <> msg 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 :: TestCC -> IO String
getInvitation cc = do getInvitation cc = do
cc <## "pass this invitation link to your contact (via another channel):" 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 :: ConnectionRequestUri 'CMInvitation
testConnReq = CRInvitationUri connReqData testE2ERatchetParams testConnReq = CRInvitationUri connReqData testE2ERatchetParams
(==##) :: ByteString -> ChatMessage -> Expectation (==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ==## msg = do s ==## msg = do
strDecode s `shouldBe` Right msg strDecode s `shouldBe` Right msg
parseAll strP s `shouldBe` Right msg parseAll strP s `shouldBe` Right msg
(##==) :: ByteString -> ChatMessage -> Expectation (##==) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##== msg = s ##== msg =
J.eitherDecodeStrict' (strEncode msg) J.eitherDecodeStrict' (strEncode msg)
`shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value) `shouldBe` (J.eitherDecodeStrict' s :: Either String J.Value)
(##==##) :: ByteString -> ChatMessage -> Expectation (##==##) :: MsgEncodingI e => ByteString -> ChatMessage e -> Expectation
s ##==## msg = do s ##==## msg = do
s ##== msg s ##== msg
s ==## msg s ==## msg
(==#) :: ByteString -> ChatMsgEvent -> Expectation (==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s ==# msg = s ==## ChatMessage Nothing msg s ==# msg = s ==## ChatMessage Nothing msg
(#==) :: ByteString -> ChatMsgEvent -> Expectation (#==) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s #== msg = s ##== ChatMessage Nothing msg s #== msg = s ##== ChatMessage Nothing msg
(#==#) :: ByteString -> ChatMsgEvent -> Expectation (#==#) :: MsgEncodingI e => ByteString -> ChatMsgEvent e -> Expectation
s #==# msg = do s #==# msg = do
s #== msg s #== msg
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)) ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing))
it "x.msg.new simple text with file" $ it "x.msg.new simple text with file" $
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" "{\"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" $ it "x.msg.new simple file with file" $
"{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"file\"},\"file\":{\"fileSize\":12345,\"fileName\":\"file.txt\"}}}" "{\"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" $ 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\"}}}" "{\"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 ##==## ChatMessage
@ -138,13 +138,13 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
) )
( ExtMsgContent ( ExtMsgContent
(MCText "hello to you too") (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" $ 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\"}}}" "{\"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" $ it "x.msg.update" $
"{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" "{\"event\":\"x.msg.update\",\"params\":{\"msgId\":\"AQIDBA==\", \"content\":{\"text\":\"hello\",\"type\":\"text\"}}}"
#==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello") #==# XMsgUpdate (SharedMsgId "\1\2\3\4") (MCText "hello")
@ -156,16 +156,19 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do
#==# XMsgDeleted #==# XMsgDeleted
it "x.file" $ 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\"}}}" "{\"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" $ it "x.file without file invitation" $
"{\"event\":\"x.file\",\"params\":{\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" "{\"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" $ it "x.file.acpt" $
"{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}" "{\"event\":\"x.file.acpt\",\"params\":{\"fileName\":\"photo.jpg\"}}"
#==# XFileAcpt "photo.jpg" #==# XFileAcpt "photo.jpg"
it "x.file.acpt.inv" $ 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\"}}" "{\"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" $ it "x.file.cancel" $
"{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}" "{\"event\":\"x.file.cancel\",\"params\":{\"msgId\":\"AQIDBA==\"}}"
#==# XFileCancel (SharedMsgId "\1\2\3\4") #==# XFileCancel (SharedMsgId "\1\2\3\4")

BIN
tests/fixtures/test.pdf vendored Normal file

Binary file not shown.