diff --git a/cabal.project b/cabal.project index da9c180bb1..c5c00106eb 100644 --- a/cabal.project +++ b/cabal.project @@ -7,7 +7,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 552759018e493cf224d2451a3dabee2401ab3853 + tag: 8fde8e1344699cdcdc67709595c9285cd06bbef3 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 44afd025e6..c945101586 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."552759018e493cf224d2451a3dabee2401ab3853" = "06jv5ax4482jkrfmr3alffixay1cvpjycqnhk53xkm8midhx8mg5"; + "https://github.com/simplex-chat/simplexmq.git"."8fde8e1344699cdcdc67709595c9285cd06bbef3" = "1nvxmmfq3k1a8l14lksxdsqzxq19kmvg2kpiryqdks3k946x6pzn"; "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"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 0c1a9c7bca..e2f31b94a1 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1350,7 +1350,7 @@ processChatCommand = \case updateGroupProfileByName gName $ \p -> p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p} QuitChat -> liftIO exitSuccess - ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) $(simplexmqCommitQ) + ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) "" -- $(simplexmqCommitQ) DebugLocks -> do chatLockName <- atomically . tryReadTMVar =<< asks chatLock agentLocks <- withAgent debugAgentLocks @@ -1842,7 +1842,7 @@ agentSubscriber = do q <- asks $ subQ . smpAgent l <- asks chatLock forever $ do - (corrId, connId, msg) <- atomically $ readTBQueue q + (corrId, connId, APC _ msg) <- atomically $ readTBQueue q let name = "agentSubscriber connId=" <> str connId <> " corrId=" <> str corrId <> " msg=" <> str (aCommandTag msg) withLock l name . void . runExceptT $ processAgentMessage corrId connId msg `catchError` (toView . CRChatError Nothing) @@ -2066,7 +2066,7 @@ expireChatItems user@User {userId} ttl sync = do membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m -processAgentMessage :: forall m. ChatMonad m => ACorrId -> ConnId -> ACommand 'Agent -> m () +processAgentMessage :: forall e m. (AEntityI e, ChatMonad m) => ACorrId -> ConnId -> ACommand 'Agent e -> m () processAgentMessage _ "" msg = processAgentMessageNoConn msg `catchError` (toView . CRChatError Nothing) processAgentMessage _ connId (DEL_RCVQ srv qId err_) = @@ -2078,7 +2078,7 @@ processAgentMessage corrId connId msg = Just user -> processAgentMessageConn user corrId connId msg `catchError` (toView . CRChatError (Just user)) _ -> throwChatError $ CENoConnectionUser (AgentConnId connId) -processAgentMessageNoConn :: forall m. ChatMonad m => ACommand 'Agent -> m () +processAgentMessageNoConn :: forall e m. ChatMonad m => ACommand 'Agent e -> m () processAgentMessageNoConn = \case CONNECT p h -> hostEvent $ CRHostConnected p h DISCONNECT p h -> hostEvent $ CRHostDisconnected p h @@ -2088,13 +2088,14 @@ processAgentMessageNoConn = \case DEL_USER agentUserId -> toView $ CRAgentUserDeleted agentUserId _ -> pure () where + hostEvent :: ChatResponse -> m () hostEvent = whenM (asks $ hostEvents . config) . toView serverEvent srv@(SMPServer host _ _) conns event str = do cs <- withStore' $ \db -> getConnectionsContacts db conns toView $ event srv cs showToast ("server " <> str) (safeDecodeUtf8 $ strEncode host) -processAgentMessageConn :: forall m. ChatMonad m => User -> ACorrId -> ConnId -> ACommand 'Agent -> m () +processAgentMessageConn :: forall e m. (AEntityI e, ChatMonad m) => User -> ACorrId -> ConnId -> ACommand 'Agent e -> m () processAgentMessageConn user _ agentConnId END = withStore (\db -> getConnectionEntity db user $ AgentConnId agentConnId) >>= \case RcvDirectMsgConnection _ (Just ct@Contact {localDisplayName = c}) -> do @@ -2128,14 +2129,14 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do isMember memId GroupInfo {membership} members = sameMemberId memId membership || isJust (find (sameMemberId memId) members) - agentMsgConnStatus :: ACommand 'Agent -> Maybe ConnStatus + agentMsgConnStatus :: ACommand 'Agent e -> Maybe ConnStatus agentMsgConnStatus = \case CONF {} -> Just ConnRequested INFO _ -> Just ConnSndReady CON -> Just ConnReady _ -> Nothing - processDirectMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> Maybe Contact -> m () + processDirectMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> Maybe Contact -> m () processDirectMessage agentMsg connEntity conn@Connection {connId, viaUserContactLink, groupLinkId, customUserProfileId} = \case Nothing -> case agentMsg of CONF confId _ connInfo -> do @@ -2282,7 +2283,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO add debugging output _ -> pure () - processGroupMessage :: ACommand 'Agent -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m () + processGroupMessage :: ACommand 'Agent e -> ConnectionEntity -> Connection -> GroupInfo -> GroupMember -> m () processGroupMessage agentMsg connEntity conn@Connection {connId} gInfo@GroupInfo {groupId, localDisplayName = gName, groupProfile, membership, chatSettings} m = case agentMsg of INV (ACR _ cReq) -> withCompletedCommand conn agentMsg $ \CommandData {cmdFunction} -> @@ -2439,7 +2440,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO add debugging output _ -> pure () - processSndFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> SndFileTransfer -> m () + processSndFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> SndFileTransfer -> m () processSndFileConn agentMsg connEntity conn ft@SndFileTransfer {fileId, fileName, fileStatus} = case agentMsg of -- SMP CONF for SndFileConnection happens for direct file protocol @@ -2483,7 +2484,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do -- TODO add debugging output _ -> pure () - processRcvFileConn :: ACommand 'Agent -> ConnectionEntity -> Connection -> RcvFileTransfer -> m () + processRcvFileConn :: ACommand 'Agent e -> ConnectionEntity -> Connection -> RcvFileTransfer -> m () processRcvFileConn agentMsg connEntity conn ft@RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}, grpMemberId} = case agentMsg of INV (ACR _ cReq) -> @@ -2578,7 +2579,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do withAckMessage agentConnId cmdId meta a Nothing -> a - processUserContactRequest :: ACommand 'Agent -> ConnectionEntity -> Connection -> UserContact -> m () + processUserContactRequest :: ACommand 'Agent e -> ConnectionEntity -> Connection -> UserContact -> m () processUserContactRequest agentMsg connEntity conn UserContact {userContactLinkId} = case agentMsg of REQ invId _ connInfo -> do ChatMessage {chatMsgEvent} <- parseChatMessage connInfo @@ -2629,20 +2630,20 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do toView $ CRConnectionDisabled connEntity _ -> pure () - updateChatLock :: MsgEncodingI e => String -> ChatMsgEvent e -> m () + updateChatLock :: MsgEncodingI enc => String -> ChatMsgEvent enc -> m () updateChatLock name event = do l <- asks chatLock atomically $ tryReadTMVar l >>= mapM_ (swapTMVar l . (<> s)) where s = " " <> name <> "=" <> B.unpack (strEncode $ toCMEventTag event) - withCompletedCommand :: Connection -> ACommand 'Agent -> (CommandData -> m ()) -> m () + withCompletedCommand :: Connection -> ACommand 'Agent e -> (CommandData -> m ()) -> m () withCompletedCommand Connection {connId} agentMsg action = do - let agentMsgTag = aCommandTag agentMsg + let agentMsgTag = APCT (sAEntity @e) $ aCommandTag agentMsg cmdData_ <- withStore' $ \db -> getCommandDataByCorrId db user corrId case cmdData_ of Just cmdData@CommandData {cmdId, cmdConnId = Just cmdConnId', cmdFunction} - | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == ERR_) -> do + | connId == cmdConnId' && (agentMsgTag == commandExpectedResponse cmdFunction || agentMsgTag == APCT SAEConn ERR_) -> do withStore' $ \db -> deleteCommand db user cmdId action cmdData | otherwise -> err cmdId $ "not matching connection id or unexpected response, corrId = " <> show corrId diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index a0aafe4223..17b3c92f92 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -49,7 +49,7 @@ 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.Agent.Protocol (ACommandTag (..), ACorrId, AParty (..), APartyCmdTag (..), ConnId, ConnectionMode (..), ConnectionRequestUri, InvitationId, SAEntity (..)) import Simplex.Messaging.Encoding.String import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, sumTypeJSON, taggedObjectJSON) import Simplex.Messaging.Protocol (AProtoServerWithAuth, ProtoServerWithAuth, ProtocolTypeI) @@ -1939,17 +1939,19 @@ instance TextEncoding CommandFunction where CFAckMessage -> "ack_message" CFDeleteConn -> "delete_conn" -commandExpectedResponse :: CommandFunction -> ACommandTag 'Agent +commandExpectedResponse :: CommandFunction -> APartyCmdTag 'Agent commandExpectedResponse = \case - CFCreateConnGrpMemInv -> INV_ - CFCreateConnGrpInv -> INV_ - CFCreateConnFileInvDirect -> INV_ - CFCreateConnFileInvGroup -> INV_ - CFJoinConn -> OK_ - CFAllowConn -> OK_ - CFAcceptContact -> OK_ - CFAckMessage -> OK_ - CFDeleteConn -> OK_ + CFCreateConnGrpMemInv -> t INV_ + CFCreateConnGrpInv -> t INV_ + CFCreateConnFileInvDirect -> t INV_ + CFCreateConnFileInvGroup -> t INV_ + CFJoinConn -> t OK_ + CFAllowConn -> t OK_ + CFAcceptContact -> t OK_ + CFAckMessage -> t OK_ + CFDeleteConn -> t OK_ + where + t = APCT SAEConn data CommandData = CommandData { cmdId :: CommandId, diff --git a/stack.yaml b/stack.yaml index 8437e1e28d..208d3ca942 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: 552759018e493cf224d2451a3dabee2401ab3853 + commit: 8fde8e1344699cdcdc67709595c9285cd06bbef3 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294