simplify mobile API to have single controller (#274)

* simplify mobile API to have single controller

* update chat response in swift

* add async to stack

apps/ios/Shared/Model/SimpleXAPI.swift

@@ -15,13 +15,16 @@ private let jsonDecoder = getJSONDecoder()
 private let jsonEncoder = getJSONEncoder()
 
 enum ChatCommand {
+    case showActiveUser
+    case createActiveUser(profile: Profile)
+    case startChat
     case apiGetChats
     case apiGetChat(type: ChatType, id: Int64)
     case apiSendMessage(type: ChatType, id: Int64, msg: MsgContent)
     case addContact
     case connect(connReq: String)
     case apiDeleteChat(type: ChatType, id: Int64)
-    case apiUpdateProfile(profile: Profile)
+    case updateProfile(profile: Profile)
     case createMyAddress
     case deleteMyAddress
     case showMyAddress
@@ -32,32 +35,22 @@ enum ChatCommand {
     var cmdString: String {
         get {
             switch self {
-            case .apiGetChats:
+            case .showActiveUser: return "/u"
-                return "/_get chats"
+            case let .createActiveUser(profile): return "/u \(profile.displayName) \(profile.fullName)"
-            case let .apiGetChat(type, id):
+            case .startChat: return "/_start"
-                return "/_get chat \(type.rawValue)\(id) count=500"
+            case .apiGetChats: return "/_get chats"
-            case let .apiSendMessage(type, id, mc):
+            case let .apiGetChat(type, id): return "/_get chat \(type.rawValue)\(id) count=500"
-                return "/_send \(type.rawValue)\(id) \(mc.cmdString)"
+            case let .apiSendMessage(type, id, mc): return "/_send \(type.rawValue)\(id) \(mc.cmdString)"
-            case .addContact:
+            case .addContact: return "/connect"
-                return "/connect"
+            case let .connect(connReq): return "/connect \(connReq)"
-            case let .connect(connReq):
+            case let .apiDeleteChat(type, id): return "/_delete \(type.rawValue)\(id)"
-                return "/connect \(connReq)"
+            case let .updateProfile(profile): return "/profile \(profile.displayName) \(profile.fullName)"
-            case let .apiDeleteChat(type, id):
+            case .createMyAddress: return "/address"
-                return "/_delete \(type.rawValue)\(id)"
+            case .deleteMyAddress: return "/delete_address"
-            case let .apiUpdateProfile(profile):
+            case .showMyAddress: return "/show_address"
-                return "/profile \(profile.displayName) \(profile.fullName)"
+            case let .apiAcceptContact(contactReqId): return "/_accept \(contactReqId)"
-            case .createMyAddress:
+            case let .apiRejectContact(contactReqId): return "/_reject \(contactReqId)"
-                return "/address"
+            case let .string(str): return str
-            case .deleteMyAddress:
-                return "/delete_address"
-            case .showMyAddress:
-                return "/show_address"
-            case let .apiAcceptContact(contactReqId):
-                return "/_accept \(contactReqId)"
-            case let .apiRejectContact(contactReqId):
-                return "/_reject \(contactReqId)"
-            case let .string(str):
-                return str
             }
         }
     }
@@ -69,6 +62,8 @@ struct APIResponse: Decodable {
 
 enum ChatResponse: Decodable, Error {
     case response(type: String, json: String)
+    case activeUser(user: User)
+    case chatStarted
     case apiChats(chats: [ChatData])
     case apiChat(chat: ChatData)
     case invitation(connReqInvitation: String)
@@ -90,11 +85,14 @@ enum ChatResponse: Decodable, Error {
     case contactSubError(contact: Contact, chatError: ChatError)
     case newChatItem(chatItem: AChatItem)
     case chatCmdError(chatError: ChatError)
+    case chatError(chatError: ChatError)
 
     var responseType: String {
         get {
             switch self {
             case let .response(type, _): return "* \(type)"
+            case .activeUser: return "activeUser"
+            case .chatStarted: return "chatStarted"
             case .apiChats: return "apiChats"
             case .apiChat: return "apiChat"
             case .invitation: return "invitation"
@@ -116,6 +114,7 @@ enum ChatResponse: Decodable, Error {
             case .contactSubError: return "contactSubError"
             case .newChatItem: return "newChatItem"
             case .chatCmdError: return "chatCmdError"
+            case .chatError: return "chatError"
             }
         }
     }
@@ -124,6 +123,8 @@ enum ChatResponse: Decodable, Error {
         get {
             switch self {
             case let .response(_, json): return json
+            case let .activeUser(user): return String(describing: user)
+            case .chatStarted: return noDetails
             case let .apiChats(chats): return String(describing: chats)
             case let .apiChat(chat): return String(describing: chat)
             case let .invitation(connReqInvitation): return connReqInvitation
@@ -145,6 +146,7 @@ enum ChatResponse: Decodable, Error {
             case let .contactSubError(contact, chatError): return "contact:\n\(String(describing: contact))\nerror:\n\(String(describing: chatError))"
             case let .newChatItem(chatItem): return String(describing: chatItem)
             case let .chatCmdError(chatError): return String(describing: chatError)
+            case let .chatError(chatError): return String(describing: chatError)
             }
         }
     }
@@ -260,7 +262,7 @@ func apiDeleteChat(type: ChatType, id: Int64) throws {
 }
 
 func apiUpdateProfile(profile: Profile) throws -> Profile? {
-    let r = try chatSendCmd(.apiUpdateProfile(profile: profile))
+    let r = try chatSendCmd(.updateProfile(profile: profile))
     switch r {
     case .userProfileNoChange: return nil
     case let .userProfileUpdated(_, toProfile): return toProfile
@@ -423,16 +425,18 @@ private func encodeCJSON<T: Encodable>(_ value: T) -> [CChar] {
 
 enum ChatError: Decodable {
     case error(errorType: ChatErrorType)
-    case errorMessage(errorMessage: String)
     case errorAgent(agentError: AgentErrorType)
     case errorStore(storeError: StoreError)
-    case errorNotImplemented
 }
 
 enum ChatErrorType: Decodable {
-    case groupUserRole
+    case noActiveUser
+    case activeUserExists
+    case chatNotStarted
     case invalidConnReq
+    case invalidChatMessage(message: String)
     case contactGroups(contact: Contact, groupNames: [GroupName])
+    case groupUserRole
     case groupContactRole(contactName: ContactName)
     case groupDuplicateMember(contactName: ContactName)
     case groupDuplicateMemberId

apps/ios/Shared/Views/Chat/ChatItem/TextItemView.swift

@@ -46,7 +46,6 @@ struct TextItemView: View {
     private func messageText(_ s: String, sent: Bool = false) -> Text {
         if s == "" { return Text("") }
         let parts = s.split(separator: " ")
-        print(parts)
         var res = wordToText(parts[0], sent)
         var i = 1
         while i < parts.count {

package.yaml

@@ -14,6 +14,7 @@ extra-source-files:
 dependencies:
   - aeson == 2.0.*
   - ansi-terminal >= 0.10 && < 0.12
+  - async == 2.2.*
   - attoparsec == 0.14.*
   - base >= 4.7 && < 5
   - base64-bytestring >= 1.0 && < 1.3

simplex-chat.cabal

@@ -46,6 +46,7 @@ library
   build-depends:
       aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
+    , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
@@ -80,6 +81,7 @@ executable simplex-chat
   build-depends:
       aeson ==2.0.*
     , ansi-terminal >=0.10 && <0.12
+    , async ==2.2.*
     , attoparsec ==0.14.*
     , base >=4.7 && <5
     , base64-bytestring >=1.0 && <1.3
@@ -112,6 +114,7 @@ test-suite simplex-chat-test
       ChatClient
       ChatTests
       MarkdownTests
+      MobileTests
       ProtocolTests
       Paths_simplex_chat
   hs-source-dirs:

src/Simplex/Chat.hs

@@ -43,7 +43,7 @@ import Simplex.Chat.Options (ChatOpts (..))
 import Simplex.Chat.Protocol
 import Simplex.Chat.Store
 import Simplex.Chat.Types
-import Simplex.Chat.Util (ifM, safeDecodeUtf8, unlessM)
+import Simplex.Chat.Util (ifM, safeDecodeUtf8, unlessM, whenM)
 import Simplex.Messaging.Agent
 import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), defaultAgentConfig)
 import Simplex.Messaging.Agent.Protocol
@@ -58,7 +58,7 @@ import System.Exit (exitFailure, exitSuccess)
 import System.FilePath (combine, splitExtensions, takeFileName)
 import System.IO (Handle, IOMode (..), SeekMode (..), hFlush, openFile, stdout)
 import Text.Read (readMaybe)
-import UnliftIO.Async (race_)
+import UnliftIO.Async (Async, async, race_)
 import UnliftIO.Concurrent (forkIO, threadDelay)
 import UnliftIO.Directory (doesDirectoryExist, doesFileExist, getFileSize, getHomeDirectory, getTemporaryDirectory)
 import qualified UnliftIO.Exception as E
@@ -83,13 +83,14 @@ defaultChatConfig =
 logCfg :: LogConfig
 logCfg = LogConfig {lc_file = Nothing, lc_stderr = True}
 
-newChatController :: SQLiteStore -> User -> ChatConfig -> ChatOpts -> (Notification -> IO ()) -> IO ChatController
+newChatController :: SQLiteStore -> Maybe User -> ChatConfig -> ChatOpts -> (Notification -> IO ()) -> IO ChatController
 newChatController chatStore user config@ChatConfig {agentConfig = cfg, tbqSize} ChatOpts {dbFilePrefix, smpServers} sendNotification = do
   let f = chatStoreFile dbFilePrefix
   activeTo <- newTVarIO ActiveNone
   firstTime <- not <$> doesFileExist f
   currentUser <- newTVarIO user
   smpAgent <- getSMPAgentClient cfg {dbFile = dbFilePrefix <> "_agent.db", smpServers}
+  agentAsync <- newTVarIO Nothing
   idsDrg <- newTVarIO =<< drgNew
   inputQ <- newTBQueueIO tbqSize
   outputQ <- newTBQueueIO tbqSize
@@ -97,10 +98,20 @@ newChatController chatStore user config@ChatConfig {agentConfig = cfg, tbqSize}
   chatLock <- newTMVarIO ()
   sndFiles <- newTVarIO M.empty
   rcvFiles <- newTVarIO M.empty
-  pure ChatController {activeTo, firstTime, currentUser, smpAgent, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, config, sendNotification}
+  pure ChatController {activeTo, firstTime, currentUser, smpAgent, agentAsync, chatStore, idsDrg, inputQ, outputQ, notifyQ, chatLock, sndFiles, rcvFiles, config, sendNotification}
 
-runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
+runChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
-runChatController = race_ agentSubscriber notificationSubscriber
+runChatController = race_ notificationSubscriber . agentSubscriber
+
+startChatController :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m (Async ())
+startChatController user = do
+  s <- asks agentAsync
+  readTVarIO s >>= maybe (start s) pure
+  where
+    start s = do
+      a <- async $ runChatController user
+      atomically . writeTVar s $ Just a
+      pure a
 
 withLock :: MonadUnliftIO m => TMVar () -> m a -> m a
 withLock lock =
@@ -110,26 +121,31 @@ withLock lock =
 
 execChatCommand :: (MonadUnliftIO m, MonadReader ChatController m) => ByteString -> m ChatResponse
 execChatCommand s = case parseAll chatCommandP $ B.dropWhileEnd isSpace s of
-  Left e -> pure . CRChatError . ChatError $ CECommandError e
+  Left e -> pure $ chatCmdError e
-  Right cmd -> do
+  Right cmd -> either CRChatCmdError id <$> runExceptT (processChatCommand cmd)
-    ChatController {currentUser} <- ask
-    user <- readTVarIO currentUser
-    either CRChatCmdError id <$> runExceptT (processChatCommand user cmd)
 
 toView :: ChatMonad m => ChatResponse -> m ()
 toView event = do
   q <- asks outputQ
   atomically $ writeTBQueue q (Nothing, event)
 
-processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ChatResponse
+processChatCommand :: forall m. ChatMonad m => ChatCommand -> m ChatResponse
-processChatCommand user@User {userId, profile} = \case
+processChatCommand = \case
-  APIGetChats -> CRApiChats <$> withStore (`getChatPreviews` user)
+  ShowActiveUser -> withUser' $ pure . CRActiveUser
-  APIGetChat cType cId pagination -> case cType of
+  CreateActiveUser p -> do
+    u <- asks currentUser
+    whenM (isJust <$> readTVarIO u) $ throwChatError CEActiveUserExists
+    user <- withStore $ \st -> createUser st p True
+    atomically . writeTVar u $ Just user
+    pure $ CRActiveUser user
+  StartChat -> withUser' $ \user -> startChatController user $> CRChatStarted
+  APIGetChats -> CRApiChats <$> withUser (\user -> withStore (`getChatPreviews` user))
+  APIGetChat cType cId pagination -> withUser $ \user -> case cType of
     CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st user cId pagination)
     CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination)
-    CTContactRequest -> pure $ CRChatError ChatErrorNotImplemented
+    CTContactRequest -> pure $ chatCmdError "not implemented"
-  APIGetChatItems _count -> pure $ CRChatError ChatErrorNotImplemented
+  APIGetChatItems _pagination -> pure $ chatCmdError "not implemented"
-  APISendMessage cType chatId mc -> withChatLock $ case cType of
+  APISendMessage cType chatId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of
     CTDirect -> do
       ct@Contact {localDisplayName = c} <- withStore $ \st -> getContact st userId chatId
       ci <- sendDirectChatItem userId ct (XMsgNew mc) (CISndMsgContent mc)
@@ -141,8 +157,8 @@ processChatCommand user@User {userId, profile} = \case
       ci <- sendGroupChatItem userId group (XMsgNew mc) (CISndMsgContent mc)
       setActive $ ActiveG gName
       pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci
-    CTContactRequest -> pure . CRChatError . ChatError $ CECommandError "not supported"
+    CTContactRequest -> pure $ chatCmdError "not supported"
-  APIDeleteChat cType chatId -> case cType of
+  APIDeleteChat cType chatId -> withUser $ \User {userId} -> case cType of
     CTDirect -> do
       ct@Contact {localDisplayName} <- withStore $ \st -> getContact st userId chatId
       withStore (\st -> getContactGroupNames st userId ct) >>= \case
@@ -155,16 +171,16 @@ processChatCommand user@User {userId, profile} = \case
             unsetActive $ ActiveC localDisplayName
             pure $ CRContactDeleted ct
         gs -> throwChatError $ CEContactGroups ct gs
-    CTGroup -> pure $ CRChatCmdError ChatErrorNotImplemented
+    CTGroup -> pure $ chatCmdError "not implemented"
-    CTContactRequest -> pure . CRChatError . ChatError $ CECommandError "not supported"
+    CTContactRequest -> pure $ chatCmdError "not supported"
-  APIAcceptContact connReqId -> do
+  APIAcceptContact connReqId -> withUser $ \User {userId, profile} -> do
     UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p} <- withStore $ \st ->
       getContactRequest st userId connReqId
     withChatLock . procCmd $ do
       connId <- withAgent $ \a -> acceptContact a invId . directMessage $ XInfo profile
       acceptedContact <- withStore $ \st -> createAcceptedContact st userId connId cName profileId p
       pure $ CRAcceptingContactRequest acceptedContact
-  APIRejectContact connReqId -> withChatLock $ do
+  APIRejectContact connReqId -> withUser $ \User {userId} -> withChatLock $ do
     cReq@UserContactRequest {agentContactConnId = AgentConnId connId, agentInvitationId = AgentInvId invId} <-
       withStore $ \st ->
         getContactRequest st userId connReqId
@@ -172,51 +188,51 @@ processChatCommand user@User {userId, profile} = \case
     withAgent $ \a -> rejectContact a connId invId
     pure $ CRContactRequestRejected cReq
   ChatHelp section -> pure $ CRChatHelp section
-  Welcome -> pure $ CRWelcome user
+  Welcome -> withUser $ pure . CRWelcome
-  AddContact -> withChatLock . procCmd $ do
+  AddContact -> withUser $ \User {userId} -> withChatLock . procCmd $ do
     (connId, cReq) <- withAgent (`createConnection` SCMInvitation)
     withStore $ \st -> createDirectConnection st userId connId
     pure $ CRInvitation cReq
-  Connect (Just (ACR SCMInvitation cReq)) -> withChatLock . procCmd $ do
+  Connect (Just (ACR SCMInvitation cReq)) -> withUser $ \User {userId, profile} -> withChatLock . procCmd $ do
-    connect cReq $ XInfo profile
+    connect userId cReq $ XInfo profile
     pure CRSentConfirmation
-  Connect (Just (ACR SCMContact cReq)) -> withChatLock . procCmd $ do
+  Connect (Just (ACR SCMContact cReq)) -> withUser $ \User {userId, profile} -> withChatLock . procCmd $ do
-    connect cReq $ XContact profile Nothing
+    connect userId cReq $ XContact profile Nothing
     pure CRSentInvitation
   Connect Nothing -> throwChatError CEInvalidConnReq
-  ConnectAdmin -> withChatLock . procCmd $ do
+  ConnectAdmin -> withUser $ \User {userId, profile} -> withChatLock . procCmd $ do
-    connect adminContactReq $ XContact profile Nothing
+    connect userId adminContactReq $ XContact profile Nothing
     pure CRSentInvitation
-  DeleteContact cName -> do
+  DeleteContact cName -> withUser $ \User {userId} -> do
     contactId <- withStore $ \st -> getContactIdByName st userId cName
-    processChatCommand user $ APIDeleteChat CTDirect contactId
+    processChatCommand $ APIDeleteChat CTDirect contactId
-  ListContacts -> CRContactsList <$> withStore (`getUserContacts` user)
+  ListContacts -> withUser $ \user -> CRContactsList <$> withStore (`getUserContacts` user)
-  CreateMyAddress -> withChatLock . procCmd $ do
+  CreateMyAddress -> withUser $ \User {userId} -> withChatLock . procCmd $ do
     (connId, cReq) <- withAgent (`createConnection` SCMContact)
     withStore $ \st -> createUserContactLink st userId connId cReq
     pure $ CRUserContactLinkCreated cReq
-  DeleteMyAddress -> withChatLock $ do
+  DeleteMyAddress -> withUser $ \User {userId} -> withChatLock $ do
     conns <- withStore $ \st -> getUserContactLinkConnections st userId
     procCmd $ do
       withAgent $ \a -> forM_ conns $ \conn ->
         deleteConnection a (aConnId conn) `catchError` \(_ :: AgentErrorType) -> pure ()
       withStore $ \st -> deleteUserContactLink st userId
       pure CRUserContactLinkDeleted
-  ShowMyAddress -> CRUserContactLink <$> withStore (`getUserContactLink` userId)
+  ShowMyAddress -> CRUserContactLink <$> (withUser $ \User {userId} -> withStore (`getUserContactLink` userId))
-  AcceptContact cName -> do
+  AcceptContact cName -> withUser $ \User {userId} -> do
     connReqId <- withStore $ \st -> getContactRequestIdByName st userId cName
-    processChatCommand user $ APIAcceptContact connReqId
+    processChatCommand $ APIAcceptContact connReqId
-  RejectContact cName -> do
+  RejectContact cName -> withUser $ \User {userId} -> do
     connReqId <- withStore $ \st -> getContactRequestIdByName st userId cName
-    processChatCommand user $ APIRejectContact connReqId
+    processChatCommand $ APIRejectContact connReqId
-  SendMessage cName msg -> do
+  SendMessage cName msg -> withUser $ \User {userId} -> do
     contactId <- withStore $ \st -> getContactIdByName st userId cName
     let mc = MCText $ safeDecodeUtf8 msg
-    processChatCommand user $ APISendMessage CTDirect contactId mc
+    processChatCommand $ APISendMessage CTDirect contactId mc
-  NewGroup gProfile -> do
+  NewGroup gProfile -> withUser $ \user -> do
     gVar <- asks idsDrg
     CRGroupCreated <$> withStore (\st -> createNewGroup st gVar user gProfile)
-  AddMember gName cName memRole -> withChatLock $ do
+  AddMember gName cName memRole -> withUser $ \user@User {userId} -> withChatLock $ do
     -- TODO for large groups: no need to load all members to determine if contact is a member
     (group, contact) <- withStore $ \st -> (,) <$> getGroupByName st user gName <*> getContactByName st userId cName
     let Group gInfo@GroupInfo {groupId, groupProfile, membership} members = group
@@ -241,7 +257,7 @@ processChatCommand user@User {userId, profile} = \case
             Just cReq -> sendInvitation memberId cReq
             Nothing -> throwChatError $ CEGroupCantResendInvitation gInfo cName
         | otherwise -> throwChatError $ CEGroupDuplicateMember cName
-  JoinGroup gName -> do
+  JoinGroup gName -> withUser $ \user@User {userId} -> do
     ReceivedGroupInvitation {fromMember, connRequest, groupInfo = g} <- withStore $ \st -> getGroupInvitation st user gName
     withChatLock . procCmd $ do
       agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId (membership g :: GroupMember)
@@ -251,7 +267,7 @@ processChatCommand user@User {userId, profile} = \case
         updateGroupMemberStatus st userId (membership g) GSMemAccepted
       pure $ CRUserAcceptedGroupSent g
   MemberRole _gName _cName _mRole -> throwChatError $ CECommandError "unsupported"
-  RemoveMember gName cName -> do
+  RemoveMember gName cName -> withUser $ \user@User {userId} -> do
     Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName
     case find ((== cName) . (localDisplayName :: GroupMember -> ContactName)) members of
       Nothing -> throwChatError $ CEGroupMemberNotFound cName
@@ -263,14 +279,14 @@ processChatCommand user@User {userId, profile} = \case
           deleteMemberConnection m
           withStore $ \st -> updateGroupMemberStatus st userId m GSMemRemoved
           pure $ CRUserDeletedMember gInfo m
-  LeaveGroup gName -> do
+  LeaveGroup gName -> withUser $ \user@User {userId} -> do
     Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName
     withChatLock . procCmd $ do
       void $ sendGroupMessage members XGrpLeave
       mapM_ deleteMemberConnection members
       withStore $ \st -> updateGroupMemberStatus st userId membership GSMemLeft
       pure $ CRLeftMemberUser gInfo
-  DeleteGroup gName -> do
+  DeleteGroup gName -> withUser $ \user -> do
     g@(Group gInfo@GroupInfo {membership} members) <- withStore $ \st -> getGroupByName st user gName
     let s = memberStatus membership
         canDelete =
@@ -282,13 +298,13 @@ processChatCommand user@User {userId, profile} = \case
       mapM_ deleteMemberConnection members
       withStore $ \st -> deleteGroup st user g
       pure $ CRGroupDeletedUser gInfo
-  ListMembers gName -> CRGroupMembers <$> withStore (\st -> getGroupByName st user gName)
+  ListMembers gName -> CRGroupMembers <$> (withUser $ \user -> withStore (\st -> getGroupByName st user gName))
-  ListGroups -> CRGroupsList <$> withStore (`getUserGroupDetails` user)
+  ListGroups -> CRGroupsList <$> withUser (\user -> withStore (`getUserGroupDetails` user))
-  SendGroupMessage gName msg -> do
+  SendGroupMessage gName msg -> withUser $ \user -> do
     groupId <- withStore $ \st -> getGroupIdByName st user gName
     let mc = MCText $ safeDecodeUtf8 msg
-    processChatCommand user $ APISendMessage CTGroup groupId mc
+    processChatCommand $ APISendMessage CTGroup groupId mc
-  SendFile cName f -> withChatLock $ do
+  SendFile cName f -> withUser $ \User {userId} -> withChatLock $ do
     (fileSize, chSize) <- checkSndFile f
     contact <- withStore $ \st -> getContactByName st userId cName
     (agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation)
@@ -299,7 +315,7 @@ processChatCommand user@User {userId, profile} = \case
     withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId ci
     setActive $ ActiveC cName
     pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci
-  SendGroupFile gName f -> withChatLock $ do
+  SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do
     (fileSize, chSize) <- checkSndFile f
     Group gInfo@GroupInfo {membership} members <- withStore $ \st -> getGroupByName st user gName
     unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved
@@ -319,7 +335,7 @@ processChatCommand user@User {userId, profile} = \case
     ciMeta@CIMeta {itemId} <- saveChatItem userId (CDGroupSnd gInfo) ci
     withStore $ \st -> updateFileTransferChatItemId st fileId itemId
     pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) $ ChatItem CIGroupSnd ciMeta ciContent
-  ReceiveFile fileId filePath_ -> do
+  ReceiveFile fileId filePath_ -> withUser $ \User {userId} -> do
     ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileConnReq}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
     unless (fileStatus == RFSNew) . throwChatError $ CEFileAlreadyReceiving fileName
     withChatLock . procCmd $ do
@@ -331,7 +347,7 @@ processChatCommand user@User {userId, profile} = \case
         Left (ChatErrorAgent (SMP SMP.AUTH)) -> pure $ CRRcvFileAcceptedSndCancelled ft
         Left (ChatErrorAgent (CONN DUPLICATE)) -> pure $ CRRcvFileAcceptedSndCancelled ft
         Left e -> throwError e
-  CancelFile fileId -> do
+  CancelFile fileId -> withUser $ \User {userId} -> do
     ft' <- withStore (\st -> getFileTransfer st userId fileId)
     withChatLock . procCmd $ case ft' of
       FTSnd fts -> do
@@ -341,18 +357,19 @@ processChatCommand user@User {userId, profile} = \case
         cancelRcvFileTransfer ft
         pure $ CRRcvFileCancelled ft
   FileStatus fileId ->
-    CRFileTransferStatus <$> withStore (\st -> getFileTransferProgress st userId fileId)
+    CRFileTransferStatus <$> withUser (\User {userId} -> withStore $ \st -> getFileTransferProgress st userId fileId)
-  ShowProfile -> pure $ CRUserProfile profile
+  ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile profile
-  UpdateProfile p@Profile {displayName}
+  UpdateProfile p@Profile {displayName} -> withUser $ \user@User {profile} ->
-    | p == profile -> pure CRUserProfileNoChange
+    if p == profile
-    | otherwise -> do
+      then pure CRUserProfileNoChange
-      withStore $ \st -> updateUserProfile st user p
+      else do
-      let user' = (user :: User) {localDisplayName = displayName, profile = p}
+        withStore $ \st -> updateUserProfile st user p
-      asks currentUser >>= atomically . (`writeTVar` user')
+        let user' = (user :: User) {localDisplayName = displayName, profile = p}
-      contacts <- withStore (`getUserContacts` user)
+        asks currentUser >>= atomically . (`writeTVar` Just user')
-      withChatLock . procCmd $ do
+        contacts <- withStore (`getUserContacts` user)
-        forM_ contacts $ \ct -> sendDirectMessage (contactConn ct) $ XInfo p
+        withChatLock . procCmd $ do
-        pure $ CRUserProfileUpdated profile p
+          forM_ contacts $ \ct -> sendDirectMessage (contactConn ct) $ XInfo p
+          pure $ CRUserProfileUpdated profile p
   QuitChat -> liftIO exitSuccess
   ShowVersion -> pure CRVersionInfo
   where
@@ -367,13 +384,13 @@ processChatCommand user@User {userId, profile} = \case
     --   corrId <- liftIO $ SMP.CorrId <$> randomBytes gVar 8
     --   void . forkIO $
     --     withAgentLock a . withLock l $
-    --       (atomically . writeTBQueue q) . (Just corrId,) =<< (action `catchError` (pure . CRChatError))
+    --       (atomically . writeTBQueue q) . (Just corrId,) =<< (action `catchError` (pure . CRChatCmdError))
     --   pure $ CRCmdAccepted corrId
     -- use function below to make commands "synchronous"
     procCmd :: m ChatResponse -> m ChatResponse
     procCmd = id
-    connect :: ConnectionRequestUri c -> ChatMsgEvent -> m ()
+    connect :: UserId -> ConnectionRequestUri c -> ChatMsgEvent -> m ()
-    connect cReq msg = do
+    connect userId cReq msg = do
       connId <- withAgent $ \a -> joinConnection a cReq $ directMessage msg
       withStore $ \st -> createDirectConnection st userId connId
     contactMember :: Contact -> [GroupMember] -> Maybe GroupMember
@@ -416,31 +433,30 @@ processChatCommand user@User {userId, profile} = \case
               f = filePath `combine` (name <> suffix <> ext)
            in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f)
 
-agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => m ()
+agentSubscriber :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
-agentSubscriber = do
+agentSubscriber user = do
   q <- asks $ subQ . smpAgent
   l <- asks chatLock
-  subscribeUserConnections
+  subscribeUserConnections user
   forever $ do
     (_, connId, msg) <- atomically $ readTBQueue q
-    user <- readTVarIO =<< asks currentUser
+    u <- readTVarIO =<< asks currentUser
     withLock l . void . runExceptT $
-      processAgentMessage user connId msg `catchError` (toView . CRChatError)
+      processAgentMessage u connId msg `catchError` (toView . CRChatError)
 
-subscribeUserConnections :: forall m. (MonadUnliftIO m, MonadReader ChatController m) => m ()
+subscribeUserConnections :: (MonadUnliftIO m, MonadReader ChatController m) => User -> m ()
-subscribeUserConnections = void . runExceptT $ do
+subscribeUserConnections user@User {userId} = void . runExceptT $ do
-  user <- readTVarIO =<< asks currentUser
+  subscribeContacts
-  subscribeContacts user
+  subscribeGroups
-  subscribeGroups user
+  subscribeFiles
-  subscribeFiles user
+  subscribePendingConnections
-  subscribePendingConnections user
+  subscribeUserContactLink
-  subscribeUserContactLink user
   where
-    subscribeContacts user = do
+    subscribeContacts = do
       contacts <- withStore (`getUserContacts` user)
       forM_ contacts $ \ct ->
         (subscribe (contactConnId ct) >> toView (CRContactSubscribed ct)) `catchError` (toView . CRContactSubError ct)
-    subscribeGroups user = do
+    subscribeGroups = do
       groups <- withStore (`getUserGroups` user)
       forM_ groups $ \(Group g@GroupInfo {membership} members) -> do
         let connectedMembers = mapMaybe (\m -> (m,) <$> memberConnId m) members
@@ -456,7 +472,7 @@ subscribeUserConnections = void . runExceptT $ do
                 forM_ connectedMembers $ \(GroupMember {localDisplayName = c}, cId) ->
                   subscribe cId `catchError` (toView . CRMemberSubError g c)
                 toView $ CRGroupSubscribed g
-    subscribeFiles user = do
+    subscribeFiles = do
       withStore (`getLiveSndFileTransfers` user) >>= mapM_ subscribeSndFile
       withStore (`getLiveRcvFileTransfers` user) >>= mapM_ subscribeRcvFile
       where
@@ -477,10 +493,10 @@ subscribeUserConnections = void . runExceptT $ do
           where
             resume RcvFileInfo {agentConnId = AgentConnId cId} =
               subscribe cId `catchError` (toView . CRRcvFileSubError ft)
-    subscribePendingConnections user = do
+    subscribePendingConnections = do
       cs <- withStore (`getPendingConnections` user)
       subscribeConns cs `catchError` \_ -> pure ()
-    subscribeUserContactLink User {userId} = do
+    subscribeUserContactLink = do
       cs <- withStore (`getUserContactLinkConnections` userId)
       (subscribeConns cs >> toView CRUserContactLinkSubscribed)
         `catchError` (toView . CRUserContactLinkSubError)
@@ -489,8 +505,9 @@ subscribeUserConnections = void . runExceptT $ do
       withAgent $ \a ->
         forM_ conns $ subscribeConnection a . aConnId
 
-processAgentMessage :: forall m. ChatMonad m => User -> ConnId -> ACommand 'Agent -> m ()
+processAgentMessage :: forall m. ChatMonad m => Maybe User -> ConnId -> ACommand 'Agent -> m ()
-processAgentMessage user@User {userId, profile} agentConnId agentMessage =
+processAgentMessage Nothing _ _ = throwChatError CENoActiveUser
+processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage =
   (withStore (\st -> getConnectionEntity st user agentConnId) >>= updateConnStatus) >>= \case
     RcvDirectMsgConnection conn contact_ ->
       processDirectMessage agentMessage conn contact_
@@ -1026,7 +1043,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage =
       toView $ CRGroupDeleted gInfo m
 
 parseChatMessage :: ByteString -> Either ChatError ChatMessage
-parseChatMessage = first ChatErrorMessage . strDecode
+parseChatMessage = first (ChatError . CEInvalidChatMessage) . strDecode
 
 sendFileChunk :: ChatMonad m => SndFileTransfer -> m ()
 sendFileChunk ft@SndFileTransfer {fileId, fileStatus, agentConnId = AgentConnId acId} =
@@ -1319,6 +1336,18 @@ notificationSubscriber = do
   ChatController {notifyQ, sendNotification} <- ask
   forever $ atomically (readTBQueue notifyQ) >>= liftIO . sendNotification
 
+withUser' :: ChatMonad m => (User -> m a) -> m a
+withUser' action =
+  asks currentUser
+    >>= readTVarIO
+    >>= maybe (throwChatError CENoActiveUser) action
+
+withUser :: ChatMonad m => (User -> m a) -> m a
+withUser action = withUser' $ \user ->
+  ifM chatStarted (action user) (throwChatError CEChatNotStarted)
+  where
+    chatStarted = fmap isJust . readTVarIO =<< asks agentAsync
+
 withAgent :: ChatMonad m => (AgentClient -> ExceptT AgentErrorType m a) -> m a
 withAgent action =
   asks smpAgent
@@ -1336,7 +1365,10 @@ withStore action =
 
 chatCommandP :: Parser ChatCommand
 chatCommandP =
-  "/_get chats" $> APIGetChats
+  ("/user " <|> "/u ") *> (CreateActiveUser <$> userProfile)
+    <|> ("/user" <|> "/u") $> ShowActiveUser
+    <|> "/_start" $> StartChat
+    <|> "/_get chats" $> APIGetChats
     <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP)
     <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)
     <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP)

src/Simplex/Chat/Controller.hs

@@ -8,6 +8,7 @@
 
 module Simplex.Chat.Controller where
 
+import Control.Concurrent.Async (Async)
 import Control.Exception
 import Control.Monad.Except
 import Control.Monad.IO.Unlift
@@ -54,10 +55,11 @@ data ActiveTo = ActiveNone | ActiveC ContactName | ActiveG GroupName
   deriving (Eq)
 
 data ChatController = ChatController
-  { currentUser :: TVar User,
+  { currentUser :: TVar (Maybe User),
     activeTo :: TVar ActiveTo,
     firstTime :: Bool,
     smpAgent :: AgentClient,
+    agentAsync :: TVar (Maybe (Async ())),
     chatStore :: SQLiteStore,
     idsDrg :: TVar ChaChaDRG,
     inputQ :: TBQueue String,
@@ -78,7 +80,10 @@ instance ToJSON HelpSection where
   toEncoding = J.genericToEncoding . enumJSON $ dropPrefix "HS"
 
 data ChatCommand
-  = APIGetChats
+  = ShowActiveUser
+  | CreateActiveUser Profile
+  | StartChat
+  | APIGetChats
   | APIGetChat ChatType Int64 ChatPagination
   | APIGetChatItems Int
   | APISendMessage ChatType Int64 MsgContent
@@ -120,7 +125,9 @@ data ChatCommand
   deriving (Show)
 
 data ChatResponse
-  = CRApiChats {chats :: [AChat]}
+  = CRActiveUser {user :: User}
+  | CRChatStarted
+  | CRApiChats {chats :: [AChat]}
   | CRApiChat {chat :: AChat}
   | CRNewChatItem {chatItem :: AChatItem}
   | CRMsgIntegrityError {msgerror :: MsgErrorType} -- TODO make it chat item to support in mobile
@@ -198,10 +205,8 @@ instance ToJSON ChatResponse where
 
 data ChatError
   = ChatError {errorType :: ChatErrorType}
-  | ChatErrorMessage {errorMessage :: String}
   | ChatErrorAgent {agentError :: AgentErrorType}
   | ChatErrorStore {storeError :: StoreError}
-  | ChatErrorNotImplemented
   deriving (Show, Exception, Generic)
 
 instance ToJSON ChatError where
@@ -209,9 +214,13 @@ instance ToJSON ChatError where
   toEncoding = J.genericToEncoding . sumTypeJSON $ dropPrefix "Chat"
 
 data ChatErrorType
-  = CEGroupUserRole
+  = CENoActiveUser
+  | CEActiveUserExists
+  | CEChatNotStarted
   | CEInvalidConnReq
+  | CEInvalidChatMessage {message :: String}
   | CEContactGroups {contact :: Contact, groupNames :: [GroupName]}
+  | CEGroupUserRole
   | CEGroupContactRole {contactName :: ContactName}
   | CEGroupDuplicateMember {contactName :: ContactName}
   | CEGroupDuplicateMemberId
@@ -240,6 +249,9 @@ instance ToJSON ChatErrorType where
 
 type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
 
+chatCmdError :: String -> ChatResponse
+chatCmdError = CRChatCmdError . ChatError . CECommandError
+
 setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
 setActive to = asks activeTo >>= atomically . (`writeTVar` to)
 

src/Simplex/Chat/Mobile.hs

@@ -6,13 +6,10 @@
 
 module Simplex.Chat.Mobile where
 
-import Control.Concurrent (forkIO)
 import Control.Concurrent.STM
-import Control.Monad.Except
 import Control.Monad.Reader
-import Data.Aeson (ToJSON (..), (.=))
+import Data.Aeson (ToJSON (..))
 import qualified Data.Aeson as J
-import qualified Data.Aeson.Encoding as JE
 import qualified Data.ByteString.Char8 as B
 import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.List (find)
@@ -26,36 +23,16 @@ import Simplex.Chat.Store
 import Simplex.Chat.Types
 import Simplex.Messaging.Protocol (CorrId (..))
 
-foreign export ccall "chat_init_store" cChatInitStore :: CString -> IO (StablePtr ChatStore)
+foreign export ccall "chat_init" cChatInit :: CString -> IO (StablePtr ChatController)
-
-foreign export ccall "chat_get_user" cChatGetUser :: StablePtr ChatStore -> IO CJSONString
-
-foreign export ccall "chat_create_user" cChatCreateUser :: StablePtr ChatStore -> CJSONString -> IO CJSONString
-
-foreign export ccall "chat_start" cChatStart :: StablePtr ChatStore -> IO (StablePtr ChatController)
 
 foreign export ccall "chat_send_cmd" cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
 
 foreign export ccall "chat_recv_msg" cChatRecvMsg :: StablePtr ChatController -> IO CJSONString
 
--- | creates or connects to chat store
+-- | initialize chat controller
-cChatInitStore :: CString -> IO (StablePtr ChatStore)
+-- The active user has to be created and the chat has to be started before most commands can be used.
-cChatInitStore fp = peekCAString fp >>= chatInitStore >>= newStablePtr
+cChatInit :: CString -> IO (StablePtr ChatController)
-
+cChatInit fp = peekCAString fp >>= chatInit >>= newStablePtr
--- | returns JSON in the form `{"user": <user object>}` or `{}` in case there is no active user (to show dialog to enter displayName/fullName)
-cChatGetUser :: StablePtr ChatStore -> IO CJSONString
-cChatGetUser cc = deRefStablePtr cc >>= chatGetUser >>= newCAString
-
--- | accepts Profile JSON, returns JSON `{"user": <user object>}` or `{"error": "<error>"}`
-cChatCreateUser :: StablePtr ChatStore -> CJSONString -> IO CJSONString
-cChatCreateUser cPtr profileCJson = do
-  c <- deRefStablePtr cPtr
-  p <- peekCAString profileCJson
-  newCAString =<< chatCreateUser c p
-
--- | this function starts chat - it cannot be started during initialization right now, as it cannot work without user (to be fixed later)
-cChatStart :: StablePtr ChatStore -> IO (StablePtr ChatController)
-cChatStart st = deRefStablePtr st >>= chatStart >>= newStablePtr
 
 -- | send command to chat (same syntax as in terminal for now)
 cChatSendCmd :: StablePtr ChatController -> CString -> IO CJSONString
@@ -78,43 +55,15 @@ mobileChatOpts =
 
 type CJSONString = CString
 
-data ChatStore = ChatStore
-  { dbFilePrefix :: FilePath,
-    chatStore :: SQLiteStore
-  }
-
-chatInitStore :: String -> IO ChatStore
-chatInitStore dbFilePrefix = do
-  let f = chatStoreFile dbFilePrefix
-  chatStore <- createStore f $ dbPoolSize defaultChatConfig
-  pure ChatStore {dbFilePrefix, chatStore}
-
 getActiveUser_ :: SQLiteStore -> IO (Maybe User)
 getActiveUser_ st = find activeUser <$> getUsers st
 
--- | returns JSON in the form `{"user": <user object>}` or `{}`
+chatInit :: String -> IO ChatController
-chatGetUser :: ChatStore -> IO JSONString
+chatInit dbFilePrefix = do
-chatGetUser ChatStore {chatStore} =
+  let f = chatStoreFile dbFilePrefix
-  maybe "{}" userObject <$> getActiveUser_ chatStore
+  chatStore <- createStore f $ dbPoolSize defaultChatConfig
-
+  user_ <- getActiveUser_ chatStore
--- | returns JSON in the form `{"user": <user object>}` or `{"error": "<error>"}`
+  newChatController chatStore user_ defaultChatConfig mobileChatOpts {dbFilePrefix} . const $ pure ()
-chatCreateUser :: ChatStore -> JSONString -> IO JSONString
-chatCreateUser ChatStore {chatStore} profileJson =
-  case J.eitherDecodeStrict' $ B.pack profileJson of
-    Left e -> pure $ err e
-    Right p -> either err userObject <$> runExceptT (createUser chatStore p True)
-  where
-    err e = jsonObject $ "error" .= show e
-
-userObject :: User -> JSONString
-userObject user = jsonObject $ "user" .= user
-
-chatStart :: ChatStore -> IO ChatController
-chatStart ChatStore {dbFilePrefix, chatStore} = do
-  Just user <- getActiveUser_ chatStore
-  cc <- newChatController chatStore user defaultChatConfig mobileChatOpts {dbFilePrefix} . const $ pure ()
-  void . forkIO $ runReaderT runChatController cc
-  pure cc
 
 chatSendCmd :: ChatController -> String -> IO JSONString
 chatSendCmd cc s = LB.unpack . J.encode . APIResponse Nothing <$> runReaderT (execChatCommand $ B.pack s) cc
@@ -124,9 +73,6 @@ chatRecvMsg ChatController {outputQ} = json <$> atomically (readTBQueue outputQ)
   where
     json (corr, resp) = LB.unpack $ J.encode APIResponse {corr, resp}
 
-jsonObject :: J.Series -> JSONString
-jsonObject = LB.unpack . JE.encodingToLazyByteString . J.pairs
-
 data APIResponse = APIResponse {corr :: Maybe CorrId, resp :: ChatResponse}
   deriving (Generic)
 

src/Simplex/Chat/Terminal.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 module Simplex.Chat.Terminal where
 
 import Control.Logger.Simple
+import Control.Monad.Except
 import Control.Monad.Reader
 import Simplex.Chat
 import Simplex.Chat.Controller
@@ -11,8 +14,8 @@ import Simplex.Chat.Terminal.Input
 import Simplex.Chat.Terminal.Notification
 import Simplex.Chat.Terminal.Output
 import Simplex.Chat.Types (User)
-import Simplex.Chat.Util (whenM)
 import Simplex.Messaging.Util (raceAny_)
+import UnliftIO (async, waitEither_)
 
 simplexChat :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO ()
 simplexChat cfg opts t
@@ -27,10 +30,15 @@ simplexChat cfg opts t
       st <- createStore f $ dbPoolSize cfg
       u <- getCreateActiveUser st
       ct <- newChatTerminal t
-      cc <- newChatController st u cfg opts sendNotification'
+      cc <- newChatController st (Just u) cfg opts sendNotification'
       runSimplexChat u ct cc
 
 runSimplexChat :: User -> ChatTerminal -> ChatController -> IO ()
-runSimplexChat u ct = runReaderT $ do
+runSimplexChat u ct cc = do
-  whenM (asks firstTime) . liftIO . printToTerminal ct $ chatWelcome u
+  when (firstTime cc) . printToTerminal ct $ chatWelcome u
-  raceAny_ [runTerminalInput ct, runTerminalOutput ct, runInputLoop ct, runChatController]
+  a1 <- async $ runChatTerminal ct cc
+  a2 <- runReaderT (startChatController u) cc
+  waitEither_ a1 a2
+
+runChatTerminal :: ChatTerminal -> ChatController -> IO ()
+runChatTerminal ct cc = raceAny_ [runTerminalInput ct cc, runTerminalOutput ct cc, runInputLoop ct cc]

src/Simplex/Chat/Terminal/Input.hs

@@ -25,21 +25,16 @@ getKey =
     Right (KeyEvent key ms) -> pure (key, ms)
     _ -> getKey
 
-runInputLoop :: (MonadUnliftIO m, MonadReader ChatController m) => ChatTerminal -> m ()
+runInputLoop :: ChatTerminal -> ChatController -> IO ()
-runInputLoop ct = do
+runInputLoop ct cc = forever $ do
-  q <- asks inputQ
+  s <- atomically . readTBQueue $ inputQ cc
-  forever $ do
+  r <- runReaderT (execChatCommand . encodeUtf8 $ T.pack s) cc
-    s <- atomically $ readTBQueue q
+  printToTerminal ct $ responseToView s r
-    r <- execChatCommand . encodeUtf8 $ T.pack s
-    liftIO . printToTerminal ct $ responseToView s r
 
-runTerminalInput :: (MonadUnliftIO m, MonadReader ChatController m) => ChatTerminal -> m ()
+runTerminalInput :: ChatTerminal -> ChatController -> IO ()
-runTerminalInput ct = do
+runTerminalInput ct cc = withChatTerm ct $ do
-  cc <- ask
+  updateInput ct
-  liftIO $
+  receiveFromTTY cc ct
-    withChatTerm ct $ do
-      updateInput ct
-      receiveFromTTY cc ct
 
 receiveFromTTY :: MonadTerminal m => ChatController -> ChatTerminal -> m ()
 receiveFromTTY ChatController {inputQ, activeTo} ct@ChatTerminal {termSize, termState} =

src/Simplex/Chat/Terminal/Output.hs

@@ -72,11 +72,10 @@ withTermLock ChatTerminal {termLock} action = do
   action
   atomically $ putTMVar termLock ()
 
-runTerminalOutput :: (MonadUnliftIO m, MonadReader ChatController m) => ChatTerminal -> m ()
+runTerminalOutput :: ChatTerminal -> ChatController -> IO ()
-runTerminalOutput ct = do
+runTerminalOutput ct cc =
-  ChatController {outputQ} <- ask
   forever $
-    atomically (readTBQueue outputQ) >>= liftIO . printToTerminal ct . responseToView "" . snd
+    atomically (readTBQueue $ outputQ cc) >>= printToTerminal ct . responseToView "" . snd
 
 printToTerminal :: ChatTerminal -> [StyledString] -> IO ()
 printToTerminal ct s =

src/Simplex/Chat/View.hs

@@ -34,8 +34,10 @@ serializeChatResponse = unlines . map unStyle . responseToView ""
 
 responseToView :: String -> ChatResponse -> [StyledString]
 responseToView cmd = \case
-  CRApiChats chats -> api [sShow chats]
+  CRActiveUser User {profile} -> r $ viewUserProfile profile
-  CRApiChat chat -> api [sShow chat]
+  CRChatStarted -> r ["chat started"]
+  CRApiChats chats -> r [sShow chats]
+  CRApiChat chat -> r [sShow chat]
   CRNewChatItem (AChatItem _ _ chat item) -> viewChatItem chat item
   CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
   CRCmdAccepted _ -> r []
@@ -115,7 +117,6 @@ responseToView cmd = \case
   CRMessageError prefix err -> [plain prefix <> ": " <> plain err]
   CRChatError e -> viewChatError e
   where
-    api = (highlight cmd :)
     r = (plain cmd :)
     -- this function should be `r` for "synchronous", `id` for "asynchronous" command responses
     -- r' = id
@@ -447,7 +448,11 @@ fileProgress chunksNum chunkSize fileSize =
 viewChatError :: ChatError -> [StyledString]
 viewChatError = \case
   ChatError err -> case err of
+    CENoActiveUser -> ["error: active user is required"]
+    CEActiveUserExists -> ["error: active user already exists"]
+    CEChatNotStarted -> ["error: chat not started"]
     CEInvalidConnReq -> viewInvalidConnReq
+    CEInvalidChatMessage e -> ["chat message error: " <> sShow e]
     CEContactGroups Contact {localDisplayName} gNames -> [ttyContact localDisplayName <> ": contact cannot be deleted, it is a member of the group(s) " <> ttyGroups gNames]
     CEGroupDuplicateMember c -> ["contact " <> ttyContact c <> " is already in the group"]
     CEGroupDuplicateMemberId -> ["cannot add member - duplicate member ID"]
@@ -488,8 +493,6 @@ viewChatError = \case
   ChatErrorAgent err -> case err of
     SMP SMP.AUTH -> ["error: this connection is deleted"]
     e -> ["smp agent error: " <> sShow e]
-  ChatErrorMessage e -> ["chat message error: " <> sShow e]
-  ChatErrorNotImplemented -> ["chat error: not implemented"]
   where
     fileNotFound fileId = ["file " <> sShow fileId <> " not found"]
 

tests/ChatClient.hs

@@ -79,7 +79,7 @@ virtualSimplexChat dbFilePrefix profile = do
   Right user <- runExceptT $ createUser st profile True
   t <- withVirtualTerminal termSettings pure
   ct <- newChatTerminal t
-  cc <- newChatController st user cfg opts {dbFilePrefix} . const $ pure () -- no notifications
+  cc <- newChatController st (Just user) cfg opts {dbFilePrefix} . const $ pure () -- no notifications
   chatAsync <- async $ runSimplexChat user ct cc
   termQ <- newTQueueIO
   termAsync <- async $ readTerminalOutput t termQ
@@ -108,16 +108,18 @@ readTerminalOutput t termQ = do
             then map (dropWhileEnd (== ' ')) diff
             else getDiff_ (n + 1) len win' win
 
-testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO ()
+withTmpFiles :: IO () -> IO ()
-testChatN ps test =
+withTmpFiles =
   bracket_
     (createDirectoryIfMissing False "tests/tmp")
     (removeDirectoryRecursive "tests/tmp")
-    $ do
+
-      let envs = zip ps $ map ((testDBPrefix <>) . show) [(1 :: Int) ..]
+testChatN :: [Profile] -> ([TestCC] -> IO ()) -> IO ()
-      tcs <- getTestCCs envs []
+testChatN ps test = withTmpFiles $ do
-      test tcs
+  let envs = zip ps $ map ((testDBPrefix <>) . show) [(1 :: Int) ..]
-      concurrentlyN_ $ map (<// 100000) tcs
+  tcs <- getTestCCs envs []
+  test tcs
+  concurrentlyN_ $ map (<// 100000) tcs
   where
     getTestCCs [] tcs = pure tcs
     getTestCCs ((p, db) : envs') tcs = (:) <$> virtualSimplexChat db p <*> getTestCCs envs' tcs

tests/ChatTests.hs

@@ -10,6 +10,7 @@ import Control.Concurrent.Async (concurrently_)
 import Control.Concurrent.STM
 import qualified Data.ByteString as B
 import Data.Char (isDigit)
+import Data.Maybe (fromJust)
 import qualified Data.Text as T
 import Simplex.Chat.Controller
 import Simplex.Chat.Types (Profile (..), User (..))
@@ -753,7 +754,7 @@ connectUsers cc1 cc2 = do
 
 showName :: TestCC -> IO String
 showName (TestCC ChatController {currentUser} _ _ _ _) = do
-  User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser
+  Just User {localDisplayName, profile = Profile {fullName}} <- readTVarIO currentUser
   pure . T.unpack $ localDisplayName <> " (" <> fullName <> ")"
 
 createGroup2 :: String -> TestCC -> TestCC -> IO ()
@@ -811,7 +812,7 @@ cc1 <##> cc2 = do
   cc1 <# (name2 <> "> hey")
 
 userName :: TestCC -> IO [Char]
-userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName <$> readTVarIO currentUser
+userName (TestCC ChatController {currentUser} _ _ _ _) = T.unpack . localDisplayName . fromJust <$> readTVarIO currentUser
 
 (##>) :: TestCC -> String -> IO ()
 cc ##> cmd = do

tests/MobileTests.hs

@@ -0,0 +1,43 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module MobileTests where
+
+import ChatClient
+import ChatTests
+import Control.Monad.Except
+import Simplex.Chat.Mobile
+import Simplex.Chat.Store
+import Test.Hspec
+
+mobileTests :: Spec
+mobileTests = do
+  describe "mobile API" $ do
+    it "start new chat without user" testChatApiNoUser
+    it "start new chat with existing user" testChatApi
+
+noActiveUser :: String
+noActiveUser = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"error\":{\"errorType\":{\"noActiveUser\":{}}}}}}}"
+
+activeUserExists :: String
+activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"error\":{\"errorType\":{\"activeUserExists\":{}}}}}}}"
+
+activeUser :: String
+activeUser = "{\"resp\":{\"activeUser\":{\"user\":{\"userId\":1,\"userContactId\":1,\"localDisplayName\":\"alice\",\"profile\":{\"displayName\":\"alice\",\"fullName\":\"Alice\"},\"activeUser\":true}}}}"
+
+testChatApiNoUser :: IO ()
+testChatApiNoUser = withTmpFiles $ do
+  cc <- chatInit testDBPrefix
+  chatSendCmd cc "/u" `shouldReturn` noActiveUser
+  chatSendCmd cc "/_start" `shouldReturn` noActiveUser
+  chatSendCmd cc "/u alice Alice" `shouldReturn` activeUser
+  chatSendCmd cc "/_start" `shouldReturn` "{\"resp\":{\"chatStarted\":{}}}"
+
+testChatApi :: IO ()
+testChatApi = withTmpFiles $ do
+  let f = chatStoreFile testDBPrefix
+  st <- createStore f 1
+  Right _ <- runExceptT $ createUser st aliceProfile True
+  cc <- chatInit testDBPrefix
+  chatSendCmd cc "/u" `shouldReturn` activeUser
+  chatSendCmd cc "/u alice Alice" `shouldReturn` activeUserExists
+  chatSendCmd cc "/_start" `shouldReturn` "{\"resp\":{\"chatStarted\":{}}}"

tests/Test.hs

@@ -1,6 +1,7 @@
 import ChatClient
 import ChatTests
 import MarkdownTests
+import MobileTests
 import ProtocolTests
 import Test.Hspec
 
@@ -8,4 +9,5 @@ main :: IO ()
 main = withSmpServer . hspec $ do
   describe "SimpleX chat markdown" markdownTests
   describe "SimpleX chat protocol" protocolTests
+  describe "Mobile API Tests" mobileTests
   describe "SimpleX chat client" chatTests