api for chat pagination (#249)

This commit is contained in:
Efim Poberezkin
2022-02-01 15:05:27 +04:00
committed by GitHub
parent 0b86402ce3
commit 228c118714
4 changed files with 181 additions and 52 deletions
+8 -4
View File
@@ -125,9 +125,9 @@ toView event = do
processChatCommand :: forall m. ChatMonad m => User -> ChatCommand -> m ChatResponse
processChatCommand user@User {userId, profile} = \case
APIGetChats -> CRApiChats <$> withStore (`getChatPreviews` user)
APIGetChat cType cId -> case cType of
CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st userId cId)
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId)
APIGetChat cType cId pagination -> case cType of
CTDirect -> CRApiChat . AChat SCTDirect <$> withStore (\st -> getDirectChat st user cId pagination)
CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination)
CTContactRequest -> pure $ CRChatError ChatErrorNotImplemented
APIGetChatItems _count -> pure $ CRChatError ChatErrorNotImplemented
APISendMessage cType chatId mc -> case cType of
@@ -1320,7 +1320,7 @@ withStore action =
chatCommandP :: Parser ChatCommand
chatCommandP =
"/_get chats" $> APIGetChats
<|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal)
<|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP)
<|> "/_get items count=" *> (APIGetChatItems <$> A.decimal)
<|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <* A.space <*> msgContentP)
<|> "/_delete " *> (APIDeleteChat <$> chatTypeP <*> A.decimal)
@@ -1363,6 +1363,10 @@ chatCommandP =
<|> ("/version" <|> "/v") $> ShowVersion
where
chatTypeP = A.char '@' $> CTDirect <|> A.char '#' $> CTGroup
chatPaginationP =
(CPLast <$ "count=" <*> A.decimal)
<|> (CPAfter <$ "after=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
<|> (CPBefore <$ "before=" <*> A.decimal <* A.space <* "count=" <*> A.decimal)
msgContentP = "text " *> (MCText . safeDecodeUtf8 <$> A.takeByteString)
displayName = safeDecodeUtf8 <$> (B.cons <$> A.satisfy refChar <*> A.takeTill (== ' '))
refChar c = c > ' ' && c /= '#' && c /= '@'