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