working create/send/tail

This commit is contained in:
IC Rainbow
2023-12-21 22:58:54 +02:00
parent 21b754d23f
commit de697beff1
8 changed files with 242 additions and 46 deletions
+14 -6
View File
@@ -613,7 +613,8 @@ processChatCommand = \case
groupChat <- withStore (\db -> getGroupChat db user cId pagination search)
pure $ CRApiChat user (AChat SCTGroup groupChat)
CTLocal -> do
error "TODO: APIGetChat.CTLocal"
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
@@ -762,7 +763,12 @@ 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
CTLocal -> pure $ chatCmdError (Just user) "TODO: send local"
CTLocal -> do
nf@NoteFolder {noteFolderId} <- withStore $ \db -> getNoteFolder db user chatId
-- TODO: files, voice, etc.
msg <- createSndMessage (XMsgNew . MCSimple $ extMsgContent mc Nothing) (NoteFolderId noteFolderId)
ci <- saveSndChatItem user (CDLocalSnd nf) msg (CISndMsgContent mc)
pure $ CRNewChatItem user (AChatItem SCTLocal SMDSnd (LocalChat nf) ci)
CTContactRequest -> pure $ chatCmdError (Just user) "not supported"
CTContactConnection -> pure $ chatCmdError (Just user) "not supported"
where
@@ -1546,7 +1552,8 @@ processChatCommand = \case
let chatRef = ChatRef CTGroup gId
processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc
CTLocal -> do
error "TODO: SendMessage.CTLocal"
chatRef <- withStore $ \db -> ChatRef CTLocal <$> getNoteFolderIdByName db user name
processChatCommand . APISendMessage chatRef False Nothing $ ComposedMessage Nothing Nothing mc
_ -> throwChatError $ CECommandError "not supported"
SendMemberContactMessage gName mName msg -> withUser $ \user -> do
(gId, mId) <- getGroupAndMemberId user gName mName
@@ -2064,7 +2071,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"
CTLocal -> withStore $ \db -> getNoteFolderIdByName db user name
_ -> throwChatError $ CECommandError "not supported"
checkChatStopped :: m ChatResponse -> m ChatResponse
checkChatStopped a = asks agentAsync >>= readTVarIO >>= maybe a (const $ throwChatError CEChatNotStopped)
@@ -5682,11 +5689,11 @@ saveSndChatItem' user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem
pure ciId
liftIO $ 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, 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, 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
@@ -6160,6 +6167,7 @@ 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),
-- "/notes" $> ListNoteFolders, -- TODO
-- "/_new local chat " *> (APINewLocalChat <$> A.decimal <*> jsonP),
"/note folder " *> (NewNoteFolder <$> (char_ '$' *> displayName)),
"/_contacts " *> (APIListContacts <$> A.decimal),