iOS: update call invitations when exiting background (#771)

* core: communicate call invitations state between NSE and app via db

* enable tests

* delete calls, encoding

* load calls on start

* remove line

* remove table alias

Co-authored-by: JRoberts <8711996+jr-simplex@users.noreply.github.com>

apps/ios/Shared/SimpleXApp.swift

@@ -63,6 +63,7 @@ struct SimpleXApp: App {
                         let appState = appStateGroupDefault.get()
                         activateChat()
                         if appState.inactive && chatModel.chatRunning == true {
+                            // TODO refresh call invitation
                             updateChats()
                         }
                         doAuthenticate = authenticationExpired()

package.yaml

@@ -78,6 +78,7 @@ tests:
     dependencies:
       - simplex-chat
       - async == 2.2.*
+      - deepseq == 1.4.*
       - hspec == 2.7.*
       - network == 3.1.*
       - stm == 2.5.*

simplex-chat.cabal

@@ -40,6 +40,7 @@ library
       Simplex.Chat.Migrations.M20220404_files_status_fields
       Simplex.Chat.Migrations.M20220514_profiles_user_id
       Simplex.Chat.Migrations.M20220626_auto_reply
+      Simplex.Chat.Migrations.M20220702_calls
       Simplex.Chat.Mobile
       Simplex.Chat.Options
       Simplex.Chat.Protocol
@@ -233,6 +234,7 @@ test-suite simplex-chat-test
     , composition ==1.0.*
     , containers ==0.6.*
     , cryptonite >=0.27 && <0.30
+    , deepseq ==1.4.*
     , directory ==1.3.*
     , email-validate ==2.3.*
     , exceptions ==0.10.*

src/Simplex/Chat.hs

@@ -27,6 +27,7 @@ import qualified Data.ByteString.Base64 as B64
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
 import Data.Char (isSpace)
+import Data.Either (fromRight)
 import Data.Fixed (div')
 import Data.Functor (($>))
 import Data.Int (Int64)
@@ -149,6 +150,7 @@ newChatController chatStore user cfg@ChatConfig {agentConfig = aCfg, tbqSize, de
 startChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> Bool -> m (Async ())
 startChatController user subConns = do
   asks smpAgent >>= resumeAgentClient
+  restoreCalls
   s <- asks agentAsync
   readTVarIO s >>= maybe (start s) (pure . fst)
   where
@@ -160,6 +162,11 @@ startChatController user subConns = do
           else pure Nothing
       atomically . writeTVar s $ Just (a1, a2)
       pure a1
+    restoreCalls = do
+      savedCalls <- fromRight [] <$> runExceptT (withStore' $ \db -> getCalls db user)
+      let callsMap = M.fromList $ map (\(call@Call {contactId}) -> (contactId, call)) savedCalls
+      calls <- asks currentCalls
+      atomically $ writeTVar calls callsMap
 
 stopChatController :: MonadUnliftIO m => ChatController -> m ()
 stopChatController ChatController {smpAgent, agentAsync = s} = do
@@ -478,7 +485,7 @@ processChatCommand = \case
           callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
       msg <- sendDirectContactMessage ct (XCallInv callId invitation)
       ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0) Nothing Nothing
-      let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState}
+      let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
       call_ <- atomically $ TM.lookupInsert contactId call' calls
       forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing
       toView . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci
@@ -537,6 +544,16 @@ processChatCommand = \case
       SndMessage {msgId} <- sendDirectContactMessage ct (XCallEnd callId)
       updateCallItemStatus userId ct call WCSDisconnected $ Just msgId
       pure Nothing
+  APIGetCallInvitations -> withUser $ \user@User {userId} -> do
+    invs <- mapMaybe callInvitation <$> withStore' (`getCalls` user)
+    CRCallInvitations <$> mapM (rcvCallInvitation userId) invs
+    where
+      callInvitation Call {contactId, callState, callTs} = case callState of
+        CallInvitationReceived {peerCallType, sharedKey} -> Just (contactId, callTs, peerCallType, sharedKey)
+        _ -> Nothing
+      rcvCallInvitation userId (contactId, callTs, peerCallType, sharedKey) = do
+        contact <- withStore (\db -> getContact db userId contactId)
+        pure RcvCallInvitation {contact, callType = peerCallType, sharedKey, callTs}
   APICallStatus contactId receivedStatus ->
     withCurrentCall contactId $ \userId ct call ->
       updateCallItemStatus userId ct call receivedStatus Nothing $> Just call
@@ -861,7 +878,7 @@ processChatCommand = \case
             ft@RcvFileTransfer {cancelled} <- withStore (\db -> getRcvFileTransfer db user fileId)
             unless cancelled $ cancelRcvFileTransfer user ft
     withCurrentCall :: ContactId -> (UserId -> Contact -> Call -> m (Maybe Call)) -> m ChatResponse
-    withCurrentCall ctId action = withUser $ \User {userId} -> do
+    withCurrentCall ctId action = withUser $ \user@User {userId} -> do
       ct <- withStore $ \db -> getContact db userId ctId
       calls <- asks currentCalls
       withChatLock $
@@ -870,9 +887,13 @@ processChatCommand = \case
           Just call@Call {contactId}
             | ctId == contactId -> do
               call_ <- action userId ct call
-              atomically $ case call_ of
-                Just call' -> TM.insert ctId call' calls
-                _ -> TM.delete ctId calls
+              case call_ of
+                Just call' -> do
+                  unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId
+                  atomically $ TM.insert ctId call' calls
+                _ -> do
+                  withStore' $ \db -> deleteCalls db user ctId
+                  atomically $ TM.delete ctId calls
               pure CRCmdOk
             | otherwise -> throwChatError $ CECallContact contactId
     forwardFile :: ChatName -> FileTransferId -> (ChatName -> FilePath -> ChatCommand) -> m ChatResponse
@@ -1713,14 +1734,15 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
       ci <- saveCallItem CISCallPending
       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}
+          call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
       calls <- asks currentCalls
-      -- theoretically, the new call invitation for the current contant can mark the in-progress call as ended
+      -- theoretically, the new call invitation for the current contact can mark the in-progress call as ended
       -- (and replace it in ChatController)
       -- practically, this should not happen
+      withStore' $ \db -> createCall db user call' $ chatItemTs' ci
       call_ <- atomically (TM.lookupInsert contactId call' calls)
       forM_ call_ $ \call -> updateCallItemStatus userId ct call WCSDisconnected Nothing
-      toView . CRCallInvitation ct callType sharedKey $ chatItemTs' ci
+      toView . CRCallInvitation $ RcvCallInvitation {contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
       toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
       where
         saveCallItem status = saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvCall status 0) Nothing
@@ -1789,9 +1811,13 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
           | contactId /= ctId' || callId /= callId' -> messageError $ eventName <> ": wrong contact or callId"
           | otherwise -> do
             (call_, aciContent_) <- action call
-            atomically $ case call_ of
-              Just call' -> TM.insert ctId' call' calls
-              _ -> TM.delete ctId' calls
+            case call_ of
+              Just call' -> do
+                unless (isRcvInvitation call') $ withStore' $ \db -> deleteCalls db user ctId'
+                atomically $ TM.insert ctId' call' calls
+              _ -> do
+                withStore' $ \db -> deleteCalls db user ctId'
+                atomically $ TM.delete ctId' calls
             forM_ aciContent_ $ \aciContent ->
               updateDirectChatItemView userId ct chatItemId aciContent $ Just msgId
 
@@ -2279,6 +2305,7 @@ chatCommandP =
     <|> "/_call extra @" *> (APISendCallExtraInfo <$> A.decimal <* A.space <*> jsonP)
     <|> "/_call end @" *> (APIEndCall <$> A.decimal)
     <|> "/_call status @" *> (APICallStatus <$> A.decimal <* A.space <*> strP)
+    <|> "/_call get" $> APIGetCallInvitations
     <|> "/_profile " *> (APIUpdateProfile <$> jsonP)
     <|> "/_parse " *> (APIParseMarkdown . safeDecodeUtf8 <$> A.takeByteString)
     <|> "/_ntf get" $> APIGetNtfToken

src/Simplex/Chat/Call.hs

@@ -12,20 +12,33 @@ import Data.Aeson (FromJSON, ToJSON)
 import qualified Data.Aeson as J
 import qualified Data.Attoparsec.ByteString.Char8 as A
 import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Int (Int64)
 import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Data.Time.Clock (UTCTime)
+import Database.SQLite.Simple.FromField (FromField (..))
+import Database.SQLite.Simple.ToField (ToField (..))
 import GHC.Generics (Generic)
+import Simplex.Chat.Types (Contact, ContactId)
+import Simplex.Chat.Util (safeDecodeUtf8)
 import qualified Simplex.Messaging.Crypto as C
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Parsers (dropPrefix, enumJSON)
+import Simplex.Messaging.Parsers (dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
 
 data Call = Call
-  { contactId :: Int64,
+  { contactId :: ContactId,
     callId :: CallId,
     chatItemId :: Int64,
-    callState :: CallState
+    callState :: CallState,
+    callTs :: UTCTime
   }
 
+isRcvInvitation :: Call -> Bool
+isRcvInvitation Call {callState} = case callState of
+  CallInvitationReceived {} -> True
+  _ -> False
+
 data CallStateTag
   = CSTCallInvitationSent
   | CSTCallInvitationReceived
@@ -75,6 +88,21 @@ data CallState
         peerCallSession :: WebRTCSession,
         sharedKey :: Maybe C.Key
       }
+  deriving (Generic)
+
+-- database representation
+instance FromJSON CallState where
+  parseJSON = J.genericParseJSON $ singleFieldJSON fstToLower
+
+instance ToJSON CallState where
+  toJSON = J.genericToJSON $ singleFieldJSON fstToLower
+  toEncoding = J.genericToEncoding $ singleFieldJSON fstToLower
+
+instance ToField CallState where
+  toField = toField . safeDecodeUtf8 . LB.toStrict . J.encode
+
+instance FromField CallState where
+  fromField = fromTextField_ $ J.decode . LB.fromStrict . encodeUtf8
 
 newtype CallId = CallId ByteString
   deriving (Eq, Show)
@@ -91,6 +119,22 @@ instance ToJSON CallId where
   toJSON = strToJSON
   toEncoding = strToJEncoding
 
+instance FromField CallId where fromField f = CallId <$> fromField f
+
+instance ToField CallId where toField (CallId m) = toField m
+
+data RcvCallInvitation = RcvCallInvitation
+  { contact :: Contact,
+    callType :: CallType,
+    sharedKey :: Maybe C.Key,
+    callTs :: UTCTime
+  }
+  deriving (Show, Generic)
+
+instance ToJSON RcvCallInvitation where
+  toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True}
+  toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True}
+
 data CallType = CallType
   { media :: CallMedia,
     capabilities :: CallCapabilities

src/Simplex/Chat/Controller.hs

@@ -126,6 +126,7 @@ data ChatCommand
   | APISendCallAnswer ContactId WebRTCSession
   | APISendCallExtraInfo ContactId WebRTCExtraInfo
   | APIEndCall ContactId
+  | APIGetCallInvitations
   | APICallStatus ContactId WebRTCCallStatus
   | APIUpdateProfile Profile
   | APIParseMarkdown Text
@@ -269,11 +270,12 @@ data ChatResponse
   | CRPendingSubSummary {pendingSubStatus :: [PendingSubStatus]}
   | CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
   | CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
-  | CRCallInvitation {contact :: Contact, callType :: CallType, sharedKey :: Maybe C.Key, callTs :: UTCTime}
+  | CRCallInvitation {callInvitation :: RcvCallInvitation}
   | CRCallOffer {contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
   | CRCallAnswer {contact :: Contact, answer :: WebRTCSession}
   | CRCallExtraInfo {contact :: Contact, extraInfo :: WebRTCExtraInfo}
   | CRCallEnded {contact :: Contact}
+  | CRCallInvitations {callInvitations :: [RcvCallInvitation]}
   | CRUserContactLinkSubscribed
   | CRUserContactLinkSubError {chatError :: ChatError}
   | CRNtfTokenStatus {status :: NtfTknStatus}

src/Simplex/Chat/Migrations/M20220702_calls.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20220702_calls where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20220702_calls :: Query
+m20220702_calls =
+  [sql|
+CREATE TABLE calls ( -- stores call invitations state for communicating state between NSE and app when call notification comes
+  call_id INTEGER PRIMARY KEY,
+  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
+  shared_call_id BLOB NOT NULL,
+  chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
+  call_state BLOB NOT NULL,
+  call_ts TEXT NOT NULL,
+  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'))
+);
+|]

src/Simplex/Chat/Migrations/chat_schema.sql

@@ -369,3 +369,15 @@ CREATE UNIQUE INDEX idx_messages_group_shared_msg_id ON messages(
   shared_msg_id
 );
 CREATE INDEX idx_chat_items_shared_msg_id ON chat_items(shared_msg_id);
+CREATE TABLE calls(
+  -- stores call invitations state for communicating state between NSE and app when call notification comes
+  call_id INTEGER PRIMARY KEY,
+  contact_id INTEGER NOT NULL REFERENCES contacts ON DELETE CASCADE,
+  shared_call_id BLOB NOT NULL,
+  chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE,
+  call_state BLOB NOT NULL,
+  call_ts TEXT NOT NULL,
+  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'))
+);

src/Simplex/Chat/Store.hs

@@ -160,6 +160,9 @@ module Simplex.Chat.Store
     updateGroupChatItemsRead,
     getSMPServers,
     overwriteSMPServers,
+    createCall,
+    deleteCalls,
+    getCalls,
     getPendingContactConnection,
     deletePendingContactConnection,
     withTransaction,
@@ -193,6 +196,7 @@ import Database.SQLite.Simple (NamedParam (..), Only (..), Query (..), SQLError,
 import qualified Database.SQLite.Simple as DB
 import Database.SQLite.Simple.QQ (sql)
 import GHC.Generics (Generic)
+import Simplex.Chat.Call
 import Simplex.Chat.Markdown
 import Simplex.Chat.Messages
 import Simplex.Chat.Migrations.M20220101_initial
@@ -207,6 +211,7 @@ import Simplex.Chat.Migrations.M20220321_chat_item_edited
 import Simplex.Chat.Migrations.M20220404_files_status_fields
 import Simplex.Chat.Migrations.M20220514_profiles_user_id
 import Simplex.Chat.Migrations.M20220626_auto_reply
+import Simplex.Chat.Migrations.M20220702_calls
 import Simplex.Chat.Protocol
 import Simplex.Chat.Types
 import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, InvitationId, MsgMeta (..))
@@ -232,7 +237,8 @@ schemaMigrations =
     ("20220321_chat_item_edited", m20220321_chat_item_edited),
     ("20220404_files_status_fields", m20220404_files_status_fields),
     ("20220514_profiles_user_id", m20220514_profiles_user_id),
-    ("20220626_auto_reply", m20220626_auto_reply)
+    ("20220626_auto_reply", m20220626_auto_reply),
+    ("20220702_calls", m20220702_calls)
   ]
 
 -- | The list of migrations in ascending order by date
@@ -3661,6 +3667,38 @@ overwriteSMPServers db User {userId} smpServers =
         (host, port, keyHash, userId, currentTs, currentTs)
     pure $ Right ()
 
+createCall :: DB.Connection -> User -> Call -> UTCTime -> IO ()
+createCall db User {userId} Call {contactId, callId, chatItemId, callState} callTs = do
+  currentTs <- getCurrentTime
+  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 (?,?,?,?,?,?,?,?)
+    |]
+    (contactId, callId, chatItemId, callState, callTs, userId, currentTs, currentTs)
+
+deleteCalls :: DB.Connection -> User -> ContactId -> IO ()
+deleteCalls db User {userId} contactId = do
+  DB.execute db "DELETE FROM calls WHERE user_id = ? AND contact_id = ?" (userId, contactId)
+
+getCalls :: DB.Connection -> User -> IO [Call]
+getCalls db User {userId} = do
+  map toCall
+    <$> DB.query
+      db
+      [sql|
+        SELECT
+          contact_id, shared_call_id, chat_item_id, call_state, call_ts
+        FROM calls
+        WHERE user_id = ?
+      |]
+      (Only userId)
+  where
+    toCall :: (ContactId, CallId, ChatItemId, CallState, UTCTime) -> Call
+    toCall (contactId, callId, chatItemId, callState, callTs) = Call {contactId, callId, chatItemId, callState, callTs}
+
 -- | Saves unique local display name based on passed displayName, suffixed with _N if required.
 -- This function should be called inside transaction.
 withLocalDisplayName :: forall a. DB.Connection -> UserId -> Text -> (Text -> IO a) -> IO (Either StoreError a)

src/Simplex/Chat/View.hs

@@ -152,11 +152,12 @@ responseToView testView = \case
     ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
   CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
     ["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
-  CRCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey
+  CRCallInvitation RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey
   CRCallOffer {contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey
   CRCallAnswer {contact, answer} -> viewCallAnswer contact answer
   CRCallExtraInfo {contact} -> ["call extra info from " <> ttyContact' contact]
   CRCallEnded {contact} -> ["call with " <> ttyContact' contact <> " ended"]
+  CRCallInvitations _ -> []
   CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
   CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
   CRNewContactConnection _ -> []

tests/ChatClient.hs

@@ -14,7 +14,7 @@ import Control.Concurrent.STM
 import Control.Exception (bracket, bracket_)
 import Control.Monad.Except
 import Data.List (dropWhileEnd, find)
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, isNothing)
 import qualified Data.Text as T
 import Network.Socket
 import Simplex.Chat
@@ -118,6 +118,7 @@ startTestChat_ st cfg opts dbFilePrefix user = do
   ct <- newChatTerminal t
   cc <- newChatController st (Just user) cfg opts {dbFilePrefix} Nothing -- no notifications
   chatAsync <- async . runSimplexChat opts user cc . const $ runChatTerminal ct
+  atomically . unless (maintenance opts) $ readTVar (agentAsync cc) >>= \a -> when (isNothing a) retry
   termQ <- newTQueueIO
   termAsync <- async $ readTerminalOutput t termQ
   pure TestCC {chatController = cc, virtualTerminal = t, chatAsync, termAsync, termQ}

tests/ChatTests.hs

@@ -2093,6 +2093,8 @@ testNegotiateCall :: IO ()
 testNegotiateCall =
   testChat2 aliceProfile bobProfile $ \alice bob -> do
     connectUsers alice bob
+    -- just for testing db query
+    alice ##> "/_call get"
     -- alice invite bob to call
     alice ##> ("/_call invite @2 " <> serialize testCallType)
     alice <## "ok"

tests/SchemaDump.hs

@@ -3,6 +3,7 @@
 module SchemaDump where
 
 import ChatClient (withTmpFiles)
+import Control.DeepSeq
 import Control.Monad (void)
 import Simplex.Chat.Store (createStore)
 import System.Process (readCreateProcess, shell)
@@ -24,7 +25,7 @@ testVerifySchemaDump =
     void $ createStore testDB False
     void $ readCreateProcess (shell $ "touch " <> schema) ""
     savedSchema <- readFile schema
-    savedSchema `seq` pure ()
+    savedSchema `deepseq` pure ()
     void $ readCreateProcess (shell $ "sqlite3 " <> testDB <> " '.schema --indent' > " <> schema) ""
     currentSchema <- readFile schema
     savedSchema `shouldBe` currentSchema