From bc8a6f483397964fcf9252646f76c297398bc335 Mon Sep 17 00:00:00 2001 From: Alexander Bondarenko <486682+dpwiz@users.noreply.github.com> Date: Thu, 11 Jan 2024 19:01:44 +0200 Subject: [PATCH] core: add notes chat type (#3568) * Add chat type "self" * rename to Notes * cover more things * remove quote, tweak sql * resolve comments * constrain ACIQDirection to exclude CTLocal * add CILocalRcv handling * plug in migrations and tests * cover more API, implement new folders * working create/send/tail * remove interaction with messages * add note deletion (api-only) * add folder deletion * add getLocalChatItemIdByText * add APICreateChatItem and files * add protocol check for getFileTransfer protocol * replace FTLocal with createLocalFile * add chat previews * add folder clear * add reactions * add read/unread * add note updates * resolve some comments * remove local reactions * remove folder names, deletion, add autocreate * add file deletion check * add preview pagination test * add per-item file deletion check * pull mkChatItem out of createLocal to prevent ci record updates * use - as notes name * bump migration ts * update schema * resolve comments * add chat pagination test * use chat queries from Direct instead * evict note folders from createUserRecord * switch to - for note folder chat type prefix and use empty name * fix getLocalChatXxx * add explicit createCCNoteFolder for tests * use overloadedstrings for single-line queries * add suggested chat list tests * add notes chat to a user-creating test * throw correct error for missing file * remove unique check from schema * add UndecidableInstances for ghc8.10 * switch to * for chat type sigil * add file safety test * add drop index * remove indentation * remove repeated folder * remove redundant filter query, NoteFolderName * don't attempt to cancel local files when deleting chat item * rename function * fix comment * rename * fix merge * fix typo * remove editable limit * restore comment * remove local file cancel * Revert "remove editable limit" This reverts commit 65df55caf88df8538c593dfd77b3c62e9c4bce06. * refactor --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --- simplex-chat.cabal | 3 + src/Simplex/Chat.hs | 133 ++++++- src/Simplex/Chat/Controller.hs | 2 + src/Simplex/Chat/Messages.hs | 71 +++- .../Chat/Migrations/M20240102_note_folders.hs | 42 ++ src/Simplex/Chat/Migrations/chat_schema.sql | 18 +- src/Simplex/Chat/Store/Direct.hs | 1 + src/Simplex/Chat/Store/Files.hs | 65 +++- src/Simplex/Chat/Store/Messages.hs | 358 +++++++++++++++++- src/Simplex/Chat/Store/Migrations.hs | 4 +- src/Simplex/Chat/Store/NoteFolders.hs | 69 ++++ src/Simplex/Chat/Store/Profiles.hs | 7 + src/Simplex/Chat/Store/Shared.hs | 4 + src/Simplex/Chat/Types.hs | 27 ++ src/Simplex/Chat/View.hs | 34 +- tests/ChatTests.hs | 2 + tests/ChatTests/ChatList.hs | 20 +- tests/ChatTests/Direct.hs | 6 +- tests/ChatTests/Local.hs | 189 +++++++++ tests/ChatTests/Utils.hs | 13 + 20 files changed, 1000 insertions(+), 68 deletions(-) create mode 100644 src/Simplex/Chat/Migrations/M20240102_note_folders.hs create mode 100644 src/Simplex/Chat/Store/NoteFolders.hs create mode 100644 tests/ChatTests/Local.hs diff --git a/simplex-chat.cabal b/simplex-chat.cabal index ebb167936..8aafb8e86 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -129,6 +129,7 @@ library Simplex.Chat.Migrations.M20231207_chat_list_pagination Simplex.Chat.Migrations.M20231214_item_content_tag Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries + Simplex.Chat.Migrations.M20240102_note_folders Simplex.Chat.Mobile Simplex.Chat.Mobile.File Simplex.Chat.Mobile.Shared @@ -150,6 +151,7 @@ library Simplex.Chat.Store.Groups Simplex.Chat.Store.Messages Simplex.Chat.Store.Migrations + Simplex.Chat.Store.NoteFolders Simplex.Chat.Store.Profiles Simplex.Chat.Store.Remote Simplex.Chat.Store.Shared @@ -541,6 +543,7 @@ test-suite simplex-chat-test ChatTests.Direct ChatTests.Files ChatTests.Groups + ChatTests.Local ChatTests.Profiles ChatTests.Utils JSONTests diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index f455ca63a..95424ea79 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -73,6 +73,7 @@ import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Files import Simplex.Chat.Store.Groups import Simplex.Chat.Store.Messages +import Simplex.Chat.Store.NoteFolders import Simplex.Chat.Store.Profiles import Simplex.Chat.Store.Shared import Simplex.Chat.Types @@ -465,6 +466,7 @@ processChatCommand' vr = \case ts <- liftIO $ getCurrentTime >>= if pastTimestamp then coupleDaysAgo else pure user <- withStore $ \db -> createUserRecordAt db (AgentUserId auId) p True ts when (auId == 1) $ withStore (\db -> createContact db user simplexContactProfile) `catchChatError` \_ -> pure () + withStore $ \db -> createNoteFolder db user storeServers user smpServers storeServers user xftpServers atomically . writeTVar u $ Just user @@ -630,6 +632,9 @@ processChatCommand' vr = \case CTGroup -> do groupChat <- withStore (\db -> getGroupChat db vr user cId pagination search) pure $ CRApiChat user (AChat SCTGroup groupChat) + CTLocal -> do + localChat <- withStore (\db -> getLocalChat db user cId pagination search) + pure $ CRApiChat user (AChat SCTLocal localChat) CTContactRequest -> pure $ chatCmdError (Just user) "not implemented" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIGetChatItems pagination search -> withUser $ \user -> do @@ -761,6 +766,7 @@ processChatCommand' vr = \case void . withStore' $ \db -> createSndGroupInlineFT db m conn ft sendMemberFileInline m conn ft sharedMsgId processMember _ = pure () + CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" where @@ -792,6 +798,22 @@ processChatCommand' vr = \case unzipMaybe3 :: Maybe (a, b, c) -> (Maybe a, Maybe b, Maybe c) unzipMaybe3 (Just (a, b, c)) = (Just a, Just b, Just c) unzipMaybe3 _ = (Nothing, Nothing, Nothing) + APICreateChatItem folderId (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> do + forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported" + nf <- withStore $ \db -> getNoteFolder db user folderId + createdAt <- liftIO getCurrentTime + let content = CISndMsgContent mc + let cd = CDLocalSnd nf + ciId <- createLocalChatItem user cd content createdAt + ciFile_ <- forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do + fsFilePath <- toFSFilePath filePath + fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs + chunkSize <- asks $ fileChunkSize . config + withStore' $ \db -> do + fileId <- createLocalFile CIFSSndStored db user nf ciId createdAt cf fileSize chunkSize + pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndStored, fileProtocol = FPLocal} + let ci = mkChatItem cd ciId content ciFile_ Nothing Nothing Nothing False createdAt Nothing createdAt + pure . CRNewChatItem user $ AChatItem SCTLocal SMDSnd (LocalChat nf) ci APIUpdateChatItem (ChatRef cType chatId) itemId live mc -> withUser $ \user -> withChatLock "updateChatItem" $ case cType of CTDirect -> do ct@Contact {contactId} <- withStore $ \db -> getContact db user chatId @@ -837,6 +859,17 @@ processChatCommand' vr = \case else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci) _ -> throwChatError CEInvalidChatItemUpdate CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate + CTLocal -> do + (nf@NoteFolder {noteFolderId}, cci) <- withStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId + case cci of + CChatItem SMDSnd ci@ChatItem {content = CISndMsgContent oldMC} + | mc == oldMC -> pure $ CRChatItemNotChanged user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci) + | otherwise -> withStore' $ \db -> do + currentTs <- getCurrentTime + addInitialAndNewCIVersions db itemId (chatItemTs' ci, oldMC) (currentTs, mc) + ci' <- updateLocalChatItem' db user noteFolderId ci (CISndMsgContent mc) + pure $ CRChatItemUpdated user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci') + _ -> throwChatError CEInvalidChatItemUpdate CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteChatItem (ChatRef cType chatId) itemId mode -> withUser $ \user -> withChatLock "deleteChatItem" $ case cType of @@ -861,6 +894,9 @@ processChatCommand' vr = \case (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing delGroupChatItem user gInfo ci msgId Nothing (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete + CTLocal -> do + (nf, CChatItem _ ci) <- withStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId + deleteLocalCI user nf ci True False CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do @@ -911,6 +947,7 @@ processChatCommand' vr = \case r = ACIReaction SCTGroup SMDSnd (GroupChat g) $ CIReaction CIGroupSnd ci' createdAt reaction pure $ CRChatItemReaction user add r _ -> throwChatError $ CECommandError "reaction not possible - no shared item ID" + CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" CTContactConnection -> pure $ chatCmdError (Just user) "not supported" where @@ -942,6 +979,10 @@ processChatCommand' vr = \case startProximateTimedItemThread user (ChatRef CTGroup chatId, itemId) deleteAt withStore' $ \db -> updateGroupChatItemsRead db userId chatId fromToIds ok user + CTLocal -> do + user <- withStore $ \db -> getUserByNoteFolderId db chatId + withStore' $ \db -> updateLocalChatItemsRead db user chatId fromToIds + ok user CTContactRequest -> pure $ chatCmdError Nothing "not supported" CTContactConnection -> pure $ chatCmdError Nothing "not supported" APIChatUnread (ChatRef cType chatId) unreadChat -> withUser $ \user -> case cType of @@ -955,6 +996,11 @@ processChatCommand' vr = \case Group {groupInfo} <- getGroup db vr user chatId liftIO $ updateGroupUnreadChat db user groupInfo unreadChat ok user + CTLocal -> do + withStore $ \db -> do + nf <- getNoteFolder db user chatId + liftIO $ updateNoteFolderUnreadChat db user nf unreadChat + ok user _ -> pure $ chatCmdError (Just user) "not supported" APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of CTDirect -> do @@ -1012,8 +1058,9 @@ processChatCommand' vr = \case withStore' (\db -> setContactDeleted db user ct) `catchChatError` (toView . CRChatError (Just user)) pure $ map aConnId conns + CTLocal -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" - APIClearChat (ChatRef cType chatId) -> withUser $ \user -> case cType of + APIClearChat (ChatRef cType chatId) -> withUser $ \user@User {userId} -> case cType of CTDirect -> do ct <- withStore $ \db -> getContact db user chatId filesInfo <- withStore' $ \db -> getContactFileInfo db user ct @@ -1028,6 +1075,14 @@ processChatCommand' vr = \case membersToDelete <- withStore' $ \db -> getGroupMembersForExpiration db user gInfo forM_ membersToDelete $ \m -> withStore' $ \db -> deleteGroupMember db user m pure $ CRChatCleared user (AChatInfo SCTGroup $ GroupChat gInfo) + CTLocal -> do + nf <- withStore $ \db -> getNoteFolder db user chatId + filesInfo <- withStore' $ \db -> getNoteFolderFileInfo db user nf + withChatLock "clearChat local" . procCmd $ do + mapM_ (deleteFile user) filesInfo + withStore' $ \db -> deleteNoteFolderFiles db userId nf + withStore' $ \db -> deleteNoteFolderCIs db user nf + pure $ CRChatCleared user (AChatInfo SCTLocal $ LocalChat nf) CTContactConnection -> pure $ chatCmdError (Just user) "not supported" CTContactRequest -> pure $ chatCmdError (Just user) "not supported" APIAcceptContact incognito connReqId -> withUser $ \_ -> withChatLock "acceptContact" $ do @@ -1513,6 +1568,11 @@ processChatCommand' vr = \case gId <- withStore $ \db -> getGroupIdByName db user name let chatRef = ChatRef CTGroup gId processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc + CTLocal + | name == "" -> do + folderId <- withStore (`getUserNoteFolderId` user) + processChatCommand . APICreateChatItem folderId $ ComposedMessage Nothing Nothing mc + | otherwise -> throwChatError $ CECommandError "not supported" _ -> throwChatError $ CECommandError "not supported" SendMemberContactMessage gName mName msg -> withUser $ \user -> do (gId, mId) <- getGroupAndMemberId user gName mName @@ -1806,6 +1866,9 @@ processChatCommand' vr = \case quotedItemId <- withStore $ \db -> getGroupChatItemIdByText db user groupId cName quotedMsg let mc = MCText msg processChatCommand . APISendMessage (ChatRef CTGroup groupId) False Nothing $ ComposedMessage Nothing (Just quotedItemId) mc + ClearNoteFolder -> withUser $ \user -> do + folderId <- withStore (`getUserNoteFolderId` user) + processChatCommand $ APIClearChat (ChatRef CTLocal folderId) LastChats count_ -> withUser' $ \user -> do let count = fromMaybe 5000 count_ (errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db vr user False (PTLast count) clqNoFilters) @@ -1841,7 +1904,9 @@ processChatCommand' vr = \case asks showLiveItems >>= atomically . (`writeTVar` on) >> ok_ SendFile chatName f -> withUser $ \user -> do chatRef <- getChatRef user chatName - processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "") + case chatRef of + ChatRef CTLocal folderId -> processChatCommand . APICreateChatItem folderId $ ComposedMessage (Just f) Nothing (MCFile "") + _ -> processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage (Just f) Nothing (MCFile "") SendImage chatName f@(CryptoFile fPath _) -> withUser $ \user -> do chatRef <- getChatRef user chatName filePath <- toFSFilePath fPath @@ -1913,6 +1978,8 @@ processChatCommand' vr = \case FileStatus fileId -> withUser $ \user -> do ci@(AChatItem _ _ _ ChatItem {file}) <- withStore $ \db -> getChatItemByFileId db vr user fileId case file of + Just CIFile {fileProtocol = FPLocal} -> + throwChatError $ CECommandError "not supported for local files" Just CIFile {fileProtocol = FPXFTP} -> pure $ CRFileTransferStatusXFTP user ci _ -> do @@ -2024,6 +2091,9 @@ processChatCommand' vr = \case ChatRef cType <$> case cType of CTDirect -> withStore $ \db -> getContactIdByName db user name CTGroup -> withStore $ \db -> getGroupIdByName db user name + CTLocal + | name == "" -> withStore (`getUserNoteFolderId` user) + | otherwise -> throwChatError $ CECommandError "not supported" _ -> throwChatError $ CECommandError "not supported" checkChatStopped :: m ChatResponse -> m ChatResponse checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped) @@ -2057,11 +2127,13 @@ processChatCommand' vr = \case getSentChatItemIdByText user@User {userId, localDisplayName} (ChatRef cType cId) msg = case cType of CTDirect -> withStore $ \db -> getDirectChatItemIdByText db userId cId SMDSnd msg CTGroup -> withStore $ \db -> getGroupChatItemIdByText db user cId (Just localDisplayName) msg + CTLocal -> withStore $ \db -> getLocalChatItemIdByText db user cId SMDSnd msg _ -> throwChatError $ CECommandError "not supported" getChatItemIdByText :: User -> ChatRef -> Text -> m Int64 getChatItemIdByText user (ChatRef cType cId) msg = case cType of CTDirect -> withStore $ \db -> getDirectChatItemIdByText' db user cId msg CTGroup -> withStore $ \db -> getGroupChatItemIdByText' db user cId msg + CTLocal -> withStore $ \db -> getLocalChatItemIdByText' db user cId msg _ -> throwChatError $ CECommandError "not supported" connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do @@ -2532,15 +2604,17 @@ deleteFile user fileInfo = deleteFile' user fileInfo False deleteFile' :: forall m. ChatMonad m => User -> CIFileInfo -> Bool -> m [ConnId] deleteFile' user ciFileInfo@CIFileInfo {filePath} sendCancel = do aConnIds <- cancelFile' user ciFileInfo sendCancel - delete `catchChatError` (toView . CRChatError (Just user)) + forM_ filePath $ \fPath -> + deleteFileLocally fPath `catchChatError` (toView . CRChatError (Just user)) pure aConnIds + +deleteFileLocally :: forall m. ChatMonad m => FilePath -> m () +deleteFileLocally fPath = + withFilesFolder $ \filesFolder -> liftIO $ do + let fsFilePath = filesFolder fPath + removeFile fsFilePath `catchAll` \_ -> + removePathForcibly fsFilePath `catchAll_` pure () where - delete :: m () - delete = withFilesFolder $ \filesFolder -> - liftIO . forM_ filePath $ \fPath -> do - let fsFilePath = filesFolder fPath - removeFile fsFilePath `catchAll` \_ -> - removePathForcibly fsFilePath `catchAll_` pure () -- perform an action only if filesFolder is set (i.e. on mobile devices) withFilesFolder :: (FilePath -> m ()) -> m () withFilesFolder action = asks filesFolder >>= readTVarIO >>= mapM_ action @@ -5893,10 +5967,10 @@ saveGroupFwdRcvMsg user groupId forwardingMember refAuthorMember@GroupMember {me throwError e _ -> throwError e -saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd) +saveSndChatItem :: (ChatMonad m, ChatTypeI c) => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> m (ChatItem c 'MDSnd) saveSndChatItem user cd msg content = saveSndChatItem' user cd msg content Nothing Nothing Nothing False -saveSndChatItem' :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDSnd) +saveSndChatItem' :: (ChatMonad m, ChatTypeI c) => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDSnd) saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem itemTimed live = do createdAt <- liftIO getCurrentTime ciId <- withStore' $ \db -> do @@ -5906,11 +5980,11 @@ saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem pure ciId pure $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) itemTimed live createdAt Nothing createdAt -saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) +saveRcvChatItem :: (ChatMonad m, ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> UTCTime -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} brokerTs content = saveRcvChatItem' user cd msg sharedMsgId_ brokerTs content Nothing Nothing False -saveRcvChatItem' :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv) +saveRcvChatItem' :: (ChatMonad m, ChatTypeI c, ChatTypeQuotable c) => User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> UTCTime -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> Maybe CITimed -> Bool -> m (ChatItem c 'MDRcv) saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerTs content ciFile itemTimed live = do createdAt <- liftIO getCurrentTime (ciId, quotedItem) <- withStore' $ \db -> do @@ -5920,7 +5994,7 @@ saveRcvChatItem' user cd msg@RcvMessage {forwardedByMember} sharedMsgId_ brokerT pure (ciId, quotedItem) pure $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ itemTimed live brokerTs forwardedByMember createdAt -mkChatItem :: forall c d. MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d +mkChatItem :: forall c d. (ChatTypeI c, MsgDirectionI d) => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> Maybe CITimed -> Bool -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> ChatItem c d mkChatItem cd ciId content file quotedItem sharedMsgId itemTimed live itemTs forwardedByMember currentTs = let itemText = ciContentToText content itemStatus = ciCreateStatus content @@ -5944,6 +6018,14 @@ deleteGroupCI user gInfo ci@ChatItem {file} byUser timed byGroupMember_ deletedT where gItem = AChatItem SCTGroup msgDirection (GroupChat gInfo) +deleteLocalCI :: (ChatMonad m, MsgDirectionI d) => User -> NoteFolder -> ChatItem 'CTLocal d -> Bool -> Bool -> m ChatResponse +deleteLocalCI user nf ci@ChatItem {file} byUser timed = do + forM_ file $ \CIFile {fileSource} -> do + forM_ (CF.filePath <$> fileSource) $ \fPath -> + deleteFileLocally fPath `catchChatError` (toView . CRChatError (Just user)) + withStore' $ \db -> deleteLocalChatItem db user nf ci + pure $ CRChatItemDeleted user (AChatItem SCTLocal msgDirection (LocalChat nf) ci) Nothing byUser timed + deleteCIFile :: (ChatMonad m, MsgDirectionI d) => User -> Maybe (CIFile d) -> m () deleteCIFile user file_ = forM_ file_ $ \file -> do @@ -6141,6 +6223,15 @@ createInternalItemsForChats user itemTs_ dirsCIContents = do let ci = mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs Nothing createdAt pure $ AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci +createLocalChatItem :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection 'CTLocal d -> CIContent d -> UTCTime -> m ChatItemId +createLocalChatItem user cd content createdAt = do + gVar <- asks random + withStore $ \db -> do + liftIO $ updateChatTs db user cd createdAt + createWithRandomId gVar $ \sharedMsgId -> + let smi_ = Just (SharedMsgId sharedMsgId) + in createNewChatItem_ db user cd Nothing smi_ content (Nothing, Nothing, Nothing, Nothing, Nothing) Nothing False createdAt Nothing createdAt + getCreateActiveUser :: SQLiteStore -> Bool -> IO User getCreateActiveUser st testView = do user <- @@ -6166,7 +6257,9 @@ getCreateActiveUser st testView = do putStrLn "chosen display name is already used by another profile on this device, choose another one" loop Left e -> putStrLn ("database error " <> show e) >> exitFailure - Right user -> pure user + Right user -> do + void . withTransaction st $ \db -> runExceptT $ createNoteFolder db user + pure user selectUser :: [User] -> IO User selectUser [user@User {userId}] = do withTransaction st (`setActiveUser` userId) @@ -6312,6 +6405,7 @@ chatCommandP = "/_get items " *> (APIGetChatItems <$> chatPaginationP <*> optional (" search=" *> stringP)), "/_get item info " *> (APIGetChatItemInfo <$> chatRefP <* A.space <*> A.decimal), "/_send " *> (APISendMessage <$> chatRefP <*> liveMessageP <*> sendMessageTTLP <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), + "/_create *" *> (APICreateChatItem <$> A.decimal <*> (" json " *> jsonP <|> " text " *> (ComposedMessage Nothing Nothing <$> mcTextP))), "/_update item " *> (APIUpdateChatItem <$> chatRefP <* A.space <*> A.decimal <*> liveMessageP <* A.space <*> msgContentP), "/_delete item " *> (APIDeleteChatItem <$> chatRefP <* A.space <*> A.decimal <* A.space <*> ciDeleteMode), "/_delete member item #" *> (APIDeleteMemberChatItem <$> A.decimal <* A.space <*> A.decimal <* A.space <*> A.decimal), @@ -6420,6 +6514,7 @@ chatCommandP = ("/leave " <|> "/l ") *> char_ '#' *> (LeaveGroup <$> displayName), ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName), ("/delete " <|> "/d ") *> char_ '@' *> (DeleteContact <$> displayName), + "/clear *" $> ClearNoteFolder, "/clear #" *> (ClearGroup <$> displayName), "/clear " *> char_ '@' *> (ClearContact <$> displayName), ("/members " <|> "/ms ") *> char_ '#' *> (ListMembers <$> displayName), @@ -6453,6 +6548,7 @@ chatCommandP = ("/connect" <|> "/c") *> (Connect <$> incognitoP <* A.space <*> ((Just <$> strP) <|> A.takeTill isSpace $> Nothing)), ("/connect" <|> "/c") *> (AddContact <$> incognitoP), SendMessage <$> chatNameP <* A.space <*> msgTextP, + "/* " *> (SendMessage (ChatName CTLocal "") <$> msgTextP), "@#" *> (SendMemberContactMessage <$> displayName <* A.space <* char_ '@' <*> displayName <* A.space <*> msgTextP), "/live " *> (SendLiveMessage <$> chatNameP <*> (A.space *> msgTextP <|> pure "")), (">@" <|> "> @") *> sendMsgQuote (AMsgDirection SMDRcv), @@ -6543,7 +6639,7 @@ chatCommandP = incognitoOnOffP = (A.space *> "incognito=" *> onOffP) <|> pure False imagePrefix = (<>) <$> "data:" <*> ("image/png;base64," <|> "image/jpg;base64,") imageP = safeDecodeUtf8 <$> ((<>) <$> imagePrefix <*> (B64.encode <$> base64P)) - chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char ':' $> CTContactConnection + chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup <|> A.char '*' $> CTLocal <|> A.char ':' $> CTContactConnection chatPaginationP = (CPLast <$ "count=" <*> A.decimal) <|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal) @@ -6616,7 +6712,10 @@ chatCommandP = " member" $> GRMember, " observer" $> GRObserver ] - chatNameP = ChatName <$> chatTypeP <*> displayName + chatNameP = + chatTypeP >>= \case + CTLocal -> pure $ ChatName CTLocal "" + ct -> ChatName ct <$> displayName chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName chatRefP = ChatRef <$> chatTypeP <*> A.decimal msgCountP = A.space *> A.decimal <|> pure 10 diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index f9004db4c..7b4a228c5 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -258,6 +258,7 @@ data ChatCommand | APIGetChatItems ChatPagination (Maybe String) | APIGetChatItemInfo ChatRef ChatItemId | APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, ttl :: Maybe Int, composedMessage :: ComposedMessage} + | APICreateChatItem {noteFolderId :: NoteFolderId, composedMessage :: ComposedMessage} | APIUpdateChatItem {chatRef :: ChatRef, chatItemId :: ChatItemId, liveMessage :: Bool, msgContent :: MsgContent} | APIDeleteChatItem ChatRef ChatItemId CIDeleteMode | APIDeleteMemberChatItem GroupId GroupMemberId ChatItemId @@ -408,6 +409,7 @@ data ChatCommand | DeleteGroupLink GroupName | ShowGroupLink GroupName | SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text} + | ClearNoteFolder | LastChats (Maybe Int) -- UserId (not used in UI) | LastMessages (Maybe ChatName) Int (Maybe String) -- UserId (not used in UI) | LastChatItemId (Maybe ChatName) Int -- UserId (not used in UI) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 4ee2e9cc1..cc0337f58 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -10,11 +10,15 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-ambiguous-fields #-} module Simplex.Chat.Messages where import Control.Applicative ((<|>)) +import Control.Monad ((>=>)) import Data.Aeson (FromJSON, ToJSON, (.:)) import qualified Data.Aeson as J import qualified Data.Aeson.Encoding as JE @@ -25,6 +29,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as LB import Data.Char (isSpace) import Data.Int (Int64) +import Data.Kind (Constraint) import Data.Maybe (fromMaybe, isJust, isNothing) import Data.Text (Text) import qualified Data.Text as T @@ -34,6 +39,8 @@ import Data.Type.Equality import Data.Typeable (Typeable) import Database.SQLite.Simple.FromField (FromField (..)) import Database.SQLite.Simple.ToField (ToField (..)) +import GHC.TypeLits (ErrorMessage (ShowType, type (:<>:)), TypeError) +import qualified GHC.TypeLits as Type import Simplex.Chat.Markdown import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol @@ -47,7 +54,7 @@ import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextFie import Simplex.Messaging.Protocol (MsgBody) import Simplex.Messaging.Util (eitherToMaybe, safeDecodeUtf8, (<$?>)) -data ChatType = CTDirect | CTGroup | CTContactRequest | CTContactConnection +data ChatType = CTDirect | CTGroup | CTLocal | CTContactRequest | CTContactConnection deriving (Eq, Show, Ord) data ChatName = ChatName {chatType :: ChatType, chatName :: Text} @@ -57,6 +64,7 @@ chatTypeStr :: ChatType -> Text chatTypeStr = \case CTDirect -> "@" CTGroup -> "#" + CTLocal -> "*" CTContactRequest -> "<@" CTContactConnection -> ":" @@ -69,6 +77,7 @@ data ChatRef = ChatRef ChatType Int64 data ChatInfo (c :: ChatType) where DirectChat :: Contact -> ChatInfo 'CTDirect GroupChat :: GroupInfo -> ChatInfo 'CTGroup + LocalChat :: NoteFolder -> ChatInfo 'CTLocal ContactRequest :: UserContactRequest -> ChatInfo 'CTContactRequest ContactConnection :: PendingContactConnection -> ChatInfo 'CTContactConnection @@ -84,6 +93,7 @@ chatInfoUpdatedAt :: ChatInfo c -> UTCTime chatInfoUpdatedAt = \case DirectChat Contact {updatedAt} -> updatedAt GroupChat GroupInfo {updatedAt} -> updatedAt + LocalChat NoteFolder {updatedAt} -> updatedAt ContactRequest UserContactRequest {updatedAt} -> updatedAt ContactConnection PendingContactConnection {updatedAt} -> updatedAt @@ -91,6 +101,7 @@ chatInfoToRef :: ChatInfo c -> ChatRef chatInfoToRef = \case DirectChat Contact {contactId} -> ChatRef CTDirect contactId GroupChat GroupInfo {groupId} -> ChatRef CTGroup groupId + LocalChat NoteFolder {noteFolderId} -> ChatRef CTLocal noteFolderId ContactRequest UserContactRequest {contactRequestId} -> ChatRef CTContactRequest contactRequestId ContactConnection PendingContactConnection {pccConnId} -> ChatRef CTContactConnection pccConnId @@ -102,6 +113,7 @@ chatInfoMembership = \case data JSONChatInfo = JCInfoDirect {contact :: Contact} | JCInfoGroup {groupInfo :: GroupInfo} + | JCInfoLocal {noteFolder :: NoteFolder} | JCInfoContactRequest {contactRequest :: UserContactRequest} | JCInfoContactConnection {contactConnection :: PendingContactConnection} @@ -118,6 +130,7 @@ jsonChatInfo :: ChatInfo c -> JSONChatInfo jsonChatInfo = \case DirectChat c -> JCInfoDirect c GroupChat g -> JCInfoGroup g + LocalChat l -> JCInfoLocal l ContactRequest g -> JCInfoContactRequest g ContactConnection c -> JCInfoContactConnection c @@ -129,6 +142,7 @@ jsonAChatInfo :: JSONChatInfo -> AChatInfo jsonAChatInfo = \case JCInfoDirect c -> AChatInfo SCTDirect $ DirectChat c JCInfoGroup g -> AChatInfo SCTGroup $ GroupChat g + JCInfoLocal l -> AChatInfo SCTLocal $ LocalChat l JCInfoContactRequest g -> AChatInfo SCTContactRequest $ ContactRequest g JCInfoContactConnection c -> AChatInfo SCTContactConnection $ ContactConnection c @@ -168,6 +182,8 @@ data CIDirection (c :: ChatType) (d :: MsgDirection) where CIDirectRcv :: CIDirection 'CTDirect 'MDRcv CIGroupSnd :: CIDirection 'CTGroup 'MDSnd CIGroupRcv :: GroupMember -> CIDirection 'CTGroup 'MDRcv + CILocalSnd :: CIDirection 'CTLocal 'MDSnd + CILocalRcv :: CIDirection 'CTLocal 'MDRcv deriving instance Show (CIDirection c d) @@ -180,6 +196,8 @@ data JSONCIDirection | JCIDirectRcv | JCIGroupSnd | JCIGroupRcv {groupMember :: GroupMember} + | JCILocalSnd + | JCILocalRcv deriving (Show) jsonCIDirection :: CIDirection c d -> JSONCIDirection @@ -188,6 +206,8 @@ jsonCIDirection = \case CIDirectRcv -> JCIDirectRcv CIGroupSnd -> JCIGroupSnd CIGroupRcv m -> JCIGroupRcv m + CILocalSnd -> JCILocalSnd + CILocalRcv -> JCILocalRcv jsonACIDirection :: JSONCIDirection -> ACIDirection jsonACIDirection = \case @@ -195,6 +215,8 @@ jsonACIDirection = \case JCIDirectRcv -> ACID SCTDirect SMDRcv CIDirectRcv JCIGroupSnd -> ACID SCTGroup SMDSnd CIGroupSnd JCIGroupRcv m -> ACID SCTGroup SMDRcv $ CIGroupRcv m + JCILocalSnd -> ACID SCTLocal SMDSnd CILocalSnd + JCILocalRcv -> ACID SCTLocal SMDRcv CILocalRcv data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int} deriving (Show) @@ -235,6 +257,8 @@ data ChatDirection (c :: ChatType) (d :: MsgDirection) where CDDirectRcv :: Contact -> ChatDirection 'CTDirect 'MDRcv CDGroupSnd :: GroupInfo -> ChatDirection 'CTGroup 'MDSnd CDGroupRcv :: GroupInfo -> GroupMember -> ChatDirection 'CTGroup 'MDRcv + CDLocalSnd :: NoteFolder -> ChatDirection 'CTLocal 'MDSnd + CDLocalRcv :: NoteFolder -> ChatDirection 'CTLocal 'MDRcv toCIDirection :: ChatDirection c d -> CIDirection c d toCIDirection = \case @@ -242,6 +266,8 @@ toCIDirection = \case CDDirectRcv _ -> CIDirectRcv CDGroupSnd _ -> CIGroupSnd CDGroupRcv _ m -> CIGroupRcv m + CDLocalSnd _ -> CILocalSnd + CDLocalRcv _ -> CILocalRcv toChatInfo :: ChatDirection c d -> ChatInfo c toChatInfo = \case @@ -249,6 +275,8 @@ toChatInfo = \case CDDirectRcv c -> DirectChat c CDGroupSnd g -> GroupChat g CDGroupRcv g _ -> GroupChat g + CDLocalSnd l -> LocalChat l + CDLocalRcv l -> LocalChat l data NewChatItem d = NewChatItem { createdByMsgId :: Maybe MessageId, @@ -323,10 +351,13 @@ data CIMeta (c :: ChatType) (d :: MsgDirection) = CIMeta } deriving (Show) -mkCIMeta :: ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d +mkCIMeta :: forall c d. ChatTypeI c => ChatItemId -> CIContent d -> Text -> CIStatus d -> Maybe SharedMsgId -> Maybe (CIDeleted c) -> Bool -> Maybe CITimed -> Maybe Bool -> UTCTime -> ChatItemTs -> Maybe GroupMemberId -> UTCTime -> UTCTime -> CIMeta c d mkCIMeta itemId itemContent itemText itemStatus itemSharedMsgId itemDeleted itemEdited itemTimed itemLive currentTs itemTs forwardedByMember createdAt updatedAt = let editable = case itemContent of - CISndMsgContent _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted + CISndMsgContent _ -> + case chatTypeI @c of + SCTLocal -> isNothing itemDeleted + _ -> diffUTCTime currentTs itemTs < nominalDay && isNothing itemDeleted _ -> False in CIMeta {itemId, itemTs, itemText, itemStatus, itemSharedMsgId, itemDeleted, itemEdited, itemTimed, itemLive, editable, forwardedByMember, createdAt, updatedAt} @@ -391,6 +422,12 @@ deriving instance Show ACIReaction data JSONCIReaction c d = JSONCIReaction {chatInfo :: ChatInfo c, chatReaction :: CIReaction c d} +type family ChatTypeQuotable (a :: ChatType) :: Constraint where + ChatTypeQuotable CTDirect = () + ChatTypeQuotable CTGroup = () + ChatTypeQuotable a = + (Int ~ Bool, TypeError (Type.Text "ChatType " :<>: ShowType a :<>: Type.Text " cannot be quoted")) + data CIQDirection (c :: ChatType) where CIQDirectSnd :: CIQDirection 'CTDirect CIQDirectRcv :: CIQDirection 'CTDirect @@ -399,7 +436,7 @@ data CIQDirection (c :: ChatType) where deriving instance Show (CIQDirection c) -data ACIQDirection = forall c. ChatTypeI c => ACIQDirection (SChatType c) (CIQDirection c) +data ACIQDirection = forall c. (ChatTypeI c, ChatTypeQuotable c) => ACIQDirection (SChatType c) (CIQDirection c) jsonCIQDirection :: CIQDirection c -> Maybe JSONCIDirection jsonCIQDirection = \case @@ -409,13 +446,15 @@ jsonCIQDirection = \case CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m CIQGroupRcv Nothing -> Nothing -jsonACIQDirection :: Maybe JSONCIDirection -> ACIQDirection +jsonACIQDirection :: Maybe JSONCIDirection -> Either String ACIQDirection jsonACIQDirection = \case - Just JCIDirectSnd -> ACIQDirection SCTDirect CIQDirectSnd - Just JCIDirectRcv -> ACIQDirection SCTDirect CIQDirectRcv - Just JCIGroupSnd -> ACIQDirection SCTGroup CIQGroupSnd - Just (JCIGroupRcv m) -> ACIQDirection SCTGroup $ CIQGroupRcv (Just m) - Nothing -> ACIQDirection SCTGroup $ CIQGroupRcv Nothing + Just JCIDirectSnd -> Right $ ACIQDirection SCTDirect CIQDirectSnd + Just JCIDirectRcv -> Right $ ACIQDirection SCTDirect CIQDirectRcv + Just JCIGroupSnd -> Right $ ACIQDirection SCTGroup CIQGroupSnd + Just (JCIGroupRcv m) -> Right $ ACIQDirection SCTGroup $ CIQGroupRcv (Just m) + Nothing -> Right $ ACIQDirection SCTGroup $ CIQGroupRcv Nothing + Just JCILocalSnd -> Left "unquotable" + Just JCILocalRcv -> Left "unquotable" quoteMsgDirection :: CIQDirection c -> MsgDirection quoteMsgDirection = \case @@ -434,7 +473,7 @@ data CIFile (d :: MsgDirection) = CIFile } deriving (Show) -data FileProtocol = FPSMP | FPXFTP +data FileProtocol = FPSMP | FPXFTP | FPLocal deriving (Eq, Show, Ord) instance FromField FileProtocol where fromField = fromTextField_ textDecode @@ -452,10 +491,12 @@ instance TextEncoding FileProtocol where textDecode = \case "smp" -> Just FPSMP "xftp" -> Just FPXFTP + "local" -> Just FPLocal _ -> Nothing textEncode = \case FPSMP -> "smp" FPXFTP -> "xftp" + FPLocal -> "local" data CIFileStatus (d :: MsgDirection) where CIFSSndStored :: CIFileStatus 'MDSnd @@ -721,6 +762,7 @@ type ChatItemTs = UTCTime data SChatType (c :: ChatType) where SCTDirect :: SChatType 'CTDirect SCTGroup :: SChatType 'CTGroup + SCTLocal :: SChatType 'CTLocal SCTContactRequest :: SChatType 'CTContactRequest SCTContactConnection :: SChatType 'CTContactConnection @@ -729,6 +771,7 @@ deriving instance Show (SChatType c) instance TestEquality SChatType where testEquality SCTDirect SCTDirect = Just Refl testEquality SCTGroup SCTGroup = Just Refl + testEquality SCTLocal SCTLocal = Just Refl testEquality SCTContactRequest SCTContactRequest = Just Refl testEquality SCTContactConnection SCTContactConnection = Just Refl testEquality _ _ = Nothing @@ -742,6 +785,8 @@ instance ChatTypeI 'CTDirect where chatTypeI = SCTDirect instance ChatTypeI 'CTGroup where chatTypeI = SCTGroup +instance ChatTypeI 'CTLocal where chatTypeI = SCTLocal + instance ChatTypeI 'CTContactRequest where chatTypeI = SCTContactRequest instance ChatTypeI 'CTContactConnection where chatTypeI = SCTContactConnection @@ -750,6 +795,7 @@ toChatType :: SChatType c -> ChatType toChatType = \case SCTDirect -> CTDirect SCTGroup -> CTGroup + SCTLocal -> CTLocal SCTContactRequest -> CTContactRequest SCTContactConnection -> CTContactConnection @@ -757,6 +803,7 @@ aChatType :: ChatType -> AChatType aChatType = \case CTDirect -> ACT SCTDirect CTGroup -> ACT SCTGroup + CTLocal -> ACT SCTLocal CTContactRequest -> ACT SCTContactRequest CTContactConnection -> ACT SCTContactConnection @@ -1045,7 +1092,7 @@ instance FromJSON ACIDirection where parseJSON v = jsonACIDirection <$> J.parseJSON v instance ChatTypeI c => FromJSON (CIQDirection c) where - parseJSON v = (\(ACIQDirection _ x) -> checkChatType x) . jsonACIQDirection <$?> J.parseJSON v + parseJSON v = (jsonACIQDirection >=> \(ACIQDirection _ x) -> checkChatType x) <$?> J.parseJSON v instance ToJSON (CIQDirection c) where toJSON = J.toJSON . jsonCIQDirection diff --git a/src/Simplex/Chat/Migrations/M20240102_note_folders.hs b/src/Simplex/Chat/Migrations/M20240102_note_folders.hs new file mode 100644 index 000000000..02ad74166 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20240102_note_folders.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20240102_note_folders where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20240102_note_folders :: Query +m20240102_note_folders = + [sql| +CREATE TABLE note_folders ( + note_folder_id INTEGER PRIMARY KEY AUTOINCREMENT, + 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')), + chat_ts TEXT NOT NULL DEFAULT(datetime('now')), + favorite INTEGER NOT NULL DEFAULT 0, + unread_chat INTEGER NOT NULL DEFAULT 0 +); + +ALTER TABLE chat_items ADD COLUMN note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE; +ALTER TABLE files ADD COLUMN note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE; + +CREATE INDEX chat_items_note_folder_id ON chat_items(note_folder_id); +CREATE INDEX files_note_folder_id ON files(note_folder_id); +CREATE INDEX note_folders_user_id ON note_folders(user_id); + +INSERT INTO note_folders (user_id) SELECT user_id FROM users; +|] + +down_m20240102_note_folders :: Query +down_m20240102_note_folders = + [sql| +DROP INDEX chat_items_note_folder_id; +DROP INDEX files_note_folder_id; +DROP INDEX note_folders_user_id; + +ALTER TABLE chat_items DROP COLUMN note_folder_id; +ALTER TABLE files DROP COLUMN note_folder_id; + +DROP TABLE note_folders; +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index 7a3be6e3a..c8445f857 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -189,7 +189,8 @@ CREATE TABLE files( agent_snd_file_deleted INTEGER DEFAULT 0 CHECK(agent_snd_file_deleted NOT NULL), protocol TEXT NOT NULL DEFAULT 'smp', file_crypto_key BLOB, - file_crypto_nonce BLOB + file_crypto_nonce BLOB, + note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE ); CREATE TABLE snd_files( file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, @@ -368,7 +369,8 @@ CREATE TABLE chat_items( item_deleted_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL, item_deleted_ts TEXT, forwarded_by_group_member_id INTEGER REFERENCES group_members ON DELETE SET NULL, - item_content_tag TEXT + item_content_tag TEXT, + note_folder_id INTEGER DEFAULT NULL REFERENCES note_folders ON DELETE CASCADE ); CREATE TABLE chat_item_messages( chat_item_id INTEGER NOT NULL REFERENCES chat_items ON DELETE CASCADE, @@ -547,6 +549,15 @@ CREATE TABLE IF NOT EXISTS "msg_deliveries"( agent_ack_cmd_id INTEGER, -- broker_ts for received, created_at for sent delivery_status TEXT -- MsgDeliveryStatus ); +CREATE TABLE note_folders( + note_folder_id INTEGER PRIMARY KEY AUTOINCREMENT, + 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')), + chat_ts TEXT NOT NULL DEFAULT(datetime('now')), + favorite INTEGER NOT NULL DEFAULT 0, + unread_chat INTEGER NOT NULL DEFAULT 0 +); CREATE INDEX contact_profiles_index ON contact_profiles( display_name, full_name @@ -812,3 +823,6 @@ CREATE INDEX idx_msg_deliveries_agent_msg_id ON "msg_deliveries"( connection_id, agent_msg_id ); +CREATE INDEX chat_items_note_folder_id ON chat_items(note_folder_id); +CREATE INDEX files_note_folder_id ON files(note_folder_id); +CREATE INDEX note_folders_user_id ON note_folders(user_id); diff --git a/src/Simplex/Chat/Store/Direct.hs b/src/Simplex/Chat/Store/Direct.hs index 422299465..0d1e470a6 100644 --- a/src/Simplex/Chat/Store/Direct.hs +++ b/src/Simplex/Chat/Store/Direct.hs @@ -398,6 +398,7 @@ setUserChatsRead db User {userId} = do updatedAt <- getCurrentTime DB.execute db "UPDATE contacts SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True) DB.execute db "UPDATE groups SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True) + DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND unread_chat = ?" (False, updatedAt, userId, True) DB.execute db "UPDATE chat_items SET item_status = ?, updated_at = ? WHERE user_id = ? AND item_status = ?" (CISRcvRead, updatedAt, userId, CISRcvNew) updateContactStatus :: DB.Connection -> User -> Contact -> ContactStatus -> IO Contact diff --git a/src/Simplex/Chat/Store/Files.hs b/src/Simplex/Chat/Store/Files.hs index 8789ccd86..bc5cec333 100644 --- a/src/Simplex/Chat/Store/Files.hs +++ b/src/Simplex/Chat/Store/Files.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -72,7 +73,10 @@ module Simplex.Chat.Store.Files getSndFileTransfer, getSndFileTransfers, getContactFileInfo, + getNoteFolderFileInfo, + createLocalFile, getLocalCryptoFile, + getLocalFileMeta, updateDirectCIFileStatus, ) where @@ -90,6 +94,7 @@ import Data.Time.Clock (UTCTime (..), getCurrentTime, nominalDay) import Data.Type.Equality import Database.SQLite.Simple (Only (..), (:.) (..)) import Database.SQLite.Simple.QQ (sql) +import Database.SQLite.Simple.ToField (ToField) import Simplex.Chat.Messages import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol @@ -107,6 +112,7 @@ import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..)) import qualified Simplex.Messaging.Crypto.File as CF import Simplex.Messaging.Protocol (SubscriptionMode (..)) import Simplex.Messaging.Version (VersionRange) +import System.FilePath (takeFileName) getLiveSndFileTransfers :: DB.Connection -> User -> IO [SndFileTransfer] getLiveSndFileTransfers db User {userId} = do @@ -839,18 +845,19 @@ getFileTransfer :: DB.Connection -> User -> Int64 -> ExceptT StoreError IO FileT getFileTransfer db user@User {userId} fileId = fileTransfer =<< liftIO (getFileTransferRow_ db userId fileId) where - fileTransfer :: [(Maybe Int64, Maybe Int64)] -> ExceptT StoreError IO FileTransfer - fileTransfer [(Nothing, Just _)] = FTRcv <$> getRcvFileTransfer db user fileId + fileTransfer :: [(Maybe Int64, Maybe Int64, FileProtocol)] -> ExceptT StoreError IO FileTransfer + fileTransfer [(_, _, FPLocal)] = throwError $ SELocalFileNoTransfer fileId + fileTransfer [(Nothing, Just _, _)] = FTRcv <$> getRcvFileTransfer db user fileId fileTransfer _ = do (ftm, fts) <- getSndFileTransfer db user fileId pure $ FTSnd {fileTransferMeta = ftm, sndFileTransfers = fts} -getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64)] +getFileTransferRow_ :: DB.Connection -> UserId -> Int64 -> IO [(Maybe Int64, Maybe Int64, FileProtocol)] getFileTransferRow_ db userId fileId = DB.query db [sql| - SELECT s.file_id, r.file_id + SELECT s.file_id, r.file_id, f.protocol FROM files f LEFT JOIN snd_files s ON s.file_id = f.file_id LEFT JOIN rcv_files r ON r.file_id = f.file_id @@ -911,24 +918,70 @@ getFileTransferMeta_ db userId fileId = xftpSndFile = (\fId -> XFTPSndFile {agentSndFileId = fId, privateSndFileDescr, agentSndFileDeleted, cryptoArgs}) <$> aSndFileId_ in FileTransferMeta {fileId, xftpSndFile, fileName, fileSize, chunkSize, filePath, fileInline, cancelled = fromMaybe False cancelled_} +createLocalFile :: ToField (CIFileStatus d) => CIFileStatus d -> DB.Connection -> User -> NoteFolder -> ChatItemId -> UTCTime -> CryptoFile -> Integer -> Integer -> IO Int64 +createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize fileChunkSize = do + DB.execute + db + [sql| + INSERT INTO files + ( user_id, note_folder_id, chat_item_id, + file_name, file_path, file_size, + file_crypto_key, file_crypto_nonce, + chunk_size, file_inline, ci_file_status, protocol, created_at, updated_at + ) + VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?) + |] + ( (userId, noteFolderId, chatItemId) + :. (takeFileName filePath, filePath, fileSize) + :. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs + :. (fileChunkSize, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs) + ) + insertedRowId db + +getLocalFileMeta :: DB.Connection -> UserId -> Int64 -> ExceptT StoreError IO LocalFileMeta +getLocalFileMeta db userId fileId = + ExceptT . firstRow localFileMeta (SEFileNotFound fileId) $ + DB.query + db + [sql| + SELECT file_name, file_size, file_path, file_crypto_key, file_crypto_nonce + FROM files + WHERE user_id = ? AND file_id = ? + |] + (userId, fileId) + where + localFileMeta :: (FilePath, Integer, FilePath, Maybe C.SbKey, Maybe C.CbNonce) -> LocalFileMeta + localFileMeta (fileName, fileSize, filePath, fileKey, fileNonce) = + let fileCryptoArgs = CFArgs <$> fileKey <*> fileNonce + in LocalFileMeta {fileId, fileName, fileSize, filePath, fileCryptoArgs} + getContactFileInfo :: DB.Connection -> User -> Contact -> IO [CIFileInfo] getContactFileInfo db User {userId} Contact {contactId} = map toFileInfo <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.contact_id = ?") (userId, contactId) +getNoteFolderFileInfo :: DB.Connection -> User -> NoteFolder -> IO [CIFileInfo] +getNoteFolderFileInfo db User {userId} NoteFolder {noteFolderId} = + map toFileInfo + <$> DB.query db (fileInfoQuery <> " WHERE i.user_id = ? AND i.note_folder_id = ?") (userId, noteFolderId) + getLocalCryptoFile :: DB.Connection -> UserId -> Int64 -> Bool -> ExceptT StoreError IO CryptoFile getLocalCryptoFile db userId fileId sent = liftIO (getFileTransferRow_ db userId fileId) >>= \case - [(Nothing, Just _)] -> do + [(Nothing, Just _, _)] -> do when sent $ throwError $ SEFileNotFound fileId RcvFileTransfer {fileStatus, cryptoArgs} <- getRcvFileTransfer_ db userId fileId case fileStatus of RFSComplete RcvFileInfo {filePath} -> pure $ CryptoFile filePath cryptoArgs _ -> throwError $ SEFileNotFound fileId - _ -> do + [(Just _, Nothing, _)] -> do unless sent $ throwError $ SEFileNotFound fileId FileTransferMeta {filePath, xftpSndFile} <- getFileTransferMeta_ db userId fileId pure $ CryptoFile filePath $ xftpSndFile >>= \XFTPSndFile {cryptoArgs} -> cryptoArgs + [(Nothing, Nothing, FPLocal)] -> do + LocalFileMeta {filePath, fileCryptoArgs} <- getLocalFileMeta db userId fileId + pure $ CryptoFile filePath fileCryptoArgs + _ -> throwError $ SEFileNotFound fileId updateDirectCIFileStatus :: forall d. MsgDirectionI d => DB.Connection -> VersionRange -> User -> Int64 -> CIFileStatus d -> ExceptT StoreError IO AChatItem updateDirectCIFileStatus db vr user fileId fileStatus = do diff --git a/src/Simplex/Chat/Store/Messages.hs b/src/Simplex/Chat/Store/Messages.hs index fc840849a..2ece41666 100644 --- a/src/Simplex/Chat/Store/Messages.hs +++ b/src/Simplex/Chat/Store/Messages.hs @@ -34,9 +34,11 @@ module Simplex.Chat.Store.Messages createNewSndChatItem, createNewRcvChatItem, createNewChatItemNoMsg, + createNewChatItem_, getChatPreviews, getDirectChat, getGroupChat, + getLocalChat, getDirectChatItemsLast, getAllChatItems, getAChatItem, @@ -52,12 +54,14 @@ module Simplex.Chat.Store.Messages updateGroupChatItemModerated, markGroupChatItemDeleted, markGroupChatItemBlocked, + deleteLocalChatItem, updateDirectChatItemsRead, getDirectUnreadTimedItems, setDirectChatItemDeleteAt, updateGroupChatItemsRead, getGroupUnreadTimedItems, setGroupChatItemDeleteAt, + updateLocalChatItemsRead, getChatRefViaItemId, getChatItemVersions, getDirectCIReactions, @@ -77,10 +81,14 @@ module Simplex.Chat.Store.Messages getGroupMemberCIBySharedMsgId, getGroupChatItemByAgentMsgId, getGroupMemberChatItemLast, + getLocalChatItem, + updateLocalChatItem', getDirectChatItemIdByText, getDirectChatItemIdByText', getGroupChatItemIdByText, getGroupChatItemIdByText', + getLocalChatItemIdByText, + getLocalChatItemIdByText', getChatItemByFileId, getChatItemByGroupId, updateDirectChatItemStatus, @@ -126,6 +134,7 @@ import Simplex.Chat.Messages.CIContent import Simplex.Chat.Protocol import Simplex.Chat.Store.Direct import Simplex.Chat.Store.Groups +import Simplex.Chat.Store.NoteFolders import Simplex.Chat.Store.Shared import Simplex.Chat.Types import Simplex.Messaging.Agent.Protocol (AgentMsgId, ConnId, MsgMeta (..), UserId) @@ -322,6 +331,11 @@ updateChatTs db User {userId} chatDirection chatTs = case toChatInfo chatDirecti db "UPDATE groups SET chat_ts = ? WHERE user_id = ? AND group_id = ?" (chatTs, userId, groupId) + LocalChat NoteFolder {noteFolderId} -> + DB.execute + db + "UPDATE note_folders SET chat_ts = ? WHERE user_id = ? AND note_folder_id = ?" + (chatTs, userId, noteFolderId) _ -> pure () createNewSndChatItem :: DB.Connection -> User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> Maybe CITimed -> Bool -> UTCTime -> IO ChatItemId @@ -340,7 +354,7 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId) CIQGroupRcv Nothing -> (Just False, Nothing) -createNewRcvChatItem :: DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c)) +createNewRcvChatItem :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> RcvMessage -> Maybe SharedMsgId -> CIContent 'MDRcv -> Maybe CITimed -> Bool -> UTCTime -> UTCTime -> IO (ChatItemId, Maybe (CIQuote c)) createNewRcvChatItem db user chatDirection RcvMessage {msgId, chatMsgEvent, forwardedByMember} sharedMsgId_ ciContent timed live itemTs createdAt = do ciId <- createNewChatItem_ db user chatDirection (Just msgId) sharedMsgId_ ciContent quoteRow timed live itemTs forwardedByMember createdAt quotedItem <- mapM (getChatItemQuote_ db user chatDirection) quotedMsg @@ -370,13 +384,13 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q [sql| INSERT INTO chat_items ( -- user and IDs - user_id, created_by_msg_id, contact_id, group_id, group_member_id, + user_id, created_by_msg_id, contact_id, group_id, group_member_id, note_folder_id, -- meta item_sent, item_ts, item_content, item_content_tag, item_text, item_status, shared_msg_id, forwarded_by_group_member_id, created_at, updated_at, item_live, timed_ttl, timed_delete_at, -- quote quoted_shared_msg_id, quoted_sent_at, quoted_content, quoted_sent, quoted_member_id - ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) + ) VALUES (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?) |] ((userId, msgId_) :. idsRow :. itemRow :. quoteRow) ciId <- insertedRowId db @@ -385,12 +399,14 @@ createNewChatItem_ db User {userId} chatDirection msgId_ sharedMsgId ciContent q where itemRow :: (SMsgDirection d, UTCTime, CIContent d, Text, Text, CIStatus d, Maybe SharedMsgId, Maybe GroupMemberId) :. (UTCTime, UTCTime, Maybe Bool) :. (Maybe Int, Maybe UTCTime) itemRow = (msgDirection @d, itemTs, ciContent, toCIContentTag ciContent, ciContentToText ciContent, ciCreateStatus ciContent, sharedMsgId, forwardedByMember) :. (createdAt, createdAt, justTrue live) :. ciTimedRow timed - idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64) + idsRow :: (Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64) idsRow = case chatDirection of - CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing) - CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing) - CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId) - CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing) + CDDirectRcv Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing) + CDDirectSnd Contact {contactId} -> (Just contactId, Nothing, Nothing, Nothing) + CDGroupRcv GroupInfo {groupId} GroupMember {groupMemberId} -> (Nothing, Just groupId, Just groupMemberId, Nothing) + CDGroupSnd GroupInfo {groupId} -> (Nothing, Just groupId, Nothing, Nothing) + CDLocalRcv NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId) + CDLocalSnd NoteFolder {noteFolderId} -> (Nothing, Nothing, Nothing, Just noteFolderId) ciTimedRow :: Maybe CITimed -> (Maybe Int, Maybe UTCTime) ciTimedRow (Just CITimed {ttl, deleteAt}) = (Just ttl, deleteAt) @@ -399,7 +415,7 @@ ciTimedRow _ = (Nothing, Nothing) insertChatItemMessage_ :: DB.Connection -> ChatItemId -> MessageId -> UTCTime -> IO () insertChatItemMessage_ db ciId msgId ts = DB.execute db "INSERT INTO chat_item_messages (chat_item_id, message_id, created_at, updated_at) VALUES (?,?,?,?)" (ciId, msgId, ts, ts) -getChatItemQuote_ :: DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c) +getChatItemQuote_ :: ChatTypeQuotable c => DB.Connection -> User -> ChatDirection c 'MDRcv -> QuotedMsg -> IO (CIQuote c) getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRef = MsgRef {msgId, sentAt, sent, memberId}, content} = case chatDirection of CDDirectRcv Contact {contactId} -> getDirectChatItemQuote_ contactId (not sent) @@ -466,15 +482,17 @@ getChatPreviews :: DB.Connection -> VersionRange -> User -> Bool -> PaginationBy getChatPreviews db vr user withPCC pagination query = do directChats <- findDirectChatPreviews_ db user pagination query groupChats <- findGroupChatPreviews_ db user pagination query + localChats <- findLocalChatPreviews_ db user pagination query cReqChats <- getContactRequestChatPreviews_ db user pagination query connChats <- if withPCC then getContactConnectionChatPreviews_ db user pagination query else pure [] - let refs = sortTake $ concat [directChats, groupChats, cReqChats, connChats] + let refs = sortTake $ concat [directChats, groupChats, localChats, cReqChats, connChats] mapM (runExceptT <$> getChatPreview) refs where ts :: AChatPreviewData -> UTCTime ts (ACPD _ cpd) = case cpd of (DirectChatPD t _ _ _) -> t (GroupChatPD t _ _ _) -> t + (LocalChatPD t _ _ _) -> t (ContactRequestPD t _) -> t (ContactConnectionPD t _) -> t sortTake = case pagination of @@ -485,12 +503,14 @@ getChatPreviews db vr user withPCC pagination query = do getChatPreview (ACPD cType cpd) = case cType of SCTDirect -> getDirectChatPreview_ db user cpd SCTGroup -> getGroupChatPreview_ db vr user cpd + SCTLocal -> getLocalChatPreview_ db user cpd SCTContactRequest -> let (ContactRequestPD _ chat) = cpd in pure chat SCTContactConnection -> let (ContactConnectionPD _ chat) = cpd in pure chat data ChatPreviewData (c :: ChatType) where DirectChatPD :: UTCTime -> ContactId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTDirect GroupChatPD :: UTCTime -> GroupId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTGroup + LocalChatPD :: UTCTime -> NoteFolderId -> Maybe ChatItemId -> ChatStats -> ChatPreviewData 'CTLocal ContactRequestPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactRequest ContactConnectionPD :: UTCTime -> AChat -> ChatPreviewData 'CTContactConnection @@ -697,6 +717,123 @@ getGroupChatPreview_ db vr user (GroupChatPD _ groupId lastItemId_ stats) = do Nothing -> pure [] pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats) +findLocalChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData] +findLocalChatPreviews_ db User {userId} pagination clq = + map toPreview <$> getPreviews + where + toPreview :: (NoteFolderId, UTCTime, Maybe ChatItemId) :. ChatStatsRow -> AChatPreviewData + toPreview ((noteFolderId, ts, lastItemId_) :. statsRow) = + ACPD SCTLocal $ LocalChatPD ts noteFolderId lastItemId_ (toChatStats statsRow) + baseQuery = + [sql| + SELECT nf.note_folder_id, nf.chat_ts as ts, LastItems.chat_item_id, COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), nf.unread_chat + FROM note_folders nf + LEFT JOIN ( + SELECT note_folder_id, chat_item_id, MAX(created_at) + FROM chat_items + GROUP BY note_folder_id + ) LastItems ON LastItems.note_folder_id = nf.note_folder_id + LEFT JOIN ( + SELECT note_folder_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread + FROM chat_items + WHERE item_status = :rcv_new + GROUP BY note_folder_id + ) ChatStats ON ChatStats.note_folder_id = nf.note_folder_id + |] + (pagQuery, pagParams) = paginationByTimeFilter pagination + getPreviews = case clq of + CLQFilters {favorite = False, unread = False} -> + DB.queryNamed + db + ( baseQuery + <> [sql| + WHERE nf.user_id = :user_id + |] + <> pagQuery + ) + ([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams) + CLQFilters {favorite = True, unread = False} -> + DB.queryNamed + db + ( baseQuery + <> [sql| + WHERE nf.user_id = :user_id + AND nf.favorite = 1 + |] + <> pagQuery + ) + ([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams) + CLQFilters {favorite = False, unread = True} -> + DB.queryNamed + db + ( baseQuery + <> [sql| + WHERE nf.user_id = :user_id + AND (nf.unread_chat = 1 OR ChatStats.UnreadCount > 0) + |] + <> pagQuery + ) + ([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams) + CLQFilters {favorite = True, unread = True} -> + DB.queryNamed + db + ( baseQuery + <> [sql| + WHERE nf.user_id = :user_id + AND (nf.favorite = 1 + OR nf.unread_chat = 1 OR ChatStats.UnreadCount > 0) + |] + <> pagQuery + ) + ([":user_id" := userId, ":rcv_new" := CISRcvNew] <> pagParams) + CLQSearch {} -> pure [] + +getLocalChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTLocal -> ExceptT StoreError IO AChat +getLocalChatPreview_ db user (LocalChatPD _ noteFolderId lastItemId_ stats) = do + nf <- getNoteFolder db user noteFolderId + lastItem <- case lastItemId_ of + Just lastItemId -> (: []) <$> getLocalChatItem db user noteFolderId lastItemId + Nothing -> pure [] + pure $ AChat SCTLocal (Chat (LocalChat nf) lastItem stats) + +-- this function can be changed so it never fails, not only avoid failure on invalid json +toLocalChatItem :: UTCTime -> ChatItemRow -> Either StoreError (CChatItem 'CTLocal) +toLocalChatItem currentTs ((itemId, itemTs, AMsgDirection msgDir, itemContentText, itemText, itemStatus, sharedMsgId) :. (itemDeleted, deletedTs, itemEdited, createdAt, updatedAt) :. (timedTTL, timedDeleteAt, itemLive) :. (fileId_, fileName_, fileSize_, filePath, fileKey, fileNonce, fileStatus_, fileProtocol_)) = + chatItem $ fromRight invalid $ dbParseACIContent itemContentText + where + invalid = ACIContent msgDir $ CIInvalidJSON itemContentText + chatItem itemContent = case (itemContent, itemStatus, fileStatus_) of + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) -> + Right $ cItem SMDSnd CILocalSnd ciStatus ciContent (maybeCIFile fileStatus) + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Nothing) -> + Right $ cItem SMDSnd CILocalSnd ciStatus ciContent Nothing + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just (AFS SMDRcv fileStatus)) -> + Right $ cItem SMDRcv CILocalRcv ciStatus ciContent (maybeCIFile fileStatus) + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Nothing) -> + Right $ cItem SMDRcv CILocalRcv ciStatus ciContent Nothing + _ -> badItem + maybeCIFile :: CIFileStatus d -> Maybe (CIFile d) + maybeCIFile fileStatus = + case (fileId_, fileName_, fileSize_, fileProtocol_) of + (Just fileId, Just fileName, Just fileSize, Just fileProtocol) -> + let cfArgs = CFArgs <$> fileKey <*> fileNonce + fileSource = (`CryptoFile` cfArgs) <$> filePath + in Just CIFile {fileId, fileName, fileSize, fileSource, fileStatus, fileProtocol} + _ -> Nothing + cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTLocal d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTLocal + cItem d chatDir ciStatus content file = + CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = Nothing, reactions = [], file} + badItem = Left $ SEBadChatItem itemId + ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTLocal d + ciMeta content status = + let itemDeleted' = case itemDeleted of + DBCINotDeleted -> Nothing + _ -> Just (CIDeleted @'CTLocal deletedTs) + itemEdited' = fromMaybe False itemEdited + in mkCIMeta itemId content itemText status sharedMsgId itemDeleted' itemEdited' ciTimed itemLive currentTs itemTs Nothing createdAt updatedAt + ciTimed :: Maybe CITimed + ciTimed = timedTTL >>= \ttl -> Just CITimed {ttl, deleteAt = timedDeleteAt} + getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData] getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of CLQFilters {favorite = False, unread = False} -> query "" @@ -967,11 +1104,86 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId |] (userId, groupId, search, beforeChatItemTs, beforeChatItemTs, beforeChatItemId, count) -toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId) +getLocalChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChat db user folderId pagination search_ = do + let search = fromMaybe "" search_ + nf <- getNoteFolder db user folderId + case pagination of + CPLast count -> getLocalChatLast_ db user nf count search + CPAfter afterId count -> getLocalChatAfter_ db user nf afterId count search + CPBefore beforeId count -> getLocalChatBefore_ db user nf beforeId count search + +getLocalChatLast_ :: DB.Connection -> User -> NoteFolder -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChatLast_ db user@User {userId} nf@NoteFolder {noteFolderId} count search = do + let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} + chatItemIds <- liftIO getLocalChatItemIdsLast_ + chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + pure $ Chat (LocalChat nf) (reverse chatItems) stats + where + getLocalChatItemIdsLast_ :: IO [ChatItemId] + getLocalChatItemIdsLast_ = + map fromOnly + <$> DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%' + ORDER BY created_at DESC, chat_item_id DESC + LIMIT ? + |] + (userId, noteFolderId, search, count) + +getLocalChatAfter_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChatAfter_ db user@User {userId} nf@NoteFolder {noteFolderId} afterChatItemId count search = do + let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} + chatItemIds <- liftIO getLocalChatItemIdsAfter_ + chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + pure $ Chat (LocalChat nf) chatItems stats + where + getLocalChatItemIdsAfter_ :: IO [ChatItemId] + getLocalChatItemIdsAfter_ = + map fromOnly + <$> DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%' + AND chat_item_id > ? + ORDER BY created_at ASC, chat_item_id ASC + LIMIT ? + |] + (userId, noteFolderId, search, afterChatItemId, count) + +getLocalChatBefore_ :: DB.Connection -> User -> NoteFolder -> ChatItemId -> Int -> String -> ExceptT StoreError IO (Chat 'CTLocal) +getLocalChatBefore_ db user@User {userId} nf@NoteFolder {noteFolderId} beforeChatItemId count search = do + let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False} + chatItemIds <- liftIO getLocalChatItemIdsBefore_ + chatItems <- mapM (getLocalChatItem db user noteFolderId) chatItemIds + pure $ Chat (LocalChat nf) (reverse chatItems) stats + where + getLocalChatItemIdsBefore_ :: IO [ChatItemId] + getLocalChatItemIdsBefore_ = + map fromOnly + <$> DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE '%' || ? || '%' + AND chat_item_id < ? + ORDER BY created_at DESC, chat_item_id DESC + LIMIT ? + |] + (userId, noteFolderId, search, beforeChatItemId, count) + +toChatItemRef :: (ChatItemId, Maybe Int64, Maybe Int64, Maybe Int64) -> Either StoreError (ChatRef, ChatItemId) toChatItemRef = \case - (itemId, Just contactId, Nothing) -> Right (ChatRef CTDirect contactId, itemId) - (itemId, Nothing, Just groupId) -> Right (ChatRef CTGroup groupId, itemId) - (itemId, _, _) -> Left $ SEBadChatItem itemId + (itemId, Just contactId, Nothing, Nothing) -> Right (ChatRef CTDirect contactId, itemId) + (itemId, Nothing, Just groupId, Nothing) -> Right (ChatRef CTGroup groupId, itemId) + (itemId, Nothing, Nothing, Just folderId) -> Right (ChatRef CTLocal folderId, itemId) + (itemId, _, _, _) -> Left $ SEBadChatItem itemId updateDirectChatItemsRead :: DB.Connection -> User -> ContactId -> Maybe (ChatItemId, ChatItemId) -> IO () updateDirectChatItemsRead db User {userId} contactId itemsRange_ = do @@ -1079,6 +1291,27 @@ setGroupChatItemDeleteAt db User {userId} groupId chatItemId deleteAt = "UPDATE chat_items SET timed_delete_at = ? WHERE user_id = ? AND group_id = ? AND chat_item_id = ?" (deleteAt, userId, groupId, chatItemId) +updateLocalChatItemsRead :: DB.Connection -> User -> NoteFolderId -> Maybe (ChatItemId, ChatItemId) -> IO () +updateLocalChatItemsRead db User {userId} noteFolderId itemsRange_ = do + currentTs <- getCurrentTime + case itemsRange_ of + Just (fromItemId, toItemId) -> + DB.execute + db + [sql| + UPDATE chat_items SET item_status = ?, updated_at = ? + WHERE user_id = ? AND note_folder_id = ? AND chat_item_id >= ? AND chat_item_id <= ? AND item_status = ? + |] + (CISRcvRead, currentTs, userId, noteFolderId, fromItemId, toItemId, CISRcvNew) + _ -> + DB.execute + db + [sql| + UPDATE chat_items SET item_status = ?, updated_at = ? + WHERE user_id = ? AND note_folder_id = ? AND item_status = ? + |] + (CISRcvRead, currentTs, userId, noteFolderId, CISRcvNew) + type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe C.SbKey, Maybe C.CbNonce, Maybe ACIFileStatus, Maybe FileProtocol) type ChatItemModeRow = (Maybe Int, Maybe UTCTime, Maybe Bool) @@ -1204,7 +1437,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do <$> DB.query db [sql| - SELECT chat_item_id, contact_id, group_id + SELECT chat_item_id, contact_id, group_id, note_folder_id FROM chat_items WHERE user_id = ? AND item_text LIKE '%' || ? || '%' ORDER BY item_ts DESC, chat_item_id DESC @@ -1215,7 +1448,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do DB.query db [sql| - SELECT chat_item_id, contact_id, group_id + SELECT chat_item_id, contact_id, group_id, note_folder_id FROM chat_items WHERE user_id = ? AND item_text LIKE '%' || ? || '%' AND (item_ts > ? OR (item_ts = ? AND chat_item_id > ?)) @@ -1228,7 +1461,7 @@ getAllChatItems db vr user@User {userId} pagination search_ = do <$> DB.query db [sql| - SELECT chat_item_id, contact_id, group_id + SELECT chat_item_id, contact_id, group_id, note_folder_id FROM chat_items WHERE user_id = ? AND item_text LIKE '%' || ? || '%' AND (item_ts < ? OR (item_ts = ? AND chat_item_id < ?)) @@ -1714,6 +1947,89 @@ getGroupChatItemIdByText' db User {userId} groupId msg = |] (userId, groupId, msg <> "%") +getLocalChatItem :: DB.Connection -> User -> Int64 -> ChatItemId -> ExceptT StoreError IO (CChatItem 'CTLocal) +getLocalChatItem db User {userId} folderId itemId = ExceptT $ do + currentTs <- getCurrentTime + firstRow' (toLocalChatItem currentTs) (SEChatItemNotFound itemId) getItem + where + getItem = + DB.query + db + [sql| + SELECT + -- ChatItem + i.chat_item_id, i.item_ts, i.item_sent, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_deleted_ts, i.item_edited, i.created_at, i.updated_at, i.timed_ttl, i.timed_delete_at, i.item_live, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.file_crypto_key, f.file_crypto_nonce, f.ci_file_status, f.protocol + FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id + WHERE i.user_id = ? AND i.note_folder_id = ? AND i.chat_item_id = ? + |] + (userId, folderId, itemId) + +getLocalChatItemIdByText :: DB.Connection -> User -> NoteFolderId -> SMsgDirection d -> Text -> ExceptT StoreError IO ChatItemId +getLocalChatItemIdByText db User {userId} noteFolderId msgDir quotedMsg = + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText quotedMsg) $ + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND item_sent = ? AND item_text LIKE ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, noteFolderId, msgDir, quotedMsg <> "%") + +getLocalChatItemIdByText' :: DB.Connection -> User -> NoteFolderId -> Text -> ExceptT StoreError IO ChatItemId +getLocalChatItemIdByText' db User {userId} noteFolderId msg = + ExceptT . firstRow fromOnly (SEChatItemNotFoundByText msg) $ + DB.query + db + [sql| + SELECT chat_item_id + FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND item_text LIKE ? + ORDER BY chat_item_id DESC + LIMIT 1 + |] + (userId, noteFolderId, msg <> "%") + +updateLocalChatItem' :: forall d. MsgDirectionI d => DB.Connection -> User -> NoteFolderId -> ChatItem 'CTLocal d -> CIContent d -> IO (ChatItem 'CTLocal d) +updateLocalChatItem' db User {userId} noteFolderId ci newContent = do + currentTs <- liftIO getCurrentTime + let ci' = updatedChatItem ci newContent False currentTs + liftIO $ updateLocalChatItem_ db userId noteFolderId ci' + pure ci' + +-- this function assumes that local item with correct chat direction already exists, +-- it should be checked before calling it +updateLocalChatItem_ :: forall d. MsgDirectionI d => DB.Connection -> UserId -> NoteFolderId -> ChatItem 'CTLocal d -> IO () +updateLocalChatItem_ db userId noteFolderId ChatItem {meta, content} = do + let CIMeta {itemId, itemText, itemStatus, itemDeleted, itemEdited, updatedAt} = meta + itemDeleted' = isJust itemDeleted + itemDeletedTs' = itemDeletedTs =<< itemDeleted + DB.execute + db + [sql| + UPDATE chat_items + SET item_content = ?, item_text = ?, item_status = ?, item_deleted = ?, item_deleted_ts = ?, item_edited = ?, updated_at = ? + WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ? + |] + ((content, itemText, itemStatus, itemDeleted', itemDeletedTs', itemEdited, updatedAt) :. (userId, noteFolderId, itemId)) + +deleteLocalChatItem :: DB.Connection -> User -> NoteFolder -> ChatItem 'CTLocal d -> IO () +deleteLocalChatItem db User {userId} NoteFolder {noteFolderId} ci = do + let itemId = chatItemId' ci + deleteChatItemVersions_ db itemId + DB.execute + db + [sql| + DELETE FROM chat_items + WHERE user_id = ? AND note_folder_id = ? AND chat_item_id = ? + |] + (userId, noteFolderId, itemId) + getChatItemByFileId :: DB.Connection -> VersionRange -> User -> Int64 -> ExceptT StoreError IO AChatItem getChatItemByFileId db vr user@User {userId} fileId = do (chatRef, itemId) <- @@ -1721,7 +2037,7 @@ getChatItemByFileId db vr user@User {userId} fileId = do DB.query db [sql| - SELECT i.chat_item_id, i.contact_id, i.group_id + SELECT i.chat_item_id, i.contact_id, i.group_id, i.note_folder_id FROM chat_items i JOIN files f ON f.chat_item_id = i.chat_item_id WHERE f.user_id = ? AND f.file_id = ? @@ -1737,7 +2053,7 @@ getChatItemByGroupId db vr user@User {userId} groupId = do DB.query db [sql| - SELECT i.chat_item_id, i.contact_id, i.group_id + SELECT i.chat_item_id, i.contact_id, i.group_id, i.note_folder_id FROM chat_items i JOIN groups g ON g.chat_item_id = i.chat_item_id WHERE g.user_id = ? AND g.group_id = ? @@ -1766,6 +2082,10 @@ getAChatItem db vr user chatRef itemId = case chatRef of gInfo <- getGroupInfo db vr user groupId (CChatItem msgDir ci) <- getGroupChatItem db user groupId itemId pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci + ChatRef CTLocal folderId -> do + nf <- getNoteFolder db user folderId + CChatItem msgDir ci <- getLocalChatItem db user folderId itemId + pure $ AChatItem SCTLocal msgDir (LocalChat nf) ci _ -> throwError $ SEChatItemNotFound itemId getChatItemVersions :: DB.Connection -> ChatItemId -> IO [ChatItemVersion] diff --git a/src/Simplex/Chat/Store/Migrations.hs b/src/Simplex/Chat/Store/Migrations.hs index 61fbfe359..db70ffeab 100644 --- a/src/Simplex/Chat/Store/Migrations.hs +++ b/src/Simplex/Chat/Store/Migrations.hs @@ -94,6 +94,7 @@ import Simplex.Chat.Migrations.M20231126_remote_ctrl_address import Simplex.Chat.Migrations.M20231207_chat_list_pagination import Simplex.Chat.Migrations.M20231214_item_content_tag import Simplex.Chat.Migrations.M20231215_recreate_msg_deliveries +import Simplex.Chat.Migrations.M20240102_note_folders import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..)) schemaMigrations :: [(String, Query, Maybe Query)] @@ -187,7 +188,8 @@ schemaMigrations = ("20231126_remote_ctrl_address", m20231126_remote_ctrl_address, Just down_m20231126_remote_ctrl_address), ("20231207_chat_list_pagination", m20231207_chat_list_pagination, Just down_m20231207_chat_list_pagination), ("20231214_item_content_tag", m20231214_item_content_tag, Just down_m20231214_item_content_tag), - ("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries) + ("20231215_recreate_msg_deliveries", m20231215_recreate_msg_deliveries, Just down_m20231215_recreate_msg_deliveries), + ("20240102_note_folders", m20240102_note_folders, Just down_m20240102_note_folders) ] -- | The list of migrations in ascending order by date diff --git a/src/Simplex/Chat/Store/NoteFolders.hs b/src/Simplex/Chat/Store/NoteFolders.hs new file mode 100644 index 000000000..e8336a73d --- /dev/null +++ b/src/Simplex/Chat/Store/NoteFolders.hs @@ -0,0 +1,69 @@ +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Simplex.Chat.Store.NoteFolders where + +import Control.Monad.Except (ExceptT (..), throwError) +import Control.Monad.IO.Class (liftIO) +import Data.Time (getCurrentTime) +import Database.SQLite.Simple (Only (..)) +import Database.SQLite.Simple.QQ (sql) +import Simplex.Chat.Store.Shared (StoreError (..)) +import Simplex.Chat.Types (NoteFolder (..), NoteFolderId, User (..)) +import Simplex.Messaging.Agent.Protocol (UserId) +import Simplex.Messaging.Agent.Store.SQLite (firstRow) +import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB + +createNoteFolder :: DB.Connection -> User -> ExceptT StoreError IO () +createNoteFolder db User {userId} = do + liftIO (DB.query db "SELECT note_folder_id FROM note_folders WHERE user_id = ? LIMIT 1" $ Only userId) >>= \case + [] -> liftIO $ DB.execute db "INSERT INTO note_folders (user_id) VALUES (?)" (Only userId) + Only noteFolderId : _ -> throwError $ SENoteFolderAlreadyExists noteFolderId + +getUserNoteFolderId :: DB.Connection -> User -> ExceptT StoreError IO NoteFolderId +getUserNoteFolderId db User {userId} = + ExceptT . firstRow fromOnly SEUserNoteFolderNotFound $ + DB.query db "SELECT note_folder_id FROM note_folders WHERE user_id = ?" (Only userId) + +getNoteFolder :: DB.Connection -> User -> NoteFolderId -> ExceptT StoreError IO NoteFolder +getNoteFolder db User {userId} noteFolderId = + ExceptT . firstRow toNoteFolder (SENoteFolderNotFound noteFolderId) $ + DB.query + db + [sql| + SELECT + created_at, updated_at, chat_ts, favorite, unread_chat + FROM note_folders + WHERE user_id = ? + AND note_folder_id = ? + |] + (userId, noteFolderId) + where + toNoteFolder (createdAt, updatedAt, chatTs, favorite, unread) = + NoteFolder {noteFolderId, userId, createdAt, updatedAt, chatTs, favorite, unread} + +updateNoteFolderUnreadChat :: DB.Connection -> User -> NoteFolder -> Bool -> IO () +updateNoteFolderUnreadChat db User {userId} NoteFolder {noteFolderId} unreadChat = do + updatedAt <- getCurrentTime + DB.execute db "UPDATE note_folders SET unread_chat = ?, updated_at = ? WHERE user_id = ? AND note_folder_id = ?" (unreadChat, updatedAt, userId, noteFolderId) + +deleteNoteFolderFiles :: DB.Connection -> UserId -> NoteFolder -> IO () +deleteNoteFolderFiles db userId NoteFolder {noteFolderId} = do + DB.execute + db + [sql| + DELETE FROM files + WHERE user_id = ? + AND chat_item_id IN ( + SELECT chat_item_id FROM chat_items WHERE user_id = ? AND note_folder_id = ? + ) + |] + (userId, userId, noteFolderId) + +deleteNoteFolderCIs :: DB.Connection -> User -> NoteFolder -> IO () +deleteNoteFolderCIs db User {userId} NoteFolder {noteFolderId} = + DB.execute db "DELETE FROM chat_items WHERE user_id = ? AND note_folder_id = ?" (userId, noteFolderId) diff --git a/src/Simplex/Chat/Store/Profiles.hs b/src/Simplex/Chat/Store/Profiles.hs index ce1d17859..6d25c120a 100644 --- a/src/Simplex/Chat/Store/Profiles.hs +++ b/src/Simplex/Chat/Store/Profiles.hs @@ -27,6 +27,7 @@ module Simplex.Chat.Store.Profiles getUserByARcvFileId, getUserByContactId, getUserByGroupId, + getUserByNoteFolderId, getUserByFileId, getUserFileInfo, deleteUserRecord, @@ -120,6 +121,7 @@ createUserRecordAt db (AgentUserId auId) Profile {displayName, fullName, image, (profileId, displayName, userId, True, currentTs, currentTs, currentTs) contactId <- insertedRowId db DB.execute db "UPDATE users SET contact_id = ? WHERE user_id = ?" (contactId, userId) + pure $ toUser $ (userId, auId, contactId, profileId, activeUser, displayName, fullName, image, Nothing, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, Nothing, Nothing) getUsersInfo :: DB.Connection -> IO [UserInfo] @@ -200,6 +202,11 @@ getUserByGroupId db groupId = ExceptT . firstRow toUser (SEUserNotFoundByGroupId groupId) $ DB.query db (userQuery <> " JOIN groups g ON g.user_id = u.user_id WHERE g.group_id = ?") (Only groupId) +getUserByNoteFolderId :: DB.Connection -> NoteFolderId -> ExceptT StoreError IO User +getUserByNoteFolderId db contactId = + ExceptT . firstRow toUser (SEUserNotFoundByContactId contactId) $ + DB.query db (userQuery <> " JOIN note_folders nf ON nf.user_id = u.user_id WHERE nf.note_folder_id = ?") (Only contactId) + getUserByFileId :: DB.Connection -> FileTransferId -> ExceptT StoreError IO User getUserByFileId db fileId = ExceptT . firstRow toUser (SEUserNotFoundByFileId fileId) $ diff --git a/src/Simplex/Chat/Store/Shared.hs b/src/Simplex/Chat/Store/Shared.hs index a5f4f0e0e..6fdeaee13 100644 --- a/src/Simplex/Chat/Store/Shared.hs +++ b/src/Simplex/Chat/Store/Shared.hs @@ -69,6 +69,9 @@ data StoreError | SEDuplicateGroupMember | SEGroupAlreadyJoined | SEGroupInvitationNotFound + | SENoteFolderAlreadyExists {noteFolderId :: NoteFolderId} + | SENoteFolderNotFound {noteFolderId :: NoteFolderId} + | SEUserNoteFolderNotFound | SESndFileNotFound {fileId :: FileTransferId} | SESndFileInvalid {fileId :: FileTransferId} | SERcvFileNotFound {fileId :: FileTransferId} @@ -76,6 +79,7 @@ data StoreError | SEFileNotFound {fileId :: FileTransferId} | SERcvFileInvalid {fileId :: FileTransferId} | SERcvFileInvalidDescrPart + | SELocalFileNoTransfer {fileId :: FileTransferId} | SESharedMsgIdNotFoundByFileId {fileId :: FileTransferId} | SEFileIdNotFoundBySharedMsgId {sharedMsgId :: SharedMsgId} | SESndFileNotFoundXFTP {agentSndFileId :: AgentSndFileId} diff --git a/src/Simplex/Chat/Types.hs b/src/Simplex/Chat/Types.hs index 889c6fe5e..c834bc7a6 100644 --- a/src/Simplex/Chat/Types.hs +++ b/src/Simplex/Chat/Types.hs @@ -1164,6 +1164,15 @@ data FileTransferMeta = FileTransferMeta } deriving (Eq, Show) +data LocalFileMeta = LocalFileMeta + { fileId :: FileTransferId, + fileName :: String, + filePath :: String, + fileSize :: Integer, + fileCryptoArgs :: Maybe CryptoFileArgs + } + deriving (Eq, Show) + data XFTPSndFile = XFTPSndFile { agentSndFileId :: AgentSndFileId, privateSndFileDescr :: Maybe Text, @@ -1528,6 +1537,20 @@ data XGrpMemIntroCont = XGrpMemIntroCont } deriving (Show) +-- | Entity for local chats +data NoteFolder = NoteFolder + { noteFolderId :: NoteFolderId, + userId :: UserId, + createdAt :: UTCTime, + updatedAt :: UTCTime, + chatTs :: UTCTime, + favorite :: Bool, + unread :: Bool + } + deriving (Eq, Show) + +type NoteFolderId = Int64 + data ServerCfg p = ServerCfg { server :: ProtoServerWithAuth p, preset :: Bool, @@ -1634,6 +1657,8 @@ $(JQ.deriveJSON defaultJSON ''XFTPSndFile) $(JQ.deriveJSON defaultJSON ''FileTransferMeta) +$(JQ.deriveJSON defaultJSON ''LocalFileMeta) + $(JQ.deriveJSON (sumTypeJSON $ dropPrefix "FT") ''FileTransfer) $(JQ.deriveJSON defaultJSON ''UserPwdHash) @@ -1648,6 +1673,8 @@ $(JQ.deriveJSON defaultJSON ''Contact) $(JQ.deriveJSON defaultJSON ''ContactRef) +$(JQ.deriveJSON defaultJSON ''NoteFolder) + instance ProtocolTypeI p => ToJSON (ServerCfg p) where toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg) toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg) diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index c68f54eca..d0d0135f2 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -396,6 +396,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe toChatView :: AChat -> (Text, Text, Maybe ConnStatus) toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, connStatus <$> activeConn) toChatView (AChat _ (Chat (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing) + toChatView (AChat _ (Chat (LocalChat _) items _)) = ("*", toCIPreview items Nothing, Nothing) toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing) toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus) toCIPreview :: [CChatItem c] -> Maybe GroupMember -> Text @@ -554,7 +555,24 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, from = ttyFromGroup g m where quote = maybe [] (groupQuote g) quotedItem - _ -> [] + LocalChat _ -> case chatDir of + CILocalSnd -> case content of + CISndMsgContent mc -> hideLive meta $ withLocalFile to $ sndMsg to quote mc + CISndGroupEvent {} -> showSndItemProhibited to + _ -> showSndItem to + where + to = "* " + CILocalRcv -> case content of + CIRcvMsgContent mc -> withLocalFile from $ rcvMsg from quote mc + CIRcvIntegrityError err -> viewRcvIntegrityError from err ts tz meta + CIRcvGroupEvent {} -> showRcvItemProhibited from + _ -> showRcvItem from + where + from = "* " + where + quote = [] + ContactRequest {} -> [] + ContactConnection {} -> [] withItemDeleted item = case chatItemDeletedText ci (chatInfoMembership chat) of Nothing -> item Just t -> item <> styled (colored Red) (" [" <> t <> "]") @@ -563,6 +581,7 @@ viewChatItem chat ci@ChatItem {chatDir, meta = meta@CIMeta {forwardedByMember}, Just _ -> item <> styled (colored Yellow) (" [>>]" :: String) withSndFile = withFile viewSentFileInvitation withRcvFile = withFile viewReceivedFileInvitation + withLocalFile = withFile viewLocalFile withFile view dir l = maybe l (\f -> l <> view dir f ts tz meta) file sndMsg = msg viewSentMessage rcvMsg = msg viewReceivedMessage @@ -706,8 +725,15 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md where from = ttyFromGroup g m reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir + (LocalChat _, CILocalRcv) -> case ciMsgContent content of + Just mc -> view from $ reactionMsg mc + _ -> [] + where + from = "* " + reactionMsg mc = quoteText mc $ if toMsgDirection md == MDSnd then ">>" else ">" (_, CIDirectSnd) -> [sentText] (_, CIGroupSnd) -> [sentText] + (_, CILocalSnd) -> [sentText] where view from msg | showReactions = viewReceivedReaction from msg reactionText ts tz sentAt @@ -1569,6 +1595,11 @@ receivingFile_' hu testView status (AChatItem _ _ chat ChatItem {file = Just CIF _ -> [] receivingFile_' _ _ status _ = [plain status <> " receiving file"] -- shouldn't happen +viewLocalFile :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString] +viewLocalFile to CIFile {fileId, fileSource} ts tz = case fileSource of + Just (CryptoFile fPath _) -> sentWithTime_ ts tz [to <> fileTransferStr fileId fPath] + _ -> const [] + cryptoFileArgsStr :: Bool -> CryptoFileArgs -> ByteString cryptoFileArgsStr testView cfArgs@(CFArgs key nonce) | testView = LB.toStrict $ J.encode cfArgs @@ -1875,6 +1906,7 @@ viewChatError logLevel testView = \case SEDuplicateGroupMessage {groupId, sharedMsgId} | testView -> ["duplicate group message, group id: " <> sShow groupId <> ", message id: " <> sShow sharedMsgId] | otherwise -> [] + SEUserNoteFolderNotFound -> ["no notes folder"] e -> ["chat db error: " <> sShow e] ChatErrorDatabase err -> case err of DBErrorEncrypted -> ["error: chat database is already encrypted"] diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index a00274a54..0bcd6b520 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -4,6 +4,7 @@ import ChatTests.ChatList import ChatTests.Direct import ChatTests.Files import ChatTests.Groups +import ChatTests.Local import ChatTests.Profiles import Test.Hspec @@ -11,6 +12,7 @@ chatTests :: SpecWith FilePath chatTests = do describe "direct tests" chatDirectTests describe "group tests" chatGroupTests + describe "local chats tests" chatLocalChatsTests describe "file tests" chatFileTests describe "profile tests" chatProfileTests describe "chat list pagination tests" chatListTests diff --git a/tests/ChatTests/ChatList.hs b/tests/ChatTests/ChatList.hs index f42067c7e..b3f94a959 100644 --- a/tests/ChatTests/ChatList.hs +++ b/tests/ChatTests/ChatList.hs @@ -191,17 +191,23 @@ testPaginationAllChatTypes = connectUsers alice dan alice <##> dan - ts6 <- iso8601Show <$> getCurrentTime + _ts6 <- iso8601Show <$> getCurrentTime - getChats_ alice "count=10" [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice "count=3" [("@dan", "hey"), ("#team", ""), (":3", "")] + -- * (notes) + createCCNoteFolder alice + alice /* "psst" + + ts7 <- iso8601Show <$> getCurrentTime + + getChats_ alice "count=10" [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice "count=3" [("*", "psst"), ("@dan", "hey"), ("#team", "")] getChats_ alice ("after=" <> ts2 <> " count=2") [(":3", ""), ("<@cath", "")] getChats_ alice ("before=" <> ts5 <> " count=2") [("#team", ""), (":3", "")] - getChats_ alice ("after=" <> ts3 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", "")] + getChats_ alice ("after=" <> ts3 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", "")] getChats_ alice ("before=" <> ts4 <> " count=10") [(":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("after=" <> ts1 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("before=" <> ts6 <> " count=10") [("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] - getChats_ alice ("after=" <> ts6 <> " count=10") [] + getChats_ alice ("after=" <> ts1 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("before=" <> ts7 <> " count=10") [("*", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")] + getChats_ alice ("after=" <> ts7 <> " count=10") [] getChats_ alice ("before=" <> ts1 <> " count=10") [] let queryFavorite = "{\"type\": \"filters\", \"favorite\": true, \"unread\": false}" diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index a53bbff3d..9422b1f3b 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -1386,14 +1386,14 @@ testMultipleUserAddresses = cLinkAlisa <- getContactLink alice True bob ##> ("/c " <> cLinkAlisa) alice <#? bob - alice #$> ("/_get chats 2 pcc=on", chats, [("<@bob", "")]) + alice #$> ("/_get chats 2 pcc=on", chats, [("<@bob", ""), ("*", "")]) alice ##> "/ac bob" alice <## "bob (Bob): accepting contact request..." concurrently_ (bob <## "alisa: contact is connected") (alice <## "bob (Bob): contact is connected") threadDelay 100000 - alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", lastChatFeature)]) + alice #$> ("/_get chats 2 pcc=on", chats, [("@bob", lastChatFeature), ("*", "")]) alice <##> bob bob #> "@alice hey alice" @@ -1424,7 +1424,7 @@ testMultipleUserAddresses = (cath <## "alisa: contact is connected") (alice <## "cath (Catherine): contact is connected") threadDelay 100000 - alice #$> ("/_get chats 2 pcc=on", chats, [("@cath", lastChatFeature), ("@bob", "hey")]) + alice #$> ("/_get chats 2 pcc=on", chats, [("@cath", lastChatFeature), ("@bob", "hey"), ("*", "")]) alice <##> cath -- first user doesn't have cath as contact diff --git a/tests/ChatTests/Local.hs b/tests/ChatTests/Local.hs new file mode 100644 index 000000000..6e9bfa92c --- /dev/null +++ b/tests/ChatTests/Local.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PostfixOperators #-} + +module ChatTests.Local where + +import ChatClient +import ChatTests.ChatList (getChats_) +import ChatTests.Utils +import Data.Time (getCurrentTime) +import Data.Time.Format.ISO8601 (iso8601Show) +import Simplex.Chat.Controller (ChatConfig (..), InlineFilesConfig (..), defaultInlineFilesConfig) +import System.Directory (copyFile, doesFileExist) +import System.FilePath (()) +import Test.Hspec +import UnliftIO.Async (concurrently_) + +chatLocalChatsTests :: SpecWith FilePath +chatLocalChatsTests = do + describe "note folders" $ do + it "create folders, add notes, read, search" testNotes + it "switch users" testUserNotes + it "preview pagination for notes" testPreviewsPagination + it "chat pagination" testChatPagination + it "stores files" testFiles + it "deleting files does not interfere with other chat types" testOtherFiles + +testNotes :: FilePath -> IO () +testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + + alice ##> "/contacts" + -- not a contact + + alice /* "keep in mind" + alice ##> "/tail" + alice <# "* keep in mind" + alice ##> "/chats" + alice <# "* keep in mind" + alice ##> "/? keep" + alice <# "* keep in mind" + + alice #$> ("/_read chat *1 from=1 to=100", id, "ok") + alice ##> "/_unread chat *1 on" + alice <## "ok" + + alice ##> "/_delete item *1 1 internal" + alice <## "message deleted" + alice ##> "/tail" + alice ##> "/chats" + + alice /* "ahoy!" + alice ##> "/_update item *1 1 text Greetings." + alice ##> "/tail *" + alice <# "* Greetings." + +testUserNotes :: FilePath -> IO () +testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + + alice /* "keep in mind" + alice ##> "/tail" + alice <# "* keep in mind" + + alice ##> "/create user secret" + alice <## "user profile: secret" + alice <## "use /p to change it" + alice <## "(the updated profile will be sent to all your contacts)" + + alice ##> "/tail" + + alice ##> "/_delete item *1 1 internal" + alice <## "chat db error: SENoteFolderNotFound {noteFolderId = 1}" + +testPreviewsPagination :: FilePath -> IO () +testPreviewsPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + + tsS <- iso8601Show <$> getCurrentTime + alice /* "first" + tsM <- iso8601Show <$> getCurrentTime + alice /* "last" + tsE <- iso8601Show <$> getCurrentTime + + -- there's only one folder that got updated after tsM and before tsE + getChats_ alice "count=3" [("*", "last")] + getChats_ alice ("after=" <> tsE <> " count=10") [] + getChats_ alice ("after=" <> tsS <> " count=10") [("*", "last")] + getChats_ alice ("before=" <> tsM <> " count=10") [] + getChats_ alice ("before=" <> tsE <> " count=10") [("*", "last")] + getChats_ alice ("before=" <> tsS <> " count=10") [] + +testChatPagination :: FilePath -> IO () +testChatPagination tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + createCCNoteFolder alice + + alice /* "hello world" + alice /* "memento mori" + alice /* "knock-knock" + alice /* "who's there?" + + alice #$> ("/_get chat *1 count=100", chat, [(1, "hello world"), (1, "memento mori"), (1, "knock-knock"), (1, "who's there?")]) + alice #$> ("/_get chat *1 count=1", chat, [(1, "who's there?")]) + alice #$> ("/_get chat *1 after=2 count=10", chat, [(1, "knock-knock"), (1, "who's there?")]) + alice #$> ("/_get chat *1 after=2 count=2", chat, [(1, "knock-knock"), (1, "who's there?")]) + alice #$> ("/_get chat *1 after=1 count=2", chat, [(1, "memento mori"), (1, "knock-knock")]) + alice #$> ("/_get chat *1 before=3 count=10", chat, [(1, "hello world"), (1, "memento mori")]) + alice #$> ("/_get chat *1 before=3 count=2", chat, [(1, "hello world"), (1, "memento mori")]) + alice #$> ("/_get chat *1 before=4 count=2", chat, [(1, "memento mori"), (1, "knock-knock")]) + + alice #$> ("/_get chat *1 count=10 search=k-k", chat, [(1, "knock-knock")]) + +testFiles :: FilePath -> IO () +testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do + -- setup + createCCNoteFolder alice + let files = "./tests/tmp/app_files" + alice ##> ("/_files_folder " <> files) + alice <## "ok" + + -- ui-like upload + let source = "./tests/fixtures/test.jpg" + let stored = files "test.jpg" + copyFile source stored + alice ##> "/_create *1 json {\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"hi myself\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}" + alice <# "* hi myself" + alice <# "* file 1 (test.jpg)" + + alice ##> "/tail" + alice <# "* hi myself" + alice <# "* file 1 (test.jpg)" + + alice ##> "/_get chat *1 count=100" + r <- chatF <$> getTermLine alice + r `shouldBe` [((1, "hi myself"), Just "test.jpg")] + + alice ##> "/fs 1" + alice <## "bad chat command: not supported for local files" + + alice ##> "/fc 1" + alice <## "chat db error: SELocalFileNoTransfer {fileId = 1}" + + -- one more file + let stored2 = files "another_test.jpg" + copyFile source stored2 + alice ##> "/_create *1 json {\"filePath\": \"another_test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}" + alice <# "* file 2 (another_test.jpg)" + + alice ##> "/_delete item *1 2 internal" + alice <## "message deleted" + doesFileExist stored2 `shouldReturn` False + doesFileExist stored `shouldReturn` True + + alice ##> "/clear *" + alice ##> "/fs 1" + alice <## "chat db error: SEChatItemNotFoundByFileId {fileId = 1}" + alice ##> "/tail" + doesFileExist stored `shouldReturn` False + +testOtherFiles :: FilePath -> IO () +testOtherFiles = + testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do + connectUsers alice bob + createCCNoteFolder bob + bob ##> "/_files_folder ./tests/tmp/" + bob <## "ok" + alice ##> "/_send @2 json {\"msgContent\":{\"type\":\"voice\", \"duration\":10, \"text\":\"\"}, \"filePath\":\"./tests/fixtures/test.jpg\"}" + alice <# "@bob voice message (00:10)" + alice <# "/f @bob ./tests/fixtures/test.jpg" + -- below is not shown in "sent" mode + -- alice <## "use /fc 1 to cancel sending" + bob <# "alice> voice message (00:10)" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + -- below is not shown in "sent" mode + -- bob <## "use /fr 1 [/ | ] to receive it" + bob <## "started receiving file 1 (test.jpg) from alice" + concurrently_ + (alice <## "completed sending file 1 (test.jpg) to bob") + (bob <## "completed receiving file 1 (test.jpg) from alice") + + bob /* "test" + bob ##> "/tail *" + bob <# "* test" + bob ##> "/clear *" + bob ##> "/tail *" + bob ##> "/fs 1" + bob <## "receiving file 1 (test.jpg) complete, path: test.jpg" + doesFileExist "./tests/tmp/test.jpg" `shouldReturn` True + where + cfg = testCfg {inlineFiles = defaultInlineFilesConfig {offerChunks = 100, sendChunks = 100, receiveChunks = 100}} diff --git a/tests/ChatTests/Utils.hs b/tests/ChatTests/Utils.hs index ac87311c9..a7fd55ea4 100644 --- a/tests/ChatTests/Utils.hs +++ b/tests/ChatTests/Utils.hs @@ -11,6 +11,7 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.Async (concurrently_) import Control.Concurrent.STM import Control.Monad (unless, when) +import Control.Monad.Except (runExceptT) import qualified Data.ByteString.Char8 as B import Data.Char (isDigit) import Data.List (isPrefixOf, isSuffixOf) @@ -20,6 +21,7 @@ import qualified Data.Text as T import Database.SQLite.Simple (Only (..)) import Simplex.Chat.Controller (ChatConfig (..), ChatController (..), InlineFilesConfig (..), defaultInlineFilesConfig) import Simplex.Chat.Protocol +import Simplex.Chat.Store.NoteFolders (createNoteFolder) import Simplex.Chat.Store.Profiles (getUserContactProfiles) import Simplex.Chat.Types import Simplex.Chat.Types.Preferences @@ -287,6 +289,11 @@ cc <##.. ls = do unless prefix $ print ("expected to start from one of: " <> show ls, ", got: " <> l) prefix `shouldBe` True +(/*) :: HasCallStack => TestCC -> String -> IO () +cc /* note = do + cc `send` ("/* " <> note) + (dropTime <$> getTermLine cc) `shouldReturn` ("* " <> note) + data ConsoleResponse = ConsoleString String | WithTime String @@ -462,6 +469,12 @@ withCCTransaction :: TestCC -> (DB.Connection -> IO a) -> IO a withCCTransaction cc action = withTransaction (chatStore $ chatController cc) $ \db -> action db +createCCNoteFolder :: TestCC -> IO () +createCCNoteFolder cc = + withCCTransaction cc $ \db -> + withCCUser cc $ \user -> + runExceptT (createNoteFolder db user) >>= either (fail . show) pure + getProfilePictureByName :: TestCC -> String -> IO (Maybe String) getProfilePictureByName cc displayName = withTransaction (chatStore $ chatController cc) $ \db ->