Merge branch 'master' into dc/core-pagination

This commit is contained in:
Diogo
2024-10-26 22:21:44 +01:00
11 changed files with 482 additions and 229 deletions
+27 -22
View File
@@ -1457,26 +1457,31 @@ processChatCommand' vr = \case
CRNtfTokenStatus <$> withAgent (\a -> registerNtfToken a token mode)
APIVerifyToken token nonce code -> withUser $ \_ -> withAgent (\a -> verifyNtfToken a token nonce code) >> ok_
APIDeleteToken token -> withUser $ \_ -> withAgent (`deleteNtfToken` token) >> ok_
APIGetNtfMessage nonce encNtfInfo -> withUser $ \_ -> do
(NotificationInfo {ntfConnId, ntfMsgMeta = nMsgMeta}, msg) <- withAgent $ \a -> getNotificationMessage a nonce encNtfInfo
let agentConnId = AgentConnId ntfConnId
user_ <- withStore' (`getUserByAConnId` agentConnId)
connEntity_ <-
pure user_ $>>= \user ->
withStore (\db -> Just <$> getConnectionEntity db vr user agentConnId) `catchChatError` (\e -> toView (CRChatError (Just user) e) $> Nothing)
pure
CRNtfMessages
{ user_,
connEntity_,
-- Decrypted ntf meta of the expected message (the one notification was sent for)
expectedMsg_ = expectedMsgInfo <$> nMsgMeta,
-- Info of the first message retrieved by agent using GET
-- (may differ from the expected message due to, for example, coalescing or loss of notifications)
receivedMsg_ = receivedMsgInfo <$> msg
}
ApiGetConnNtfMessage (AgentConnId connId) -> withUser $ \_ -> do
msg <- withAgent $ \a -> getConnectionMessage a connId
pure $ CRConnNtfMessage (receivedMsgInfo <$> msg)
APIGetNtfConns nonce encNtfInfo -> withUser $ \user -> do
ntfInfos <- withAgent $ \a -> getNotificationConns a nonce encNtfInfo
(errs, ntfMsgs) <- lift $ partitionEithers <$> withStoreBatch' (\db -> map (getMsgConn db) (L.toList ntfInfos))
unless (null errs) $ toView $ CRChatErrors (Just user) errs
pure $ CRNtfConns ntfMsgs
where
getMsgConn :: DB.Connection -> NotificationInfo -> IO NtfConn
getMsgConn db NotificationInfo {ntfConnId, ntfMsgMeta = nMsgMeta} = do
let agentConnId = AgentConnId ntfConnId
user_ <- getUserByAConnId db agentConnId
connEntity_ <-
pure user_ $>>= \user ->
eitherToMaybe <$> runExceptT (getConnectionEntity db vr user agentConnId)
pure $
NtfConn
{ user_,
connEntity_,
-- Decrypted ntf meta of the expected message (the one notification was sent for)
expectedMsg_ = expectedMsgInfo <$> nMsgMeta
}
ApiGetConnNtfMessages connIds -> withUser $ \_ -> do
let acIds = L.map (\(AgentConnId acId) -> acId) connIds
msgs <- lift $ withAgent' $ \a -> getConnectionMessages a acIds
let ntfMsgs = L.map (\msg -> receivedMsgInfo <$> msg) msgs
pure $ CRConnNtfMessages ntfMsgs
APIGetUserProtoServers userId (AProtocolType p) -> withUserId userId $ \user -> withServerProtocol p $ do
cfg@ChatConfig {defaultServers} <- asks config
servers <- withFastStore' (`getProtocolServers` user)
@@ -8062,8 +8067,8 @@ chatCommandP =
"/_ntf register " *> (APIRegisterToken <$> strP_ <*> strP),
"/_ntf verify " *> (APIVerifyToken <$> strP <* A.space <*> strP <* A.space <*> strP),
"/_ntf delete " *> (APIDeleteToken <$> strP),
"/_ntf message " *> (APIGetNtfMessage <$> strP <* A.space <*> strP),
"/_ntf conn message " *> (ApiGetConnNtfMessage <$> strP),
"/_ntf conns " *> (APIGetNtfConns <$> strP <* A.space <*> strP),
"/_ntf conn messages " *> (ApiGetConnNtfMessages <$> strP),
"/_add #" *> (APIAddMember <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
"/_join #" *> (APIJoinGroup <$> A.decimal),
"/_member role #" *> (APIMemberRole <$> A.decimal <* A.space <*> A.decimal <*> memberRole),
+13 -4
View File
@@ -330,8 +330,8 @@ data ChatCommand
| APIRegisterToken DeviceToken NotificationsMode
| APIVerifyToken DeviceToken C.CbNonce ByteString
| APIDeleteToken DeviceToken
| APIGetNtfMessage {nonce :: C.CbNonce, encNtfInfo :: ByteString}
| ApiGetConnNtfMessage {connId :: AgentConnId}
| APIGetNtfConns {nonce :: C.CbNonce, encNtfInfo :: ByteString}
| ApiGetConnNtfMessages {connIds :: NonEmpty AgentConnId}
| APIAddMember GroupId ContactId GroupMemberRole
| APIJoinGroup GroupId
| APIMemberRole GroupId GroupMemberId GroupMemberRole
@@ -745,8 +745,8 @@ data ChatResponse
| CRUserContactLinkSubError {chatError :: ChatError} -- TODO delete
| CRNtfTokenStatus {status :: NtfTknStatus}
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode, ntfServer :: NtfServer}
| CRNtfMessages {user_ :: Maybe User, connEntity_ :: Maybe ConnectionEntity, expectedMsg_ :: Maybe NtfMsgInfo, receivedMsg_ :: Maybe NtfMsgInfo}
| CRConnNtfMessage {receivedMsg_ :: Maybe NtfMsgInfo}
| CRNtfConns {ntfConns :: [NtfConn]}
| CRConnNtfMessages {receivedMsgs :: NonEmpty (Maybe NtfMsgInfo)}
| CRNtfMessage {user :: User, connEntity :: ConnectionEntity, ntfMessage :: NtfMsgAckInfo}
| CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
| CRRemoteHostList {remoteHosts :: [RemoteHostInfo]}
@@ -1064,6 +1064,13 @@ instance FromJSON ComposedMessage where
parseJSON invalid =
JT.prependFailure "bad ComposedMessage, " (JT.typeMismatch "Object" invalid)
data NtfConn = NtfConn
{ user_ :: Maybe User,
connEntity_ :: Maybe ConnectionEntity,
expectedMsg_ :: Maybe NtfMsgInfo
}
deriving (Show)
data NtfMsgInfo = NtfMsgInfo {msgId :: Text, msgTs :: UTCTime}
deriving (Show)
@@ -1536,6 +1543,8 @@ $(JQ.deriveJSON defaultJSON ''UserProfileUpdateSummary)
$(JQ.deriveJSON defaultJSON ''NtfMsgInfo)
$(JQ.deriveJSON defaultJSON ''NtfConn)
$(JQ.deriveJSON defaultJSON ''NtfMsgAckInfo)
$(JQ.deriveJSON defaultJSON ''SwitchProgress)
+2 -2
View File
@@ -325,8 +325,8 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
CRContactConnectionDeleted u PendingContactConnection {pccConnId} -> ttyUser u ["connection :" <> sShow pccConnId <> " deleted"]
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
CRNtfToken _ status mode srv -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode) <> ", server: " <> sShow srv]
CRNtfMessages {} -> []
CRConnNtfMessage {} -> []
CRNtfConns {} -> []
CRConnNtfMessages {} -> []
CRNtfMessage {} -> []
CRCurrentRemoteHost rhi_ ->
[ maybe