cover more API, implement new folders

This commit is contained in:
IC Rainbow
2023-12-21 18:32:19 +02:00
parent 758a9f227b
commit 21b754d23f
7 changed files with 74 additions and 6 deletions
+1
View File
@@ -149,6 +149,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
+17 -1
View File
@@ -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
@@ -985,6 +986,7 @@ processChatCommand = \case
Group {groupInfo} <- getGroup db user chatId
liftIO $ updateGroupUnreadChat db user groupInfo unreadChat
ok user
CTLocal -> error "APIChatUnread: CTLocal"
_ -> pure $ chatCmdError (Just user) "not supported"
APIDeleteChat (ChatRef cType chatId) notify -> withUser $ \user@User {userId} -> case cType of
CTDirect -> do
@@ -1543,6 +1545,8 @@ processChatCommand = \case
gId <- withStore $ \db -> getGroupIdByName db user name
let chatRef = ChatRef CTGroup gId
processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc
CTLocal -> do
error "TODO: SendMessage.CTLocal"
_ -> throwChatError $ CECommandError "not supported"
SendMemberContactMessage gName mName msg -> withUser $ \user -> do
(gId, mId) <- getGroupAndMemberId user gName mName
@@ -1835,6 +1839,13 @@ processChatCommand = \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
-- APINewLocalChat userId localChatProfile -> withUserId userId $ \user -> do
-- checkValidName displayName
-- CRLocalChatCreated user <$> createLocalChat userId localChatProfile
NewNoteFolder displayName -> withUser $ \user@User {userId} -> do
-- processChatCommand $ APINewLocalChat userId localChatProfile
checkValidName displayName
withStore $ \db -> CRLocalChatCreated user <$> createNewNoteFolder db userId displayName
LastChats count_ -> withUser' $ \user -> do
let count = fromMaybe 5000 count_
(errs, previews) <- partitionEithers <$> withStore' (\db -> getChatPreviews db user False (PTLast count) clqNoFilters)
@@ -2053,6 +2064,7 @@ processChatCommand = \case
ChatRef cType <$> case cType of
CTDirect -> withStore $ \db -> getContactIdByName db user name
CTGroup -> withStore $ \db -> getGroupIdByName db user name
CTLocal -> withStore $ \db -> error "TODO: getNoteFolderIdByName db user name"
_ -> throwChatError $ CECommandError "not supported"
checkChatStopped :: m ChatResponse -> m ChatResponse
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
@@ -2086,11 +2098,13 @@ processChatCommand = \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 -> error "TODO: getSentChatItemIdByText.CTLocal"
_ -> 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 -> error "TODO: getChatItemIdByText.CTLocal"
_ -> throwChatError $ CECommandError "not supported"
connectViaContact :: User -> IncognitoEnabled -> ConnectionRequestUri 'CMContact -> m ChatResponse
connectViaContact user@User {userId} incognito cReq@(CRContactUri ConnReqUriData {crClientData}) = withChatLock "connectViaContact" $ do
@@ -6146,6 +6160,8 @@ chatCommandP =
"/_invite member contact @" *> (APISendMemberContactInvitation <$> A.decimal <*> optional (A.space *> msgContentP)),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <*> pure Nothing <*> quotedMsg <*> msgTextP),
(">#" <|> "> #") *> (SendGroupMessageQuote <$> displayName <* A.space <* char_ '@' <*> (Just <$> displayName) <* A.space <*> quotedMsg <*> msgTextP),
-- "/_new local chat " *> (APINewLocalChat <$> A.decimal <*> jsonP),
"/note folder " *> (NewNoteFolder <$> (char_ '$' *> displayName)),
"/_contacts " *> (APIListContacts <$> A.decimal),
"/contacts" $> ListContacts,
"/_connect plan " *> (APIConnectPlan <$> A.decimal <* A.space <*> strP),
@@ -6244,7 +6260,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)
+3
View File
@@ -406,6 +406,8 @@ data ChatCommand
| DeleteGroupLink GroupName
| ShowGroupLink GroupName
| SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: Text, message :: Text}
-- | APINewLocalChat UserId LocalChatProfile
| NewNoteFolder NoteFolderName
| 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)
@@ -554,6 +556,7 @@ data ChatResponse
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
| CRGroupsList {user :: User, groups :: [(GroupInfo, GroupSummary)]}
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
| CRLocalChatCreated {user :: User, noteFolder :: NoteFolder}
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
| CRFileTransferStatusXFTP User AChatItem
| CRUserProfile {user :: User, profile :: Profile}
+45
View File
@@ -0,0 +1,45 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE QuasiQuotes #-}
module Simplex.Chat.Store.NoteFolders where
import Control.Monad.Except (ExceptT (..), runExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import Data.Time (getCurrentTime)
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Store.Shared (StoreError, insertedRowId, withLocalDisplayName)
import Simplex.Chat.Types (NoteFolder (..))
import Simplex.Messaging.Agent.Protocol (UserId)
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
createNewNoteFolder :: DB.Connection -> UserId -> Text -> ExceptT StoreError IO NoteFolder
createNewNoteFolder db userId displayName = do
ts <- liftIO getCurrentTime
ExceptT $ withLocalDisplayName db userId displayName $ \localDisplayName -> runExceptT $ do
liftIO $ do
DB.execute
db
[sql|
INSERT INTO note_folders
(user_id, display_name, local_display_name, created_at, updated_at, chat_ts, favorite, unread_chat)
VALUES
(?, ?, ?, ?, ?, ?, ?, ?)
|]
(userId, displayName, localDisplayName, ts, ts, ts, favorite, unread)
noteFolderId <- insertedRowId db
pure
NoteFolder
{ noteFolderId,
userId,
displayName,
localDisplayName,
createdAt = ts,
updatedAt = ts,
chatTs = ts,
favorite,
unread
}
where
favorite = False
unread = False
-1
View File
@@ -1528,7 +1528,6 @@ data NoteFolder = NoteFolder
userId :: UserId,
displayName :: NoteFolderName,
localDisplayName :: NoteFolderName,
chatItemId :: Maybe Int64,
createdAt :: UTCTime,
updatedAt :: UTCTime,
chatTs :: UTCTime,
+1
View File
@@ -262,6 +262,7 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRMemberSubError u g m e -> ttyUser u [ttyGroup' g <> " member " <> ttyMember m <> " error: " <> sShow e]
CRMemberSubSummary u summary -> ttyUser u $ viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
CRGroupSubscribed u g -> ttyUser u $ viewGroupSubscribed g
CRLocalChatCreated u NoteFolder {displayName} -> ttyUser u ["new note folder created, write to $" <> plain displayName <> " to add notes"]
CRPendingSubSummary u _ -> ttyUser u []
CRSndFileSubError u SndFileTransfer {fileId, fileName} e ->
ttyUser u ["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
+7 -4
View File
@@ -15,16 +15,16 @@ chatLocalTests = do
testNotes :: FilePath -> IO ()
testNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/create note folder self"
alice <## "note folder created, write to $self to add notes"
alice ##> "/note folder self"
alice <## "new note folder created, write to $self to add notes"
alice ##> "$self keep in mind"
alice <## "ok"
testUserNotes :: FilePath -> IO ()
testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice ##> "/create note folder self"
alice <## "note folder created, write to $self to add notes"
alice ##> "/note folder self"
alice <## "new note folder created, write to $self to add notes"
alice ##> "$self keep in mind"
alice <## "ok"
@@ -36,4 +36,7 @@ testUserNotes tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
alice <## "use /p <display name> to change it"
alice <## "(the updated profile will be sent to all your contacts)"
alice ##> "/note folder $gossip Do not quote me on this"
alice <## "new note folder created, write to $gossip to add notes"
alice ##> "/chats"