diff --git a/cabal.project b/cabal.project index f7e3226a7c..38e8c852af 100644 --- a/cabal.project +++ b/cabal.project @@ -12,7 +12,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: ad8cd1d5154617663065652b45c784ad5a0a584d + tag: e65ca0e8d4a23ebb77528b8564f55d88c338b908 source-repository-package type: git diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5c35f89775..1dc45b8604 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -209,7 +209,7 @@ newChatController backgroundMode = do let inlineFiles' = if allowInstantFiles || autoAcceptFileSize > 0 then inlineFiles else inlineFiles {sendChunks = 0, receiveInstant = False} config = cfg {logLevel, showReactions, tbqSize, subscriptionEvents = logConnections, hostEvents = logServerHosts, defaultServers = configServers, inlineFiles = inlineFiles', autoAcceptFileSize, highlyAvailable} - firstTime <- newTVarIO $ dbNew chatStore + firstTime = dbNew chatStore currentUser <- newTVarIO user currentRemoteHost <- newTVarIO Nothing servers <- agentServers config @@ -455,20 +455,14 @@ processChatCommand' vr = \case u <- asks currentUser (smp, smpServers) <- chooseServers SPSMP (xftp, xftpServers) <- chooseServers SPXFTP - fstTime <- chatReadVar firstTime users <- withStore' getUsers - auId <- - case users of - [] | fstTime -> pure 1 - _ -> do - forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} -> - when (n == displayName) . throwChatError $ - if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""} - withAgent (\a -> createUser a smp xftp) + forM_ users $ \User {localDisplayName = n, activeUser, viewPwdHash} -> + when (n == displayName) . throwChatError $ + if activeUser || isNothing viewPwdHash then CEUserExists displayName else CEInvalidDisplayName {displayName, validName = ""} + auId <- withAgent (\a -> createUser a smp xftp) ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts - chatWriteVar firstTime False - when (null users && fstTime) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure () + when (null users) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure () withStore $ \db -> createNoteFolder db user storeServers user smpServers storeServers user xftpServers diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 0787842b5c..7b4a228c59 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -175,7 +175,7 @@ data ChatDatabase = ChatDatabase {chatStore :: SQLiteStore, agentStore :: SQLite data ChatController = ChatController { currentUser :: TVar (Maybe User), currentRemoteHost :: TVar (Maybe RemoteHostId), - firstTime :: TVar Bool, + firstTime :: Bool, smpAgent :: AgentClient, agentAsync :: TVar (Maybe (Async (), Maybe (Async ()))), chatStore :: SQLiteStore, diff --git a/src/Simplex/Chat/Core.hs b/src/Simplex/Chat/Core.hs index 7da572d095..72c136f3f8 100644 --- a/src/Simplex/Chat/Core.hs +++ b/src/Simplex/Chat/Core.hs @@ -6,7 +6,6 @@ module Simplex.Chat.Core ( simplexChatCore, - simplexChatCore', runSimplexChat, sendChatCmdStr, sendChatCmd, @@ -35,10 +34,7 @@ import Text.Read (readMaybe) import UnliftIO.Async simplexChatCore :: ChatConfig -> ChatOpts -> (User -> ChatController -> IO ()) -> IO () -simplexChatCore cfg opts = simplexChatCore' cfg opts . const - -simplexChatCore' :: ChatConfig -> ChatOpts -> (Bool -> User -> ChatController -> IO ()) -> IO () -simplexChatCore' cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} chat = +simplexChatCore cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {coreOptions = CoreChatOpts {dbFilePrefix, dbKey, logAgent}} chat = case logAgent of Just level -> do setLogLevel level @@ -52,10 +48,9 @@ simplexChatCore' cfg@ChatConfig {confirmMigrations, testView} opts@ChatOpts {cor run db@ChatDatabase {chatStore} = do u_ <- getSelectActiveUser chatStore cc <- newChatController db u_ cfg opts False - fstTime <- readTVarIO $ firstTime cc u <- maybe (createActiveUser cc) pure u_ unless testView $ putStrLn $ "Current user: " <> userStr u - runSimplexChat opts u cc $ chat fstTime + runSimplexChat opts u cc chat runSimplexChat :: ChatOpts -> User -> ChatController -> (User -> ChatController -> IO ()) -> IO () runSimplexChat ChatOpts {maintenance} u cc chat diff --git a/src/Simplex/Chat/Terminal.hs b/src/Simplex/Chat/Terminal.hs index 87c8d5d13e..549a6cc080 100644 --- a/src/Simplex/Chat/Terminal.hs +++ b/src/Simplex/Chat/Terminal.hs @@ -48,9 +48,9 @@ simplexChatTerminal :: WithTerminal t => ChatConfig -> ChatOpts -> t -> IO () simplexChatTerminal cfg options t = run options where run opts@ChatOpts {coreOptions = coreOptions@CoreChatOpts {dbKey}} = - handle checkDBKeyError . simplexChatCore' cfg opts $ \fstTime u cc -> do + handle checkDBKeyError . simplexChatCore cfg opts $ \u cc -> do ct <- newChatTerminal t opts - when fstTime . printToTerminal ct $ chatWelcome u + when (firstTime cc) . printToTerminal ct $ chatWelcome u runChatTerminal ct cc opts where checkDBKeyError :: SQLError -> IO () diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index c04d99f9ee..b26f76ab2c 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -306,8 +306,8 @@ getTermLine cc = 5000000 `timeout` atomically (readTQueue $ termQ cc) >>= \case Just s -> do -- remove condition to always echo virtual terminal - -- when True $ do - when (printOutput cc) $ do + when True $ do + -- when (printOutput cc) $ do name <- userName cc putStrLn $ name <> ": " <> s pure s diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index bb194df82b..f641135aeb 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -29,7 +29,7 @@ import Test.Hspec chatDirectTests :: SpecWith FilePath chatDirectTests = do describe "direct messages" $ do - describe "add contact and send/receive messages" testAddContact + fdescribe "add contact and send/receive messages" testAddContact it "clear chat with contact" testContactClear it "deleting contact deletes profile" testDeleteContactDeletesProfile it "unused contact is deleted silently" testDeleteUnusedContactSilent