diff --git a/changelog.d/1-api-changes/get-subconversation b/changelog.d/1-api-changes/get-subconversation index 175ddb4b90..c39f07dfb7 100644 --- a/changelog.d/1-api-changes/get-subconversation +++ b/changelog.d/1-api-changes/get-subconversation @@ -1 +1 @@ -Introduce a subconversation GET endpoint +Introduce a subconversation GET endpoint (#2869, #2993) diff --git a/libs/cassandra-util/src/Cassandra/Util.hs b/libs/cassandra-util/src/Cassandra/Util.hs index 062d9913a9..1b033038da 100644 --- a/libs/cassandra-util/src/Cassandra/Util.hs +++ b/libs/cassandra-util/src/Cassandra/Util.hs @@ -14,28 +14,28 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# LANGUAGE NumericUnderscores #-} module Cassandra.Util - ( writeTimeToUTC, - defInitCassandra, - Writetime, + ( defInitCassandra, + Writetime (..), + writetimeToInt64, ) where -import Cassandra (ClientState, Keyspace (Keyspace), init) +import Cassandra (ClientState, init) +import Cassandra.CQL import Cassandra.Settings (defSettings, setContacts, setKeyspace, setLogger, setPortNumber) +import Data.Aeson +import Data.Fixed import Data.Text (unpack) -import Data.Time (UTCTime) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Time (UTCTime, nominalDiffTimeToSeconds) +import Data.Time.Clock (secondsToNominalDiffTime) +import Data.Time.Clock.POSIX import qualified Database.CQL.IO.Tinylog as CT import Imports hiding (init) import qualified System.Logger as Log -type Writetime a = Int64 - -writeTimeToUTC :: Writetime a -> UTCTime -writeTimeToUTC = posixSecondsToUTCTime . fromIntegral . (`div` 1000000) - defInitCassandra :: Text -> Text -> Word16 -> Log.Logger -> IO ClientState defInitCassandra ks h p lg = init @@ -44,3 +44,37 @@ defInitCassandra ks h p lg = . setContacts (unpack h) [] . setKeyspace (Keyspace ks) $ defSettings + +-- | Read cassandra's writetimes https://docs.datastax.com/en/dse/5.1/cql/cql/cql_using/useWritetime.html +-- as UTCTime values without any loss of precision +newtype Writetime a = Writetime {writetimeToUTC :: UTCTime} + +instance Cql (Writetime a) where + ctype = Tagged BigIntColumn + toCql = CqlBigInt . writetimeToInt64 + fromCql (CqlBigInt n) = + pure + . Writetime + . posixSecondsToUTCTime + . secondsToNominalDiffTime + . MkFixed + . (* 1_000_000) + . fromIntegral @Int64 @Integer + $ n + fromCql _ = Left "Writetime: bigint expected" + +-- | This yields the same int as it is returned by WRITETIME() +writetimeToInt64 :: Writetime a -> Int64 +writetimeToInt64 = + fromIntegral @Integer @Int64 + . (`div` 1_000_000) + . unfixed + . nominalDiffTimeToSeconds + . utcTimeToPOSIXSeconds + . writetimeToUTC + where + unfixed :: Fixed a -> Integer + unfixed (MkFixed n) = n + +instance ToJSON (Writetime a) where + toJSON = toJSON . writetimeToInt64 diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs index c912a68991..cf6c637c95 100644 --- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs +++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/ConversationCreated.hs @@ -22,6 +22,7 @@ import Data.Id import Data.Misc import Data.Qualified import qualified Data.Set as Set +import Data.Time import qualified Data.UUID as UUID import Imports import Wire.API.Conversation @@ -84,5 +85,5 @@ testObject_ConversationCreated2 = ccNonCreatorMembers = Set.fromList [], ccMessageTimer = Nothing, ccReceiptMode = Nothing, - ccProtocol = ProtocolMLS (ConversationMLSData (GroupId "group") (Epoch 3) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) + ccProtocol = ProtocolMLS (ConversationMLSData (GroupId "group") (Epoch 3) (Just (UTCTime (fromGregorian 2020 8 29) 0)) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) } diff --git a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs index 30ca0b6591..0fa9fc99c1 100644 --- a/libs/wire-api/src/Wire/API/Conversation/Protocol.hs +++ b/libs/wire-api/src/Wire/API/Conversation/Protocol.hs @@ -36,11 +36,13 @@ import Control.Arrow import Control.Lens (makePrisms, (?~)) import Data.Aeson (FromJSON (..), ToJSON (..)) import Data.Schema +import Data.Time.Clock import Imports import Wire.API.Conversation.Action.Tag import Wire.API.MLS.CipherSuite import Wire.API.MLS.Epoch import Wire.API.MLS.Group +import Wire.API.MLS.SubConversation import Wire.Arbitrary data ProtocolTag = ProtocolProteusTag | ProtocolMLSTag @@ -52,6 +54,8 @@ data ConversationMLSData = ConversationMLSData cnvmlsGroupId :: GroupId, -- | The current epoch number of the corresponding MLS group. cnvmlsEpoch :: Epoch, + -- | The time stamp of the epoch. + cnvmlsEpochTimestamp :: Maybe UTCTime, -- | The cipher suite to be used in the MLS group. cnvmlsCipherSuite :: CipherSuiteTag } @@ -126,6 +130,11 @@ mlsDataSchema = "epoch" (description ?~ "The epoch number of the corresponding MLS group") schema + <*> cnvmlsEpochTimestamp + .= fieldWithDocModifier + "epoch_timestamp" + (description ?~ "The timestamp of the epoch number") + schemaEpochTimestamp <*> cnvmlsCipherSuite .= fieldWithDocModifier "cipher_suite" diff --git a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs index 7b4288707d..00d616e33d 100644 --- a/libs/wire-api/src/Wire/API/MLS/SubConversation.hs +++ b/libs/wire-api/src/Wire/API/MLS/SubConversation.hs @@ -29,10 +29,12 @@ import qualified Data.Aeson as A import Data.ByteArray import Data.ByteString.Conversion import Data.Id +import Data.Json.Util import Data.Qualified import Data.Schema import qualified Data.Swagger as S import qualified Data.Text as T +import Data.Time.Clock import Imports import Servant (FromHttpApiData (..), ToHttpApiData (toQueryParam)) import Test.QuickCheck @@ -77,6 +79,9 @@ data PublicSubConversation = PublicSubConversation pscSubConvId :: SubConvId, pscGroupId :: GroupId, pscEpoch :: Epoch, + -- | It is 'Nothing' when the epoch is 0, and otherwise a timestamp when the + -- epoch was bumped, i.e., it is a timestamp of the most recent commit. + pscEpochTimestamp :: Maybe UTCTime, pscCipherSuite :: CipherSuiteTag, pscMembers :: [ClientIdentity] } @@ -87,15 +92,20 @@ instance ToSchema PublicSubConversation where schema = objectWithDocModifier "PublicSubConversation" - (description ?~ "A MLS subconversation") + (description ?~ "An MLS subconversation") $ PublicSubConversation <$> pscParentConvId .= field "parent_qualified_id" schema <*> pscSubConvId .= field "subconv_id" schema <*> pscGroupId .= field "group_id" schema <*> pscEpoch .= field "epoch" schema + <*> pscEpochTimestamp .= field "epoch_timestamp" schemaEpochTimestamp <*> pscCipherSuite .= field "cipher_suite" schema <*> pscMembers .= field "members" (array schema) +schemaEpochTimestamp :: ValueSchema NamedSwaggerDoc (Maybe UTCTime) +schemaEpochTimestamp = + named "Epoch Timestamp" . nullable . unnamed $ utcTimeSchema + data ConvOrSubTag = ConvTag | SubConvTag deriving (Eq, Enum, Bounded) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationsResponse.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationsResponse.hs index c5d39f191a..0e32a61ca4 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationsResponse.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/ConversationsResponse.hs @@ -25,6 +25,8 @@ import Data.Id (Id (Id)) import Data.Misc import Data.Qualified import qualified Data.Set as Set +import Data.Time.Calendar +import Data.Time.Clock import qualified Data.UUID as UUID import Imports import Wire.API.Conversation @@ -128,5 +130,15 @@ conv2 = }, cmOthers = [] }, - cnvProtocol = ProtocolMLS (ConversationMLSData (GroupId "test_group") (Epoch 42) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519) + cnvProtocol = + ProtocolMLS + ( ConversationMLSData + (GroupId "test_group") + (Epoch 42) + (Just timestamp) + MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 + ) } + where + timestamp :: UTCTime + timestamp = UTCTime (fromGregorian 2023 1 17) (secondsToDiffTime 42) diff --git a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/SubConversation.hs b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/SubConversation.hs index 640dde1c77..b2af34d183 100644 --- a/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/SubConversation.hs +++ b/libs/wire-api/test/golden/Test/Wire/API/Golden/Manual/SubConversation.hs @@ -24,6 +24,8 @@ where import Data.Domain import Data.Id import Data.Qualified +import Data.Time.Calendar +import Data.Time.Clock import qualified Data.UUID as UUID import Imports import Wire.API.MLS.CipherSuite @@ -55,8 +57,14 @@ testObject_PublicSubConversation_1 = subConvId1 (GroupId "test_group") (Epoch 5) + (Just (UTCTime day fromMidnight)) MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 [] + where + fromMidnight :: DiffTime + fromMidnight = 42 + day :: Day + day = fromGregorian 2023 1 17 testObject_PublicSubConversation_2 :: PublicSubConversation testObject_PublicSubConversation_2 = @@ -65,6 +73,7 @@ testObject_PublicSubConversation_2 = subConvId2 (GroupId "test_group_2") (Epoch 0) + Nothing MLS_128_DHKEMX25519_AES128GCM_SHA256_Ed25519 [mkClientIdentity user cid] where diff --git a/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json b/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json index 3bba990476..1156816764 100644 --- a/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationsResponse_1.json @@ -72,6 +72,7 @@ "cipher_suite": 1, "creator": "00000000-0000-0000-0000-000200000001", "epoch": 42, + "epoch_timestamp": "2023-01-17T00:00:42Z", "group_id": "dGVzdF9ncm91cA==", "id": "00000000-0000-0000-0000-000000000002", "last_event": "0.0", diff --git a/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json b/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json index 0bba3b7e15..cf0cc2893b 100644 --- a/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json +++ b/libs/wire-api/test/golden/testObject_ConversationsResponse_v2_1.json @@ -74,6 +74,7 @@ "cipher_suite": 1, "creator": "00000000-0000-0000-0000-000200000001", "epoch": 42, + "epoch_timestamp": "2023-01-17T00:00:42Z", "group_id": "dGVzdF9ncm91cA==", "id": "00000000-0000-0000-0000-000000000002", "last_event": "0.0", diff --git a/libs/wire-api/test/golden/testObject_PublicSubConversation_1.json b/libs/wire-api/test/golden/testObject_PublicSubConversation_1.json index d81e3853f4..05ce835507 100644 --- a/libs/wire-api/test/golden/testObject_PublicSubConversation_1.json +++ b/libs/wire-api/test/golden/testObject_PublicSubConversation_1.json @@ -1,6 +1,7 @@ { "cipher_suite": 1, "epoch": 5, + "epoch_timestamp": "2023-01-17T00:00:42Z", "group_id": "dGVzdF9ncm91cA==", "members": [], "parent_qualified_id": { diff --git a/libs/wire-api/test/golden/testObject_PublicSubConversation_2.json b/libs/wire-api/test/golden/testObject_PublicSubConversation_2.json index ac57e7e8e1..a918c3161b 100644 --- a/libs/wire-api/test/golden/testObject_PublicSubConversation_2.json +++ b/libs/wire-api/test/golden/testObject_PublicSubConversation_2.json @@ -1,6 +1,7 @@ { "cipher_suite": 1, "epoch": 0, + "epoch_timestamp": null, "group_id": "dGVzdF9ncm91cF8y", "members": [ { diff --git a/services/brig/src/Brig/User/Search/Index.hs b/services/brig/src/Brig/User/Search/Index.hs index 8dfc420437..bd460bee31 100644 --- a/services/brig/src/Brig/User/Search/Index.hs +++ b/services/brig/src/Brig/User/Search/Index.hs @@ -62,6 +62,7 @@ import Brig.Types.Intra import Brig.Types.Search (SearchVisibilityInbound, defaultSearchVisibilityInbound, searchVisibilityInboundFromFeatureStatus) import Brig.User.Search.Index.Types as Types import qualified Cassandra as C +import Cassandra.Util import Control.Lens hiding ((#), (.=)) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow, throwM, try) import Control.Monad.Except @@ -73,7 +74,6 @@ import Data.ByteString.Builder (Builder, toLazyByteString) import Data.ByteString.Conversion (toByteString') import qualified Data.ByteString.Conversion as Bytes import qualified Data.ByteString.Lazy as BL -import Data.Fixed (Fixed (MkFixed)) import Data.Handle (Handle) import Data.Id import qualified Data.Map as Map @@ -85,8 +85,6 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Data.Text.Lazy as LT import Data.Text.Lazy.Builder.Int (decimal) import Data.Text.Lens hiding (text) -import Data.Time (UTCTime, secondsToNominalDiffTime) -import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import qualified Data.UUID as UUID import qualified Database.Bloodhound as ES import Imports hiding (log, searchable) @@ -775,12 +773,6 @@ scanForIndex num = do type Activated = Bool -type Writetime a = Int64 - --- Note: Writetime is in microseconds (e-6) https://docs.datastax.com/en/dse/5.1/cql/cql/cql_using/useWritetime.html -writeTimeToUTC :: Writetime a -> UTCTime -writeTimeToUTC = posixSecondsToUTCTime . secondsToNominalDiffTime . MkFixed . (* 1_000_000) . fromIntegral @Int64 @Integer - type ReindexRow = ( UserId, Maybe TeamId, @@ -837,7 +829,20 @@ reindexRowToIndexUser ) searchVisInbound = do - iu <- mkIndexUser u <$> version [Just tName, tStatus, tHandle, tEmail, Just tColour, Just tActivated, tService, tManagedBy, tSsoId, tEmailUnvalidated] + iu <- + mkIndexUser u + <$> version + [ Just (v tName), + v <$> tStatus, + v <$> tHandle, + v <$> tEmail, + Just (v tColour), + Just (v tActivated), + v <$> tService, + v <$> tManagedBy, + v <$> tSsoId, + v <$> tEmailUnvalidated + ] pure $ if shouldIndex then @@ -850,7 +855,7 @@ reindexRowToIndexUser . set iuAccountStatus status . set iuSAMLIdP (idpUrl =<< ssoId) . set iuManagedBy managedBy - . set iuCreatedAt (Just (writeTimeToUTC tActivated)) + . set iuCreatedAt (Just (writetimeToUTC tActivated)) . set iuSearchVisibilityInbound (Just searchVisInbound) . set iuScimExternalId (join $ User.scimExternalId <$> managedBy <*> ssoId) . set iuSso (sso =<< ssoId) @@ -861,8 +866,12 @@ reindexRowToIndexUser -- It's mostly empty, but having the status here might be useful in the future. & set iuAccountStatus status where - version :: [Maybe (Writetime Name)] -> m IndexVersion + v :: Writetime a -> Int64 + v = writetimeToInt64 + + version :: [Maybe Int64] -> m IndexVersion version = mkIndexVersion . getMax . mconcat . fmap Max . catMaybes + shouldIndex = ( case status of Nothing -> True diff --git a/services/brig/test/integration/API/Internal.hs b/services/brig/test/integration/API/Internal.hs index c8bc85804b..261f50981f 100644 --- a/services/brig/test/integration/API/Internal.hs +++ b/services/brig/test/integration/API/Internal.hs @@ -14,6 +14,7 @@ -- -- You should have received a copy of the GNU Affero General Public License along -- with this program. If not, see . +{-# LANGUAGE NumericUnderscores #-} module API.Internal ( tests, @@ -28,7 +29,9 @@ import Bilge.Assert import Brig.Data.User (lookupFeatureConferenceCalling, lookupStatus, userExists) import qualified Brig.Options as Opt import Brig.Types.Intra +import qualified Cassandra as C import qualified Cassandra as Cass +import Cassandra.Util import Control.Exception (ErrorCall (ErrorCall), throwIO) import Control.Lens ((^.), (^?!)) import Control.Monad.Catch @@ -77,7 +80,8 @@ tests opts mgr db brig brigep gundeck galley = do test mgr "get,get" $ testKpcGetGet brig, test mgr "put,put" $ testKpcPutPut brig, test mgr "add key package ref" $ testAddKeyPackageRef brig - ] + ], + test mgr "writetimeToInt64" $ testWritetimeRepresentation opts mgr db brig brigep galley ] testSuspendUser :: forall m. TestConstraints m => Cass.ClientState -> Brig -> m () @@ -370,3 +374,20 @@ getFeatureConfig galley uid = do getAllFeatureConfigs :: (MonadIO m, MonadHttp m, HasCallStack) => (Request -> Request) -> UserId -> m ResponseLBS getAllFeatureConfigs galley uid = do get $ galley . paths ["feature-configs"] . zUser uid + +testWritetimeRepresentation :: forall m. TestConstraints m => Opt.Opts -> Manager -> Cass.ClientState -> Brig -> Endpoint -> Galley -> m () +testWritetimeRepresentation _ _mgr db brig _brigep _galley = do + quid <- userQualifiedId <$> randomUser brig + let uid = qUnqualified quid + + ref <- fromJust <$> (runIdentity <$$> Cass.runClient db (C.query1 q1 (C.params C.LocalQuorum (Identity uid)))) + + wt <- fromJust <$> (runIdentity <$$> Cass.runClient db (C.query1 q2 (C.params C.LocalQuorum (Identity uid)))) + + liftIO $ assertEqual "ts representaiton do not match" ref (writetimeToInt64 wt) + where + q1 :: C.PrepQuery C.R (Identity UserId) (Identity Int64) + q1 = "SELECT WRITETIME(status) from user where id = ?" + + q2 :: C.PrepQuery C.R (Identity UserId) (Identity (Writetime ())) + q2 = "SELECT WRITETIME(status) from user where id = ?" diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/services/galley/src/Galley/API/MLS/Message.hs index 9b80af005d..f8c7ab52ad 100644 --- a/services/galley/src/Galley/API/MLS/Message.hs +++ b/services/galley/src/Galley/API/MLS/Message.hs @@ -1553,6 +1553,8 @@ fetchConvOrSub qusr convOrSubId = for convOrSubId $ \case incrementEpoch :: Members '[ ConversationStore, + ErrorS 'ConvNotFound, + MemberStore, SubConversationStore ] r => @@ -1561,9 +1563,11 @@ incrementEpoch :: incrementEpoch (Conv c) = do let epoch' = succ (cnvmlsEpoch (mcMLSData c)) setConversationEpoch (mcId c) epoch' - pure $ Conv c {mcMLSData = (mcMLSData c) {cnvmlsEpoch = epoch'}} + conv <- getConversation (mcId c) >>= noteS @'ConvNotFound + fmap Conv (mkMLSConversation conv >>= noteS @'ConvNotFound) incrementEpoch (SubConv c s) = do let epoch' = succ (cnvmlsEpoch (scMLSData s)) setSubConversationEpoch (scParentConvId s) (scSubConvId s) epoch' - let s' = s {scMLSData = (scMLSData s) {cnvmlsEpoch = epoch'}} - pure (SubConv c s') + subconv <- + getSubConversation (mcId c) (scSubConvId s) >>= noteS @'ConvNotFound + pure (SubConv c subconv) diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/services/galley/src/Galley/API/MLS/SubConversation.hs index 13039388e7..9f9617f35f 100644 --- a/services/galley/src/Galley/API/MLS/SubConversation.hs +++ b/services/galley/src/Galley/API/MLS/SubConversation.hs @@ -128,6 +128,7 @@ getLocalSubConversation qusr lconv sconv = do ConversationMLSData { cnvmlsGroupId = groupId, cnvmlsEpoch = epoch, + cnvmlsEpochTimestamp = Nothing, cnvmlsCipherSuite = suite }, scMembers = mkClientMap [] diff --git a/services/galley/src/Galley/API/MLS/Types.hs b/services/galley/src/Galley/API/MLS/Types.hs index ec2643884e..d1feefdd3b 100644 --- a/services/galley/src/Galley/API/MLS/Types.hs +++ b/services/galley/src/Galley/API/MLS/Types.hs @@ -85,6 +85,7 @@ toPublicSubConv (Qualified (SubConversation {..}) domain) = pscSubConvId = scSubConvId, pscGroupId = cnvmlsGroupId scMLSData, pscEpoch = cnvmlsEpoch scMLSData, + pscEpochTimestamp = cnvmlsEpochTimestamp scMLSData, pscCipherSuite = cnvmlsCipherSuite scMLSData, pscMembers = members } diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs index a6ce01494d..60089042f7 100644 --- a/services/galley/src/Galley/Cassandra/Conversation.hs +++ b/services/galley/src/Galley/Cassandra/Conversation.hs @@ -24,6 +24,7 @@ where import Cassandra hiding (Set) import qualified Cassandra as Cql +import Cassandra.Util import Control.Error.Util import Control.Monad.Trans.Maybe import Data.ByteString.Conversion @@ -34,6 +35,7 @@ import Data.Misc import Data.Qualified import Data.Range import qualified Data.Set as Set +import Data.Time.Clock import Data.UUID.V4 (nextRandom) import Galley.Cassandra.Access import Galley.Cassandra.Conversation.MLS @@ -84,6 +86,7 @@ createMLSSelfConversation lusr = do ConversationMLSData { cnvmlsGroupId = gid, cnvmlsEpoch = Epoch 0, + cnvmlsEpochTimestamp = Nothing, cnvmlsCipherSuite = cs } retry x5 . batch $ do @@ -129,6 +132,7 @@ createConversation lcnv nc = do ConversationMLSData { cnvmlsGroupId = gid, cnvmlsEpoch = ep, + cnvmlsEpochTimestamp = Nothing, cnvmlsCipherSuite = cs }, Just gid, @@ -189,7 +193,7 @@ conversationMeta conv = (toConvMeta =<<) <$> retry x1 (query1 Cql.selectConv (params LocalQuorum (Identity conv))) where - toConvMeta (t, mc, a, r, r', n, i, _, mt, rm, _, _, _, _) = do + toConvMeta (t, mc, a, r, r', n, i, _, mt, rm, _, _, _, _, _) = do c <- mc let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> r' accessRoles = maybeRole t $ parseAccessRoles r mbAccessRolesV2 @@ -249,9 +253,20 @@ getConversation conv = do toConv conv <$> members conv <*> UnliftIO.wait remoteMems - <*> UnliftIO.wait cdata + <*> UnliftIO.wait (convUTCTime <$$> cdata) runMaybeT $ conversationGC =<< maybe mzero pure mbConv +-- | The 'Cql.selectConv' query returns a @Maybe (Writetime Epoch)@ value, yet a +-- @Maybe UTCTime@ value is needed. This function does the conversion, leaving +-- all the other columns intact. +convUTCTime :: + forall k1 (f1 :: * -> *) a1 b c d e f2 g h i j k2 l m (a2 :: k1) o. + Functor f1 => + (a1, b, c, d, e, f2, g, h, i, j, k2, l, m, f1 (Writetime a2), o) -> + (a1, b, c, d, e, f2, g, h, i, j, k2, l, m, f1 UTCTime, o) +convUTCTime (t, u, a, arl, ar, text, tid, b, mil, rm, p, gid, e, wt, cs) = + (t, u, a, arl, ar, text, tid, b, mil, rm, p, gid, e, writetimeToUTC <$> wt, cs) + -- | "Garbage collect" a 'Conversation', i.e. if the conversation is -- marked as deleted, actually remove it from the database and return -- 'Nothing'. @@ -272,7 +287,11 @@ localConversation cid = toConv cid <$> UnliftIO.Concurrently (members cid) <*> UnliftIO.Concurrently (lookupRemoteMembers cid) - <*> UnliftIO.Concurrently (retry x1 $ query1 Cql.selectConv (params LocalQuorum (Identity cid))) + <*> UnliftIO.Concurrently + ( fmap convUTCTime + <$$> retry x1 + $ query1 Cql.selectConv (params LocalQuorum (Identity cid)) + ) localConversations :: Members '[Embed IO, Input ClientState, TinyLog] r => @@ -322,31 +341,54 @@ toProtocol :: Maybe ProtocolTag -> Maybe GroupId -> Maybe Epoch -> + Maybe UTCTime -> Maybe CipherSuiteTag -> Maybe Protocol -toProtocol Nothing _ _ _ = Just ProtocolProteus -toProtocol (Just ProtocolProteusTag) _ _ _ = Just ProtocolProteus -toProtocol (Just ProtocolMLSTag) mgid mepoch mcs = +toProtocol Nothing _ _ _ _ = Just ProtocolProteus +toProtocol (Just ProtocolProteusTag) _ _ _ _ = Just ProtocolProteus +toProtocol (Just ProtocolMLSTag) mgid mepoch mtimestamp mcs = ProtocolMLS <$> ( ConversationMLSData <$> mgid -- If there is no epoch in the database, assume the epoch is 0 <*> (mepoch <|> Just (Epoch 0)) + <*> pure (mepoch `toTimestamp` mtimestamp) <*> mcs ) + where + toTimestamp :: Maybe Epoch -> Maybe UTCTime -> Maybe UTCTime + toTimestamp Nothing _ = Nothing + toTimestamp (Just (Epoch 0)) _ = Nothing + toTimestamp (Just _) ts = ts toConv :: ConvId -> [LocalMember] -> [RemoteMember] -> - Maybe (ConvType, Maybe UserId, Maybe (Cql.Set Access), Maybe AccessRoleLegacy, Maybe (Cql.Set AccessRole), Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode, Maybe ProtocolTag, Maybe GroupId, Maybe Epoch, Maybe CipherSuiteTag) -> + Maybe + ( ConvType, + Maybe UserId, + Maybe (Cql.Set Access), + Maybe AccessRoleLegacy, + Maybe (Cql.Set AccessRole), + Maybe Text, + Maybe TeamId, + Maybe Bool, + Maybe Milliseconds, + Maybe ReceiptMode, + Maybe ProtocolTag, + Maybe GroupId, + Maybe Epoch, + Maybe UTCTime, + Maybe CipherSuiteTag + ) -> Maybe Conversation toConv cid ms remoteMems mconv = do - (cty, muid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mcs) <- mconv + (cty, muid, acc, role, roleV2, nme, ti, del, timer, rm, ptag, mgid, mep, mts, mcs) <- mconv uid <- muid let mbAccessRolesV2 = Set.fromList . Cql.fromSet <$> roleV2 accessRoles = maybeRole cty $ parseAccessRoles role mbAccessRolesV2 - proto <- toProtocol ptag mgid mep mcs + proto <- toProtocol ptag mgid mep mts mcs pure Conversation { convId = cid, diff --git a/services/galley/src/Galley/Cassandra/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs index 2ee25de823..78771cefd5 100644 --- a/services/galley/src/Galley/Cassandra/Queries.hs +++ b/services/galley/src/Galley/Cassandra/Queries.hs @@ -216,9 +216,10 @@ selectConv :: Maybe ProtocolTag, Maybe GroupId, Maybe Epoch, + Maybe (Writetime Epoch), Maybe CipherSuiteTag ) -selectConv = "select type, creator, access, access_role, access_roles_v2, name, team, deleted, message_timer, receipt_mode, protocol, group_id, epoch, cipher_suite from conversation where conv = ?" +selectConv = "select type, creator, access, access_role, access_roles_v2, name, team, deleted, message_timer, receipt_mode, protocol, group_id, epoch, WRITETIME(epoch), cipher_suite from conversation where conv = ?" selectReceiptMode :: PrepQuery R (Identity ConvId) (Identity (Maybe ReceiptMode)) selectReceiptMode = "select receipt_mode from conversation where conv = ?" @@ -322,8 +323,8 @@ lookupGroupId = "SELECT conv_id, domain, subconv_id from group_id_conv_id where -- MLS SubConversations ----------------------------------------------------- -selectSubConversation :: PrepQuery R (ConvId, SubConvId) (CipherSuiteTag, Epoch, GroupId) -selectSubConversation = "SELECT cipher_suite, epoch, group_id FROM subconversation WHERE conv_id = ? and subconv_id = ?" +selectSubConversation :: PrepQuery R (ConvId, SubConvId) (CipherSuiteTag, Epoch, Writetime Epoch, GroupId) +selectSubConversation = "SELECT cipher_suite, epoch, WRITETIME(epoch), group_id FROM subconversation WHERE conv_id = ? and subconv_id = ?" insertSubConversation :: PrepQuery W (ConvId, SubConvId, CipherSuiteTag, Epoch, GroupId, Maybe OpaquePublicGroupState) () insertSubConversation = "INSERT INTO subconversation (conv_id, subconv_id, cipher_suite, epoch, group_id, public_group_state) VALUES (?, ?, ?, ?, ?, ?)" diff --git a/services/galley/src/Galley/Cassandra/SubConversation.hs b/services/galley/src/Galley/Cassandra/SubConversation.hs index efa3ab4132..f1cb57ed45 100644 --- a/services/galley/src/Galley/Cassandra/SubConversation.hs +++ b/services/galley/src/Galley/Cassandra/SubConversation.hs @@ -18,8 +18,10 @@ module Galley.Cassandra.SubConversation where import Cassandra +import Cassandra.Util import Data.Id import Data.Qualified +import Data.Time.Clock import Galley.API.MLS.Types (SubConversation (..)) import Galley.Cassandra.Conversation.MLS (lookupMLSClients) import qualified Galley.Cassandra.Queries as Cql @@ -37,7 +39,7 @@ import Wire.API.MLS.SubConversation selectSubConversation :: ConvId -> SubConvId -> Client (Maybe SubConversation) selectSubConversation convId subConvId = do m <- retry x5 (query1 Cql.selectSubConversation (params LocalQuorum (convId, subConvId))) - for m $ \(suite, epoch, groupId) -> do + for m $ \(suite, epoch, timestamp, groupId) -> do cm <- lookupMLSClients groupId pure $ SubConversation @@ -47,10 +49,15 @@ selectSubConversation convId subConvId = do ConversationMLSData { cnvmlsGroupId = groupId, cnvmlsEpoch = epoch, + cnvmlsEpochTimestamp = epoch `toMaybe` timestamp, cnvmlsCipherSuite = suite }, scMembers = cm } + where + toMaybe :: Epoch -> Writetime Epoch -> Maybe UTCTime + toMaybe (Epoch 0) _ = Nothing + toMaybe _ (Writetime t) = Just t insertSubConversation :: ConvId -> SubConvId -> CipherSuiteTag -> Epoch -> GroupId -> Maybe OpaquePublicGroupState -> Client () insertSubConversation convId subConvId suite epoch groupId mPgs = @@ -81,10 +88,10 @@ interpretSubConversationStoreToCassandra :: Sem (SubConversationStore ': r) a -> Sem r a interpretSubConversationStoreToCassandra = interpret $ \case - GetSubConversation convId subConvId -> embedClient (selectSubConversation convId subConvId) CreateSubConversation convId subConvId suite epoch groupId mPgs -> embedClient (insertSubConversation convId subConvId suite epoch groupId mPgs) - SetSubConversationPublicGroupState convId subConvId mPgs -> embedClient (updateSubConvPublicGroupState convId subConvId mPgs) + GetSubConversation convId subConvId -> embedClient (selectSubConversation convId subConvId) GetSubConversationPublicGroupState convId subConvId -> embedClient (selectSubConvPublicGroupState convId subConvId) + SetSubConversationPublicGroupState convId subConvId mPgs -> embedClient (updateSubConvPublicGroupState convId subConvId mPgs) SetGroupIdForSubConversation gId cid sconv -> embedClient $ setGroupIdForSubConversation gId cid sconv SetSubConversationEpoch cid sconv epoch -> embedClient $ setEpochForSubConversation cid sconv epoch DeleteGroupIdForSubConversation groupId -> embedClient $ deleteGroupId groupId diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs index 1dc85be7a7..ff03dc0062 100644 --- a/services/galley/src/Galley/Cassandra/Team.hs +++ b/services/galley/src/Galley/Cassandra/Team.hs @@ -258,7 +258,7 @@ team tid = toTeam (u, n, i, k, d, s, st, b, ss) = let t = newTeam tid u n i (fromMaybe NonBinding b) & teamIconKey .~ k & teamSplashScreen .~ fromMaybe DefaultIcon ss status = if d then PendingDelete else fromMaybe Active s - in TeamData t status (writeTimeToUTC <$> st) + in TeamData t status (writetimeToUTC <$> st) teamIdsOf :: UserId -> [TeamId] -> Client [TeamId] teamIdsOf usr tids = diff --git a/services/galley/src/Galley/Effects/ConversationStore.hs b/services/galley/src/Galley/Effects/ConversationStore.hs index f8e5336e3a..c89d58dce9 100644 --- a/services/galley/src/Galley/Effects/ConversationStore.hs +++ b/services/galley/src/Galley/Effects/ConversationStore.hs @@ -60,7 +60,7 @@ import Data.Id import Data.Misc import Data.Qualified import Data.Range -import Data.Time (NominalDiffTime) +import Data.Time.Clock import Galley.Data.Conversation import Galley.Data.Types import Galley.Types.Conversations.Members diff --git a/services/galley/src/Galley/Effects/SubConversationStore.hs b/services/galley/src/Galley/Effects/SubConversationStore.hs index 0316e5d1f4..cb6f41b05e 100644 --- a/services/galley/src/Galley/Effects/SubConversationStore.hs +++ b/services/galley/src/Galley/Effects/SubConversationStore.hs @@ -31,10 +31,10 @@ import Wire.API.MLS.PublicGroupState import Wire.API.MLS.SubConversation data SubConversationStore m a where - GetSubConversation :: ConvId -> SubConvId -> SubConversationStore m (Maybe SubConversation) CreateSubConversation :: ConvId -> SubConvId -> CipherSuiteTag -> Epoch -> GroupId -> Maybe OpaquePublicGroupState -> SubConversationStore m () - SetSubConversationPublicGroupState :: ConvId -> SubConvId -> Maybe OpaquePublicGroupState -> SubConversationStore m () + GetSubConversation :: ConvId -> SubConvId -> SubConversationStore m (Maybe SubConversation) GetSubConversationPublicGroupState :: ConvId -> SubConvId -> SubConversationStore m (Maybe OpaquePublicGroupState) + SetSubConversationPublicGroupState :: ConvId -> SubConvId -> Maybe OpaquePublicGroupState -> SubConversationStore m () SetGroupIdForSubConversation :: GroupId -> Qualified ConvId -> SubConvId -> SubConversationStore m () SetSubConversationEpoch :: ConvId -> SubConvId -> Epoch -> SubConversationStore m () DeleteGroupIdForSubConversation :: GroupId -> SubConversationStore m () diff --git a/services/galley/test/integration/API/MLS.hs b/services/galley/test/integration/API/MLS.hs index e4c4acccd4..978a6afc98 100644 --- a/services/galley/test/integration/API/MLS.hs +++ b/services/galley/test/integration/API/MLS.hs @@ -2341,10 +2341,22 @@ testCreateSubConv parentIsMLSConv = do cnvQualifiedId <$> liftTest (postConvQualified (qUnqualified alice) defNewProteusConv >>= responseJsonError) let sconv = SubConvId "conference" - liftTest $ - getSubConv (qUnqualified alice) qcnv sconv - !!! do - const (if parentIsMLSConv then 200 else 404) === statusCode + if parentIsMLSConv + then do + sub <- + liftTest $ + responseJsonError + =<< getSubConv (qUnqualified alice) qcnv sconv + >= sendAndConsumeCommitBundle + subAfter <- + liftTest $ + responseJsonError + =<< getSubConv (qUnqualified bob) qcnv subId + MLSTest PublicSubConversation createSubConv qcnv creator subId = do - sub <- - liftTest $ - responseJsonError - =<< getSubConv (ciUser creator) qcnv subId - >= sendAndConsumeCommitBundle - liftTest $ - responseJsonError - =<< getSubConv (ciUser creator) qcnv subId - time) + . Log.field "write time" (show $ writetimeToUTC <$> time) getScrolled :: (ES.MonadBH m, MonadThrow m) => ES.IndexName -> ES.MappingName -> ConduitM () [UUID] m () getScrolled index mapping = processRes =<< lift (ES.getInitialScroll index mapping esSearch) diff --git a/tools/db/inconsistencies/src/DanglingHandles.hs b/tools/db/inconsistencies/src/DanglingHandles.hs index 5a208bd868..613d6deabf 100644 --- a/tools/db/inconsistencies/src/DanglingHandles.hs +++ b/tools/db/inconsistencies/src/DanglingHandles.hs @@ -138,8 +138,9 @@ freeHandle l handle = do handleDelete = "DELETE FROM user_handle WHERE handle = ?" checkUser :: Logger -> ClientState -> Handle -> UserId -> Writetime UserId -> Bool -> IO (Maybe HandleInfo) -checkUser l brig claimedHandle userId handleClaimTime fixClaim = do +checkUser l brig claimedHandle userId handleClaimTime' fixClaim = do maybeDetails <- runClient brig $ getUserDetails userId + let handleClaimTime = Writetime . writetimeToUTC $ handleClaimTime' case maybeDetails of Nothing -> do let status = Nothing