cover more things

simplex-chat.cabal

@@ -127,6 +127,7 @@ library
       Simplex.Chat.Migrations.M20231126_remote_ctrl_address
       Simplex.Chat.Migrations.M20231207_chat_list_pagination
       Simplex.Chat.Migrations.M20231214_item_content_tag
+      Simplex.Chat.Migrations.M20231219_notes_folders
       Simplex.Chat.Mobile
       Simplex.Chat.Mobile.File
       Simplex.Chat.Mobile.Shared
@@ -539,6 +540,7 @@ test-suite simplex-chat-test
       ChatTests.Direct
       ChatTests.Files
       ChatTests.Groups
+      ChatTests.Notes
       ChatTests.Profiles
       ChatTests.Utils
       JSONTests

src/Simplex/Chat.hs

@@ -761,6 +761,7 @@ processChatCommand = \case
             quoteData ChatItem {chatDir = CIGroupSnd, content = CISndMsgContent qmc} membership' = pure (qmc, CIQGroupSnd, True, membership')
             quoteData ChatItem {chatDir = CIGroupRcv m, content = CIRcvMsgContent qmc} _ = pure (qmc, CIQGroupRcv $ Just m, False, m)
             quoteData _ _ = throwChatError CEInvalidQuote
+    CTNotes -> pure $ chatCmdError (Just user) "TODO: send note"
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where
@@ -862,6 +863,7 @@ processChatCommand = \case
                 else pure $ CRChatItemNotChanged user (AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci)
             _ -> throwChatError CEInvalidChatItemUpdate
         CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
+    CTNotes -> pure $ chatCmdError (Just user) "TODO: update note"
     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
@@ -886,6 +888,7 @@ processChatCommand = \case
           (SndMessage {msgId}, _) <- sendGroupMessage user gInfo ms $ XMsgDel itemSharedMId Nothing
           delGroupChatItem user gInfo ci msgId Nothing
         (CIDMBroadcast, _, _, _) -> throwChatError CEInvalidChatItemDelete
+    CTNotes -> pure $ chatCmdError (Just user) "TODO: APIDeleteChatItem.Note"
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
   APIDeleteMemberChatItem gId mId itemId -> withUser $ \user -> withChatLock "deleteChatItem" $ do
@@ -936,6 +939,7 @@ processChatCommand = \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"
+    CTNotes -> pure $ chatCmdError (Just user) "TODO: note reactions"
     CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
     CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
     where

src/Simplex/Chat/Messages.hs

@@ -59,7 +59,7 @@ chatTypeStr = \case
   CTGroup -> "#"
   CTContactRequest -> "<@"
   CTContactConnection -> ":"
-  CTNotes -> "~"
+  CTNotes -> "*"
 
 chatNameStr :: ChatName -> String
 chatNameStr (ChatName cType name) = T.unpack $ chatTypeStr cType <> if T.any isSpace name then "'" <> name <> "'" else name
@@ -70,7 +70,7 @@ data ChatRef = ChatRef ChatType Int64
 data ChatInfo (c :: ChatType) where
   DirectChat :: Contact -> ChatInfo 'CTDirect
   GroupChat :: GroupInfo -> ChatInfo 'CTGroup
-  NotesChat :: UTCTime -> ChatInfo 'CTNotes
+  NotesChat :: NotesFolder -> ChatInfo 'CTNotes
   ContactRequest :: UserContactRequest -> ChatInfo 'CTContactRequest
   ContactConnection :: PendingContactConnection -> ChatInfo 'CTContactConnection
 
@@ -86,7 +86,7 @@ chatInfoUpdatedAt :: ChatInfo c -> UTCTime
 chatInfoUpdatedAt = \case
   DirectChat Contact {updatedAt} -> updatedAt
   GroupChat GroupInfo {updatedAt} -> updatedAt
-  NotesChat updatedAt -> updatedAt
+  NotesChat NotesFolder {updatedAt} -> updatedAt
   ContactRequest UserContactRequest {updatedAt} -> updatedAt
   ContactConnection PendingContactConnection {updatedAt} -> updatedAt
 
@@ -94,7 +94,7 @@ chatInfoToRef :: ChatInfo c -> ChatRef
 chatInfoToRef = \case
   DirectChat Contact {contactId} -> ChatRef CTDirect contactId
   GroupChat GroupInfo {groupId} -> ChatRef CTGroup groupId
-  NotesChat {} -> ChatRef CTNotes 0
+  NotesChat NotesFolder {notesFolderId} -> ChatRef CTNotes notesFolderId
   ContactRequest UserContactRequest {contactRequestId} -> ChatRef CTContactRequest contactRequestId
   ContactConnection PendingContactConnection {pccConnId} -> ChatRef CTContactConnection pccConnId
 
