Merge branch 'stable'

This commit is contained in:
Evgeny Poberezkin
2024-08-28 18:04:50 +01:00
24 changed files with 368 additions and 103 deletions
+11 -7
View File
@@ -56,6 +56,8 @@ import Data.Time (NominalDiffTime, addUTCTime, defaultTimeLocale, formatTime)
import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime, nominalDay, nominalDiffTimeToSeconds)
import Data.Time.Clock.System (systemToUTCTime)
import Data.Word (Word32)
import qualified Data.UUID as UUID
import qualified Data.UUID.V4 as V4
import qualified Database.SQLite.Simple as SQL
import Simplex.Chat.Archive
import Simplex.Chat.Call
@@ -1291,12 +1293,13 @@ processChatCommand' vr = \case
withContactLock "sendCallInvitation" contactId $ do
g <- asks random
callId <- atomically $ CallId <$> C.randomBytes 16 g
callUUID <- UUID.toText <$> liftIO V4.nextRandom
dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
let invitation = CallInvitation {callType, callDhPubKey = fst <$> dhKeyPair}
callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
(msg, _) <- sendDirectContactMessage user ct (XCallInv callId invitation)
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0)
let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
let call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
call_ <- atomically $ TM.lookupInsert contactId call' calls
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
toView $ CRNewChatItems user [AChatItem SCTDirect SMDSnd (DirectChat ct) ci]
@@ -1366,13 +1369,13 @@ processChatCommand' vr = \case
rcvCallInvitations <- rights <$> mapM rcvCallInvitation invs
pure $ CRCallInvitations rcvCallInvitations
where
callInvitation Call {contactId, callState, callTs} = case callState of
CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callTs, peerCallType, sharedKey)
callInvitation Call {contactId, callUUID, callState, callTs} = case callState of
CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callUUID, callTs, peerCallType, sharedKey)
_ -> Nothing
rcvCallInvitation (contactId, callTs, peerCallType, sharedKey) = runExceptT . withFastStore $ \db -> do
rcvCallInvitation (contactId, callUUID, callTs, peerCallType, sharedKey) = runExceptT . withFastStore $ \db -> do
user <- getUserByContactId db contactId
contact <- getContact db vr user contactId
pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callTs}
pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callUUID, callTs}
APIGetNetworkStatuses -> withUser $ \_ ->
CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses
APICallStatus contactId receivedStatus ->
@@ -6093,9 +6096,10 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
g <- asks random
dhKeyPair <- atomically $ if encryptedCall callType then Just <$> C.generateKeyPair g else pure Nothing
ci <- saveCallItem CISCallPending
callUUID <- UUID.toText <$> liftIO V4.nextRandom
let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair))
callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey}
call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
call' = Call {contactId, callId, callUUID, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
calls <- asks currentCalls
-- theoretically, the new call invitation for the current contact can mark the in-progress call as ended
-- (and replace it in ChatController)
@@ -6103,7 +6107,7 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage =
withStore' $ \db -> createCall db user call' $ chatItemTs' ci
call_ <- atomically (TM.lookupInsert contactId call' calls)
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callUUID, callTs = chatItemTs' ci}
toView $ CRNewChatItems user [AChatItem SCTDirect SMDRcv (DirectChat ct) ci]
else featureRejected CFCalls
where
+2
View File
@@ -29,6 +29,7 @@ import Simplex.Messaging.Util (decodeJSON, encodeJSON)
data Call = Call
{ contactId :: ContactId,
callId :: CallId,
callUUID :: Text,
chatItemId :: Int64,
callState :: CallState,
callTs :: UTCTime
@@ -111,6 +112,7 @@ data RcvCallInvitation = RcvCallInvitation
contact :: Contact,
callType :: CallType,
sharedKey :: Maybe C.Key,
callUUID :: Text,
callTs :: UTCTime
}
deriving (Show)
@@ -0,0 +1,18 @@
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Migrations.M20240827_calls_uuid where
import Database.SQLite.Simple (Query)
import Database.SQLite.Simple.QQ (sql)
m20240827_calls_uuid :: Query
m20240827_calls_uuid =
[sql|
ALTER TABLE calls ADD COLUMN call_uuid TEXT NOT NULL DEFAULT "";
|]
down_m20240827_calls_uuid :: Query
down_m20240827_calls_uuid =
[sql|
ALTER TABLE calls DROP COLUMN call_uuid;
|]
@@ -415,6 +415,8 @@ CREATE TABLE calls(
user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
created_at TEXT NOT NULL DEFAULT(datetime('now')),
updated_at TEXT NOT NULL DEFAULT(datetime('now'))
,
call_uuid TEXT NOT NULL DEFAULT ""
);
CREATE TABLE commands(
command_id INTEGER PRIMARY KEY AUTOINCREMENT, -- used as ACorrId
+3 -1
View File
@@ -110,6 +110,7 @@ import Simplex.Chat.Migrations.M20240501_chat_deleted
import Simplex.Chat.Migrations.M20240510_chat_items_via_proxy
import Simplex.Chat.Migrations.M20240515_rcv_files_user_approved_relays
import Simplex.Chat.Migrations.M20240528_quota_err_counter
import Simplex.Chat.Migrations.M20240827_calls_uuid
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
schemaMigrations :: [(String, Query, Maybe Query)]
@@ -219,7 +220,8 @@ schemaMigrations =
("20240501_chat_deleted", m20240501_chat_deleted, Just down_m20240501_chat_deleted),
("20240510_chat_items_via_proxy", m20240510_chat_items_via_proxy, Just down_m20240510_chat_items_via_proxy),
("20240515_rcv_files_user_approved_relays", m20240515_rcv_files_user_approved_relays, Just down_m20240515_rcv_files_user_approved_relays),
("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter)
("20240528_quota_err_counter", m20240528_quota_err_counter, Just down_m20240528_quota_err_counter),
("20240827_calls_uuid", m20240827_calls_uuid, Just down_m20240827_calls_uuid)
]
-- | The list of migrations in ascending order by date
+7 -7
View File
@@ -549,17 +549,17 @@ overwriteProtocolServers db User {userId} servers =
protocol = decodeLatin1 $ strEncode $ protocolTypeI @p
createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
createCall db user@User {userId} Call {contactId, callId, chatItemId, callState} callTs = do
createCall db user@User {userId} Call {contactId, callId, callUUID, chatItemId, callState} callTs = do
currentTs <- getCurrentTime
deleteCalls db user contactId
DB.execute
db
[sql|
INSERT INTO calls
(contact_id, shared_call_id, chat_item_id, call_state, call_ts, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?)
(contact_id, shared_call_id, call_uuid, chat_item_id, call_state, call_ts, user_id, created_at, updated_at)
VALUES (?,?,?,?,?,?,?,?,?)
|]
(contactId, callId, chatItemId, callState, callTs, userId, currentTs, currentTs)
(contactId, callId, callUUID, chatItemId, callState, callTs, userId, currentTs, currentTs)
deleteCalls :: DB.Connection -> User -> ContactId -> IO ()
deleteCalls db User {userId} contactId = do
@@ -572,13 +572,13 @@ getCalls db =
db
[sql|
SELECT
contact_id, shared_call_id, chat_item_id, call_state, call_ts
contact_id, shared_call_id, call_uuid, chat_item_id, call_state, call_ts
FROM calls
ORDER BY call_ts ASC
|]
where
toCall :: (ContactId, CallId, ChatItemId, CallState, UTCTime) -> Call
toCall (contactId, callId, chatItemId, callState, callTs) = Call {contactId, callId, chatItemId, callState, callTs}
toCall :: (ContactId, CallId, Text, ChatItemId, CallState, UTCTime) -> Call
toCall (contactId, callId, callUUID, chatItemId, callState, callTs) = Call {contactId, callId, callUUID, chatItemId, callState, callTs}
createCommand :: DB.Connection -> User -> Maybe Int64 -> CommandFunction -> IO CommandId
createCommand db User {userId} connId commandFunction = do