core: send SMP notification msg flag based on chat message (#733)

* core: send SMP notification msg flag based on chat message * update simplexmq * remove unnecessary condition Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com> Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>
2022-06-07 14:14:54 +01:00
parent 33e702d453
commit 16bd9ccc4f
10 changed files with 43 additions and 44 deletions
--- 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
--- 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";
--- 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
--- 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
--- 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)
--- 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
--- 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)]
--- 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
--- 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
--- 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