Extra muted conversation field

libs/galley-types/src/Galley/Types.hs

@@ -46,6 +46,7 @@ module Galley.Types
     , NewConvManaged            (..)
     , NewConvUnmanaged          (..)
     , MemberUpdate              (..)
+    , MutedStatus               (..)
     , TypingStatus              (..)
     , UserClientMap             (..)
     , UserClients               (..)
@@ -66,6 +67,7 @@ import Data.Set (Set)
 import Data.Text (Text)
 import Data.Time
 import Data.Id
+import Data.Int
 import Data.Json.Util
 import Data.List1
 import Data.UUID (toASCIIBytes)
@@ -286,10 +288,16 @@ newtype Accept = Accept
 
 -- Members ------------------------------------------------------------------
 
+-- The semantics of the possible different values is entirely up to clients,
+-- the server will not interpret this value in any way.
+newtype MutedStatus = MutedStatus { fromMutedStatus :: Int32 }
+    deriving (Eq, Num, Ord, Show, FromJSON, ToJSON)
+
 data Member = Member
     { memId             :: !UserId
     , memService        :: !(Maybe ServiceRef)
-    , memOtrMuted       :: !Bool
+    , memOtrMuted       :: !Bool -- ^ DEPRECATED, remove it once enough clients use `memOtrMutedStatus`
+    , memOtrMutedStatus :: !(Maybe MutedStatus)
     , memOtrMutedRef    :: !(Maybe Text)
     , memOtrArchived    :: !Bool
     , memOtrArchivedRef :: !(Maybe Text)
@@ -305,8 +313,11 @@ data OtherMember = OtherMember
 instance Ord OtherMember where
     compare a b = compare (omId a) (omId b)
 
+-- Inbound member updates.  This is what galley expects on its endpoint.  See also
+-- 'MemberUpdateData'.
 data MemberUpdate = MemberUpdate
     { mupOtrMute       :: !(Maybe Bool)
+    , mupOtrMuteStatus :: !(Maybe MutedStatus)
     , mupOtrMuteRef    :: !(Maybe Text)
     , mupOtrArchive    :: !(Maybe Bool)
     , mupOtrArchiveRef :: !(Maybe Text)
@@ -381,8 +392,11 @@ data Connect = Connect
     , cEmail     :: !(Maybe Text)
     } deriving (Eq, Show)
 
+-- Outbound member updates.  Used for events (sent over the websocket, etc.).  See also
+-- 'MemberUpdate'.
 data MemberUpdateData = MemberUpdateData
     { misOtrMuted       :: !(Maybe Bool)
+    , misOtrMutedStatus :: !(Maybe MutedStatus)
     , misOtrMutedRef    :: !(Maybe Text)
     , misOtrArchived    :: !(Maybe Bool)
     , misOtrArchivedRef :: !(Maybe Text)
@@ -797,13 +811,15 @@ instance ToJSON ConversationRename where
 instance FromJSON MemberUpdate where
     parseJSON = withObject "member-update object" $ \m -> do
         u <- MemberUpdate <$> m .:? "otr_muted"
+                          <*> m .:? "otr_muted_status"
                           <*> m .:? "otr_muted_ref"
                           <*> m .:? "otr_archived"
                           <*> m .:? "otr_archived_ref"
                           <*> m .:? "hidden"
                           <*> m .:? "hidden_ref"
 
         unless (isJust (mupOtrMute u)
+            || isJust (mupOtrMuteStatus u)
             || isJust (mupOtrMuteRef u)
             || isJust (mupOtrArchive u)
             || isJust (mupOtrArchiveRef u)
@@ -827,6 +843,7 @@ instance ToJSON MemberUpdate where
 instance FromJSON MemberUpdateData where
     parseJSON = withObject "member-update event data" $ \m ->
         MemberUpdateData <$> m .:? "otr_muted"
+                         <*> m .:? "otr_muted_status"
                          <*> m .:? "otr_muted_ref"
                          <*> m .:? "otr_archived"
                          <*> m .:? "otr_archived_ref"
@@ -836,6 +853,7 @@ instance FromJSON MemberUpdateData where
 instance ToJSON MemberUpdateData where
     toJSON m = object
         $ "otr_muted"        .= misOtrMuted m
+        # "otr_muted_status" .= misOtrMutedStatus m
         # "otr_muted_ref"    .= misOtrMutedRef m
         # "otr_archived"     .= misOtrArchived m
         # "otr_archived_ref" .= misOtrArchivedRef m
@@ -855,6 +873,7 @@ instance ToJSON Member where
 -- ... until here
 
         , "otr_muted"        .= memOtrMuted m
+        , "otr_muted_status" .= memOtrMutedStatus m
         , "otr_muted_ref"    .= memOtrMutedRef m
         , "otr_archived"     .= memOtrArchived m
         , "otr_archived_ref" .= memOtrArchivedRef m
@@ -867,6 +886,7 @@ instance FromJSON Member where
         Member <$> o .:  "id"
                <*> o .:? "service"
                <*> o .:? "otr_muted"        .!= False
+               <*> o .:? "otr_muted_status"
                <*> o .:? "otr_muted_ref"
                <*> o .:? "otr_archived"     .!= False
                <*> o .:? "otr_archived_ref"

services/galley/galley.cabal

@@ -155,6 +155,7 @@ executable galley-schema
         V25
         V26
         V27
+        V28
 
     build-depends:
         base

services/galley/schema/src/Main.hs

@@ -16,6 +16,7 @@ import qualified V24
 import qualified V25
 import qualified V26
 import qualified V27
+import qualified V28
 
 main :: IO ()
 main = do
@@ -30,6 +31,7 @@ main = do
         , V25.migration
         , V26.migration
         , V27.migration
+        , V28.migration
         -- When adding migrations here, don't forget to update
         -- 'schemaVersion' in Galley.Data
         ]

services/galley/schema/src/V28.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+
+module V28 (migration) where
+
+import Cassandra.Schema
+import Text.RawString.QQ
+
+migration :: Migration
+migration = Migration 28 "Add (extra) otr muted status to member" $
+    schema' [r| ALTER TABLE member ADD otr_muted_status int; |]

services/galley/src/Galley/Data.hs

@@ -131,7 +131,7 @@ import qualified System.Logger.Class  as Log
 newtype ResultSet a = ResultSet { page :: Page a }
 
 schemaVersion :: Int32
-schemaVersion = 27
+schemaVersion = 28
 
 -- | Insert a conversation code
 insertCode :: MonadClient m => Code -> m ()
@@ -524,8 +524,8 @@ memberLists convs = do
         let f = (Just . maybe [mem] (mem :))
         in Map.alter f conv acc
 
-    mkMem (cnv, usr, srv, prv, st, omu, omur, oar, oarr, hid, hidr) =
-        (cnv, ) <$> toMember (usr, srv, prv, st, omu, omur, oar, oarr, hid, hidr)
+    mkMem (cnv, usr, srv, prv, st, omu, omus, omur, oar, oarr, hid, hidr) =
+        (cnv, ) <$> toMember (usr, srv, prv, st, omu, omus, omur, oar, oarr, hid, hidr)
 
 members :: MonadClient m => ConvId -> m [Member]
 members conv = join <$> memberLists [conv]
@@ -554,12 +554,15 @@ updateMember cid uid mup = do
         setConsistency Quorum
         for_ (mupOtrMute mup) $ \m ->
             addPrepQuery Cql.updateOtrMemberMuted (m, mupOtrMuteRef mup, cid, uid)
+        for_ (mupOtrMuteStatus mup) $ \ms ->
+            addPrepQuery Cql.updateOtrMemberMutedStatus (ms, mupOtrMuteRef mup, cid, uid)
         for_ (mupOtrArchive mup) $ \a ->
             addPrepQuery Cql.updateOtrMemberArchived (a, mupOtrArchiveRef mup, cid, uid)
         for_ (mupHidden mup) $ \h ->
             addPrepQuery Cql.updateMemberHidden (h, mupHiddenRef mup, cid, uid)
     return MemberUpdateData
         { misOtrMuted = mupOtrMute mup
+        , misOtrMutedStatus = mupOtrMuteStatus mup
         , misOtrMutedRef = mupOtrMuteRef mup
         , misOtrArchived = mupOtrArchive mup
         , misOtrArchivedRef = mupOtrArchiveRef mup
@@ -590,6 +593,7 @@ newMember u = Member
     { memId             = u
     , memService        = Nothing
     , memOtrMuted       = False
+    , memOtrMutedStatus = Nothing
     , memOtrMutedRef    = Nothing
     , memOtrArchived    = False
     , memOtrArchivedRef = Nothing
@@ -598,17 +602,18 @@ newMember u = Member
     }
 
 toMember :: ( UserId, Maybe ServiceId, Maybe ProviderId, Maybe Cql.MemberStatus
-            , Maybe Bool, Maybe Text -- otr muted
-            , Maybe Bool, Maybe Text -- otr archived
-            , Maybe Bool, Maybe Text -- hidden
+            , Maybe Bool, Maybe MutedStatus, Maybe Text -- otr muted
+            , Maybe Bool, Maybe Text                    -- otr archived
+            , Maybe Bool, Maybe Text                    -- hidden
             ) -> Maybe Member
-toMember (usr, srv, prv, sta, omu, omur, oar, oarr, hid, hidr) =
+toMember (usr, srv, prv, sta, omu, omus, omur, oar, oarr, hid, hidr) =
     if sta /= Just 0
         then Nothing
         else Just $ Member
             { memId             = usr
             , memService        = newServiceRef <$> srv <*> prv
             , memOtrMuted       = fromMaybe False omu
+            , memOtrMutedStatus = omus
             , memOtrMutedRef    = omur
             , memOtrArchived    = fromMaybe False oar
             , memOtrArchivedRef = oarr
@@ -624,7 +629,7 @@ updateClient add usr cls = do
     retry x5 $ write (q cls) (params Quorum (Identity usr))
 
 -- Do, at most, 16 parallel lookups of up to 128 users each
-lookupClients :: (MonadClient m, MonadBaseControl IO m, Forall (Pure m)) 
+lookupClients :: (MonadClient m, MonadBaseControl IO m, Forall (Pure m))
               => [UserId] -> m Clients
 lookupClients users = Clients.fromList . concat . concat <$>
     forM (chunksOf 2048 users) (mapConcurrently getClients . chunksOf 128)

services/galley/src/Galley/Data/Instances.hs

@@ -20,6 +20,7 @@ import Galley.Types.Teams.Intra
 import qualified Data.Set
 
 deriving instance Cql ServiceToken
+deriving instance Cql MutedStatus
 
 instance Cql ConvType where
     ctype = Tagged IntColumn

services/galley/src/Galley/Data/Queries.hs

@@ -166,11 +166,11 @@ deleteUserConv = "delete from user where user = ? and conv = ?"
 
 type MemberStatus = Int32
 
-selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text)
-selectMember = "select user, service, provider, status, otr_muted, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from member where conv = ? and user = ?"
+selectMember :: PrepQuery R (ConvId, UserId) (UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe Bool, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text)
+selectMember = "select user, service, provider, status, otr_muted, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from member where conv = ? and user = ?"
 
-selectMembers :: PrepQuery R (Identity [ConvId]) (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text)
-selectMembers = "select conv, user, service, provider, status, otr_muted, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from member where conv in ?"
+selectMembers :: PrepQuery R (Identity [ConvId]) (ConvId, UserId, Maybe ServiceId, Maybe ProviderId, Maybe MemberStatus, Maybe Bool, Maybe MutedStatus, Maybe Text, Maybe Bool, Maybe Text, Maybe Bool, Maybe Text)
+selectMembers = "select conv, user, service, provider, status, otr_muted, otr_muted_status, otr_muted_ref, otr_archived, otr_archived_ref, hidden, hidden_ref from member where conv in ?"
 
 insertMember :: PrepQuery W (ConvId, UserId, Maybe ServiceId, Maybe ProviderId) ()
 insertMember = "insert into member (conv, user, service, provider, status) values (?, ?, ?, ?, 0)"
@@ -181,6 +181,9 @@ removeMember = "delete from member where conv = ? and user = ?"
 updateOtrMemberMuted :: PrepQuery W (Bool, Maybe Text, ConvId, UserId) ()
 updateOtrMemberMuted = "update member set otr_muted = ?, otr_muted_ref = ? where conv = ? and user = ?"
 
+updateOtrMemberMutedStatus :: PrepQuery W (MutedStatus, Maybe Text, ConvId, UserId) ()
+updateOtrMemberMutedStatus = "update member set otr_muted_status = ?, otr_muted_ref = ? where conv = ? and user = ?"
+
 updateOtrMemberArchived :: PrepQuery W (Bool, Maybe Text, ConvId, UserId) ()
 updateOtrMemberArchived = "update member set otr_archived = ?, otr_archived_ref = ? where conv = ? and user = ?"
 

services/galley/src/Galley/Intra/Push.hs

@@ -170,6 +170,11 @@ push ps = do
         & Gundeck.recipientClients  .~ _recipientClients r
         & Gundeck.recipientFallback .~ not (_recipientMuted r)
 
+    -- TODO: ^ memOtrMuted/recipientMuted is now deprecated. Thus,
+    --         we should remove the usage of recipientFallback, which
+    --         is already irrelevant since gundeck _never_ send fallbacks.
+    --         Removing this logic both on galley and gundeck should be
+    --         done in a (single) separate PR.
 -----------------------------------------------------------------------------
 -- Helpers
 

services/galley/test/integration/API.hs

@@ -956,7 +956,7 @@ putConvRenameOk g b c _ = do
 
 putMemberOtrMuteOk :: Galley -> Brig -> Cannon -> TestSetup -> Http ()
 putMemberOtrMuteOk g b c _ = do
-    putMemberOk (memberUpdate { mupOtrMute = Just True, mupOtrMuteRef = Just "ref" }) g b c
+    putMemberOk (memberUpdate { mupOtrMute = Just True, mupOtrMuteStatus = Just 0, mupOtrMuteRef = Just "ref" }) g b c
     putMemberOk (memberUpdate { mupOtrMute = Just False }) g b c
 
 putMemberOtrArchiveOk :: Galley -> Brig -> Cannon -> TestSetup -> Http ()
@@ -973,6 +973,7 @@ putMemberAllOk :: Galley -> Brig -> Cannon -> TestSetup -> Http ()
 putMemberAllOk g b c _ = putMemberOk
     (memberUpdate
         { mupOtrMute = Just True
+        , mupOtrMuteStatus = Just 0
         , mupOtrMuteRef = Just "mref"
         , mupOtrArchive = Just True
         , mupOtrArchiveRef = Just "aref"
@@ -993,6 +994,7 @@ putMemberOk update g b ca = do
                   { memId = bob
                   , memService = Nothing
                   , memOtrMuted = fromMaybe False (mupOtrMute update)
+                  , memOtrMutedStatus = mupOtrMuteStatus update
                   , memOtrMutedRef = mupOtrMuteRef update
                   , memOtrArchived = fromMaybe False (mupOtrArchive update)
                   , memOtrArchivedRef = mupOtrArchiveRef update

services/galley/test/integration/API/Util.hs

@@ -737,7 +737,7 @@ encodeCiphertext :: ByteString -> Text
 encodeCiphertext = decodeUtf8 . B64.encode
 
 memberUpdate :: MemberUpdate
-memberUpdate = MemberUpdate Nothing Nothing Nothing Nothing Nothing Nothing
+memberUpdate = MemberUpdate Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 genRandom :: (Q.Arbitrary a, MonadIO m) => m a
 genRandom = liftIO . Q.generate $ Q.arbitrary

tools/api-simulations/smoketest/src/Network/Wire/Simulations/SmokeTest.hs

@@ -88,6 +88,7 @@ mainBotNet n = do
     runBotSession bill $ do
         let update = MemberUpdateData
                    { misOtrMuted       = Nothing
+                   , misOtrMutedStatus = Nothing
                    , misOtrMutedRef    = Nothing
                    , misOtrArchived    = Just True
                    , misOtrArchivedRef = Nothing