mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-04-29 03:55:51 +00:00
cover more API, implement new folders
This commit is contained in:
@@ -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
@@ -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)
|
||||
|
||||
@@ -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}
|
||||
|
||||
@@ -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
|
||||
@@ -1528,7 +1528,6 @@ data NoteFolder = NoteFolder
|
||||
userId :: UserId,
|
||||
displayName :: NoteFolderName,
|
||||
localDisplayName :: NoteFolderName,
|
||||
chatItemId :: Maybe Int64,
|
||||
createdAt :: UTCTime,
|
||||
updatedAt :: UTCTime,
|
||||
chatTs :: UTCTime,
|
||||
|
||||
@@ -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]
|
||||
|
||||
@@ -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"
|
||||
|
||||
Reference in New Issue
Block a user