@@ -106,7 +106,7 @@ chatInfoMembership = \case
 data JSONChatInfo
   = JCInfoDirect {contact :: Contact}
   | JCInfoGroup {groupInfo :: GroupInfo}
-  | JCInfoNotes {updatedAt :: UTCTime}
+  | JCInfoNotes {notesFolder :: NotesFolder}
   | JCInfoContactRequest {contactRequest :: UserContactRequest}
   | JCInfoContactConnection {contactConnection :: PendingContactConnection}
 
@@ -135,7 +135,7 @@ jsonAChatInfo :: JSONChatInfo -> AChatInfo
 jsonAChatInfo = \case
   JCInfoDirect c -> AChatInfo SCTDirect $ DirectChat c
   JCInfoGroup g -> AChatInfo SCTGroup $ GroupChat g
-  JCInfoNotes s -> AChatInfo SCTNotes $ NotesChat s
+  JCInfoNotes n -> AChatInfo SCTNotes $ NotesChat n
   JCInfoContactRequest g -> AChatInfo SCTContactRequest $ ContactRequest g
   JCInfoContactConnection c -> AChatInfo SCTContactConnection $ ContactConnection c
 
@@ -175,6 +175,7 @@ data CIDirection (c :: ChatType) (d :: MsgDirection) where
   CIDirectRcv :: CIDirection 'CTDirect 'MDRcv
   CIGroupSnd :: CIDirection 'CTGroup 'MDSnd
   CIGroupRcv :: GroupMember -> CIDirection 'CTGroup 'MDRcv
+  CINote :: CIDirection 'CTNotes 'MDSnd
 
 deriving instance Show (CIDirection c d)
 
@@ -187,6 +188,7 @@ data JSONCIDirection
   | JCIDirectRcv
   | JCIGroupSnd
   | JCIGroupRcv {groupMember :: GroupMember}
+  | JCINote
   deriving (Show)
 
 jsonCIDirection :: CIDirection c d -> JSONCIDirection
@@ -195,6 +197,7 @@ jsonCIDirection = \case
   CIDirectRcv -> JCIDirectRcv
   CIGroupSnd -> JCIGroupSnd
   CIGroupRcv m -> JCIGroupRcv m
+  CINote -> JCINote
 
 jsonACIDirection :: JSONCIDirection -> ACIDirection
 jsonACIDirection = \case
@@ -202,6 +205,7 @@ jsonACIDirection = \case
   JCIDirectRcv -> ACID SCTDirect SMDRcv CIDirectRcv
   JCIGroupSnd -> ACID SCTGroup SMDSnd CIGroupSnd
   JCIGroupRcv m -> ACID SCTGroup SMDRcv $ CIGroupRcv m
+  JCINote -> ACID SCTNotes SMDSnd CINote
 
 data CIReactionCount = CIReactionCount {reaction :: MsgReaction, userReacted :: Bool, totalReacted :: Int}
   deriving (Show)
@@ -398,6 +402,7 @@ data CIQDirection (c :: ChatType) where
   CIQDirectRcv :: CIQDirection 'CTDirect
   CIQGroupSnd :: CIQDirection 'CTGroup
   CIQGroupRcv :: Maybe GroupMember -> CIQDirection 'CTGroup -- member can be Nothing in case MsgRef has memberId that the user is not notified about yet
+  CIQNote :: CIQDirection 'CTNotes
 
 deriving instance Show (CIQDirection c)
 
@@ -410,6 +415,7 @@ jsonCIQDirection = \case
   CIQGroupSnd -> Just JCIGroupSnd
   CIQGroupRcv (Just m) -> Just $ JCIGroupRcv m
   CIQGroupRcv Nothing -> Nothing
+  CIQNote -> Just JCINote
 
 jsonACIQDirection :: Maybe JSONCIDirection -> ACIQDirection
 jsonACIQDirection = \case
@@ -417,6 +423,7 @@ jsonACIQDirection = \case
   Just JCIDirectRcv -> ACIQDirection SCTDirect CIQDirectRcv
   Just JCIGroupSnd -> ACIQDirection SCTGroup CIQGroupSnd
   Just (JCIGroupRcv m) -> ACIQDirection SCTGroup $ CIQGroupRcv (Just m)
+  Just JCINote -> ACIQDirection SCTNotes CIQNote
   Nothing -> ACIQDirection SCTGroup $ CIQGroupRcv Nothing
 
 quoteMsgDirection :: CIQDirection c -> MsgDirection
@@ -425,6 +432,7 @@ quoteMsgDirection = \case
   CIQDirectRcv -> MDRcv
   CIQGroupSnd -> MDSnd
   CIQGroupRcv _ -> MDRcv
