diff --git a/cabal.project b/cabal.project index e3ad4ef1c1..b12f8d3987 100644 --- a/cabal.project +++ b/cabal.project @@ -1,9 +1,9 @@ -packages: . +packages: . ../simplexmq source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 628930df1fa1c3fff6fd1413e7b437148c4a83b5 + tag: 60294521f4e7a8faa576872eba140de1a3ffd21c source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index f56ebfa858..a200b8857c 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."628930df1fa1c3fff6fd1413e7b437148c4a83b5" = "03h063yahq6b5m1lng7as70a59lklhzsxg0ykmr9wldy8768dlvd"; + "https://github.com/simplex-chat/simplexmq.git"."60294521f4e7a8faa576872eba140de1a3ffd21c" = "1g99q2ds8g5jz14xs3h4xjnh0w0j2bf40adaa5cb6fpiv67fsv7y"; "https://github.com/simplex-chat/aeson.git"."3eb66f9a68f103b5f1489382aad89f5712a64db7" = "0kilkx59fl6c3qy3kjczqvm8c3f4n3p0bdk9biyflf51ljnzp4yp"; "https://github.com/simplex-chat/haskell-terminal.git"."f708b00009b54890172068f168bf98508ffcd495" = "0zmq7lmfsk8m340g47g5963yba7i88n4afa6z93sg9px5jv1mijj"; "https://github.com/zw3rk/android-support.git"."3c3a5ab0b8b137a072c98d3d0937cbdc96918ddb" = "1r6jyxbim3dsvrmakqfyxbd6ms6miaghpbwyl0sr6dzwpgaprz97"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index da5f7116c7..e6a9276e17 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -50,7 +50,7 @@ import Simplex.Chat.Options (ChatOpts (..), smpServersP) import Simplex.Chat.Protocol import Simplex.Chat.Store import Simplex.Chat.Types -import Simplex.Chat.Util (ifM, safeDecodeUtf8, unlessM, whenM) +import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Agent import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), defaultAgentConfig) import Simplex.Messaging.Agent.Protocol @@ -60,10 +60,10 @@ import Simplex.Messaging.Encoding.String import Simplex.Messaging.Notifications.Client (NtfServer) import Simplex.Messaging.Notifications.Protocol (DeviceToken (..), PushProvider (..)) import Simplex.Messaging.Parsers (base64P, parseAll) -import Simplex.Messaging.Protocol (ErrorType (..), MsgBody) +import Simplex.Messaging.Protocol (ErrorType (..), MsgBody, MsgFlags (..)) import qualified Simplex.Messaging.Protocol as SMP import qualified Simplex.Messaging.TMap as TM -import Simplex.Messaging.Util (tryError, (<$?>)) +import Simplex.Messaging.Util (ifM, tryError, unlessM, whenM, (<$?>)) import System.Exit (exitFailure, exitSuccess) import System.FilePath (combine, splitExtensions, takeFileName) import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout) @@ -1132,7 +1132,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage allowAgentConnection conn confId $ XInfo profile INFO connInfo -> saveConnInfo conn connInfo - MSG meta msgBody -> do + MSG meta _msgFlags msgBody -> do _ <- saveRcvMSG conn (ConnectionId connId) meta msgBody withAckMessage agentConnId meta $ pure () ackMsgDeliveryEvent conn meta @@ -1145,7 +1145,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage -- TODO add debugging output _ -> pure () Just ct@Contact {localDisplayName = c, contactId} -> case agentMsg of - MSG msgMeta msgBody -> do + MSG msgMeta _msgFlags msgBody -> do msg@RcvMessage {chatMsgEvent} <- saveRcvMSG conn (ConnectionId connId) msgMeta msgBody withAckMessage agentConnId msgMeta $ case chatMsgEvent of @@ -1285,7 +1285,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage when (connStatus == ConnReady) $ do notifyMemberConnected gInfo m when (memberCategory m == GCPreMember) $ probeMatchingContacts ct - MSG msgMeta msgBody -> do + MSG msgMeta _msgFlags msgBody -> do msg@RcvMessage {chatMsgEvent} <- saveRcvMSG conn (GroupId groupId) msgMeta msgBody withAckMessage agentConnId msgMeta $ case chatMsgEvent of @@ -1344,7 +1344,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage ci <- withStore $ \st -> getChatItemByFileId st user fileId toView $ CRSndFileRcvCancelled ci ft _ -> throwChatError $ CEFileSend fileId err - MSG meta _ -> + MSG meta _ _ -> withAckMessage agentConnId meta $ pure () -- TODO print errors ERR _ -> pure () @@ -1368,7 +1368,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage updateCIFileStatus st user fileId CIFSRcvTransfer getChatItemByFileId st user fileId toView $ CRRcvFileStart ci - MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do + MSG meta@MsgMeta {recipient = (msgId, _), integrity} _ msgBody -> withAckMessage agentConnId meta $ do parseFileChunk msgBody >>= \case FileChunkCancel -> unless cancelled $ do @@ -1911,7 +1911,7 @@ sendFileChunk user ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentCo sendFileChunkNo :: ChatMonad m => SndFileTransfer -> Integer -> m () sendFileChunkNo ft@SndFileTransfer {agentConnId = AgentConnId acId} chunkNo = do chunkBytes <- readFileChunk ft chunkNo - msgId <- withAgent $ \a -> sendMessage a acId $ smpEncode FileChunk {chunkNo, chunkBytes} + msgId <- withAgent $ \a -> sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunk {chunkNo, chunkBytes} withStore $ \st -> updateSndFileChunkMsg st ft chunkNo msgId readFileChunk :: ChatMonad m => SndFileTransfer -> Integer -> m ByteString @@ -2005,7 +2005,7 @@ cancelSndFileTransfer ft@SndFileTransfer {agentConnId = AgentConnId acId, fileSt updateSndFileStatus st ft FSCancelled deleteSndFileChunks st ft withAgent $ \a -> do - void (sendMessage a acId $ smpEncode FileChunkCancel) `catchError` \_ -> pure () + void (sendMessage a acId SMP.noMsgFlags $ smpEncode FileChunkCancel) `catchError` \_ -> pure () deleteConnection a acId closeFileHandle :: ChatMonad m => Int64 -> (ChatController -> TVar (Map Int64 Handle)) -> m () @@ -2033,7 +2033,7 @@ sendDirectContactMessage ct@Contact {activeConn = conn@Connection {connId, connS sendDirectMessage :: ChatMonad m => Connection -> ChatMsgEvent -> ConnOrGroupId -> m SndMessage sendDirectMessage conn chatMsgEvent connOrGroupId = do msg@SndMessage {msgId, msgBody} <- createSndMessage chatMsgEvent connOrGroupId - deliverMessage conn msgBody msgId + deliverMessage conn (toCMEventTag chatMsgEvent) msgBody msgId pure msg createSndMessage :: ChatMonad m => ChatMsgEvent -> ConnOrGroupId -> m SndMessage @@ -2046,9 +2046,10 @@ createSndMessage chatMsgEvent connOrGroupId = do directMessage :: ChatMsgEvent -> ByteString directMessage chatMsgEvent = strEncode ChatMessage {msgId = Nothing, chatMsgEvent} -deliverMessage :: ChatMonad m => Connection -> MsgBody -> MessageId -> m () -deliverMessage conn@Connection {connId} msgBody msgId = do - agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) msgBody +deliverMessage :: ChatMonad m => Connection -> CMEventTag -> MsgBody -> MessageId -> m () +deliverMessage conn@Connection {connId} cmEventTag msgBody msgId = do + let msgFlags = MsgFlags {notification = hasNotification cmEventTag} + agentMsgId <- withAgent $ \a -> sendMessage a (aConnId conn) msgFlags msgBody let sndMsgDelivery = SndMsgDelivery {connId, agentMsgId} withStore $ \st -> createSndMsgDelivery st sndMsgDelivery msgId @@ -2068,10 +2069,12 @@ sendGroupMessage' members chatMsgEvent groupId introId_ postDeliver = do forM_ (filter memberCurrent members) $ \m@GroupMember {groupMemberId} -> case memberConn m of Nothing -> withStore $ \st -> createPendingGroupMessage st groupMemberId msgId introId_ - Just conn@Connection {connStatus} -> - if not (connStatus == ConnSndReady || connStatus == ConnReady) - then unless (connStatus == ConnDeleted) $ withStore (\st -> createPendingGroupMessage st groupMemberId msgId introId_) - else (deliverMessage conn msgBody msgId >> postDeliver) `catchError` const (pure ()) + Just conn@Connection {connStatus} + | connStatus == ConnSndReady || connStatus == ConnReady -> do + let tag = toCMEventTag chatMsgEvent + (deliverMessage conn tag msgBody msgId >> postDeliver) `catchError` const (pure ()) + | connStatus == ConnDeleted -> pure () + | otherwise -> withStore (\st -> createPendingGroupMessage st groupMemberId msgId introId_) pure msg sendPendingGroupMessages :: ChatMonad m => GroupMember -> Connection -> m () @@ -2079,7 +2082,7 @@ sendPendingGroupMessages GroupMember {groupMemberId, localDisplayName} conn = do pendingMessages <- withStore $ \st -> getPendingGroupMessages st groupMemberId -- TODO ensure order - pending messages interleave with user input messages forM_ pendingMessages $ \PendingGroupMessage {msgId, cmEventTag, msgBody, introId_} -> do - deliverMessage conn msgBody msgId + deliverMessage conn cmEventTag msgBody msgId withStore (\st -> deletePendingGroupMessage st groupMemberId msgId) when (cmEventTag == XGrpMemFwd_) $ case introId_ of Nothing -> throwChatError $ CEGroupMemberIntroNotFound localDisplayName diff --git a/src/Simplex/Chat/Archive.hs b/src/Simplex/Chat/Archive.hs index 31a5714eae..a15ca1bb2d 100644 --- a/src/Simplex/Chat/Archive.hs +++ b/src/Simplex/Chat/Archive.hs @@ -6,9 +6,9 @@ module Simplex.Chat.Archive where import qualified Codec.Archive.Zip as Z import Control.Monad.Reader import Simplex.Chat.Controller -import Simplex.Chat.Util (whenM) import Simplex.Messaging.Agent.Client (agentDbPath) import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..)) +import Simplex.Messaging.Util (whenM) import System.FilePath import UnliftIO.Directory import UnliftIO.STM diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 48c1cb337a..e3bad56595 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -32,12 +32,12 @@ import GHC.Generics (Generic) import Simplex.Chat.Markdown import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8) +import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Agent.Protocol (AgentErrorType, AgentMsgId, MsgErrorType (..), MsgMeta (..)) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, singleFieldJSON, sumTypeJSON) import Simplex.Messaging.Protocol (MsgBody) -import Simplex.Messaging.Util ((<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection deriving (Show, Generic) diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 83b0d8c204..9418d26223 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -31,10 +31,10 @@ import Database.SQLite.Simple.ToField (ToField (..)) import GHC.Generics (Generic) import Simplex.Chat.Call import Simplex.Chat.Types -import Simplex.Chat.Util (eitherToMaybe, safeDecodeUtf8) +import Simplex.Chat.Util (safeDecodeUtf8) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (fromTextField_) -import Simplex.Messaging.Util ((<$?>)) +import Simplex.Messaging.Util (eitherToMaybe, (<$?>)) data ConnectionEntity = RcvDirectMsgConnection {entityConnection :: Connection, contact :: Maybe Contact} @@ -437,6 +437,16 @@ instance FromField CMEventTag where fromField = fromTextField_ cmEventTagT instance ToField CMEventTag where toField = toField . serializeCMEventTag +hasNotification :: CMEventTag -> Bool +hasNotification = \case + XMsgNew_ -> True + XFile_ -> True + XContact_ -> True + XGrpInv_ -> True + XGrpDel_ -> True + XCallInv_ -> True + _ -> False + appToChatMessage :: AppMessage -> Either String ChatMessage appToChatMessage AppMessage {msgId, event, params} = do eventTag <- strDecode $ encodeUtf8 event diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index aadac15c92..f6b4c7a1ec 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -206,7 +206,6 @@ import Simplex.Chat.Migrations.M20220404_files_status_fields import Simplex.Chat.Migrations.M20220514_profiles_user_id import Simplex.Chat.Protocol import Simplex.Chat.Types -import Simplex.Chat.Util (eitherToMaybe) import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..)) import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, firstRow, withTransaction) import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) @@ -214,7 +213,7 @@ import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String (StrEncoding (strEncode)) import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON) import Simplex.Messaging.Protocol (ProtocolServer (..), SMPServer, pattern SMPServer) -import Simplex.Messaging.Util (liftIOEither, (<$$>)) +import Simplex.Messaging.Util (eitherToMaybe, liftIOEither, (<$$>)) import UnliftIO.STM schemaMigrations :: [(String, Query)] diff --git a/src/Simplex/Chat/Util.hs b/src/Simplex/Chat/Util.hs index a5e4c8b1e0..d2fe0c3d40 100644 --- a/src/Simplex/Chat/Util.hs +++ b/src/Simplex/Chat/Util.hs @@ -1,6 +1,5 @@ module Simplex.Chat.Util where -import Control.Monad (when) import Data.ByteString.Char8 (ByteString) import Data.Text (Text) import Data.Text.Encoding (decodeUtf8With) @@ -9,15 +8,3 @@ safeDecodeUtf8 :: ByteString -> Text safeDecodeUtf8 = decodeUtf8With onError where onError _ _ = Just '?' - -ifM :: Monad m => m Bool -> m a -> m a -> m a -ifM ba t f = ba >>= \b -> if b then t else f - -whenM :: Monad m => m Bool -> m () -> m () -whenM ba a = ba >>= (`when` a) - -unlessM :: Monad m => m Bool -> m () -> m () -unlessM b = ifM b $ pure () - -eitherToMaybe :: Either a b -> Maybe b -eitherToMaybe = either (const Nothing) Just diff --git a/stack.yaml b/stack.yaml index eac63e18ad..e6e2417f55 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: 628930df1fa1c3fff6fd1413e7b437148c4a83b5 + commit: 60294521f4e7a8faa576872eba140de1a3ffd21c # - terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977 - github: simplex-chat/aeson commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7 diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index 03c7991c85..23f4d1bb45 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -20,7 +20,7 @@ import Simplex.Chat.Call import Simplex.Chat.Controller (ChatController (..)) import Simplex.Chat.Options (ChatOpts (..)) import Simplex.Chat.Types (ConnStatus (..), ImageData (..), Profile (..), User (..)) -import Simplex.Chat.Util (unlessM) +import Simplex.Messaging.Util (unlessM) import System.Directory (copyFile, doesDirectoryExist, doesFileExist) import System.FilePath (()) import Test.Hspec