resolve some comments
This commit is contained in:
IC Rainbow
parent
dba3d1d84a
commit
009772bdf8
@ -793,13 +793,13 @@ processChatCommand' vr = \case
|
||||
APICreateChatItem folderId (ComposedMessage file_ quotedItemId_ mc) -> withUser $ \user -> do
|
||||
forM_ quotedItemId_ $ \_ -> throwError $ ChatError $ CECommandError "not supported"
|
||||
nf <- withStore $ \db -> getNoteFolder db user folderId
|
||||
-- TODO: assertLocalAllowed user MDSnd nf XMsgNew_
|
||||
ci'@ChatItem {meta = CIMeta {itemId, itemTs}} <- createLocalChatItem user (CDLocalSnd nf) (CISndMsgContent mc) Nothing
|
||||
ciFile_ <- forM file_ $ \cf@CryptoFile {filePath, cryptoArgs} -> do
|
||||
fsFilePath <- toFSFilePath filePath -- XXX: only used for size?..
|
||||
fileSize <- liftIO $ CF.getFileContentsSize $ CryptoFile fsFilePath cryptoArgs
|
||||
chunkSize <- asks $ fileChunkSize . config
|
||||
withStore' $ \db -> do
|
||||
fileId <- createLocalFile CIFSSndComplete db user nf itemId itemTs cf fileSize
|
||||
fileId <- createLocalFile CIFSSndComplete db user nf itemId itemTs cf fileSize chunkSize
|
||||
pure CIFile {fileId, fileName = takeFileName filePath, fileSize, fileSource = Just cf, fileStatus = CIFSSndComplete, fileProtocol = FPLocal}
|
||||
let ci = (ci' :: ChatItem 'CTLocal 'MDSnd) {file = ciFile_}
|
||||
pure . CRNewChatItem user $ AChatItem SCTLocal SMDSnd (LocalChat nf) ci
|
||||
@ -851,18 +851,14 @@ processChatCommand' vr = \case
|
||||
CTLocal -> do
|
||||
(nf@NoteFolder {noteFolderId}, cci) <- withStore $ \db -> (,) <$> getNoteFolder db user chatId <*> getLocalChatItem db user chatId itemId
|
||||
case cci of
|
||||
CChatItem SMDRcv _ -> throwChatError CEInvalidChatItemUpdate
|
||||
CChatItem SMDSnd ci@ChatItem {meta = CIMeta {editable}, content = ciContent} -> do
|
||||
case (ciContent, editable) of
|
||||
(CISndMsgContent oldMC, True) ->
|
||||
if mc /= oldMC
|
||||
then 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')
|
||||
else pure $ CRChatItemNotChanged user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci)
|
||||
_ -> throwChatError CEInvalidChatItemUpdate
|
||||
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
|
||||
@ -1018,8 +1014,6 @@ processChatCommand' vr = \case
|
||||
void (sendDirectContactMessage ct XDirectDel) `catchChatError` const (pure ())
|
||||
contactConnIds <- map aConnId <$> withStore' (\db -> getContactConnections db userId ct)
|
||||
deleteAgentConnectionsAsync user contactConnIds
|
||||
-- functions below are called in separate transactions to prevent crashes on android
|
||||
-- (possibly, race condition on integrity check?)
|
||||
withStore' $ \db -> deleteContactConnectionsAndFiles db userId ct
|
||||
withStore' $ \db -> deleteContact db user ct
|
||||
pure $ CRContactDeleted user ct
|
||||
@ -5977,7 +5971,7 @@ deleteGroupCI user gInfo ci@ChatItem {file} byUser timed byGroupMember_ deletedT
|
||||
deleteLocalCI :: (ChatMonad m, MsgDirectionI d) => User -> NoteFolder -> ChatItem 'CTLocal d -> Bool -> Bool -> m ChatResponse
|
||||
deleteLocalCI user nf ci@ChatItem {file} byUser timed = do
|
||||
deleteCIFile user file
|
||||
withStoreCtx' (Just "deleteLocalCI, deleteLocalChatItem") $ \db -> deleteLocalChatItem db user nf ci
|
||||
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 ()
|
||||
@ -6118,17 +6112,13 @@ sameGroupProfileInfo p p' = p {groupPreferences = Nothing} == p' {groupPreferenc
|
||||
|
||||
createInternalChatItem :: forall c d m. (ChatTypeI c, MsgDirectionI d, ChatMonad m) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> m ()
|
||||
createInternalChatItem user cd content itemTs_ = do
|
||||
ci <- createInternalChatItem_ user cd content itemTs_
|
||||
toView $ CRNewChatItem user (AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci)
|
||||
|
||||
createInternalChatItem_ :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection c d -> CIContent d -> Maybe UTCTime -> m (ChatItem c d)
|
||||
createInternalChatItem_ user cd content itemTs_ = do
|
||||
createdAt <- liftIO getCurrentTime
|
||||
let itemTs = fromMaybe createdAt itemTs_
|
||||
ciId <- withStore' $ \db -> do
|
||||
when (ciRequiresAttention content) $ updateChatTs db user cd createdAt
|
||||
createNewChatItemNoMsg db user cd content itemTs createdAt
|
||||
liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs Nothing createdAt
|
||||
ci <- liftIO $ mkChatItem cd ciId content Nothing Nothing Nothing Nothing False itemTs Nothing createdAt
|
||||
toView $ CRNewChatItem user (AChatItem (chatTypeI @c) (msgDirection @d) (toChatInfo cd) ci)
|
||||
|
||||
createLocalChatItem :: (MsgDirectionI d, ChatMonad m) => User -> ChatDirection 'CTLocal d -> CIContent d -> Maybe UTCTime -> m (ChatItem 'CTLocal d)
|
||||
createLocalChatItem user cd content itemTs_ = do
|
||||
|
||||
@ -919,8 +919,8 @@ 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 -> IO Int64
|
||||
createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId itemTs CryptoFile {filePath, cryptoArgs} fileSize = do
|
||||
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|
|
||||
@ -935,7 +935,7 @@ createLocalFile fileStatus db User {userId} NoteFolder {noteFolderId} chatItemId
|
||||
( (userId, noteFolderId, chatItemId)
|
||||
:. (takeFileName filePath, filePath, fileSize)
|
||||
:. maybe (Nothing, Nothing) (\(CFArgs key nonce) -> (Just key, Just nonce)) cryptoArgs
|
||||
:. (65536 :: Int, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs)
|
||||
:. (fileChunkSize, Nothing :: Maybe InlineFileMode, fileStatus, FPLocal, itemTs, itemTs)
|
||||
)
|
||||
insertedRowId db
|
||||
|
||||
|
||||
@ -263,7 +263,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
|
||||
CRNoteFolderCreated u NoteFolder {displayName} -> ttyUser u ["new note folder created, write to $" <> plain displayName <> " to add notes"]
|
||||
CRNoteFolderCreated u NoteFolder {displayName} -> ttyUser u ["new note folder created, use $" <> plain displayName <> " to create a note"]
|
||||
CRNoteFolderDeleted u NoteFolder {displayName} -> ttyUser u ["note folder " <> plain displayName <> " deleted"]
|
||||
CRPendingSubSummary u _ -> ttyUser u []
|
||||
CRSndFileSubError u SndFileTransfer {fileId, fileName} e ->
|
||||
@ -1908,7 +1908,7 @@ viewChatError logLevel testView = \case
|
||||
SEDuplicateGroupMessage {groupId, sharedMsgId}
|
||||
| testView -> ["duplicate group message, group id: " <> sShow groupId <> ", message id: " <> sShow sharedMsgId]
|
||||
| otherwise -> []
|
||||
SENoteFolderNotFoundByName f -> ["no folder " <> ttyLocal f]
|
||||
SENoteFolderNotFoundByName f -> ["no notes folder " <> ttyLocal f]
|
||||
e -> ["chat db error: " <> sShow e]
|
||||
ChatErrorDatabase err -> case err of
|
||||
DBErrorEncrypted -> ["error: chat database is already encrypted"]
|
||||
|
||||
@ -14,7 +14,7 @@ chatListTests = do
|
||||
it "filter favorite" testFilterFavorite
|
||||
it "filter unread" testFilterUnread
|
||||
it "filter favorite or unread" testFilterFavoriteOrUnread
|
||||
it "sort and filter chats of all types" testPaginationAllChatTypes
|
||||
fit "sort and filter chats of all types" testPaginationAllChatTypes
|
||||
|
||||
testPaginationLast :: HasCallStack => FilePath -> IO ()
|
||||
testPaginationLast =
|
||||
@ -191,17 +191,24 @@ 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
|
||||
alice ##> "/note folder self"
|
||||
alice <## "new note folder created, use $self to create a note"
|
||||
alice #> "$self psst"
|
||||
|
||||
ts7 <- iso8601Show <$> getCurrentTime
|
||||
|
||||
getChats_ alice "count=10" [("$self", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice "count=3" [("$self", "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") [("$self", "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") [("$self", "psst"), ("@dan", "hey"), ("#team", ""), (":3", ""), ("<@cath", ""), ("@bob", "hey")]
|
||||
getChats_ alice ("before=" <> ts7 <> " count=10") [("$self", "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}"
|
||||
|
||||
@ -89,4 +89,4 @@ testFiles tmp = withNewTestChat tmp "alice" aliceProfile $ \alice -> do
|
||||
createFolder :: TestCC -> String -> IO ()
|
||||
createFolder cc label = do
|
||||
cc ##> ("/note folder " <> label)
|
||||
cc <## ("new note folder created, write to $" <> label <> " to add notes")
|
||||
cc <## ("new note folder created, use $" <> label <> " to create a note")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user