+  CIQNote -> MDSnd
 
 data CIFile (d :: MsgDirection) = CIFile
   { fileId :: Int64,

src/Simplex/Chat/Migrations/M20231219_notes_folders.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Chat.Migrations.M20231219_notes_folders where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20231219_notes_folders :: Query
+m20231219_notes_folders =
+  [sql|
+    CREATE TABLE notes_folders (
+      notes_folder_id INTEGER PRIMARY KEY AUTOINCREMENT,
+      user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE,
+      local_display_name TEXT NOT NULL,
+      FOREIGN KEY (user_id, local_display_name)
+        REFERENCES display_names (user_id, local_display_name)
+        ON DELETE CASCADE
+        ON UPDATE CASCADE,
+      created_at TEXT NOT NULL,
+      updated_at TEXT NOT NULL,
+      chat_ts TEXT,
+      favorite INTEGER NOT NULL DEFAULT 0,
+      unread_chat INTEGER DEFAULT 0 NOT NULL,
+      chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE SET NULL,
+    );
+
+    CREATE UNIQUE INDEX idx_notes_user_local_display_name ON notes_fodler (
+      user_id,
+      local_display_name
+    );
+
+    ALTER TABLE chat_items ADD COLUMN notes_folder_id INTEGER DEFAULT NULL REFERENCES notes_folders ON DELETE CASCADE;
+|]
+
+down_m20231219_notes_folders :: Query
+down_m20231219_notes_folders =
+  [sql|
+DROP INDEX idx_notes_user_local_display_name;
+DROP TABLE notes_folders;
+ALTER TABLE chat_items DROP COLUMN notes_folder_id;
+|]

src/Simplex/Chat/Store/Messages.hs

@@ -366,6 +366,7 @@ createNewSndChatItem db user chatDirection SndMessage {msgId, sharedMsgId} ciCon
           CIQGroupSnd -> (Just True, Nothing)
           CIQGroupRcv (Just GroupMember {memberId}) -> (Just False, Just memberId)
           CIQGroupRcv Nothing -> (Just False, Nothing)
+          CIQNote -> (Just True, Nothing)
 
 createNewRcvChatItem :: 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
@@ -491,12 +492,12 @@ getChatItemQuote_ db User {userId, userContactId} chatDirection QuotedMsg {msgRe
 
 getChatPreviews :: DB.Connection -> User -> Bool -> PaginationByTime -> ChatListQuery -> IO [Either StoreError AChat]
 getChatPreviews db user withPCC pagination query = do
-  notes <- getNotesChatPreview_ db user pagination query
   directChats <- findDirectChatPreviews_ db user pagination query
   groupChats <- findGroupChatPreviews_ db user pagination query
+  notesChats <- findNotesChatPreview_ 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 [notes, directChats, groupChats, cReqChats, connChats]
+  let refs = sortTake $ concat [directChats, groupChats, notesChats, cReqChats, connChats]
   mapM (runExceptT <$> getChatPreview) refs
   where
     ts :: AChatPreviewData -> UTCTime
@@ -728,38 +729,50 @@ getGroupChatPreview_ db user (GroupChatPD _ groupId lastItemId_ stats) = do
     Nothing -> pure []
   pure $ AChat SCTGroup (Chat (GroupChat groupInfo) lastItem stats)
 
-getNotesChatPreview_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
-getNotesChatPreview_ db User {userId} _pagination = \case
-  CLQFilters {favorite = False, unread = False} -> query
-  _ -> pure []
+findNotesChatPreview_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
+findNotesChatPreview_ db User {userId} pagination clq = pure []
+
+getNotesChatPreview_ :: DB.Connection -> User -> ChatPreviewData 'CTNotes -> ExceptT StoreError IO AChat
+getNotesChatPreview_ = error "TODO: getNotesChatPreview_"
+
+-- this function can be changed so it never fails, not only avoid failure on invalid json
+toNoteChatItem :: UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTNotes)
+toNoteChatItem 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_)) :. quoteRow) =
+  chatItem $ fromRight invalid $ dbParseACIContent itemContentText
   where
-    query =
-      map toPreview
-        <$> DB.queryNamed
-          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,
-              -- ChatItemModeRow
-              i.timed_ttl, i.timed_delete_at, i.item_live,
-              -- MaybeCIFIleRow
-              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 := :user_id AND i.notes_chat
-            ORDER BY ts DESC
-            LIMIT 1
-          |]
-          [":user_id" := userId]
-    toPreview :: ChatItemRow -> AChatPreviewData
-    toPreview (ci :. ciMode :. ciFile_) =
-      let lastItem = error "TODO: lastItem" :: CChatItem CTNotes
-          ts = error "TODO: ts" :: UTCTime
-          stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
-          aChat = AChat SCTNotes $ Chat (NotesChat ts) [lastItem] stats
-       in ACPD SCTNotes $ NotesChatPD ts aChat
+    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 CINote ciStatus ciContent (maybeCIFile fileStatus)
+      (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Nothing) ->
+        Right $ cItem SMDSnd CINote 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 'CTNotes d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTNotes
+    cItem d chatDir ciStatus content file =
+      CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toNoteQuote quoteRow, reactions = [], file}
+    badItem = Left $ SEBadChatItem itemId
+    ciMeta :: CIContent d -> CIStatus d -> CIMeta 'CTNotes d
+    ciMeta content status =
+      let itemDeleted' = case itemDeleted of
+            DBCINotDeleted -> Nothing
+            _ -> Just (CIDeleted @'CTNotes 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}
+
+toNoteQuote :: QuoteRow -> Maybe (CIQuote 'CTNotes)
+toNoteQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ quotedSent >>= direction
+  where
+    direction sent = if sent then Just CIQNote else Nothing
 
 getContactRequestChatPreviews_ :: DB.Connection -> User -> PaginationByTime -> ChatListQuery -> IO [AChatPreviewData]
 getContactRequestChatPreviews_ db User {userId} pagination clq = case clq of

src/Simplex/Chat/Types.hs

@@ -327,6 +327,8 @@ type ContactName = Text
 
 type GroupName = Text
 
+type FolderName = Text
+
 optionalFullName :: ContactName -> Text -> Text
 optionalFullName displayName fullName
   | T.null fullName || displayName == fullName = ""
@@ -1520,6 +1522,21 @@ data XGrpMemIntroCont = XGrpMemIntroCont
   }
   deriving (Show)
 
+data NotesFolder = NotesFolder
+  { notesFolderId :: NotesFolderId,
+    userId :: UserId,
+    localDisplayName :: FolderName,
+    chatItemId :: Maybe Int64,
+    createdAt :: UTCTime,
+    updatedAt :: UTCTime,
+    chatTs :: Maybe UTCTime,
+    favorite :: Bool,
+    unread :: Bool
+  }
+  deriving (Eq, Show)
+
+type NotesFolderId = Int64
+
 data ServerCfg p = ServerCfg
   { server :: ProtoServerWithAuth p,
     preset :: Bool,
@@ -1640,6 +1657,8 @@ $(JQ.deriveJSON defaultJSON ''Contact)
 
 $(JQ.deriveJSON defaultJSON ''ContactRef)
 
+$(JQ.deriveJSON defaultJSON ''NotesFolder)
+
 instance ProtocolTypeI p => ToJSON (ServerCfg p) where
   toEncoding = $(JQ.mkToEncoding defaultJSON ''ServerCfg)
   toJSON = $(JQ.mkToJSON defaultJSON ''ServerCfg)

src/Simplex/Chat/View.hs

@@ -393,6 +393,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 (NotesChat NotesFolder {localDisplayName}) items _)) = ("*" <> localDisplayName, 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
@@ -703,6 +704,7 @@ viewItemReaction showReactions chat CIReaction {chatDir, chatItem = CChatItem md
         reactionMsg mc = quoteText mc . ttyQuotedMember . Just $ sentByMember' g itemDir
     (_, CIDirectSnd) -> [sentText]
     (_, CIGroupSnd) -> [sentText]
+    (_, CINote) -> [sentText]
   where
     view from msg
       | showReactions = viewReceivedReaction from msg reactionText ts tz sentAt

tests/ChatTests/Notes.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PostfixOperators #-}
+
+module ChatTests.Notes where
+
+import ChatClient
+import ChatTests.Utils
+import Test.Hspec
+
+chatNotesTests :: SpecWith FilePath
+chatNotesTests = do
+  fdescribe "notes folders" $ do
+    it "create folders, add notes, read, search" testNotes
+    it "switch users" testUserNotes
+
+testNotes :: FilePath -> IO ()
+testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+  alice ##> "/create notes folder self"
+  alice <## "notes folder created, use *self to add notes"
+
+  alice ##> "*self keep in mind"
+  alice <## "ok"
+
+testUserNotes :: FilePath -> IO ()
+testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
+  alice ##> "/create notes folder self"
+  alice <## "notes folder created, use *self to add notes"
+
+  alice ##> "*self keep in mind"
+  alice <## "ok"
+  alice ##> "/contacts"
+  alice <## "*self"
+
+  alice ##> "/create user secret"
+  alice <## "user profile: secret"
+  alice <## "use /p <display name> to change it"
+  alice <## "(the updated profile will be sent to all your contacts)"
+
+  alice ##> "/contacts"