diff --git a/changelog.d/5-internal/WPB-24072 b/changelog.d/5-internal/WPB-24072
new file mode 100644
index 0000000000..61a31439bf
--- /dev/null
+++ b/changelog.d/5-internal/WPB-24072
@@ -0,0 +1 @@
+Move conversation-related operations into a unified Polysemy `ConversationSubsystem` effect across the wire-server codebase.
diff --git a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs
index 0f4afc600a..b2ae91b06e 100644
--- a/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs
+++ b/libs/wire-api-federation/src/Wire/API/Federation/API/Galley.hs
@@ -83,7 +83,7 @@ type GalleyApi =
'[From 'V2]
"get-conversations"
GetConversationsRequest
- GetConversationsResponseV2
+ GetRemoteConversationViewsResponse
:<|> FedEndpoint
"leave-conversation"
LeaveConversationRequest
@@ -236,7 +236,7 @@ instance ToSchema RemoteConversation
-- information as a 'Conversation', with the exception that conversation status
-- fields (muted\/archived\/hidden) are omitted, since they are not known by the
-- remote backend.
-data RemoteConversationV2 = RemoteConversationV2
+data RemoteConversationView = RemoteConversationView
{ -- | Id of the conversation, implicitly qualified with the domain of the
-- backend that created this value.
id :: ConvId,
@@ -245,13 +245,13 @@ data RemoteConversationV2 = RemoteConversationV2
protocol :: Protocol
}
deriving stock (Eq, Show, Generic)
- deriving (Arbitrary) via (GenericUniform RemoteConversationV2)
- deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConversationV2)
+ deriving (Arbitrary) via (GenericUniform RemoteConversationView)
+ deriving (FromJSON, ToJSON) via (CustomEncoded RemoteConversationView)
-instance ToSchema RemoteConversationV2
+instance ToSchema RemoteConversationView
-remoteConversationFromV2 :: RemoteConversationV2 -> RemoteConversation
-remoteConversationFromV2 rc =
+remoteConversationFromView :: RemoteConversationView -> RemoteConversation
+remoteConversationFromView rc =
RemoteConversation
{ id = rc.id,
metadata = rc.metadata,
@@ -259,9 +259,9 @@ remoteConversationFromV2 rc =
protocol = ClientAPI.Versioned rc.protocol
}
-remoteConversationToV2 :: RemoteConversation -> RemoteConversationV2
-remoteConversationToV2 rc =
- RemoteConversationV2
+remoteConversationToView :: RemoteConversation -> RemoteConversationView
+remoteConversationToView rc =
+ RemoteConversationView
{ id = rc.id,
metadata = rc.metadata,
members = rc.members,
@@ -277,20 +277,20 @@ newtype GetConversationsResponse = GetConversationsResponse
instance ToSchema GetConversationsResponse
-newtype GetConversationsResponseV2 = GetConversationsResponseV2
- { convs :: [RemoteConversationV2]
+newtype GetRemoteConversationViewsResponse = GetRemoteConversationViewsResponse
+ { convs :: [RemoteConversationView]
}
deriving stock (Eq, Show, Generic)
- deriving (Arbitrary) via (GenericUniform GetConversationsResponseV2)
- deriving (ToJSON, FromJSON) via (CustomEncoded GetConversationsResponseV2)
+ deriving (Arbitrary) via (GenericUniform GetRemoteConversationViewsResponse)
+ deriving (ToJSON, FromJSON) via (CustomEncoded GetRemoteConversationViewsResponse)
-instance ToSchema GetConversationsResponseV2
+instance ToSchema GetRemoteConversationViewsResponse
-getConversationsResponseToV2 :: GetConversationsResponse -> GetConversationsResponseV2
-getConversationsResponseToV2 res = GetConversationsResponseV2 (map remoteConversationToV2 res.convs)
+getConversationsResponseToView :: GetConversationsResponse -> GetRemoteConversationViewsResponse
+getConversationsResponseToView res = GetRemoteConversationViewsResponse (map remoteConversationToView res.convs)
-getConversationsResponseFromV2 :: GetConversationsResponseV2 -> GetConversationsResponse
-getConversationsResponseFromV2 res = GetConversationsResponse (map remoteConversationFromV2 res.convs)
+getConversationsResponseFromView :: GetRemoteConversationViewsResponse -> GetConversationsResponse
+getConversationsResponseFromView res = GetConversationsResponse (map remoteConversationFromView res.convs)
data GetOne2OneConversationResponse
= GetOne2OneConversationOk RemoteConversation
@@ -321,7 +321,7 @@ data GetOne2OneConversationResponseV2
instance ToSchema GetOne2OneConversationResponseV2
data RemoteMLSOne2OneConversation = RemoteMLSOne2OneConversation
- { conversation :: RemoteConversationV2,
+ { conversation :: RemoteConversationView,
publicKeys :: MLSKeysByPurpose MLSPublicKeys
}
deriving stock (Eq, Show, Generic)
diff --git a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs
index 25cd3f9025..5e95cdd713 100644
--- a/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs
+++ b/libs/wire-api-federation/test/Test/Wire/API/Federation/Golden/GetOne2OneConversationResponse.hs
@@ -116,9 +116,9 @@ remoteConversation =
}
}
-remoteConversationV2 :: RemoteConversationV2
+remoteConversationV2 :: RemoteConversationView
remoteConversationV2 =
- RemoteConversationV2
+ RemoteConversationView
{ id = (Id (fromJust (UUID.fromString "00000001-0000-0001-0000-000200040001"))),
metadata =
ConversationMetadata
diff --git a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs
index b46992e018..a254f17048 100644
--- a/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs
+++ b/libs/wire-api/src/Wire/API/Routes/Internal/Galley.hs
@@ -20,10 +20,11 @@ module Wire.API.Routes.Internal.Galley where
import Control.Lens ((.~))
import Data.Domain
import Data.Id as Id
+import Data.LegalHold (UserLegalHoldStatus)
import Data.OpenApi (OpenApi, info, title)
import Data.Range
import GHC.TypeLits (AppendSymbol)
-import Imports hiding (head)
+import Imports
import Servant
import Servant.OpenApi
import Wire.API.Bot
@@ -52,6 +53,7 @@ import Wire.API.Routes.QualifiedCapture
import Wire.API.Routes.Version
import Wire.API.Team
import Wire.API.Team.Feature
+import Wire.API.Team.LegalHold qualified as LegalHold
import Wire.API.Team.Member
import Wire.API.Team.Member.Info
import Wire.API.Team.SearchVisibility
@@ -550,7 +552,7 @@ type IMiscAPI =
(RespondEmpty 200 "OK")
)
:<|> Named
- "test-delete-client"
+ "remove-client"
( "clients"
:> ZUser
:> Capture "cid" ClientId
@@ -622,6 +624,21 @@ type IMiscAPI =
:> Capture "domain" Domain
:> MultiVerb1 'DELETE '[JSON] (RespondEmpty 200 "OK")
)
+ :<|> Named
+ "get-user-lh-status"
+ ( "users"
+ :> Capture "uid" UserId
+ :> "lh-status"
+ :> QueryParam "team_id" TeamId
+ :> Get '[JSON] UserLegalHoldStatus
+ )
+ :<|> Named
+ "get-users-lh-status"
+ ( "users"
+ :> "lh-status"
+ :> ReqBody '[JSON] UserIds
+ :> Post '[JSON] [LegalHold.UserLegalHoldStatusEntry]
+ )
type IEJPDAPI =
Named
diff --git a/libs/wire-api/src/Wire/API/Team/FeatureFlags.hs b/libs/wire-api/src/Wire/API/Team/FeatureFlags.hs
index 7915eb9a12..638da67240 100644
--- a/libs/wire-api/src/Wire/API/Team/FeatureFlags.hs
+++ b/libs/wire-api/src/Wire/API/Team/FeatureFlags.hs
@@ -25,6 +25,8 @@ module Wire.API.Team.FeatureFlags
FeatureFlags,
FanoutLimit,
featureDefaults,
+ defaultFanoutLimit,
+ currentFanoutLimit,
notTeamMember,
findTeamMember,
isTeamMember,
@@ -42,7 +44,7 @@ import Data.ByteString.UTF8 qualified as UTF8
import Data.Default
import Data.Id (UserId)
import Data.OpenApi qualified as S
-import Data.Range (Range)
+import Data.Range (Range, fromRange, toRange, unsafeRange)
import Data.SOP
import Data.Schema
import Data.Set qualified as Set
@@ -53,6 +55,15 @@ import Wire.API.Team.Permission
type FanoutLimit = Range 1 HardTruncationLimit Int32
+defaultFanoutLimit :: FanoutLimit
+defaultFanoutLimit = toRange (Proxy @HardTruncationLimit)
+
+currentFanoutLimit :: Word32 -> Maybe FanoutLimit -> FanoutLimit
+currentFanoutLimit maxTeamSize maxFanoutSize =
+ let optFanoutLimit = fromIntegral . fromRange $ fromMaybe defaultFanoutLimit maxFanoutSize
+ maxSize = fromIntegral maxTeamSize
+ in unsafeRange (min maxSize optFanoutLimit)
+
-- | Used to extract the feature config type out of 'FeatureDefaults' or
-- related types.
type family ConfigOf a
diff --git a/libs/wire-api/src/Wire/API/Team/LegalHold.hs b/libs/wire-api/src/Wire/API/Team/LegalHold.hs
index a7c65addd2..492229be23 100644
--- a/libs/wire-api/src/Wire/API/Team/LegalHold.hs
+++ b/libs/wire-api/src/Wire/API/Team/LegalHold.hs
@@ -22,6 +22,7 @@ module Wire.API.Team.LegalHold
ViewLegalHoldService (..),
ViewLegalHoldServiceInfo (..),
UserLegalHoldStatusResponse (..),
+ UserLegalHoldStatusEntry (..),
RemoveLegalHoldSettingsRequest (..),
DisableLegalHoldForUserRequest (..),
ApproveLegalHoldForUserRequest (..),
@@ -162,6 +163,24 @@ instance ToSchema UserLegalHoldStatusResponse where
<*> ulhsrLastPrekey .= maybe_ (optField "last_prekey" schema)
<*> (fmap IdObject . ulhsrClientId) .= maybe_ (optField "client" (fromIdObject <$> schema))
+--------------------------------------------------------------------------------
+-- UserLegalHoldStatusEntry
+
+data UserLegalHoldStatusEntry = UserLegalHoldStatusEntry
+ { ulhseUser :: UserId,
+ ulhseStatus :: UserLegalHoldStatus
+ }
+ deriving stock (Eq, Show, Generic)
+ deriving (Arbitrary) via (GenericUniform UserLegalHoldStatusEntry)
+ deriving (ToJSON, FromJSON, S.ToSchema) via (Schema UserLegalHoldStatusEntry)
+
+instance ToSchema UserLegalHoldStatusEntry where
+ schema =
+ object $
+ UserLegalHoldStatusEntry
+ <$> ulhseUser .= field "user" schema
+ <*> ulhseStatus .= field "status" schema
+
--------------------------------------------------------------------------------
-- RemoveLegalHoldSettingsRequest
diff --git a/libs/wire-subsystems/default.nix b/libs/wire-subsystems/default.nix
index e62655cecc..88cd2d1e2e 100644
--- a/libs/wire-subsystems/default.nix
+++ b/libs/wire-subsystems/default.nix
@@ -25,6 +25,7 @@
, bytestring-conversion
, case-insensitive
, cassandra-util
+, comonad
, conduit
, constraints
, containers
@@ -69,6 +70,7 @@
, imports
, iproute
, iso639
+, kan-extensions
, lens
, lens-aeson
, lib
@@ -164,6 +166,7 @@ mkDerivation {
bytestring-conversion
case-insensitive
cassandra-util
+ comonad
conduit
constraints
containers
@@ -204,6 +207,7 @@ mkDerivation {
imports
iproute
iso639
+ kan-extensions
lens
lens-aeson
lrucaching
@@ -289,6 +293,7 @@ mkDerivation {
bytestring-conversion
case-insensitive
cassandra-util
+ comonad
conduit
constraints
containers
@@ -330,6 +335,7 @@ mkDerivation {
imports
iproute
iso639
+ kan-extensions
lens
lens-aeson
lrucaching
diff --git a/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs
index 7353ad6092..fc2ba75eb6 100644
--- a/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/BackgroundJobsRunner/Interpreter.hs
@@ -44,7 +44,7 @@ import Wire.API.UserGroup
import Wire.BackgroundJobsPublisher
import Wire.BackgroundJobsRunner (BackgroundJobsRunner (..))
import Wire.ConversationStore (ConversationStore, getConversation, upsertMembers)
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem hiding (getConversation)
import Wire.Sem.Random
import Wire.StoredConversation
import Wire.UserGroupStore (UserGroupStore, getUserGroup, getUserGroupChannels)
diff --git a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs
index a4e53f2b9b..1f9dabb13b 100644
--- a/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs
+++ b/libs/wire-subsystems/src/Wire/BrigAPIAccess.hs
@@ -75,6 +75,9 @@ module Wire.BrigAPIAccess
-- * Account status
setAccountStatus,
+
+ -- * Assertions
+ ensureConnectedToLocals,
)
where
@@ -92,6 +95,7 @@ import Polysemy
import Polysemy.Error
import Web.Scim.Filter qualified as Scim
import Wire.API.Connection
+import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.MLS.CipherSuite
import Wire.API.Routes.Internal.Brig
@@ -198,3 +202,17 @@ getConnectionsUnqualifiedBidi uids1 uids2 mrel1 mrel2 = do
res1 <- getConnectionsUnqualified uids1 (Just uids2) mrel1
res2 <- getConnectionsUnqualified uids2 (Just uids1) mrel2
pure (res1, res2)
+
+ensureConnectedToLocals ::
+ ( Member (ErrorS 'NotConnected) r,
+ Member BrigAPIAccess r
+ ) =>
+ UserId ->
+ [UserId] ->
+ Sem r ()
+ensureConnectedToLocals _ [] = pure ()
+ensureConnectedToLocals u uids = do
+ (connsFrom, connsTo) <-
+ getConnectionsUnqualifiedBidi [u] uids (Just Accepted) (Just Accepted)
+ unless (length connsFrom == length uids && length connsTo == length uids) $
+ throwS @'NotConnected
diff --git a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs
index 6fdd631757..bc36f8de6b 100644
--- a/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationStore/Cassandra.hs
@@ -455,7 +455,7 @@ addMembers conv (UserList lusers rusers) = do
-- User is remote, so we only add it to the member_remote_user
-- table, but the reverse mapping has to be done on the remote
-- backend; so we assume an additional call to their backend has
- -- been (or will be) made separately. See Galley.API.Update.addMembers
+ -- been (or will be) made separately. See Wire.ConversationSubsystem.Update.addMembers
addPrepQuery Cql.insertRemoteMember (conv, domain, uid, role)
pure (map newMemberWithRole lusers, map newRemoteMemberWithRole rusers)
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs
index 3a4593cf22..44605b6446 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem.hs
@@ -17,18 +17,64 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Wire.ConversationSubsystem where
+module Wire.ConversationSubsystem
+ ( module Wire.ConversationSubsystem,
+ Util.BotsAndMembers (..),
+ Util.canDeleteMember,
+ Util.isMember,
+ Util.userLHEnabled,
+ MLSRemoval.RemoveUserIncludeMain (..),
+ LegalholdConflicts.guardLegalholdPolicyConflicts,
+ )
+where
+import Data.Code qualified as Code
+import Data.CommaSeparatedList (CommaSeparatedList)
+import Data.Domain
import Data.Id
+import Data.Misc (IpAddr)
import Data.Qualified
-import Data.Range (Range)
+import Data.Range
import Data.Singletons (Sing)
-import Galley.Types.Clients (Clients)
import Imports
import Polysemy
-import Wire.API.Conversation (ConvIdsPage, ConversationPagingState, ExtraConversationData, NewConv, NewOne2OneConv)
+import Wire.API.Bot (AddBot, RemoveBot)
+import Wire.API.Conversation hiding (Member)
+import Wire.API.Conversation qualified as Public
import Wire.API.Conversation.Action
+import Wire.API.Conversation.CellsState (CellsState)
+import Wire.API.Conversation.Code (ConversationCodeInfo, CreateConversationCodeRequest, JoinConversationByCode)
+import Wire.API.Conversation.Pagination (ConversationPage)
+import Wire.API.Conversation.Protocol
+import Wire.API.Conversation.Role (ConversationRolesList)
+import Wire.API.Conversation.Typing
import Wire.API.Event.Conversation
+import Wire.API.Federation.API.Common
+import Wire.API.Federation.API.Galley
+import Wire.API.MLS.CommitBundle
+import Wire.API.MLS.GroupInfo (GroupInfoData)
+import Wire.API.MLS.Keys (MLSKeys, MLSKeysByPurpose, MLSPublicKey, MLSPublicKeyFormat, SomeKey)
+import Wire.API.MLS.Message
+import Wire.API.MLS.OutOfSync (EnableOutOfSyncCheck)
+import Wire.API.MLS.Serialisation
+import Wire.API.MLS.SubConversation (ConvOrSubConvId, PublicSubConversation, SubConvId)
+import Wire.API.Message (ClientMismatch, IgnoreMissing, MessageSendingStatus, NewOtrMessage, QualifiedNewOtrMessage, ReportMissing)
+import Wire.API.Pagination (PageSize, SortOrder)
+import Wire.API.Provider.Bot qualified as Public (BotConvView)
+import Wire.API.Routes.Internal.Galley.ConversationsIntra (UpsertOne2OneConversationRequest)
+import Wire.API.Routes.Public (ZHostValue)
+import Wire.API.Routes.Public.Galley.Conversation
+import Wire.API.Routes.Public.Galley.MLS (MLSReset)
+import Wire.API.Routes.Public.Galley.Messaging (MessageNotSent, PostOtrResponse)
+import Wire.API.Routes.Public.Util (UpdateResult)
+import Wire.API.Routes.Version
+import Wire.API.ServantProto (RawProto (..))
+import Wire.API.Team.Feature (GuestLinksConfig, LockableFeature)
+import Wire.ConversationStore.MLS.Types (ListGlobalSelfConvs)
+import Wire.ConversationSubsystem.LegalholdConflicts qualified as LegalholdConflicts
+import Wire.ConversationSubsystem.MLS.IncomingMessage (IncomingBundle, IncomingMessage)
+import Wire.ConversationSubsystem.MLS.Removal qualified as MLSRemoval
+import Wire.ConversationSubsystem.Util qualified as Util
import Wire.NotificationSubsystem (LocalConversationUpdate)
import Wire.StoredConversation
@@ -45,24 +91,39 @@ data ConversationSubsystem m a where
ConversationAction (tag :: ConversationActionTag) ->
ExtraConversationData ->
ConversationSubsystem r LocalConversationUpdate
- CreateGroupConversation ::
+ InternalCreateGroupConversation ::
Local UserId ->
Maybe ConnId ->
NewConv ->
ConversationSubsystem m StoredConversation
+ CreateLegacyGroupConversation ::
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ ConversationSubsystem m (ConversationResponse Public.OwnConversation)
+ CreateGroupOwnConversation ::
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ ConversationSubsystem m CreateGroupConversationResponseV9
+ CreateGroupConversation ::
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ ConversationSubsystem m CreateGroupConversation
+ CreateProteusSelfConversation ::
+ Local UserId ->
+ ConversationSubsystem m (ConversationResponse Public.OwnConversation)
CreateOne2OneConversation ::
Local UserId ->
ConnId ->
NewOne2OneConv ->
- ConversationSubsystem m (StoredConversation, Bool)
- CreateProteusSelfConversation ::
- Local UserId ->
- ConversationSubsystem m (StoredConversation, Bool)
+ ConversationSubsystem m (ConversationResponse Public.OwnConversation)
CreateConnectConversation ::
Local UserId ->
Maybe ConnId ->
Connect ->
- ConversationSubsystem m (StoredConversation, Bool)
+ ConversationSubsystem m (ConversationResponse Public.OwnConversation)
GetConversations ::
[ConvId] ->
ConversationSubsystem m [StoredConversation]
@@ -71,10 +132,509 @@ data ConversationSubsystem m a where
Range 1 1000 Int32 ->
Maybe ConversationPagingState ->
ConversationSubsystem r ConvIdsPage
- InternalGetClientIds :: [UserId] -> ConversationSubsystem m Clients
InternalGetLocalMember ::
ConvId ->
UserId ->
ConversationSubsystem m (Maybe LocalMember)
+ InternalGetMember ::
+ Qualified ConvId ->
+ UserId ->
+ ConversationSubsystem m (Maybe Public.Member)
+ GetConversationMeta ::
+ ConvId ->
+ ConversationSubsystem m ConversationMetadata
+ GetMLSOne2OneConversationInternal ::
+ Local UserId ->
+ Qualified UserId ->
+ ConversationSubsystem m Public.OwnConversation
+ IsMLSOne2OneEstablished ::
+ Local UserId ->
+ Qualified UserId ->
+ ConversationSubsystem m Bool
+ GetLocalConversationInternal ::
+ ConvId ->
+ ConversationSubsystem m Conversation
+ RemoveClient ::
+ UserId ->
+ ClientId ->
+ ConversationSubsystem m ()
+ AddBot ::
+ Local UserId ->
+ ConnId ->
+ AddBot ->
+ ConversationSubsystem m Event
+ RmBot ::
+ Local UserId ->
+ Maybe ConnId ->
+ RemoveBot ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateCellsState ::
+ ConvId ->
+ CellsState ->
+ ConversationSubsystem m ()
+ RemoveUser ::
+ Local StoredConversation ->
+ MLSRemoval.RemoveUserIncludeMain ->
+ Qualified UserId ->
+ ConversationSubsystem m ()
+ PostMLSCommitBundle ::
+ Local x ->
+ Qualified UserId ->
+ ClientId ->
+ ConvType ->
+ Qualified ConvOrSubConvId ->
+ Maybe ConnId ->
+ EnableOutOfSyncCheck ->
+ IncomingBundle ->
+ ConversationSubsystem m [LocalConversationUpdate]
+ PostMLSCommitBundleFromLocalUser ::
+ Version ->
+ Local UserId ->
+ ClientId ->
+ ConnId ->
+ RawMLS CommitBundle ->
+ ConversationSubsystem m MLSMessageSendingStatus
+ PostMLSMessage ::
+ Local x ->
+ Qualified UserId ->
+ ClientId ->
+ ConvType ->
+ Qualified ConvOrSubConvId ->
+ Maybe ConnId ->
+ EnableOutOfSyncCheck ->
+ IncomingMessage ->
+ ConversationSubsystem m [LocalConversationUpdate]
+ PostMLSMessageFromLocalUser ::
+ Version ->
+ Local UserId ->
+ ClientId ->
+ ConnId ->
+ RawMLS Message ->
+ ConversationSubsystem m MLSMessageSendingStatus
+ IsMLSEnabled :: ConversationSubsystem m Bool
+ GetConversationsInternal ::
+ Local UserId ->
+ Maybe (Range 1 32 (CommaSeparatedList ConvId)) ->
+ Maybe ConvId ->
+ Maybe (Range 1 500 Int32) ->
+ ConversationSubsystem m (Public.ConversationList StoredConversation)
+ RemoveMemberFromLocalConv ::
+ Local ConvId ->
+ Local UserId ->
+ Maybe ConnId ->
+ Qualified UserId ->
+ ConversationSubsystem m (Maybe Event)
+ FederationOnConversationCreated ::
+ Domain ->
+ ConversationCreated ConvId ->
+ ConversationSubsystem m EmptyResponse
+ FederationGetConversations ::
+ Domain ->
+ GetConversationsRequest ->
+ ConversationSubsystem m GetRemoteConversationViewsResponse
+ FederationLeaveConversation ::
+ Domain ->
+ LeaveConversationRequest ->
+ ConversationSubsystem m LeaveConversationResponse
+ FederationSendMessage ::
+ Domain ->
+ ProteusMessageSendRequest ->
+ ConversationSubsystem m MessageSendResponse
+ FederationUpdateConversation ::
+ Domain ->
+ ConversationUpdateRequest ->
+ ConversationSubsystem m ConversationUpdateResponse
+ FederationMlsSendWelcome ::
+ Domain ->
+ MLSWelcomeRequest ->
+ ConversationSubsystem m MLSWelcomeResponse
+ FederationSendMLSMessage ::
+ Domain ->
+ MLSMessageSendRequest ->
+ ConversationSubsystem m MLSMessageResponse
+ FederationSendMLSCommitBundle ::
+ Domain ->
+ MLSMessageSendRequest ->
+ ConversationSubsystem m MLSMessageResponse
+ FederationQueryGroupInfo ::
+ Domain ->
+ GetGroupInfoRequest ->
+ ConversationSubsystem m GetGroupInfoResponse
+ FederationUpdateTypingIndicator ::
+ Domain ->
+ TypingDataUpdateRequest ->
+ ConversationSubsystem m TypingDataUpdateResponse
+ FederationOnTypingIndicatorUpdated ::
+ Domain ->
+ TypingDataUpdated ->
+ ConversationSubsystem m EmptyResponse
+ FederationGetSubConversationForRemoteUser ::
+ Domain ->
+ GetSubConversationsRequest ->
+ ConversationSubsystem m GetSubConversationsResponse
+ FederationDeleteSubConversationForRemoteUser ::
+ Domain ->
+ DeleteSubConversationFedRequest ->
+ ConversationSubsystem m DeleteSubConversationResponse
+ FederationLeaveSubConversation ::
+ Domain ->
+ LeaveSubConversationRequest ->
+ ConversationSubsystem m LeaveSubConversationResponse
+ FederationGetLegacyOne2OneConversation ::
+ Domain ->
+ GetOne2OneConversationRequest ->
+ ConversationSubsystem m GetOne2OneConversationResponse
+ FederationGetOne2OneConversation ::
+ Domain ->
+ GetOne2OneConversationRequest ->
+ ConversationSubsystem m GetOne2OneConversationResponseV2
+ FederationOnClientRemoved ::
+ Domain ->
+ ClientRemovedRequest ->
+ ConversationSubsystem m EmptyResponse
+ FederationOnMessageSent ::
+ Domain ->
+ RemoteMessage ConvId ->
+ ConversationSubsystem m EmptyResponse
+ FederationOnMLSMessageSent ::
+ Domain ->
+ RemoteMLSMessage ->
+ ConversationSubsystem m EmptyResponse
+ FederationOnConversationUpdated ::
+ Domain ->
+ ConversationUpdate ->
+ ConversationSubsystem m EmptyResponse
+ FederationOnUserDeleted ::
+ Domain ->
+ UserDeletedConversationsNotification ->
+ ConversationSubsystem m EmptyResponse
+ PostOtrMessageUnqualified ::
+ Local UserId ->
+ ConnId ->
+ ConvId ->
+ Maybe IgnoreMissing ->
+ Maybe ReportMissing ->
+ NewOtrMessage ->
+ ConversationSubsystem m (PostOtrResponse ClientMismatch)
+ PostOtrBroadcastUnqualified ::
+ Local UserId ->
+ ConnId ->
+ Maybe IgnoreMissing ->
+ Maybe ReportMissing ->
+ NewOtrMessage ->
+ ConversationSubsystem m (PostOtrResponse ClientMismatch)
+ PostProteusMessage ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ RawProto QualifiedNewOtrMessage ->
+ ConversationSubsystem m (PostOtrResponse MessageSendingStatus)
+ PostProteusBroadcast ::
+ Local UserId ->
+ ConnId ->
+ QualifiedNewOtrMessage ->
+ ConversationSubsystem m (PostOtrResponse MessageSendingStatus)
+ DeleteLocalConversation ::
+ Local UserId ->
+ ConnId ->
+ Local ConvId ->
+ ConversationSubsystem m (UpdateResult Event)
+ GetMLSPublicKeys ::
+ Maybe MLSPublicKeyFormat ->
+ ConversationSubsystem m (MLSKeysByPurpose (MLSKeys SomeKey))
+ ResetMLSConversation ::
+ Local UserId ->
+ MLSReset ->
+ ConversationSubsystem m ()
+ GetSubConversation ::
+ Local UserId ->
+ Qualified ConvId ->
+ SubConvId ->
+ ConversationSubsystem m PublicSubConversation
+ GetBotConversation ::
+ BotId ->
+ ConvId ->
+ ConversationSubsystem m Public.BotConvView
+ -- Query functions
+ GetUnqualifiedOwnConversation ::
+ Local UserId ->
+ ConvId ->
+ ConversationSubsystem m Public.OwnConversation
+ GetOwnConversation ::
+ Local UserId ->
+ Qualified ConvId ->
+ ConversationSubsystem m Public.OwnConversation
+ GetPaginatedConversations ::
+ Local UserId ->
+ Maybe (Range 1 32 (CommaSeparatedList ConvId)) ->
+ Maybe ConvId ->
+ Maybe (Range 1 500 Int32) ->
+ ConversationSubsystem m (Public.ConversationList Public.OwnConversation)
+ GetConversation ::
+ Local UserId ->
+ Qualified ConvId ->
+ ConversationSubsystem m Public.Conversation
+ InternalGetConversation ::
+ ConvId ->
+ ConversationSubsystem m (Maybe StoredConversation)
+ GetConversationRoles ::
+ Local UserId ->
+ ConvId ->
+ ConversationSubsystem m ConversationRolesList
+ SearchChannels ::
+ Local UserId ->
+ TeamId ->
+ Maybe Text ->
+ Maybe SortOrder ->
+ Maybe PageSize ->
+ Maybe Text ->
+ Maybe ConvId ->
+ Bool ->
+ ConversationSubsystem m ConversationPage
+ GetGroupInfo ::
+ Local UserId ->
+ Qualified ConvId ->
+ ConversationSubsystem m GroupInfoData
+ ConversationIdsPageFromUnqualified ::
+ Local UserId ->
+ Maybe ConvId ->
+ Maybe (Range 1 1000 Int32) ->
+ ConversationSubsystem m (ConversationList ConvId)
+ ConversationIdsPaginated ::
+ ListGlobalSelfConvs ->
+ Local UserId ->
+ Public.GetPaginatedConversationIds ->
+ ConversationSubsystem m Public.ConvIdsPage
+ ConversationIdsPageFrom ::
+ Local UserId ->
+ Public.GetPaginatedConversationIds ->
+ ConversationSubsystem m Public.ConvIdsPage
+ ListConversations ::
+ Local UserId ->
+ Public.ListConversations ->
+ ConversationSubsystem m ConversationsResponse
+ GetConversationByReusableCode ::
+ Local UserId ->
+ Code.Key ->
+ Code.Value ->
+ ConversationSubsystem m ConversationCoverView
+ GetMLSSelfConversationWithError ::
+ Local UserId ->
+ ConversationSubsystem m Public.OwnConversation
+ GetMLSOne2OneOwnConversation ::
+ Local UserId ->
+ Qualified UserId ->
+ ConversationSubsystem m Public.OwnConversation
+ GetMLSOne2OneMLSConversation ::
+ Local UserId ->
+ Qualified UserId ->
+ ConversationSubsystem m (MLSOne2OneConversation MLSPublicKey)
+ GetMLSOne2OneConversation ::
+ Local UserId ->
+ Qualified UserId ->
+ Maybe MLSPublicKeyFormat ->
+ ConversationSubsystem m (MLSOne2OneConversation SomeKey)
+ GetLocalSelf ::
+ Local UserId ->
+ ConvId ->
+ ConversationSubsystem m (Maybe Public.Member)
+ GetSelfMember ::
+ Local UserId ->
+ Qualified ConvId ->
+ ConversationSubsystem m (Maybe Public.Member)
+ GetConversationGuestLinksStatus ::
+ UserId ->
+ ConvId ->
+ ConversationSubsystem m (LockableFeature GuestLinksConfig)
+ GetCode ::
+ Maybe Text ->
+ Local UserId ->
+ ConvId ->
+ ConversationSubsystem m ConversationCodeInfo
+ -- Update functions
+
+ AddQualifiedMembersUnqualified ::
+ Local UserId ->
+ ConnId ->
+ ConvId ->
+ InviteQualified ->
+ ConversationSubsystem m (UpdateResult Event)
+ AddMembers ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ InviteQualified ->
+ ConversationSubsystem m (UpdateResult Event)
+ ReplaceMembers ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ InviteQualified ->
+ ConversationSubsystem m ()
+ JoinConversationById ::
+ Local UserId ->
+ ConnId ->
+ ConvId ->
+ ConversationSubsystem m (UpdateResult Event)
+ JoinConversationByReusableCode ::
+ Local UserId ->
+ ConnId ->
+ JoinConversationByCode ->
+ ConversationSubsystem m (UpdateResult Event)
+ CheckReusableCode ::
+ IpAddr ->
+ ConversationCode ->
+ ConversationSubsystem m ()
+ AddCodeUnqualified ::
+ Maybe CreateConversationCodeRequest ->
+ UserId ->
+ Maybe ZHostValue ->
+ Maybe ConnId ->
+ ConvId ->
+ ConversationSubsystem m AddCodeResult
+ RmCodeUnqualified ::
+ Local UserId ->
+ ConnId ->
+ ConvId ->
+ ConversationSubsystem m Event
+ MemberTyping ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ TypingStatus ->
+ ConversationSubsystem m ()
+ RemoveMemberQualified ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ Qualified UserId ->
+ ConversationSubsystem m (Maybe Event)
+ UpdateOtherMember ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ Qualified UserId ->
+ OtherMemberUpdate ->
+ ConversationSubsystem m ()
+ UpdateConversationName ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ConversationRename ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateConversationMessageTimer ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ConversationMessageTimerUpdate ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateConversationReceiptMode ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ConversationReceiptModeUpdate ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateConversationAccess ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ConversationAccessData ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateConversationHistory ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ConversationHistoryUpdate ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateSelfMember ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ MemberUpdate ->
+ ConversationSubsystem m ()
+ UpdateConversationProtocolWithLocalUser ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ ProtocolUpdate ->
+ ConversationSubsystem m (UpdateResult Event)
+ UpdateChannelAddPermission ::
+ Local UserId ->
+ ConnId ->
+ Qualified ConvId ->
+ AddPermissionUpdate ->
+ ConversationSubsystem m (UpdateResult Event)
+ PostBotMessageUnqualified ::
+ BotId ->
+ ConvId ->
+ Maybe IgnoreMissing ->
+ Maybe ReportMissing ->
+ NewOtrMessage ->
+ ConversationSubsystem m (Either (MessageNotSent ClientMismatch) ClientMismatch)
+ -- Sub-conversation functions
+ DeleteSubConversation ::
+ Local UserId ->
+ Qualified ConvId ->
+ SubConvId ->
+ MLSReset ->
+ ConversationSubsystem m ()
+ GetSubConversationGroupInfo ::
+ Local UserId ->
+ Qualified ConvId ->
+ SubConvId ->
+ ConversationSubsystem m GroupInfoData
+ LeaveSubConversation ::
+ Local UserId ->
+ ClientId ->
+ Qualified ConvId ->
+ SubConvId ->
+ ConversationSubsystem m ()
+ SendConversationActionNotifications ::
+ forall tag m.
+ Sing tag ->
+ Qualified UserId ->
+ Bool ->
+ Maybe ConnId ->
+ Local StoredConversation ->
+ Util.BotsAndMembers ->
+ ConversationAction (tag :: ConversationActionTag) ->
+ ExtraConversationData ->
+ ConversationSubsystem m LocalConversationUpdate
+ InternalUpsertOne2OneConversation ::
+ UpsertOne2OneConversationRequest ->
+ ConversationSubsystem m ()
+ AcceptConv ::
+ QualifiedWithTag QLocal UserId ->
+ Maybe ConnId ->
+ ConvId ->
+ ConversationSubsystem m OwnConversation
+ BlockConv ::
+ QualifiedWithTag QLocal UserId ->
+ Qualified ConvId ->
+ ConversationSubsystem m ()
+ UnblockConv ::
+ QualifiedWithTag QLocal UserId ->
+ Maybe ConnId ->
+ Qualified ConvId ->
+ ConversationSubsystem m ()
makeSem ''ConversationSubsystem
+
+iterateConversations ::
+ (Member ConversationSubsystem r) =>
+ Local UserId ->
+ Range 1 500 Int32 ->
+ ([StoredConversation] -> Sem r a) ->
+ Sem r [a]
+iterateConversations luid pageSize handleConvs = go Nothing
+ where
+ go mbConv = do
+ convResult <- getConversationsInternal luid Nothing mbConv (Just pageSize)
+ resultHead <- handleConvs (convList convResult)
+ resultTail <- case convList convResult of
+ (conv : rest) ->
+ if convHasMore convResult
+ then go (Just (maximum ((.id_) <$> (conv : rest))))
+ else pure []
+ _ -> pure []
+ pure $ resultHead : resultTail
diff --git a/services/galley/src/Galley/API/Action.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs
similarity index 97%
rename from services/galley/src/Galley/API/Action.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs
index 7a0816a015..3c81ed700f 100644
--- a/services/galley/src/Galley/API/Action.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Action
+module Wire.ConversationSubsystem.Action
( -- * Conversation action types
ConversationActionTag (..),
ConversationJoin (..),
@@ -73,14 +73,6 @@ import Data.Set qualified as Set
import Data.Singletons
import Data.Time.Clock
import GHC.TypeLits (KnownNat)
-import Galley.API.Action.Kick
-import Galley.API.Action.Leave
-import Galley.API.Action.Notify
-import Galley.API.Action.Reset
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.Migration
-import Galley.API.MLS.Removal
-import Galley.API.Teams.Features.Get
import Galley.Types.Error
import Imports hiding ((\\))
import Polysemy
@@ -122,7 +114,13 @@ import Wire.BrigAPIAccess qualified as E
import Wire.CodeStore
import Wire.CodeStore qualified as E
import Wire.ConversationStore qualified as E
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action.Kick
+import Wire.ConversationSubsystem.Action.Leave
+import Wire.ConversationSubsystem.Action.Notify
+import Wire.ConversationSubsystem.Action.Reset
+import Wire.ConversationSubsystem.MLS.Conversation
+import Wire.ConversationSubsystem.MLS.Migration
+import Wire.ConversationSubsystem.MLS.Removal
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.FeaturesConfigSubsystem
@@ -140,7 +138,7 @@ import Wire.StoredConversation
import Wire.StoredConversation qualified as Data
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (ConsentGiven (..), TeamSubsystem, consentGiven)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserList
import Wire.Util
@@ -189,7 +187,6 @@ instance IsConversationAction 'ConversationJoinTag where
HasConversationActionEffects 'ConversationJoinTag r =
( -- TODO: Replace with subsystems
Member BackendNotificationQueueAccess r,
- Member ConversationSubsystem r,
Member TeamCollaboratorsSubsystem r,
Member FederationSubsystem r,
Member TeamSubsystem r,
@@ -461,7 +458,6 @@ instance IsConversationAction 'ConversationAccessDataTag where
Member Random r,
Member (Error FederationError) r,
Member BackendNotificationQueueAccess r,
- Member ConversationSubsystem r,
Member TeamSubsystem r
)
@@ -694,7 +690,6 @@ instance IsConversationAction 'ConversationResetTag where
( Member BackendNotificationQueueAccess r,
Member (E.FederationAPIAccess FederatorClient) r,
Member ExternalAccess r,
- Member ConversationSubsystem r,
Member E.ConversationStore r,
Member NotificationSubsystem r,
Member ProposalStore r,
@@ -825,7 +820,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do
-- - ensure that a consented conv admin exists
-- - and kick all existing members that do not consent to LH from the conversation
-- See also: "Brig.API.Connection.checkLegalholdPolicyConflict"
- -- and "Galley.API.LegalHold.Conflicts.guardLegalholdPolicyConflictsUid".
+ -- and "Wire.ConversationSubsystem.LegalholdConflicts.guardLegalholdPolicyConflictsUid".
checkLHPolicyConflictsLocal ::
[UserId] ->
Sem r ()
@@ -843,7 +838,7 @@ performConversationJoin qusr lconv (ConversationJoin invited role joinType) = do
throwS @'MissingLegalholdConsent
convUsersLHStatus <- do
- uidsStatus <- getLHStatusForUsers ((.id_) <$> convUsers)
+ uidsStatus <- TeamSubsystem.getLHStatusForUsers ((.id_) <$> convUsers)
pure $ zipWith (\mem (_, status) -> (mem, status)) convUsers uidsStatus
if any
@@ -995,7 +990,6 @@ updateLocalConversationJoin ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationJoinTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member FederationSubsystem r,
Member TeamCollaboratorsSubsystem r,
Member TeamSubsystem r,
@@ -1034,7 +1028,6 @@ updateLocalConversationLeave ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationLeaveTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member TeamSubsystem r,
Member (Input ConversationSubsystemConfig) r,
Member ExternalAccess r,
@@ -1057,7 +1050,10 @@ updateLocalConversationMemberUpdate ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationMemberUpdateTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r,
Member (ErrorS ConvMemberNotFound) r,
Member E.ConversationStore r
@@ -1074,7 +1070,10 @@ updateLocalConversationDelete ::
( Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationDeleteTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r,
Member CodeStore r,
Member E.ConversationStore r,
@@ -1093,7 +1092,10 @@ updateLocalConversationRename ::
( Member (Error FederationError) r,
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationRenameTag))) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r,
Member (Error InvalidInput) r,
Member E.ConversationStore r,
@@ -1112,7 +1114,10 @@ updateLocalConversationMessageTimerUpdate ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationMessageTimerUpdateTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r,
Member E.ConversationStore r,
Member (Error NoChanges) r
@@ -1130,7 +1135,10 @@ updateLocalConversationReceiptModeUpdate ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationReceiptModeUpdateTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r,
Member E.ConversationStore r,
Member (Error NoChanges) r,
@@ -1149,7 +1157,6 @@ updateLocalConversationAccessData ::
Member (Error FederationError) r,
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationAccessDataTag))) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member (Error NoChanges) r,
Member TinyLog r,
Member E.ConversationStore r,
@@ -1179,7 +1186,6 @@ updateLocalConversationRemoveMembers ::
( Member BackendNotificationQueueAccess r,
Member (Error FederationError) r,
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationRemoveMembersTag))) r,
- Member ConversationSubsystem r,
Member (Error NoChanges) r,
Member TinyLog r,
Member E.ConversationStore r,
@@ -1207,7 +1213,6 @@ updateLocalConversationUpdateProtocol ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationUpdateProtocolTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member (Error NoChanges) r,
Member (E.FederationAPIAccess FederatorClient) r,
Member TinyLog r,
@@ -1237,7 +1242,10 @@ updateLocalConversationUpdateAddPermission ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationUpdateAddPermissionTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member (Error NoChanges) r,
Member E.ConversationStore r,
Member TeamSubsystem r,
@@ -1257,7 +1265,6 @@ updateLocalConversationReset ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationResetTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member (E.FederationAPIAccess FederatorClient) r,
Member TinyLog r,
Member E.ConversationStore r,
@@ -1285,7 +1292,10 @@ updateLocalConversationHistoryUpdate ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationHistoryUpdateTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
Member E.ConversationStore r,
Member TeamSubsystem r,
Member (ErrorS HistoryNotSupported) r
@@ -1304,7 +1314,6 @@ updateLocalConversationUncheckedJoin ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationJoinTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member FederationSubsystem r,
Member TeamCollaboratorsSubsystem r,
Member TeamSubsystem r,
@@ -1343,7 +1352,6 @@ updateLocalConversationUncheckedRemoveMembers ::
Member (ErrorS ('ActionDenied (ConversationActionPermission 'ConversationRemoveMembersTag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
Member TeamSubsystem r,
Member (Input ConversationSubsystemConfig) r,
Member (Error NoChanges) r,
@@ -1370,7 +1378,10 @@ updateLocalConversation ::
Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
HasConversationActionEffects tag r,
IsConversationAction tag,
SingI tag,
@@ -1405,7 +1416,10 @@ updateLocalConversationUnchecked ::
Member (ErrorS ('ActionDenied (ConversationActionPermission tag))) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'InvalidOperation) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member Now r,
+ Member ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
HasConversationActionEffects tag r,
Member TeamSubsystem r
) =>
diff --git a/services/galley/src/Galley/API/Action/Kick.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Kick.hs
similarity index 93%
rename from services/galley/src/Galley/API/Action/Kick.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Kick.hs
index 7356b04c10..ddb1caae8a 100644
--- a/services/galley/src/Galley/API/Action/Kick.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Kick.hs
@@ -15,14 +15,12 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Action.Kick where
+module Wire.ConversationSubsystem.Action.Kick where
import Data.Default
import Data.Id
import Data.Qualified
import Data.Singletons
-import Galley.API.Action.Leave
-import Galley.API.Action.Notify
import Imports hiding ((\\))
import Polysemy
import Polysemy.Error
@@ -35,7 +33,8 @@ import Wire.API.Event.LeaveReason
import Wire.API.Federation.Error
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore (ConversationStore)
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action.Leave
+import Wire.ConversationSubsystem.Action.Notify
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.NotificationSubsystem
@@ -53,7 +52,6 @@ kickMember ::
( Member BackendNotificationQueueAccess r,
Member (Error FederationError) r,
Member ExternalAccess r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member ProposalStore r,
Member Now r,
diff --git a/services/galley/src/Galley/API/Action/Leave.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Leave.hs
similarity index 94%
rename from services/galley/src/Galley/API/Action/Leave.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Leave.hs
index 0141cc4ad2..4e88fd77f9 100644
--- a/services/galley/src/Galley/API/Action/Leave.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Leave.hs
@@ -15,12 +15,11 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Action.Leave (leaveConversation) where
+module Wire.ConversationSubsystem.Action.Leave (leaveConversation) where
import Control.Lens
import Data.Id
import Data.Qualified
-import Galley.API.MLS.Removal
import Imports hiding ((\\))
import Polysemy
import Polysemy.Error
@@ -30,6 +29,7 @@ import Wire.API.Conversation.Config (ConversationSubsystemConfig)
import Wire.API.Federation.Error
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore (ConversationStore)
+import Wire.ConversationSubsystem.MLS.Removal
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.NotificationSubsystem
diff --git a/services/galley/src/Galley/API/Action/Notify.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Notify.hs
similarity index 76%
rename from services/galley/src/Galley/API/Action/Notify.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Notify.hs
index 77c8167ebc..4a11ac2001 100644
--- a/services/galley/src/Galley/API/Action/Notify.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Notify.hs
@@ -15,24 +15,34 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Action.Notify where
+module Wire.ConversationSubsystem.Action.Notify where
import Data.Id
import Data.Qualified
import Data.Singletons
import Imports hiding ((\\))
import Polysemy
+import Polysemy.Error
import Wire.API.Conversation hiding (Conversation, Member)
import Wire.API.Conversation.Action
import Wire.API.Event.Conversation
-import Wire.ConversationSubsystem
+import Wire.API.Federation.Error
+import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess)
+import Wire.ConversationSubsystem.Notify (notifyConversationActionImpl)
import Wire.ConversationSubsystem.Util
+import Wire.ExternalAccess (ExternalAccess)
import Wire.NotificationSubsystem
+import Wire.Sem.Now (Now)
import Wire.StoredConversation
sendConversationActionNotifications ::
forall tag r.
- (Member ConversationSubsystem r) =>
+ ( Member BackendNotificationQueueAccess r,
+ Member ExternalAccess r,
+ Member (Error FederationError) r,
+ Member Now r,
+ Member NotificationSubsystem r
+ ) =>
Sing tag ->
Qualified UserId ->
Bool ->
@@ -43,7 +53,7 @@ sendConversationActionNotifications ::
ExtraConversationData ->
Sem r LocalConversationUpdate
sendConversationActionNotifications tag quid notifyOrigDomain con lconv targets action extraData = do
- notifyConversationAction
+ notifyConversationActionImpl
tag
(EventFromUser quid)
notifyOrigDomain
diff --git a/services/galley/src/Galley/API/Action/Reset.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Reset.hs
similarity index 96%
rename from services/galley/src/Galley/API/Action/Reset.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Reset.hs
index 49614ab300..c31399a3b4 100644
--- a/services/galley/src/Galley/API/Action/Reset.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Action/Reset.hs
@@ -15,15 +15,13 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Action.Reset (resetLocalMLSMainConversation) where
+module Wire.ConversationSubsystem.Action.Reset (resetLocalMLSMainConversation) where
import Control.Monad.Codensity hiding (reset)
import Data.Aeson qualified as A
import Data.ByteString.Conversion (toByteString')
import Data.Id
import Data.Qualified
-import Galley.API.Action.Kick
-import Galley.API.MLS.Util
import Imports
import Polysemy
import Polysemy.Error
@@ -47,7 +45,8 @@ import Wire.API.Routes.Public.Galley.MLS
import Wire.API.VersionInfo
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action.Kick
+import Wire.ConversationSubsystem.MLS.Util
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.FederationAPIAccess
@@ -65,7 +64,6 @@ resetLocalMLSMainConversation ::
Member BackendNotificationQueueAccess r,
Member (FederationAPIAccess FederatorClient) r,
Member ExternalAccess r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member ProposalStore r,
Member Random r,
diff --git a/services/galley/src/Galley/API/Clients.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Clients.hs
similarity index 89%
rename from services/galley/src/Galley/API/Clients.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Clients.hs
index 7aa4c2f12e..52dae02033 100644
--- a/services/galley/src/Galley/API/Clients.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Clients.hs
@@ -15,9 +15,8 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Clients
- ( getClients,
- rmClient,
+module Wire.ConversationSubsystem.Clients
+ ( rmClient,
)
where
@@ -25,8 +24,6 @@ import Data.Id
import Data.Proxy
import Data.Qualified
import Data.Range
-import Galley.API.MLS.Removal
-import Galley.API.Query qualified as Query
import Galley.Types.Clients (clientIds)
import Galley.Types.Error
import Imports
@@ -45,7 +42,8 @@ import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
import Wire.API.Routes.MultiTablePaging
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore (ConversationStore, getConversation)
-import Wire.ConversationSubsystem qualified as ConvSubsystem
+import Wire.ConversationSubsystem.MLS.Removal qualified as Removal
+import Wire.ConversationSubsystem.Query qualified as Query
import Wire.ExternalAccess (ExternalAccess)
import Wire.NotificationSubsystem
import Wire.ProposalStore (ProposalStore)
@@ -54,12 +52,6 @@ import Wire.Sem.Random (Random)
import Wire.UserClientIndexStore qualified as E
import Wire.Util
-getClients ::
- (Member ConvSubsystem.ConversationSubsystem r) =>
- UserId ->
- Sem r [ClientId]
-getClients usr = clientIds usr <$> ConvSubsystem.internalGetClientIds [usr]
-
-- | Remove a client from conversations it is part of according to the
-- conversation protocol (Proteus or MLS). In addition, remove the client from
-- the "clients" table in Galley.
@@ -67,7 +59,6 @@ rmClient ::
forall r.
( Member E.UserClientIndexStore r,
Member ConversationStore r,
- Member ConvSubsystem.ConversationSubsystem r,
Member (Error FederationError) r,
Member ExternalAccess r,
Member BackendNotificationQueueAccess r,
@@ -107,7 +98,7 @@ rmClient usr cid = do
mConv <- getConversation convId
for_ mConv $ \conv -> do
lconv <- qualifyLocal conv
- removeClient lconv (tUntagged lusr) cid
+ Removal.removeClient lconv (tUntagged lusr) cid
traverse_ removeRemoteMLSClients (rangedChunks remoteConvs)
when (mtpHasMore page) $ do
let nextState = mtpPagingState page
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.hs
new file mode 100644
index 0000000000..983fd7f0af
--- /dev/null
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Create.hs
@@ -0,0 +1,266 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2022 Wire Swiss GmbH
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see .
+
+module Wire.ConversationSubsystem.Create where
+
+import Data.Id
+import Data.Qualified
+import Data.Set qualified as Set
+import Galley.Types.Error
+import Imports
+import Polysemy
+import Polysemy.Error
+import Polysemy.Input
+import Polysemy.TinyLog qualified as P
+import Wire.API.Conversation hiding (Member)
+import Wire.API.Conversation qualified as Public
+import Wire.API.Conversation.Config
+import Wire.API.Error
+import Wire.API.Error.Galley
+import Wire.API.Event.Conversation
+import Wire.API.Federation.Client (FederatorClient)
+import Wire.API.Federation.Error
+import Wire.API.FederationStatus (RemoteDomains (..))
+import Wire.API.Routes.Public.Galley.Conversation
+import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..))
+import Wire.API.User
+import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess)
+import Wire.BrigAPIAccess
+import Wire.ConversationStore (ConversationStore)
+import Wire.ConversationSubsystem.CreateInternal
+import Wire.ConversationSubsystem.Util
+import Wire.FeaturesConfigSubsystem
+import Wire.FederationAPIAccess (FederationAPIAccess)
+import Wire.FederationSubsystem (FederationSubsystem, checkFederationStatus, enforceFederationProtocol)
+import Wire.LegalHoldStore (LegalHoldStore)
+import Wire.NotificationSubsystem as NS
+import Wire.Sem.Now (Now)
+import Wire.Sem.Random (Random)
+import Wire.StoredConversation
+import Wire.TeamCollaboratorsSubsystem
+import Wire.TeamStore (TeamStore)
+import Wire.TeamSubsystem (TeamSubsystem)
+
+----------------------------------------------------------------------------
+-- API Handlers
+
+createLegacyGroupConversation ::
+ ( Member BrigAPIAccess r,
+ Member ConversationStore r,
+ Member (ErrorS 'ConvAccessDenied) r,
+ Member (Error InvalidInput) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotConnected) r,
+ Member (ErrorS 'MLSNotEnabled) r,
+ Member (ErrorS 'MLSNonEmptyMemberList) r,
+ Member (ErrorS 'MissingLegalholdConsent) r,
+ Member (ErrorS 'ChannelsNotEnabled) r,
+ Member (ErrorS 'NotAnMlsConversation) r,
+ Member (ErrorS HistoryNotSupported) r,
+ Member (Input ConversationSubsystemConfig) r,
+ Member LegalHoldStore r,
+ Member TeamStore r,
+ Member FeaturesConfigSubsystem r,
+ Member TeamCollaboratorsSubsystem r,
+ Member Random r,
+ Member TeamSubsystem r,
+ Member Now r,
+ Member NotificationSubsystem r,
+ Member (Error FederationError) r,
+ Member BackendNotificationQueueAccess r,
+ Member (FederationAPIAccess FederatorClient) r,
+ Member (Error UnreachableBackendsLegacy) r,
+ Member (Error InternalError) r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ Sem r (ConversationResponse Public.OwnConversation)
+createLegacyGroupConversation lusr conn newConv = mapError UnreachableBackendsLegacy $ do
+ dbConv <- createGroupConversationGeneric lusr conn newConv
+ maybe (throwIfNotOwnConversation lusr dbConv.id_) (pure . Created) $ ownConversationView lusr dbConv
+
+createGroupOwnConversation ::
+ ( Member BrigAPIAccess r,
+ Member ConversationStore r,
+ Member (ErrorS 'ConvAccessDenied) r,
+ Member (Error InvalidInput) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotConnected) r,
+ Member (ErrorS 'MLSNotEnabled) r,
+ Member (ErrorS 'MLSNonEmptyMemberList) r,
+ Member (ErrorS 'MissingLegalholdConsent) r,
+ Member (ErrorS 'ChannelsNotEnabled) r,
+ Member (ErrorS 'NotAnMlsConversation) r,
+ Member (ErrorS HistoryNotSupported) r,
+ Member (Input ConversationSubsystemConfig) r,
+ Member LegalHoldStore r,
+ Member TeamStore r,
+ Member FeaturesConfigSubsystem r,
+ Member TeamCollaboratorsSubsystem r,
+ Member Random r,
+ Member TeamSubsystem r,
+ Member Now r,
+ Member NotificationSubsystem r,
+ Member (Error FederationError) r,
+ Member (Error UnreachableBackends) r,
+ Member BackendNotificationQueueAccess r,
+ Member (FederationAPIAccess FederatorClient) r,
+ Member (Error InternalError) r,
+ Member FederationSubsystem r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ Sem r CreateGroupConversationResponseV9
+createGroupOwnConversation lusr conn newConv = do
+ let remoteDomains = void <$> snd (partitionQualified lusr $ newConv.newConvQualifiedUsers)
+ enforceFederationProtocol (baseProtocolToProtocol newConv.newConvProtocol) remoteDomains
+ checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains)
+ dbConv <- createGroupConversationGeneric lusr conn newConv
+ maybe (throwIfNotOwnConversation lusr dbConv.id_) (pure . GroupConversationCreatedV9) $
+ (CreateGroupOwnConversation <$> ownConversationView lusr dbConv <*> pure mempty)
+
+createGroupConversation ::
+ ( Member BrigAPIAccess r,
+ Member ConversationStore r,
+ Member (ErrorS 'ConvAccessDenied) r,
+ Member (Error InvalidInput) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotConnected) r,
+ Member (ErrorS 'MLSNotEnabled) r,
+ Member (ErrorS 'MLSNonEmptyMemberList) r,
+ Member (ErrorS 'MissingLegalholdConsent) r,
+ Member (ErrorS 'ChannelsNotEnabled) r,
+ Member (ErrorS 'NotAnMlsConversation) r,
+ Member (ErrorS HistoryNotSupported) r,
+ Member (Input ConversationSubsystemConfig) r,
+ Member LegalHoldStore r,
+ Member TeamStore r,
+ Member FeaturesConfigSubsystem r,
+ Member TeamCollaboratorsSubsystem r,
+ Member Random r,
+ Member TeamSubsystem r,
+ Member Now r,
+ Member NotificationSubsystem r,
+ Member (Error FederationError) r,
+ Member (Error UnreachableBackends) r,
+ Member BackendNotificationQueueAccess r,
+ Member (FederationAPIAccess FederatorClient) r,
+ Member FederationSubsystem r
+ ) =>
+ Local UserId ->
+ Maybe ConnId ->
+ NewConv ->
+ Sem r CreateGroupConversation
+createGroupConversation lusr conn newConv = do
+ let remoteDomains = void <$> snd (partitionQualified lusr $ newConv.newConvQualifiedUsers)
+ enforceFederationProtocol (baseProtocolToProtocol newConv.newConvProtocol) remoteDomains
+ checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains)
+ dbConv <- createGroupConversationGeneric lusr conn newConv
+ pure $
+ CreateGroupConversation
+ { conversation = conversationView (qualifyAs lusr ()) (Just lusr) dbConv,
+ failedToAdd = mempty
+ }
+
+createProteusSelfConversation ::
+ ( Member ConversationStore r,
+ Member (Error InternalError) r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ Sem r (ConversationResponse Public.OwnConversation)
+createProteusSelfConversation lusr = do
+ (c, created) <- createProteusSelfConversationLogic lusr
+ let mConv =
+ if created
+ then Created <$> ownConversationView lusr c
+ else Existed <$> ownConversationView lusr c
+ maybe (throwIfNotOwnConversation lusr c.id_) pure mConv
+
+createOne2OneConversation ::
+ ( Member BrigAPIAccess r,
+ Member ConversationStore r,
+ Member (Error FederationError) r,
+ Member (Error UnreachableBackends) r,
+ Member (Error InvalidInput) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NonBindingTeam) r,
+ Member (ErrorS 'NoBindingTeamMembers) r,
+ Member (ErrorS 'TeamNotFound) r,
+ Member (ErrorS 'InvalidOperation) r,
+ Member (ErrorS 'NotConnected) r,
+ Member TeamStore r,
+ Member TeamCollaboratorsSubsystem r,
+ Member TeamSubsystem r,
+ Member Now r,
+ Member NotificationSubsystem r,
+ Member BackendNotificationQueueAccess r,
+ Member (FederationAPIAccess FederatorClient) r,
+ Member (Error InternalError) r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ ConnId ->
+ NewOne2OneConv ->
+ Sem r (ConversationResponse Public.OwnConversation)
+createOne2OneConversation lusr zcon j = do
+ (c, created) <- createOne2OneConversationLogic lusr zcon j
+ let mConv =
+ if created
+ then Created <$> ownConversationView lusr c
+ else Existed <$> ownConversationView lusr c
+ maybe (throwIfNotOwnConversation lusr c.id_) pure mConv
+
+----------------------------------------------------------------------------
+-- Helpers
+
+createConnectConversation ::
+ ( Member ConversationStore r,
+ Member (Error FederationError) r,
+ Member (Error InternalError) r,
+ Member (Error InvalidInput) r,
+ Member (Error UnreachableBackends) r,
+ Member (ErrorS 'ConvNotFound) r,
+ Member (ErrorS 'InvalidOperation) r,
+ Member NotificationSubsystem r,
+ Member BackendNotificationQueueAccess r,
+ Member Now r,
+ Member (FederationAPIAccess FederatorClient) r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ Maybe ConnId ->
+ Connect ->
+ Sem r (ConversationResponse Public.OwnConversation)
+createConnectConversation lusr conn j = do
+ (c, created) <- createConnectConversationLogic lusr conn j
+ let mConv =
+ if created
+ then Created <$> ownConversationView lusr c
+ else Existed <$> ownConversationView lusr c
+ maybe (throwIfNotOwnConversation lusr c.id_) pure mConv
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs
index f2aab2d82e..e28425c906 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/CreateInternal.hs
@@ -80,7 +80,7 @@ import Wire.StoredConversation qualified as Data
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore (TeamStore)
import Wire.TeamStore qualified as TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (TeamSubsystem, permissionCheck)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserList (UserList (UserList), toUserList, ulAddLocal, ulAll, ulFromLocals, ulLocals, ulRemotes)
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Errors.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Errors.hs
new file mode 100644
index 0000000000..ec74e2b526
--- /dev/null
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Errors.hs
@@ -0,0 +1,325 @@
+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
+
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2026 Wire Swiss GmbH
+--
+-- This program is free software: you can redistribute it and/or modify it under
+-- the terms of the GNU Affero General Public License as published by the Free
+-- Software Foundation, either version 3 of the License, or (at your option) any
+-- later version.
+--
+-- This program is distributed in the hope that it will be useful, but WITHOUT
+-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+-- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
+-- details.
+--
+-- You should have received a copy of the GNU Affero General Public License along
+-- with this program. If not, see .
+
+module Wire.ConversationSubsystem.Errors
+ ( mapErrors,
+ ConversationSubsystemError (..),
+ )
+where
+
+import Data.Tagged
+import Galley.Types.Error (InternalError, InvalidInput (..))
+import Imports
+import Network.Wai.Utilities.JSONResponse (JSONResponse)
+import Polysemy
+import Polysemy.Error
+import Wire.API.Conversation.Role qualified as ConvRole
+import Wire.API.Error
+import Wire.API.Error.Galley
+import Wire.API.Federation.Error
+import Wire.API.Routes.API (ServerEffect (interpretServerEffect))
+
+data ConversationSubsystemError
+ = ConversationSubsystemErrorConvAccessDenied
+ | ConversationSubsystemErrorNotATeamMember
+ | ConversationSubsystemErrorperationDenied
+ | ConversationSubsystemErrorNotConnected
+ | ConversationSubsystemErrorMLSNotEnabled
+ | ConversationSubsystemErrorMLSNonEmptyMemberList
+ | ConversationSubsystemErrorMissingLegalholdConsent
+ | ConversationSubsystemErrorNonBindingTeam
+ | ConversationSubsystemErrorNoBindingTeamMembers
+ | ConversationSubsystemErrorTeamNotFound
+ | ConversationSubsystemErrorInvalidOperation
+ | ConversationSubsystemErrorConvNotFound
+ | ConversationSubsystemErrorChannelsNotEnabled
+ | ConversationSubsystemErrorNotAnMlsConversation
+ | ConversationSubsystemErrorMLSLegalholdIncompatible
+ | ConversationSubsystemErrorMLSIdentityMismatch
+ | ConversationSubsystemErrorMLSUnsupportedMessage
+ | ConversationSubsystemErrorMLSStaleMessage
+ | ConversationSubsystemErrorMLSProposalNotFound
+ | ConversationSubsystemErrorMLSCommitMissingReferences
+ | ConversationSubsystemErrorMLSSelfRemovalNotAllowed
+ | ConversationSubsystemErrorMLSClientSenderUserMismatch
+ | ConversationSubsystemErrorMLSSubConvClientNotInParent
+ | ConversationSubsystemErrorMLSInvalidLeafNodeSignature
+ | ConversationSubsystemErrorMLSClientMismatch
+ | ConversationSubsystemErrorMLSInvalidLeafNodeIndex
+ | ConversationSubsystemErrorMLSUnsupportedProposal
+ | ConversationSubsystemErrorGroupIdVersionNotSupported
+ | ConversationSubsystemErrorConvMemberNotFound
+ | ConversationSubsystemErrorHistoryNotSupported
+ | ConversationSubsystemErrorLSGroupConversationMismatch
+ | ConversationSubsystemErrorActionDeniedLeaveConversation
+ | ConversationSubsystemErrorActionDeniedRemoveConversationMember
+ | ConversationSubsystemErrorActionDeniedDeleteConversation
+ | ConversationSubsystemErrorBroadcastLimitExceeded
+ | ConversationSubsystemErrorMLSFederatedResetNotSupported
+ | ConversationSubsystemErrorMLSSubConvUnsupportedConvType
+ | ConversationSubsystemErrorTeamMemberNotFound
+ | ConversationSubsystemErrorAccessDenied
+ | ConversationSubsystemErrorMLSMissingGroupInfo
+ | ConversationSubsystemErrorCodeNotFound
+ | ConversationSubsystemErrorInvalidConversationPassword
+ | ConversationSubsystemErrorGuestLinksDisabled
+ | ConversationSubsystemErrorMLSFederatedOne2OneNotSupported
+ | ConversationSubsystemErrorTooManyMembers
+ | ConversationSubsystemErrorCreateConversationCodeConflict
+ | ConversationSubsystemErrorInvalidTarget
+ | ConversationSubsystemErrorMLSReadReceiptsNotAllowed
+ | ConversationSubsystemErrorInvalidTargetAccess
+ | ConversationSubsystemErrorConvInvalidProtocolTransition
+ | ConversationSubsystemErrorMLSMigrationCriteriaNotSatisfied
+ | ConversationSubsystemErrorActionDeniedAddConversationMember
+ | ConversationSubsystemErrorActionDeniedModifyOtherConversationMember
+ | ConversationSubsystemErrorActionDeniedModifyConversationName
+ | ConversationSubsystemErrorActionDeniedModifyConversationMessageTimer
+ | ConversationSubsystemErrorActionDeniedModifyConversationReceiptMode
+ | ConversationSubsystemErrorActionDeniedModifyConversationAccess
+ | ConversationSubsystemErrorActionDeniedModifyAddPermission
+ | ConversationSubsystemErrorFederationError FederationError
+ | ConversationSubsystemErrorUnreachableBackends UnreachableBackends
+ | ConversationSubsystemErrorInternalError InternalError
+ | ConversationSubsystemErrorInvalidInput InvalidInput
+ | ConversationSubsystemErrorMLSProtocolError MLSProtocolError
+ | ConversationSubsystemErrorGroupInfoDiagnostics GroupInfoDiagnostics
+ | ConversationSubsystemErrorMLSOutOfSyncError MLSOutOfSyncError
+ | ConversationSubsystemErrorNonFederatingBackends NonFederatingBackends
+ | ConversationSubsystemErrorUnreachableBackendsLegacy UnreachableBackendsLegacy
+
+instance APIError ConversationSubsystemError where
+ toResponse =
+ \case
+ ConversationSubsystemErrorConvAccessDenied -> toResponse $ Tagged @'ConvAccessDenied ()
+ ConversationSubsystemErrorNotATeamMember -> toResponse $ Tagged @'NotATeamMember ()
+ ConversationSubsystemErrorperationDenied -> toResponse $ Tagged @OperationDenied ()
+ ConversationSubsystemErrorNotConnected -> toResponse $ Tagged @'NotConnected ()
+ ConversationSubsystemErrorMLSNotEnabled -> toResponse $ Tagged @'MLSNotEnabled ()
+ ConversationSubsystemErrorMLSNonEmptyMemberList -> toResponse $ Tagged @'MLSNonEmptyMemberList ()
+ ConversationSubsystemErrorMissingLegalholdConsent -> toResponse $ Tagged @'MissingLegalholdConsent ()
+ ConversationSubsystemErrorNonBindingTeam -> toResponse $ Tagged @'NonBindingTeam ()
+ ConversationSubsystemErrorNoBindingTeamMembers -> toResponse $ Tagged @'NoBindingTeamMembers ()
+ ConversationSubsystemErrorTeamNotFound -> toResponse $ Tagged @'TeamNotFound ()
+ ConversationSubsystemErrorInvalidOperation -> toResponse $ Tagged @'InvalidOperation ()
+ ConversationSubsystemErrorConvNotFound -> toResponse $ Tagged @'ConvNotFound ()
+ ConversationSubsystemErrorChannelsNotEnabled -> toResponse $ Tagged @'ChannelsNotEnabled ()
+ ConversationSubsystemErrorNotAnMlsConversation -> toResponse $ Tagged @'NotAnMlsConversation ()
+ ConversationSubsystemErrorMLSLegalholdIncompatible -> toResponse $ Tagged @'MLSLegalholdIncompatible ()
+ ConversationSubsystemErrorMLSIdentityMismatch -> toResponse $ Tagged @'MLSIdentityMismatch ()
+ ConversationSubsystemErrorMLSUnsupportedMessage -> toResponse $ Tagged @'MLSUnsupportedMessage ()
+ ConversationSubsystemErrorMLSStaleMessage -> toResponse $ Tagged @'MLSStaleMessage ()
+ ConversationSubsystemErrorMLSProposalNotFound -> toResponse $ Tagged @'MLSProposalNotFound ()
+ ConversationSubsystemErrorMLSCommitMissingReferences -> toResponse $ Tagged @'MLSCommitMissingReferences ()
+ ConversationSubsystemErrorMLSSelfRemovalNotAllowed -> toResponse $ Tagged @'MLSSelfRemovalNotAllowed ()
+ ConversationSubsystemErrorMLSClientSenderUserMismatch -> toResponse $ Tagged @'MLSClientSenderUserMismatch ()
+ ConversationSubsystemErrorMLSSubConvClientNotInParent -> toResponse $ Tagged @'MLSSubConvClientNotInParent ()
+ ConversationSubsystemErrorMLSInvalidLeafNodeSignature -> toResponse $ Tagged @'MLSInvalidLeafNodeSignature ()
+ ConversationSubsystemErrorMLSClientMismatch -> toResponse $ Tagged @'MLSClientMismatch ()
+ ConversationSubsystemErrorMLSInvalidLeafNodeIndex -> toResponse $ Tagged @'MLSInvalidLeafNodeIndex ()
+ ConversationSubsystemErrorMLSUnsupportedProposal -> toResponse $ Tagged @'MLSUnsupportedProposal ()
+ ConversationSubsystemErrorGroupIdVersionNotSupported -> toResponse $ Tagged @'GroupIdVersionNotSupported ()
+ ConversationSubsystemErrorConvMemberNotFound -> toResponse $ Tagged @'ConvMemberNotFound ()
+ ConversationSubsystemErrorHistoryNotSupported -> toResponse $ Tagged @'HistoryNotSupported ()
+ ConversationSubsystemErrorLSGroupConversationMismatch -> toResponse $ Tagged @MLSGroupConversationMismatch ()
+ ConversationSubsystemErrorActionDeniedLeaveConversation -> toResponse $ Tagged @('ActionDenied ConvRole.LeaveConversation) ()
+ ConversationSubsystemErrorActionDeniedRemoveConversationMember -> toResponse $ Tagged @('ActionDenied ConvRole.RemoveConversationMember) ()
+ ConversationSubsystemErrorActionDeniedDeleteConversation -> toResponse $ Tagged @('ActionDenied ConvRole.DeleteConversation) ()
+ ConversationSubsystemErrorBroadcastLimitExceeded -> toResponse $ Tagged @'BroadcastLimitExceeded ()
+ ConversationSubsystemErrorMLSFederatedResetNotSupported -> toResponse $ Tagged @'MLSFederatedResetNotSupported ()
+ ConversationSubsystemErrorMLSSubConvUnsupportedConvType -> toResponse $ Tagged @'MLSSubConvUnsupportedConvType ()
+ ConversationSubsystemErrorTeamMemberNotFound -> toResponse $ Tagged @'TeamMemberNotFound ()
+ ConversationSubsystemErrorAccessDenied -> toResponse $ Tagged @'AccessDenied ()
+ ConversationSubsystemErrorMLSMissingGroupInfo -> toResponse $ Tagged @'MLSMissingGroupInfo ()
+ ConversationSubsystemErrorCodeNotFound -> toResponse $ Tagged @'CodeNotFound ()
+ ConversationSubsystemErrorInvalidConversationPassword -> toResponse $ Tagged @'InvalidConversationPassword ()
+ ConversationSubsystemErrorGuestLinksDisabled -> toResponse $ Tagged @'GuestLinksDisabled ()
+ ConversationSubsystemErrorMLSFederatedOne2OneNotSupported -> toResponse $ Tagged @'MLSFederatedOne2OneNotSupported ()
+ ConversationSubsystemErrorTooManyMembers -> toResponse $ Tagged @'TooManyMembers ()
+ ConversationSubsystemErrorCreateConversationCodeConflict -> toResponse $ Tagged @'CreateConversationCodeConflict ()
+ ConversationSubsystemErrorInvalidTarget -> toResponse $ Tagged @'InvalidTarget ()
+ ConversationSubsystemErrorMLSReadReceiptsNotAllowed -> toResponse $ Tagged @'MLSReadReceiptsNotAllowed ()
+ ConversationSubsystemErrorInvalidTargetAccess -> toResponse $ Tagged @'InvalidTargetAccess ()
+ ConversationSubsystemErrorConvInvalidProtocolTransition -> toResponse $ Tagged @'ConvInvalidProtocolTransition ()
+ ConversationSubsystemErrorMLSMigrationCriteriaNotSatisfied -> toResponse $ Tagged @'MLSMigrationCriteriaNotSatisfied ()
+ ConversationSubsystemErrorActionDeniedAddConversationMember -> toResponse $ Tagged @('ActionDenied ConvRole.AddConversationMember) ()
+ ConversationSubsystemErrorActionDeniedModifyOtherConversationMember -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyOtherConversationMember) ()
+ ConversationSubsystemErrorActionDeniedModifyConversationName -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyConversationName) ()
+ ConversationSubsystemErrorActionDeniedModifyConversationMessageTimer -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyConversationMessageTimer) ()
+ ConversationSubsystemErrorActionDeniedModifyConversationReceiptMode -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyConversationReceiptMode) ()
+ ConversationSubsystemErrorActionDeniedModifyConversationAccess -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyConversationAccess) ()
+ ConversationSubsystemErrorActionDeniedModifyAddPermission -> toResponse $ Tagged @('ActionDenied ConvRole.ModifyAddPermission) ()
+ ConversationSubsystemErrorFederationError x -> toResponse x
+ ConversationSubsystemErrorUnreachableBackends x -> toResponse x
+ ConversationSubsystemErrorInternalError x -> toResponse x
+ ConversationSubsystemErrorInvalidInput x -> toResponse x
+ ConversationSubsystemErrorMLSProtocolError x -> toResponse $ (dynError @(MapError 'MLSProtocolErrorTag)) {eMessage = unTagged x}
+ ConversationSubsystemErrorGroupInfoDiagnostics x -> toResponse x
+ ConversationSubsystemErrorMLSOutOfSyncError x -> toResponse x
+ ConversationSubsystemErrorNonFederatingBackends x -> toResponse x
+ ConversationSubsystemErrorUnreachableBackendsLegacy x -> toResponse x
+
+type ConversationSubsystemErrorEffects =
+ '[ ErrorS 'ConvAccessDenied,
+ ErrorS 'NotATeamMember,
+ ErrorS OperationDenied,
+ ErrorS 'NotConnected,
+ ErrorS 'MLSNotEnabled,
+ ErrorS 'MLSNonEmptyMemberList,
+ ErrorS 'MissingLegalholdConsent,
+ ErrorS 'NonBindingTeam,
+ ErrorS 'NoBindingTeamMembers,
+ ErrorS 'TeamNotFound,
+ ErrorS 'InvalidOperation,
+ ErrorS 'ConvNotFound,
+ ErrorS 'ChannelsNotEnabled,
+ ErrorS 'NotAnMlsConversation,
+ ErrorS 'MLSLegalholdIncompatible,
+ ErrorS 'MLSIdentityMismatch,
+ ErrorS 'MLSUnsupportedMessage,
+ ErrorS 'MLSStaleMessage,
+ ErrorS 'MLSProposalNotFound,
+ ErrorS 'MLSCommitMissingReferences,
+ ErrorS 'MLSSelfRemovalNotAllowed,
+ ErrorS 'MLSClientSenderUserMismatch,
+ ErrorS 'MLSSubConvClientNotInParent,
+ ErrorS 'MLSInvalidLeafNodeSignature,
+ ErrorS 'MLSClientMismatch,
+ ErrorS 'MLSInvalidLeafNodeIndex,
+ ErrorS 'MLSUnsupportedProposal,
+ ErrorS 'GroupIdVersionNotSupported,
+ ErrorS 'ConvMemberNotFound,
+ ErrorS 'HistoryNotSupported,
+ ErrorS MLSGroupConversationMismatch,
+ ErrorS ('ActionDenied ConvRole.LeaveConversation),
+ ErrorS ('ActionDenied ConvRole.RemoveConversationMember),
+ ErrorS ('ActionDenied ConvRole.DeleteConversation),
+ ErrorS 'BroadcastLimitExceeded,
+ ErrorS 'MLSFederatedResetNotSupported,
+ ErrorS 'MLSSubConvUnsupportedConvType,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'AccessDenied,
+ ErrorS 'MLSMissingGroupInfo,
+ ErrorS 'CodeNotFound,
+ ErrorS 'InvalidConversationPassword,
+ ErrorS 'GuestLinksDisabled,
+ ErrorS 'MLSFederatedOne2OneNotSupported,
+ ErrorS 'TooManyMembers,
+ ErrorS 'CreateConversationCodeConflict,
+ ErrorS 'InvalidTarget,
+ ErrorS 'MLSReadReceiptsNotAllowed,
+ ErrorS 'InvalidTargetAccess,
+ ErrorS 'ConvInvalidProtocolTransition,
+ ErrorS 'MLSMigrationCriteriaNotSatisfied,
+ ErrorS ('ActionDenied ConvRole.AddConversationMember),
+ ErrorS ('ActionDenied ConvRole.ModifyOtherConversationMember),
+ ErrorS ('ActionDenied ConvRole.ModifyConversationName),
+ ErrorS ('ActionDenied ConvRole.ModifyConversationMessageTimer),
+ ErrorS ('ActionDenied ConvRole.ModifyConversationReceiptMode),
+ ErrorS ('ActionDenied ConvRole.ModifyConversationAccess),
+ ErrorS ('ActionDenied ConvRole.ModifyAddPermission),
+ Error FederationError,
+ Error UnreachableBackends,
+ Error InternalError,
+ Error InvalidInput,
+ Error AuthenticationError,
+ Error MLSProtocolError,
+ Error GroupInfoDiagnostics,
+ Error MLSOutOfSyncError,
+ Error MLSProposalFailure,
+ Error NonFederatingBackends,
+ Error UnreachableBackendsLegacy
+ ]
+
+mapErrors ::
+ ( Member (Error ConversationSubsystemError) r,
+ Member (Error JSONResponse) r,
+ Member (Error DynError) r
+ ) =>
+ InterpretersFor ConversationSubsystemErrorEffects r
+mapErrors =
+ mapError (ConversationSubsystemErrorUnreachableBackendsLegacy)
+ . mapError (ConversationSubsystemErrorNonFederatingBackends)
+ . interpretServerEffect
+ . mapError (ConversationSubsystemErrorMLSOutOfSyncError)
+ . mapError (ConversationSubsystemErrorGroupInfoDiagnostics)
+ . mapError (ConversationSubsystemErrorMLSProtocolError)
+ . interpretServerEffect
+ . mapError (ConversationSubsystemErrorInvalidInput)
+ . mapError (ConversationSubsystemErrorInternalError)
+ . mapError (ConversationSubsystemErrorUnreachableBackends)
+ . mapError (ConversationSubsystemErrorFederationError)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyAddPermission)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyConversationAccess)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyConversationReceiptMode)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyConversationMessageTimer)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyConversationName)
+ . mapError (const ConversationSubsystemErrorActionDeniedModifyOtherConversationMember)
+ . mapError (const ConversationSubsystemErrorActionDeniedAddConversationMember)
+ . mapError (const ConversationSubsystemErrorMLSMigrationCriteriaNotSatisfied)
+ . mapError (const ConversationSubsystemErrorConvInvalidProtocolTransition)
+ . mapError (const ConversationSubsystemErrorInvalidTargetAccess)
+ . mapError (const ConversationSubsystemErrorMLSReadReceiptsNotAllowed)
+ . mapError (const ConversationSubsystemErrorInvalidTarget)
+ . mapError (const ConversationSubsystemErrorCreateConversationCodeConflict)
+ . mapError (const ConversationSubsystemErrorTooManyMembers)
+ . mapError (const ConversationSubsystemErrorMLSFederatedOne2OneNotSupported)
+ . mapError (const ConversationSubsystemErrorGuestLinksDisabled)
+ . mapError (const ConversationSubsystemErrorInvalidConversationPassword)
+ . mapError (const ConversationSubsystemErrorCodeNotFound)
+ . mapError (const ConversationSubsystemErrorMLSMissingGroupInfo)
+ . mapError (const ConversationSubsystemErrorAccessDenied)
+ . mapError (const ConversationSubsystemErrorTeamMemberNotFound)
+ . mapError (const ConversationSubsystemErrorMLSSubConvUnsupportedConvType)
+ . mapError (const ConversationSubsystemErrorMLSFederatedResetNotSupported)
+ . mapError (const ConversationSubsystemErrorBroadcastLimitExceeded)
+ . mapError (const ConversationSubsystemErrorActionDeniedDeleteConversation)
+ . mapError (const ConversationSubsystemErrorActionDeniedRemoveConversationMember)
+ . mapError (const ConversationSubsystemErrorActionDeniedLeaveConversation)
+ . mapError (const ConversationSubsystemErrorLSGroupConversationMismatch)
+ . mapError (const ConversationSubsystemErrorHistoryNotSupported)
+ . mapError (const ConversationSubsystemErrorConvMemberNotFound)
+ . mapError (const ConversationSubsystemErrorGroupIdVersionNotSupported)
+ . mapError (const ConversationSubsystemErrorMLSUnsupportedProposal)
+ . mapError (const ConversationSubsystemErrorMLSInvalidLeafNodeIndex)
+ . mapError (const ConversationSubsystemErrorMLSClientMismatch)
+ . mapError (const ConversationSubsystemErrorMLSInvalidLeafNodeSignature)
+ . mapError (const ConversationSubsystemErrorMLSSubConvClientNotInParent)
+ . mapError (const ConversationSubsystemErrorMLSClientSenderUserMismatch)
+ . mapError (const ConversationSubsystemErrorMLSSelfRemovalNotAllowed)
+ . mapError (const ConversationSubsystemErrorMLSCommitMissingReferences)
+ . mapError (const ConversationSubsystemErrorMLSProposalNotFound)
+ . mapError (const ConversationSubsystemErrorMLSStaleMessage)
+ . mapError (const ConversationSubsystemErrorMLSUnsupportedMessage)
+ . mapError (const ConversationSubsystemErrorMLSIdentityMismatch)
+ . mapError (const ConversationSubsystemErrorMLSLegalholdIncompatible)
+ . mapError (const ConversationSubsystemErrorNotAnMlsConversation)
+ . mapError (const ConversationSubsystemErrorChannelsNotEnabled)
+ . mapError (const ConversationSubsystemErrorConvNotFound)
+ . mapError (const ConversationSubsystemErrorInvalidOperation)
+ . mapError (const ConversationSubsystemErrorTeamNotFound)
+ . mapError (const ConversationSubsystemErrorNoBindingTeamMembers)
+ . mapError (const ConversationSubsystemErrorNonBindingTeam)
+ . mapError (const ConversationSubsystemErrorMissingLegalholdConsent)
+ . mapError (const ConversationSubsystemErrorMLSNonEmptyMemberList)
+ . mapError (const ConversationSubsystemErrorMLSNotEnabled)
+ . mapError (const ConversationSubsystemErrorNotConnected)
+ . mapError (const ConversationSubsystemErrorperationDenied)
+ . mapError (const ConversationSubsystemErrorNotATeamMember)
+ . mapError (const ConversationSubsystemErrorConvAccessDenied)
diff --git a/services/galley/src/Galley/API/Federation/Handlers.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs
similarity index 92%
rename from services/galley/src/Galley/API/Federation/Handlers.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs
index b62d7ed398..34a22f5dd4 100644
--- a/services/galley/src/Galley/API/Federation/Handlers.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Federation.hs
@@ -18,7 +18,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Federation.Handlers where
+module Wire.ConversationSubsystem.Federation where
import Control.Error hiding (note)
import Control.Lens
@@ -36,20 +36,6 @@ import Data.Set qualified as Set
import Data.Singletons (SingI (..), demote, sing)
import Data.Tagged
import Data.Text.Lazy qualified as LT
-import Galley.API.Action
-import Galley.API.MLS
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.GroupInfo
-import Galley.API.MLS.GroupInfoCheck (GroupInfoCheckEnabled)
-import Galley.API.MLS.Message
-import Galley.API.MLS.One2One
-import Galley.API.MLS.Removal
-import Galley.API.MLS.SubConversation hiding (leaveSubConversation)
-import Galley.API.MLS.Util
-import Galley.API.MLS.Welcome
-import Galley.API.Mapping
-import Galley.API.Mapping qualified as Mapping
-import Galley.API.Message
import Galley.Types.Conversations.One2One
import Galley.Types.Error
import Imports
@@ -83,12 +69,24 @@ import Wire.API.Message
import Wire.API.Push.V2 (RecipientClients (..))
import Wire.API.Routes.Public.Galley.MLS
import Wire.API.ServantProto
+import Wire.API.Team.FeatureFlags (FeatureFlags)
import Wire.API.User (BaseProtocolTag (..))
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.CodeStore
import Wire.ConversationStore qualified as E
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action
+import Wire.ConversationSubsystem.MLS.Enabled
+import Wire.ConversationSubsystem.MLS.GroupInfo
+import Wire.ConversationSubsystem.MLS.GroupInfoCheck (GroupInfoCheckEnabled)
+import Wire.ConversationSubsystem.MLS.IncomingMessage
+import Wire.ConversationSubsystem.MLS.Message
+import Wire.ConversationSubsystem.MLS.One2One
+import Wire.ConversationSubsystem.MLS.Removal
+import Wire.ConversationSubsystem.MLS.SubConversation hiding (leaveSubConversation)
+import Wire.ConversationSubsystem.MLS.Util
+import Wire.ConversationSubsystem.MLS.Welcome
+import Wire.ConversationSubsystem.Message
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess (ExternalAccess)
import Wire.FeaturesConfigSubsystem
@@ -97,7 +95,6 @@ import Wire.FederationSubsystem (FederationSubsystem)
import Wire.FireAndForget qualified as E
import Wire.LegalHoldStore (LegalHoldStore)
import Wire.NotificationSubsystem
-import Wire.Options.Galley
import Wire.ProposalStore (ProposalStore)
import Wire.Sem.Now (Now)
import Wire.Sem.Now qualified as Now
@@ -184,28 +181,18 @@ onConversationCreated domain rc = do
pushConversationEvent Nothing () event (qualifyAs loc [qUnqualified . Public.memId $ mem]) []
pure EmptyResponse
-getConversationsV1 ::
- ( Member E.ConversationStore r,
- Member (Input (Local ())) r
- ) =>
- Domain ->
- GetConversationsRequest ->
- Sem r GetConversationsResponse
-getConversationsV1 domain req =
- getConversationsResponseFromV2 <$> Galley.API.Federation.Handlers.getConversations domain req
-
getConversations ::
( Member E.ConversationStore r,
Member (Input (Local ())) r
) =>
Domain ->
GetConversationsRequest ->
- Sem r GetConversationsResponseV2
+ Sem r GetRemoteConversationViewsResponse
getConversations domain (GetConversationsRequest uid cids) = do
let ruid = toRemoteUnsafe domain uid
loc <- qualifyLocal ()
- GetConversationsResponseV2
- . mapMaybe (Mapping.conversationToRemote (tDomain loc) ruid)
+ GetRemoteConversationViewsResponse
+ . mapMaybe (conversationToRemote (tDomain loc) ruid)
<$> E.getConversations cids
-- | Update the local database with information on conversation members joining
@@ -226,27 +213,12 @@ onConversationUpdated requestingDomain cu = do
void $ updateLocalStateOfRemoteConv rcu Nothing
pure EmptyResponse
-onConversationUpdatedV0 ::
- ( Member BrigAPIAccess r,
- Member NotificationSubsystem r,
- Member ExternalAccess r,
- Member (Input (Local ())) r,
- Member E.ConversationStore r,
- Member P.TinyLog r
- ) =>
- Domain ->
- ConversationUpdateV0 ->
- Sem r EmptyResponse
-onConversationUpdatedV0 domain cu =
- onConversationUpdated domain (conversationUpdateFromV0 cu)
-
-- as of now this will not generate the necessary events on the leaver's domain
leaveConversation ::
( Member BackendNotificationQueueAccess r,
Member E.ConversationStore r,
Member (Error InternalError) r,
Member ExternalAccess r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member Now r,
@@ -365,13 +337,14 @@ onMessageSent domain rmUnqualified = do
sendMessage ::
( Member BrigAPIAccess r,
Member UserClientIndexStore r,
+ Member (Input IntraListing) r,
+ Member (Input FeatureFlags) r,
Member E.ConversationStore r,
Member (Error InvalidInput) r,
Member (FederationAPIAccess FederatorClient) r,
Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
- Member (Input Opts) r,
Member Now r,
Member ExternalAccess r,
Member TeamSubsystem r,
@@ -394,7 +367,6 @@ onUserDeleted ::
Member E.FireAndForget r,
Member (Error FederationError) r,
Member ExternalAccess r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member Now r,
@@ -456,7 +428,6 @@ updateConversation ::
Member (Error InvalidInput) r,
Member ExternalAccess r,
Member (FederationAPIAccess FederatorClient) r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member Now r,
Member LegalHoldStore r,
@@ -559,6 +530,16 @@ updateConversation origDomain updateRequest = do
. runError @UnreachableBackends
. fmap ConversationUpdateResponseUpdate
+type MLSBundleStaticErrors =
+ Append
+ MLSMessageStaticErrors
+ '[ ErrorS 'MLSWelcomeMismatch,
+ ErrorS 'MLSIdentityMismatch,
+ ErrorS 'GroupIdVersionNotSupported,
+ ErrorS 'MLSInvalidLeafNodeSignature,
+ ErrorS 'MLSGroupConversationMismatch
+ ]
+
handleMLSMessageErrors ::
( r1
~ Append
@@ -599,8 +580,10 @@ sendMLSCommitBundle ::
Member ExternalAccess r,
Member (Error FederationError) r,
Member (Error InternalError) r,
+ Member (ErrorS 'MLSClientMismatch) r,
+ Member (ErrorS 'MLSInvalidLeafNodeIndex) r,
+ Member (ErrorS 'MLSUnsupportedProposal) r,
Member (FederationAPIAccess FederatorClient) r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member (Input (Maybe GroupInfoCheckEnabled)) r,
@@ -635,25 +618,25 @@ sendMLSCommitBundle remoteDomain msr = handleMLSMessageErrors $ do
when (qUnqualified qConvOrSub /= msr.convOrSubId) $ throwS @'MLSGroupConversationMismatch
-- this cannot throw the error since we always pass the sender which is qualified to be remote
- runInputConst (fromMaybe def msr.enableOutOfSyncCheck) $
- MLSMessageResponseUpdates
- . fmap lcuUpdate
- <$> mapToRuntimeError @MLSLegalholdIncompatible
- (InternalErrorWithDescription "expected group conversation while handling policy conflicts")
- ( postMLSCommitBundle
- loc
- -- Type application to prevent future changes from introducing errors.
- -- It is only safe to assume that we can discard the error when the sender
- -- is actually remote.
- -- Since `tUntagged` works on local and remote, a future changed may
- -- go unchecked without this.
- (tUntagged @QRemote sender)
- msr.senderClient
- ctype
- qConvOrSub
- Nothing
- ibundle
- )
+ MLSMessageResponseUpdates
+ . fmap lcuUpdate
+ <$> mapToRuntimeError @MLSLegalholdIncompatible
+ (InternalErrorWithDescription "expected group conversation while handling policy conflicts")
+ ( postMLSCommitBundle
+ loc
+ -- Type application to prevent future changes from introducing errors.
+ -- It is only safe to assume that we can discard the error when the sender
+ -- is actually remote.
+ -- Since `tUntagged` works on local and remote, a future changed may
+ -- go unchecked without this.
+ (tUntagged @QRemote sender)
+ msr.senderClient
+ ctype
+ qConvOrSub
+ Nothing
+ (fromMaybe def msr.enableOutOfSyncCheck)
+ ibundle
+ )
sendMLSMessage ::
( Member BackendNotificationQueueAccess r,
@@ -663,6 +646,9 @@ sendMLSMessage ::
Member (Error FederationError) r,
Member (Error InternalError) r,
Member (FederationAPIAccess FederatorClient) r,
+ Member (ErrorS 'MLSClientMismatch) r,
+ Member (ErrorS 'MLSInvalidLeafNodeIndex) r,
+ Member (ErrorS 'MLSUnsupportedProposal) r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
@@ -684,16 +670,16 @@ sendMLSMessage remoteDomain msr = handleMLSMessageErrors $ do
msg <- noteS @'MLSUnsupportedMessage $ mkIncomingMessage raw
(ctype, qConvOrSub) <- getConvFromGroupId msg.groupId
when (qUnqualified qConvOrSub /= msr.convOrSubId) $ throwS @'MLSGroupConversationMismatch
- runInputConst (fromMaybe def msr.enableOutOfSyncCheck) $
- MLSMessageResponseUpdates . map lcuUpdate
- <$> postMLSMessage
- loc
- (tUntagged sender)
- msr.senderClient
- ctype
- qConvOrSub
- Nothing
- msg
+ MLSMessageResponseUpdates . map lcuUpdate
+ <$> postMLSMessage
+ loc
+ (tUntagged sender)
+ msr.senderClient
+ ctype
+ qConvOrSub
+ Nothing
+ (fromMaybe def msr.enableOutOfSyncCheck)
+ msg
getSubConversationForRemoteUser ::
( Member E.ConversationStore r,
@@ -760,7 +746,7 @@ deleteSubConversationForRemoteUser domain DeleteSubConversationFedRequest {..} =
lconv <- qualifyLocal dscreqConv
resetLocalSubConversation qusr lconv dscreqSubConv dsc
-getOne2OneConversationV1 ::
+getLegacyOne2OneConversation ::
( Member (Input (Local ())) r,
Member BrigAPIAccess r,
Member (Error InvalidInput) r
@@ -768,7 +754,7 @@ getOne2OneConversationV1 ::
Domain ->
GetOne2OneConversationRequest ->
Sem r GetOne2OneConversationResponse
-getOne2OneConversationV1 domain (GetOne2OneConversationRequest self other) =
+getLegacyOne2OneConversation domain (GetOne2OneConversationRequest self other) =
fmap (Imports.fromRight GetOne2OneConversationNotConnected)
. runError @(Tagged 'NotConnected ())
$ do
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Internal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Internal.hs
index 68bf8c32a3..2d36e8eeb7 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Internal.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Internal.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Wire.ConversationSubsystem.Internal (internalGetClientIdsImpl) where
+module Wire.ConversationSubsystem.Internal (internalGetClientIds) where
import Data.Id
import Galley.Types.Clients (Clients, fromUserClients)
@@ -27,14 +27,14 @@ import Wire.BrigAPIAccess
import Wire.UserClientIndexStore (UserClientIndexStore)
import Wire.UserClientIndexStore qualified as UserClientIndexStore
-internalGetClientIdsImpl ::
+internalGetClientIds ::
( Member BrigAPIAccess r,
Member UserClientIndexStore r,
Member (Input ConversationSubsystemConfig) r
) =>
[UserId] ->
Sem r Clients
-internalGetClientIdsImpl users = do
+internalGetClientIds users = do
isInternal <- inputs (.listClientsUsingBrig)
if isInternal
then fromUserClients <$> lookupClients users
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs
index 9a3d9270bc..672372cf8b 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Interpreter.hs
@@ -19,60 +19,80 @@
module Wire.ConversationSubsystem.Interpreter
( interpretConversationSubsystem,
+ GroupInfoCheckEnabled (..),
+ IntraListing (..),
+ ConversationSubsystemError (..),
)
where
-import Galley.Types.Error (InternalError, InvalidInput (..))
+import Data.Qualified
import Imports
+import Network.Wai.Utilities.JSONResponse (JSONResponse)
import Polysemy
import Polysemy.Error
import Polysemy.Input
+import Polysemy.Resource (Resource)
+import Polysemy.TinyLog (TinyLog)
import Wire.API.Conversation.Config
import Wire.API.Error
-import Wire.API.Error.Galley
import Wire.API.Federation.Client (FederatorClient)
-import Wire.API.Federation.Error
+import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
+import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureFlags)
import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess)
import Wire.BrigAPIAccess
+import Wire.CodeStore (CodeStore)
import Wire.ConversationStore (ConversationStore)
import Wire.ConversationStore qualified as ConvStore
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem (ConversationSubsystem (..))
+import Wire.ConversationSubsystem.Action.Notify qualified as ActionNotify
+import Wire.ConversationSubsystem.Clients as Clients
+import Wire.ConversationSubsystem.Create qualified as Create
import Wire.ConversationSubsystem.CreateInternal qualified as CreateInternal
+import Wire.ConversationSubsystem.Errors
+import Wire.ConversationSubsystem.Federation qualified as Federation
import Wire.ConversationSubsystem.Fetch qualified as Fetch
-import Wire.ConversationSubsystem.Internal qualified as Internal
+import Wire.ConversationSubsystem.MLS qualified as MLS
+import Wire.ConversationSubsystem.MLS.Enabled qualified as MLSEnabled
+import Wire.ConversationSubsystem.MLS.GroupInfo qualified as MLSGroupInfo
+import Wire.ConversationSubsystem.MLS.GroupInfoCheck (GroupInfoCheckEnabled (..))
+import Wire.ConversationSubsystem.MLS.Message qualified as MLSMessage
+import Wire.ConversationSubsystem.MLS.Removal qualified as MLSRemoval
+import Wire.ConversationSubsystem.MLS.Reset qualified as MLSReset
+import Wire.ConversationSubsystem.MLS.SubConversation qualified as MLSSubConversation
+import Wire.ConversationSubsystem.Message (IntraListing (..))
import Wire.ConversationSubsystem.Notify qualified as Notify
+import Wire.ConversationSubsystem.One2One qualified as One2One
+import Wire.ConversationSubsystem.Query qualified as Query
+import Wire.ConversationSubsystem.Update qualified as Update
import Wire.ExternalAccess (ExternalAccess)
import Wire.FeaturesConfigSubsystem
import Wire.FederationAPIAccess (FederationAPIAccess)
+import Wire.FederationSubsystem (FederationSubsystem)
+import Wire.FireAndForget (FireAndForget)
+import Wire.HashPassword (HashPassword)
import Wire.LegalHoldStore (LegalHoldStore)
import Wire.NotificationSubsystem as NS
+import Wire.Options.Galley (GuestLinkTTLSeconds)
+import Wire.ProposalStore (ProposalStore)
+import Wire.RateLimit (RateLimit)
import Wire.Sem.Now (Now)
import Wire.Sem.Random (Random)
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore (TeamStore)
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.UserClientIndexStore (UserClientIndexStore)
+import Wire.UserGroupStore (UserGroupStore)
interpretConversationSubsystem ::
- ( Member (Error FederationError) r,
- Member (Error UnreachableBackends) r,
- Member (Error InternalError) r,
- Member (Error InvalidInput) r,
- Member (ErrorS 'ConvAccessDenied) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
- Member (ErrorS 'NotConnected) r,
- Member (ErrorS 'MLSNotEnabled) r,
- Member (ErrorS 'MLSNonEmptyMemberList) r,
- Member (ErrorS 'MissingLegalholdConsent) r,
- Member (ErrorS 'NonBindingTeam) r,
- Member (ErrorS 'NoBindingTeamMembers) r,
- Member (ErrorS 'TeamNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'ChannelsNotEnabled) r,
- Member (ErrorS 'NotAnMlsConversation) r,
- Member (ErrorS HistoryNotSupported) r,
+ ( Member (Error ConversationSubsystemError) r,
+ Member (Error JSONResponse) r,
+ Member (Error DynError) r,
+ Member UserGroupStore r,
+ Member (Input (Maybe GuestLinkTTLSeconds)) r,
+ Member HashPassword r,
+ Member RateLimit r,
+ Member CodeStore r,
+ Member FireAndForget r,
Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
Member ExternalAccess r,
@@ -84,29 +104,235 @@ interpretConversationSubsystem ::
Member TeamCollaboratorsSubsystem r,
Member Random r,
Member TeamSubsystem r,
+ Member (Input FeatureFlags) r,
+ Member (Input IntraListing) r,
Member (Input ConversationSubsystemConfig) r,
+ Member (Input (Local ())) r,
+ Member (Input (Maybe GroupInfoCheckEnabled)) r,
+ Member ProposalStore r,
Member LegalHoldStore r,
Member TeamStore r,
- Member UserClientIndexStore r
+ Member ConvStore.MLSCommitLockStore r,
+ Member FederationSubsystem r,
+ Member Resource r,
+ Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
+ Member UserClientIndexStore r,
+ Member (Input FanoutLimit) r,
+ Member TinyLog r
) =>
- Sem (ConversationSubsystem : r) a ->
- Sem r a
+ InterpreterFor ConversationSubsystem r
interpretConversationSubsystem = interpret $ \case
NotifyConversationAction tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData ->
- Notify.notifyConversationActionImpl tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData
+ mapErrors $ Notify.notifyConversationActionImpl tag quid notifyOrigDomain con lconv targetsLocal targetsRemote targetsBots action extraData
+ InternalCreateGroupConversation lusr conn newConv ->
+ mapErrors $ CreateInternal.createGroupConversationGeneric lusr conn newConv
+ CreateLegacyGroupConversation lusr conn newConv ->
+ mapErrors $ Create.createLegacyGroupConversation lusr conn newConv
+ CreateGroupOwnConversation lusr conn newConv ->
+ mapErrors $ Create.createGroupOwnConversation lusr conn newConv
CreateGroupConversation lusr conn newConv ->
- CreateInternal.createGroupConversationGeneric lusr conn newConv
- CreateOne2OneConversation lusr conn newOne2One ->
- CreateInternal.createOne2OneConversationLogic lusr conn newOne2One
+ mapErrors $ Create.createGroupConversation lusr conn newConv
CreateProteusSelfConversation lusr ->
- CreateInternal.createProteusSelfConversationLogic lusr
+ mapErrors $ Create.createProteusSelfConversation lusr
+ CreateOne2OneConversation lusr zcon j ->
+ mapErrors $ Create.createOne2OneConversation lusr zcon j
CreateConnectConversation lusr conn j ->
- CreateInternal.createConnectConversationLogic lusr conn j
+ mapErrors $ Create.createConnectConversation lusr conn j
GetConversations convIds ->
- ConvStore.getConversations convIds
+ mapErrors $ ConvStore.getConversations convIds
GetConversationIds lusr maxIds pagingState ->
- Fetch.getConversationIdsImpl lusr maxIds pagingState
- InternalGetClientIds uids ->
- Internal.internalGetClientIdsImpl uids
+ mapErrors $ Fetch.getConversationIdsImpl lusr maxIds pagingState
InternalGetLocalMember cid uid ->
- ConvStore.getLocalMember cid uid
+ mapErrors $ ConvStore.getLocalMember cid uid
+ PostMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle ->
+ mapErrors $ MLSMessage.postMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle
+ PostMLSCommitBundleFromLocalUser v lusr c conn bundle ->
+ mapErrors $ MLSMessage.postMLSCommitBundleFromLocalUser v lusr c conn bundle
+ PostMLSMessage loc qusr c ctype qconvOrSub con oosCheck msg ->
+ mapErrors $ MLSMessage.postMLSMessage loc qusr c ctype qconvOrSub con oosCheck msg
+ PostMLSMessageFromLocalUser v lusr c conn smsg ->
+ mapErrors $ MLSMessage.postMLSMessageFromLocalUser v lusr c conn smsg
+ IsMLSEnabled ->
+ mapErrors $ MLSEnabled.isMLSEnabled
+ GetConversationsInternal luser mids mstart msize ->
+ mapErrors $ Query.getConversationsInternal luser mids mstart msize
+ RemoveMemberFromLocalConv lcnv lusr con victim ->
+ mapErrors $ Update.removeMemberFromLocalConv lcnv lusr con victim
+ FederationOnConversationCreated domain rc ->
+ mapErrors $ Federation.onConversationCreated domain rc
+ FederationGetConversations domain req ->
+ mapErrors $ Federation.getConversations domain req
+ FederationLeaveConversation domain lc ->
+ mapErrors $ Federation.leaveConversation domain lc
+ FederationSendMessage domain msr ->
+ mapErrors $ Federation.sendMessage domain msr
+ FederationUpdateConversation domain uc ->
+ mapErrors $ Federation.updateConversation domain uc
+ FederationMlsSendWelcome domain req ->
+ mapErrors $ Federation.mlsSendWelcome domain req
+ FederationSendMLSMessage domain msr ->
+ mapErrors $ Federation.sendMLSMessage domain msr
+ FederationSendMLSCommitBundle domain msr ->
+ mapErrors $ Federation.sendMLSCommitBundle domain msr
+ FederationQueryGroupInfo domain req ->
+ mapErrors $ Federation.queryGroupInfo domain req
+ FederationUpdateTypingIndicator domain req ->
+ mapErrors $ Federation.updateTypingIndicator domain req
+ FederationOnTypingIndicatorUpdated domain td ->
+ mapErrors $ Federation.onTypingIndicatorUpdated domain td
+ FederationGetSubConversationForRemoteUser domain req ->
+ mapErrors $ Federation.getSubConversationForRemoteUser domain req
+ FederationDeleteSubConversationForRemoteUser domain req ->
+ mapErrors $ Federation.deleteSubConversationForRemoteUser domain req
+ FederationLeaveSubConversation domain lscr ->
+ mapErrors $ Federation.leaveSubConversation domain lscr
+ FederationGetLegacyOne2OneConversation domain req ->
+ mapErrors $ Federation.getLegacyOne2OneConversation domain req
+ FederationGetOne2OneConversation domain req ->
+ mapErrors $ Federation.getOne2OneConversation domain req
+ FederationOnClientRemoved domain req ->
+ mapErrors $ Federation.onClientRemoved domain req
+ FederationOnMessageSent domain rm ->
+ mapErrors $ Federation.onMessageSent domain rm
+ FederationOnMLSMessageSent domain rmm ->
+ mapErrors $ Federation.onMLSMessageSent domain rmm
+ FederationOnConversationUpdated domain cu ->
+ mapErrors $ Federation.onConversationUpdated domain cu
+ FederationOnUserDeleted domain udcn ->
+ mapErrors $ Federation.onUserDeleted domain udcn
+ PostOtrMessageUnqualified lusr con cnv ignore report msg ->
+ mapErrors $ Update.postOtrMessageUnqualified lusr con cnv ignore report msg
+ PostOtrBroadcastUnqualified lusr con ignore report msg ->
+ mapErrors $ Update.postOtrBroadcastUnqualified lusr con ignore report msg
+ PostProteusMessage lusr con cnv msg ->
+ mapErrors $ Update.postProteusMessage lusr con cnv msg
+ PostProteusBroadcast lusr con msg ->
+ mapErrors $ Update.postProteusBroadcast lusr con msg
+ DeleteLocalConversation lusr con lcnv ->
+ mapErrors $ Update.deleteLocalConversation lusr con lcnv
+ GetMLSPublicKeys fmt ->
+ mapErrors $ MLS.getMLSPublicKeys fmt
+ ResetMLSConversation lusr reset ->
+ mapErrors $ MLSReset.resetMLSConversation lusr reset
+ GetSubConversation lusr cnv sub ->
+ mapErrors $ MLSSubConversation.getSubConversation lusr cnv sub
+ GetBotConversation bid cnv ->
+ mapErrors $ Query.getBotConversation bid cnv
+ GetUnqualifiedOwnConversation lusr cnv ->
+ mapErrors $ Query.getUnqualifiedOwnConversation lusr cnv
+ GetOwnConversation lusr qcnv ->
+ mapErrors $ Query.getOwnConversation lusr qcnv
+ GetConversation lusr qcnv ->
+ mapErrors $ Query.getConversation lusr qcnv
+ InternalGetConversation cnv ->
+ mapErrors $ ConvStore.getConversation cnv
+ GetConversationRoles lusr cnv ->
+ mapErrors $ Query.getConversationRoles lusr cnv
+ GetGroupInfo lusr qcnv ->
+ mapErrors $ MLSGroupInfo.getGroupInfo lusr qcnv
+ ConversationIdsPageFromUnqualified lusr mstart msize ->
+ mapErrors $ Query.conversationIdsPageFromUnqualified lusr mstart msize
+ ConversationIdsPaginated listGlobalSelf lself req ->
+ mapErrors $ Query.conversationIdsPaginated listGlobalSelf lself req
+ ConversationIdsPageFrom lusr req ->
+ mapErrors $ Query.conversationIdsPageFrom lusr req
+ ListConversations luser req ->
+ mapErrors $ Query.listConversations luser req
+ GetConversationByReusableCode lusr key value ->
+ mapErrors $ Query.getConversationByReusableCode lusr key value
+ GetMLSSelfConversationWithError lusr ->
+ mapErrors $ Query.getMLSSelfConversationWithError lusr
+ GetMLSOne2OneOwnConversation lself qother ->
+ mapErrors $ Query.getMLSOne2OneOwnConversation lself qother
+ GetMLSOne2OneMLSConversation lself qother ->
+ mapErrors $ Query.getMLSOne2OneMLSConversation lself qother
+ GetMLSOne2OneConversation lself qother fmt ->
+ mapErrors $ Query.getMLSOne2OneConversation lself qother fmt
+ GetLocalSelf lusr cnv ->
+ mapErrors $ Query.getLocalSelf lusr cnv
+ GetSelfMember lusr qcnv ->
+ mapErrors $ Query.getSelfMember lusr qcnv
+ GetConversationGuestLinksStatus uid cid ->
+ mapErrors $ Query.getConversationGuestLinksStatus uid cid
+ GetCode mcode lusr cnv ->
+ mapErrors $ Update.getCode mcode lusr cnv
+ AddQualifiedMembersUnqualified lusr con cnv invite ->
+ mapErrors $ Update.addQualifiedMembersUnqualified lusr con cnv invite
+ AddMembers lusr zcon qcnv invite ->
+ mapErrors $ Update.addMembers lusr zcon qcnv invite
+ ReplaceMembers lusr zcon qcnv invite ->
+ mapErrors $ Update.replaceMembers lusr zcon qcnv invite
+ JoinConversationById lusr con cnv ->
+ mapErrors $ Update.joinConversationById lusr con cnv
+ JoinConversationByReusableCode lusr con req ->
+ mapErrors $ Update.joinConversationByReusableCode lusr con req
+ CheckReusableCode addr code ->
+ mapErrors $ Update.checkReusableCode addr code
+ AddCodeUnqualified mReq usr mbZHost mZcon cnv ->
+ mapErrors $ Update.addCodeUnqualified mReq usr mbZHost mZcon cnv
+ RmCodeUnqualified lusr con cnv ->
+ mapErrors $ Update.rmCodeUnqualified lusr con cnv
+ MemberTyping lusr con qcnv status ->
+ mapErrors $ Update.memberTyping lusr con qcnv status
+ RemoveMemberQualified lusr con qcnv quid ->
+ mapErrors $ Update.removeMemberQualified lusr con qcnv quid
+ UpdateOtherMember lusr con qcnv quid update ->
+ mapErrors $ Update.updateOtherMember lusr con qcnv quid update
+ UpdateConversationName lusr zcon qcnv rename ->
+ mapErrors $ Update.updateConversationName lusr zcon qcnv rename
+ UpdateConversationMessageTimer lusr zcon qcnv update ->
+ mapErrors $ Update.updateConversationMessageTimer lusr zcon qcnv update
+ UpdateConversationReceiptMode lusr zcon qcnv update ->
+ mapErrors $ Update.updateConversationReceiptMode lusr zcon qcnv update
+ UpdateConversationAccess lusr zcon qcnv update ->
+ mapErrors $ Update.updateConversationAccess lusr zcon qcnv update
+ UpdateConversationHistory lusr zcon qcnv update ->
+ mapErrors $ Update.updateConversationHistory lusr zcon qcnv update
+ UpdateSelfMember lusr zcon qcnv update ->
+ mapErrors $ Update.updateSelfMember lusr zcon qcnv update
+ UpdateConversationProtocolWithLocalUser lusr conn qcnv update ->
+ mapErrors $ Update.updateConversationProtocolWithLocalUser lusr conn qcnv update
+ UpdateChannelAddPermission lusr conn qcnv update ->
+ mapErrors $ Update.updateChannelAddPermission lusr conn qcnv update
+ PostBotMessageUnqualified bid cnv ignore report msg ->
+ mapErrors $ Update.postBotMessageUnqualified bid cnv ignore report msg
+ DeleteSubConversation lusr qcnv sub reset ->
+ mapErrors $ MLSSubConversation.deleteSubConversation lusr qcnv sub reset
+ GetSubConversationGroupInfo lusr qcnv sub ->
+ mapErrors $ MLSSubConversation.getSubConversationGroupInfo lusr qcnv sub
+ LeaveSubConversation lusr cli qcnv sub ->
+ mapErrors $ MLSSubConversation.leaveSubConversation lusr cli qcnv sub
+ SendConversationActionNotifications tag quid notifyOrigDomain con lconv targets action extraData ->
+ mapErrors $ ActionNotify.sendConversationActionNotifications tag quid notifyOrigDomain con lconv targets action extraData
+ GetPaginatedConversations lusr mids mstart msize ->
+ mapErrors $ Query.getConversations lusr mids mstart msize
+ SearchChannels lusr tid searchString sortOrder pageSize lastName lastId discoverable ->
+ mapErrors $ Query.searchChannels lusr tid searchString sortOrder pageSize lastName lastId discoverable
+ InternalGetMember qcnv usr ->
+ mapErrors $ Query.internalGetMember qcnv usr
+ GetConversationMeta cnv ->
+ mapErrors $ Query.getConversationMeta cnv
+ GetMLSOne2OneConversationInternal lself qother ->
+ mapErrors $ Query.getMLSOne2OneConversationInternal lself qother
+ IsMLSOne2OneEstablished lself qother ->
+ mapErrors $ Query.isMLSOne2OneEstablished lself qother
+ GetLocalConversationInternal cid ->
+ mapErrors $ Query.getLocalConversationInternal cid
+ RemoveClient uid cid ->
+ mapErrors $ Clients.rmClient uid cid
+ AddBot lusr zcon b ->
+ mapErrors $ Update.addBot lusr zcon b
+ RmBot lusr zcon b ->
+ mapErrors $ Update.rmBot lusr zcon b
+ UpdateCellsState cnv state ->
+ mapErrors $ Update.updateCellsState cnv state
+ RemoveUser lc includeMain qusr ->
+ mapErrors $ MLSRemoval.removeUser lc includeMain qusr
+ InternalUpsertOne2OneConversation req ->
+ mapErrors $ One2One.internalUpsertOne2OneConversation req
+ AcceptConv lusr conn cnv ->
+ mapErrors $ Update.acceptConv lusr conn cnv
+ BlockConv lusr qcnv ->
+ mapErrors $ Update.blockConv lusr qcnv
+ UnblockConv lusr conn qcnv ->
+ mapErrors $ Update.unblockConv lusr conn qcnv
diff --git a/services/galley/src/Galley/API/LegalHold/Conflicts.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/LegalholdConflicts.hs
similarity index 96%
rename from services/galley/src/Galley/API/LegalHold/Conflicts.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/LegalholdConflicts.hs
index 23adf1c22b..0c45f09b64 100644
--- a/services/galley/src/Galley/API/LegalHold/Conflicts.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/LegalholdConflicts.hs
@@ -17,7 +17,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.LegalHold.Conflicts
+module Wire.ConversationSubsystem.LegalholdConflicts
( guardQualifiedLegalholdPolicyConflicts,
guardLegalholdPolicyConflicts,
LegalholdConflicts (LegalholdConflicts),
@@ -46,7 +46,6 @@ import Wire.API.Team.Member
import Wire.API.User
import Wire.API.User.Client as Client
import Wire.BrigAPIAccess
-import Wire.Options.Galley
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.Util
@@ -59,7 +58,7 @@ guardQualifiedLegalholdPolicyConflicts ::
( Member BrigAPIAccess r,
Member (Error LegalholdConflicts) r,
Member (Input (Local ())) r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member P.TinyLog r,
Member TeamSubsystem r
) =>
@@ -83,7 +82,7 @@ guardQualifiedLegalholdPolicyConflicts protectee qclients = do
guardLegalholdPolicyConflicts ::
( Member BrigAPIAccess r,
Member (Error LegalholdConflicts) r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member P.TinyLog r,
Member TeamSubsystem r
) =>
@@ -94,7 +93,7 @@ guardLegalholdPolicyConflicts LegalholdPlusFederationNotImplemented _otherClient
guardLegalholdPolicyConflicts UnprotectedBot _otherClients = pure ()
guardLegalholdPolicyConflicts (ProtectedUser self) otherClients = do
opts <- input
- case view (settings . featureFlags . to npProject) opts of
+ case view (to npProject) opts of
FeatureLegalHoldDisabledPermanently -> case FutureWork @'LegalholdPlusFederationNotImplemented () of
FutureWork () ->
-- FUTUREWORK: once we support federation and LH in combination, we still need to run
@@ -107,7 +106,7 @@ guardLegalholdPolicyConflicts (ProtectedUser self) otherClients = do
-- | Guard notification handling against legal-hold policy conflicts.
-- Ensures that if any user has a LH client then no user can be missing consent.
-- See also: "Brig.API.Connection.checkLegalholdPolicyConflict"
--- and "Galley.API.Action.checkLHPolicyConflictsLocal".
+-- and "Wire.ConversationSubsystem.Action.checkLHPolicyConflictsLocal".
guardLegalholdPolicyConflictsUid ::
forall r.
( Member BrigAPIAccess r,
diff --git a/services/galley/src/Galley/API/MLS.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS.hs
similarity index 88%
rename from services/galley/src/Galley/API/MLS.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS.hs
index 8da6d00620..a8fedb7fd5 100644
--- a/services/galley/src/Galley/API/MLS.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS.hs
@@ -15,28 +15,22 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS
- ( isMLSEnabled,
- assertMLSEnabled,
- postMLSMessage,
- postMLSCommitBundleFromLocalUser,
- postMLSMessageFromLocalUser,
- getMLSPublicKeys,
+module Wire.ConversationSubsystem.MLS
+ ( getMLSPublicKeys,
formatPublicKeys,
)
where
import Data.Default
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.Message
import Galley.Types.Error
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
-import Wire.API.Error
+import Wire.API.Error (ErrorS)
import Wire.API.Error.Galley
import Wire.API.MLS.Keys
+import Wire.ConversationSubsystem.MLS.Enabled (getMLSPrivateKeys)
getMLSPublicKeys ::
( Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
diff --git a/services/galley/src/Galley/API/MLS/CheckClients.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/CheckClients.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/CheckClients.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/CheckClients.hs
index 22ff3de481..388d6a1642 100644
--- a/services/galley/src/Galley/API/MLS/CheckClients.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/CheckClients.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.CheckClients
+module Wire.ConversationSubsystem.MLS.CheckClients
( checkClients,
getClientData,
ClientData (..),
@@ -29,7 +29,6 @@ import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
import Data.Tuple.Extra
-import Galley.API.MLS.Commit.Core
import Imports
import Polysemy
import Polysemy.Error
@@ -43,6 +42,7 @@ import Wire.API.MLS.LeafNode
import Wire.API.User.Client
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.Commit.Core
import Wire.FederationAPIAccess (FederationAPIAccess)
checkClients ::
diff --git a/services/galley/src/Galley/API/MLS/Commit/Core.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/Commit/Core.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs
index 0318881e60..a51f0adcbc 100644
--- a/services/galley/src/Galley/API/MLS/Commit/Core.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/Core.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Commit.Core
+module Wire.ConversationSubsystem.MLS.Commit.Core
( getCommitData,
incrementEpoch,
getClientInfo,
@@ -31,9 +31,6 @@ where
import Control.Comonad
import Data.Id
import Data.Qualified
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.IncomingMessage
-import Galley.API.MLS.Proposal
import Galley.Types.Error
import Imports
import Polysemy
@@ -66,6 +63,9 @@ import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.Conversation
+import Wire.ConversationSubsystem.MLS.IncomingMessage
+import Wire.ConversationSubsystem.MLS.Proposal
import Wire.ExternalAccess
import Wire.FederationAPIAccess
import Wire.LegalHoldStore (LegalHoldStore)
diff --git a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/ExternalCommit.hs
similarity index 96%
rename from services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/ExternalCommit.hs
index 9aec3fa0ea..10fa4e6bd5 100644
--- a/services/galley/src/Galley/API/MLS/Commit/ExternalCommit.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/ExternalCommit.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Commit.ExternalCommit
+module Wire.ConversationSubsystem.MLS.Commit.ExternalCommit
( ExternalCommitAction (..),
getExternalCommitData,
processExternalCommit,
@@ -28,11 +28,6 @@ import Control.Monad.Codensity
import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
-import Galley.API.MLS.Commit.Core
-import Galley.API.MLS.IncomingMessage
-import Galley.API.MLS.Proposal
-import Galley.API.MLS.Removal
-import Galley.API.MLS.Util
import Imports
import Polysemy
import Polysemy.Error
@@ -51,6 +46,11 @@ import Wire.API.MLS.ProposalTag
import Wire.API.MLS.SubConversation
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.Commit.Core
+import Wire.ConversationSubsystem.MLS.IncomingMessage
+import Wire.ConversationSubsystem.MLS.Proposal
+import Wire.ConversationSubsystem.MLS.Removal
+import Wire.ConversationSubsystem.MLS.Util
data ExternalCommitAction = ExternalCommitAction
{ add :: LeafIndex,
diff --git a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/InternalCommit.hs
similarity index 96%
rename from services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/InternalCommit.hs
index 53c51cfa62..8abc46eefb 100644
--- a/services/galley/src/Galley/API/MLS/Commit/InternalCommit.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Commit/InternalCommit.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Commit.InternalCommit (processInternalCommit) where
+module Wire.ConversationSubsystem.MLS.Commit.InternalCommit (processInternalCommit) where
import Control.Comonad
import Control.Error.Util (hush)
@@ -29,14 +29,6 @@ import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
import Data.Tuple.Extra
-import Galley.API.Action
-import Galley.API.MLS.CheckClients
-import Galley.API.MLS.Commit.Core
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.IncomingMessage
-import Galley.API.MLS.One2One
-import Galley.API.MLS.Proposal
-import Galley.API.MLS.Util
import Galley.Types.Error
import Imports
import Polysemy
@@ -60,7 +52,14 @@ import Wire.API.MLS.SubConversation
import Wire.API.Unreachable
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action
+import Wire.ConversationSubsystem.MLS.CheckClients
+import Wire.ConversationSubsystem.MLS.Commit.Core
+import Wire.ConversationSubsystem.MLS.Conversation
+import Wire.ConversationSubsystem.MLS.IncomingMessage
+import Wire.ConversationSubsystem.MLS.One2One
+import Wire.ConversationSubsystem.MLS.Proposal
+import Wire.ConversationSubsystem.MLS.Util
import Wire.ConversationSubsystem.Util
import Wire.FederationSubsystem
import Wire.ProposalStore
@@ -78,7 +77,6 @@ processInternalCommit ::
Member (ErrorS 'MLSIdentityMismatch) r,
Member (ErrorS 'MissingLegalholdConsent) r,
Member (ErrorS 'GroupIdVersionNotSupported) r,
- Member ConversationSubsystem r,
Member Resource r,
Member Random r,
Member (ErrorS MLSInvalidLeafNodeSignature) r,
@@ -258,7 +256,6 @@ processInternalCommit senderIdentity con lConvOrSub ciphersuite ciphersuiteUpdat
addMembers ::
( HasProposalActionEffects r,
- Member ConversationSubsystem r,
Member FederationSubsystem r,
Member TeamSubsystem r
) =>
@@ -286,7 +283,6 @@ addMembers qusr con lConvOrSub users = case tUnqualified lConvOrSub of
removeMembers ::
( HasProposalActionEffects r,
- Member ConversationSubsystem r,
Member TeamSubsystem r
) =>
Qualified UserId ->
diff --git a/services/galley/src/Galley/API/MLS/Conversation.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Conversation.hs
similarity index 97%
rename from services/galley/src/Galley/API/MLS/Conversation.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Conversation.hs
index 0b97988081..b129d31c00 100644
--- a/services/galley/src/Galley/API/MLS/Conversation.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Conversation.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Conversation
+module Wire.ConversationSubsystem.MLS.Conversation
( mkMLSConversation,
newMLSConversation,
mcConv,
diff --git a/services/galley/src/Galley/API/MLS/Enabled.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Enabled.hs
similarity index 95%
rename from services/galley/src/Galley/API/MLS/Enabled.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Enabled.hs
index 158d511e29..1910f5945f 100644
--- a/services/galley/src/Galley/API/MLS/Enabled.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Enabled.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Enabled where
+module Wire.ConversationSubsystem.MLS.Enabled where
import Imports hiding (getFirst)
import Polysemy
@@ -25,7 +25,7 @@ import Wire.API.Error.Galley
import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
isMLSEnabled :: (Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r) => Sem r Bool
-isMLSEnabled = inputs (isJust)
+isMLSEnabled = inputs isJust
-- | Fail if MLS is not enabled. Only use this function at the beginning of an
-- MLS endpoint, NOT in utility functions.
diff --git a/services/galley/src/Galley/API/MLS/GroupInfo.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfo.hs
similarity index 95%
rename from services/galley/src/Galley/API/MLS/GroupInfo.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfo.hs
index 69f667cab7..f52928307d 100644
--- a/services/galley/src/Galley/API/MLS/GroupInfo.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfo.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.GroupInfo
+module Wire.ConversationSubsystem.MLS.GroupInfo
( MLSGroupInfoStaticErrors,
getGroupInfo,
getGroupInfoFromLocalConv,
@@ -26,8 +26,6 @@ where
import Data.Id as Id
import Data.Json.Util
import Data.Qualified
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.Util
import Imports
import Polysemy
import Polysemy.Error
@@ -42,6 +40,8 @@ import Wire.API.MLS.GroupInfo
import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
import Wire.API.MLS.SubConversation
import Wire.ConversationStore qualified as E
+import Wire.ConversationSubsystem.MLS.Enabled
+import Wire.ConversationSubsystem.MLS.Util
import Wire.ConversationSubsystem.Util
import Wire.FederationAPIAccess qualified as E
diff --git a/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfoCheck.hs
similarity index 96%
rename from services/galley/src/Galley/API/MLS/GroupInfoCheck.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfoCheck.hs
index 667a29dc3f..d3bdabf3e3 100644
--- a/services/galley/src/Galley/API/MLS/GroupInfoCheck.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/GroupInfoCheck.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.GroupInfoCheck
+module Wire.ConversationSubsystem.MLS.GroupInfoCheck
( checkGroupState,
GroupInfoMismatch (..),
GroupInfoCheckEnabled (..),
@@ -24,7 +24,6 @@ where
import Data.Bifunctor
import Data.Id
-import Galley.API.Teams.Features.Get
import Imports
import Polysemy
import Polysemy.Error
@@ -43,7 +42,7 @@ import Wire.API.MLS.Serialisation
import Wire.API.Team.Feature
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
-import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem)
+import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getFeatureForTeam)
data GroupInfoMismatch = GroupInfoMismatch
{clients :: [(Int, ClientIdentity)]}
diff --git a/services/galley/src/Galley/API/MLS/IncomingMessage.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/IncomingMessage.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/IncomingMessage.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/IncomingMessage.hs
index 3a3fba6251..b88c90fbf7 100644
--- a/services/galley/src/Galley/API/MLS/IncomingMessage.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/IncomingMessage.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.IncomingMessage
+module Wire.ConversationSubsystem.MLS.IncomingMessage
( IncomingMessage (..),
IncomingMessageContent (..),
IncomingPublicMessageContent (..),
diff --git a/services/galley/src/Galley/API/MLS/Keys.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Keys.hs
similarity index 95%
rename from services/galley/src/Galley/API/MLS/Keys.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Keys.hs
index ddafc4e0e2..b5a84d89f5 100644
--- a/services/galley/src/Galley/API/MLS/Keys.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Keys.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Keys (getMLSRemovalKey, SomeKeyPair (..)) where
+module Wire.ConversationSubsystem.MLS.Keys (getMLSRemovalKey, SomeKeyPair (..)) where
import Control.Error.Util (hush)
import Data.Proxy
diff --git a/services/galley/src/Galley/API/MLS/Message.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Message.hs
similarity index 90%
rename from services/galley/src/Galley/API/MLS/Message.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Message.hs
index 6425512192..1059711eff 100644
--- a/services/galley/src/Galley/API/MLS/Message.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Message.hs
@@ -15,17 +15,12 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Message
- ( IncomingBundle (..),
- mkIncomingBundle,
- IncomingMessage (..),
- mkIncomingMessage,
+module Wire.ConversationSubsystem.MLS.Message
+ ( MLSMessageStaticErrors,
postMLSCommitBundle,
postMLSCommitBundleFromLocalUser,
postMLSMessageFromLocalUser,
postMLSMessage,
- MLSMessageStaticErrors,
- MLSBundleStaticErrors,
)
where
@@ -40,27 +35,11 @@ import Data.Set qualified as Set
import Data.Tagged
import Data.Text.Lazy qualified as LT
import Data.Tuple.Extra
-import Galley.API.Action
-import Galley.API.LegalHold.Get (getUserStatus)
-import Galley.API.MLS.Commit.Core (getCommitData)
-import Galley.API.MLS.Commit.ExternalCommit
-import Galley.API.MLS.Commit.InternalCommit
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.GroupInfoCheck
-import Galley.API.MLS.IncomingMessage
-import Galley.API.MLS.One2One
-import Galley.API.MLS.OutOfSync
-import Galley.API.MLS.Propagate
-import Galley.API.MLS.Proposal
-import Galley.API.MLS.Util
-import Galley.API.MLS.Welcome (sendWelcomes)
import Galley.Types.Error
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
-import Polysemy.Internal
import Polysemy.Output
import Polysemy.Resource (Resource)
import Polysemy.TinyLog
@@ -88,7 +67,20 @@ import Wire.API.Team.LegalHold
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action
+import Wire.ConversationSubsystem.MLS.Commit.Core (getCommitData)
+import Wire.ConversationSubsystem.MLS.Commit.ExternalCommit
+import Wire.ConversationSubsystem.MLS.Commit.InternalCommit
+import Wire.ConversationSubsystem.MLS.Conversation
+import Wire.ConversationSubsystem.MLS.Enabled
+import Wire.ConversationSubsystem.MLS.GroupInfoCheck
+import Wire.ConversationSubsystem.MLS.IncomingMessage
+import Wire.ConversationSubsystem.MLS.One2One
+import Wire.ConversationSubsystem.MLS.OutOfSync
+import Wire.ConversationSubsystem.MLS.Propagate
+import Wire.ConversationSubsystem.MLS.Proposal
+import Wire.ConversationSubsystem.MLS.Util
+import Wire.ConversationSubsystem.MLS.Welcome (sendWelcomes)
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.FeaturesConfigSubsystem
@@ -99,7 +91,7 @@ import Wire.Sem.Now qualified as Now
import Wire.Sem.Random (Random)
import Wire.StoredConversation
import Wire.TeamStore qualified as TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (TeamSubsystem, getUserStatus)
-- FUTUREWORK
-- - Check that the capabilities of a leaf node in an add proposal contains all
@@ -116,25 +108,12 @@ type MLSMessageStaticErrors =
ErrorS 'MLSStaleMessage,
ErrorS 'MLSProposalNotFound,
ErrorS 'MissingLegalholdConsent,
- ErrorS 'MLSInvalidLeafNodeIndex,
- ErrorS 'MLSClientMismatch,
- ErrorS 'MLSUnsupportedProposal,
ErrorS 'MLSCommitMissingReferences,
ErrorS 'MLSSelfRemovalNotAllowed,
ErrorS 'MLSClientSenderUserMismatch,
- ErrorS 'MLSGroupConversationMismatch,
ErrorS 'MLSSubConvClientNotInParent
]
-type MLSBundleStaticErrors =
- Append
- MLSMessageStaticErrors
- '[ ErrorS 'MLSWelcomeMismatch,
- ErrorS 'MLSIdentityMismatch,
- ErrorS 'GroupIdVersionNotSupported,
- ErrorS 'MLSInvalidLeafNodeSignature
- ]
-
enableOutOfSyncCheckFromVersion :: Version -> EnableOutOfSyncCheck
enableOutOfSyncCheckFromVersion v
| v < V13 = DisableOutOfSyncCheck
@@ -149,7 +128,6 @@ postMLSMessageFromLocalUser ::
Member (ErrorS 'MissingLegalholdConsent) r,
Member (ErrorS 'MLSClientSenderUserMismatch) r,
Member (ErrorS 'MLSCommitMissingReferences) r,
- Member (ErrorS 'MLSGroupConversationMismatch) r,
Member (ErrorS 'MLSNotEnabled) r,
Member (ErrorS 'MLSProposalNotFound) r,
Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
@@ -171,9 +149,8 @@ postMLSMessageFromLocalUser v lusr c conn smsg = do
imsg <- noteS @'MLSUnsupportedMessage $ mkIncomingMessage smsg
(ctype, cnvOrSub) <- getConvFromGroupId imsg.groupId
events <-
- runInputConst (enableOutOfSyncCheckFromVersion v) $
- map lcuEvent
- <$> postMLSMessage lusr (tUntagged lusr) c ctype cnvOrSub (Just conn) imsg
+ map lcuEvent
+ <$> postMLSMessage lusr (tUntagged lusr) c ctype cnvOrSub (Just conn) (enableOutOfSyncCheckFromVersion v) imsg
t <- toUTCTimeMillis <$> Now.get
pure $ MLSMessageSendingStatus events t
@@ -183,13 +160,12 @@ postMLSCommitBundle ::
Member (Error GroupInfoDiagnostics) r,
Member (Error MLSOutOfSyncError) r,
Member (ErrorS GroupIdVersionNotSupported) r,
- Member (Input EnableOutOfSyncCheck) r,
Member (Input (Maybe GroupInfoCheckEnabled)) r,
Member Random r,
Member Resource r,
- Members MLSBundleStaticErrors r,
+ Members MLSMessageStaticErrors r,
+ Member (ErrorS 'MLSInvalidLeafNodeSignature) r,
HasProposalEffects r,
- Member ConversationSubsystem r,
Member MLSCommitLockStore r,
Member FederationSubsystem r,
Member TeamSubsystem r,
@@ -202,14 +178,16 @@ postMLSCommitBundle ::
ConvType ->
Qualified ConvOrSubConvId ->
Maybe ConnId ->
+ EnableOutOfSyncCheck ->
IncomingBundle ->
Sem r [LocalConversationUpdate]
-postMLSCommitBundle loc qusr c ctype qConvOrSub conn bundle =
- foldQualified
- loc
- (postMLSCommitBundleToLocalConv qusr c conn bundle ctype)
- (postMLSCommitBundleToRemoteConv loc qusr c conn bundle ctype)
- qConvOrSub
+postMLSCommitBundle loc qusr c ctype qConvOrSub conn oosCheck bundle =
+ runInputConst oosCheck $
+ foldQualified
+ loc
+ (postMLSCommitBundleToLocalConv qusr c conn bundle ctype)
+ (postMLSCommitBundleToRemoteConv loc qusr c conn bundle ctype)
+ qConvOrSub
postMLSCommitBundleFromLocalUser ::
( Member (ErrorS MLSLegalholdIncompatible) r,
@@ -221,9 +199,9 @@ postMLSCommitBundleFromLocalUser ::
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
Member Random r,
Member Resource r,
- Members MLSBundleStaticErrors r,
+ Members MLSMessageStaticErrors r,
+ Member (ErrorS 'MLSInvalidLeafNodeSignature) r,
HasProposalEffects r,
- Member ConversationSubsystem r,
Member MLSCommitLockStore r,
Member FederationSubsystem r,
Member TeamSubsystem r,
@@ -242,9 +220,8 @@ postMLSCommitBundleFromLocalUser v lusr c conn bundle = do
(ctype, qConvOrSub) <- getConvFromGroupId ibundle.groupId
events <-
- runInputConst (enableOutOfSyncCheckFromVersion v) $
- map lcuEvent
- <$> postMLSCommitBundle lusr (tUntagged lusr) c ctype qConvOrSub (Just conn) ibundle
+ map lcuEvent
+ <$> postMLSCommitBundle lusr (tUntagged lusr) c ctype qConvOrSub (Just conn) (enableOutOfSyncCheckFromVersion v) ibundle
t <- toUTCTimeMillis <$> Now.get
pure $ MLSMessageSendingStatus events t
@@ -258,9 +235,9 @@ postMLSCommitBundleToLocalConv ::
Member (Input (Maybe GroupInfoCheckEnabled)) r,
Member Random r,
Member Resource r,
- Members MLSBundleStaticErrors r,
+ Members MLSMessageStaticErrors r,
+ Member (ErrorS 'MLSInvalidLeafNodeSignature) r,
HasProposalEffects r,
- Member ConversationSubsystem r,
Member MLSCommitLockStore r,
Member FederationSubsystem r,
Member TeamSubsystem r,
@@ -405,7 +382,7 @@ handleGroupInfoMismatch lConvId bundle m =
postMLSCommitBundleToRemoteConv ::
( Member BrigAPIAccess r,
- Members MLSBundleStaticErrors r,
+ Members MLSMessageStaticErrors r,
Member (Error FederationError) r,
Member (Error MLSProtocolError) r,
Member (Error MLSProposalFailure) r,
@@ -448,7 +425,7 @@ postMLSCommitBundleToRemoteConv loc qusr c con bundle ctype rConvOrSubId = do
enableOutOfSyncCheck
}
case resp of
- MLSMessageResponseError e -> rethrowErrors @MLSBundleStaticErrors e
+ MLSMessageResponseError e -> rethrowErrors @MLSMessageStaticErrors e
MLSMessageResponseProtocolError e -> throw (mlsProtocolError e)
MLSMessageResponseProposalFailure e -> throw (MLSProposalFailure e)
MLSMessageResponseUnreachableBackends ds -> throw (UnreachableBackends (toList ds))
@@ -470,7 +447,6 @@ postMLSMessage ::
Member (ErrorS 'MissingLegalholdConsent) r,
Member (ErrorS 'MLSClientSenderUserMismatch) r,
Member (ErrorS 'MLSCommitMissingReferences) r,
- Member (ErrorS 'MLSGroupConversationMismatch) r,
Member (ErrorS 'MLSProposalNotFound) r,
Member (ErrorS 'MLSSelfRemovalNotAllowed) r,
Member (ErrorS 'MLSStaleMessage) r,
@@ -478,8 +454,7 @@ postMLSMessage ::
Member (ErrorS 'MLSSubConvClientNotInParent) r,
Member (ErrorS MLSInvalidLeafNodeSignature) r,
Member (Error MLSOutOfSyncError) r,
- Member (Error GroupInfoDiagnostics) r,
- Member (Input EnableOutOfSyncCheck) r
+ Member (Error GroupInfoDiagnostics) r
) =>
Local x ->
Qualified UserId ->
@@ -487,14 +462,16 @@ postMLSMessage ::
ConvType ->
Qualified ConvOrSubConvId ->
Maybe ConnId ->
+ EnableOutOfSyncCheck ->
IncomingMessage ->
Sem r [LocalConversationUpdate]
-postMLSMessage loc qusr c ctype qconvOrSub con msg = do
- foldQualified
- loc
- (postMLSMessageToLocalConv qusr c con msg ctype)
- (postMLSMessageToRemoteConv loc qusr c con msg)
- qconvOrSub
+postMLSMessage loc qusr c ctype qconvOrSub con oosCheck msg = do
+ runInputConst oosCheck $
+ foldQualified
+ loc
+ (postMLSMessageToLocalConv qusr c con msg ctype)
+ (postMLSMessageToRemoteConv loc qusr c con msg)
+ qconvOrSub
getSenderIdentity ::
( Member (ErrorS 'MLSClientSenderUserMismatch) r,
diff --git a/services/galley/src/Galley/API/MLS/Migration.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Migration.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/Migration.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Migration.hs
index 1db5ce2957..0922d1588f 100644
--- a/services/galley/src/Galley/API/MLS/Migration.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Migration.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Migration where
+module Wire.ConversationSubsystem.MLS.Migration where
import Data.Qualified
import Data.Set qualified as Set
diff --git a/services/galley/src/Galley/API/MLS/One2One.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/One2One.hs
similarity index 97%
rename from services/galley/src/Galley/API/MLS/One2One.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/One2One.hs
index 3f8550b4b9..2db148d7aa 100644
--- a/services/galley/src/Galley/API/MLS/One2One.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/One2One.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.One2One
+module Wire.ConversationSubsystem.MLS.One2One
( localMLSOne2OneConversation,
localMLSOne2OneConversationAsRemote,
localMLSOne2OneConversationMetadata,
@@ -65,7 +65,7 @@ localMLSOne2OneConversation lself (tUntagged -> convId) =
-- conversation to be returned to a remote backend.
localMLSOne2OneConversationAsRemote ::
Local ConvId ->
- RemoteConversationV2
+ RemoteConversationView
localMLSOne2OneConversationAsRemote lcnv =
let members =
RemoteConvMembers
@@ -73,7 +73,7 @@ localMLSOne2OneConversationAsRemote lcnv =
others = []
}
(metadata, mlsData) = localMLSOne2OneConversationMetadata (tUntagged lcnv)
- in RemoteConversationV2
+ in RemoteConversationView
{ id = tUnqualified lcnv,
metadata = metadata,
members = members,
diff --git a/services/galley/src/Galley/API/MLS/OutOfSync.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/OutOfSync.hs
similarity index 97%
rename from services/galley/src/Galley/API/MLS/OutOfSync.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/OutOfSync.hs
index 03556f89ad..b9aaceb5bb 100644
--- a/services/galley/src/Galley/API/MLS/OutOfSync.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/OutOfSync.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.OutOfSync
+module Wire.ConversationSubsystem.MLS.OutOfSync
( checkConversationOutOfSync,
updateOutOfSyncFlag,
)
@@ -25,7 +25,6 @@ import Data.Id
import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
-import Galley.API.MLS.CheckClients
import Imports
import Polysemy
import Polysemy.Error
@@ -39,6 +38,7 @@ import Wire.API.MLS.SubConversation
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.CheckClients
import Wire.FederationAPIAccess (FederationAPIAccess)
import Wire.StoredConversation
diff --git a/services/galley/src/Galley/API/MLS/Propagate.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Propagate.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/Propagate.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Propagate.hs
index 8e71e7463e..8445a089f4 100644
--- a/services/galley/src/Galley/API/MLS/Propagate.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Propagate.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Propagate where
+module Wire.ConversationSubsystem.MLS.Propagate where
import Control.Comonad
import Data.Id
diff --git a/services/galley/src/Galley/API/MLS/Proposal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs
similarity index 99%
rename from services/galley/src/Galley/API/MLS/Proposal.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs
index fdff658e2a..712fd32aee 100644
--- a/services/galley/src/Galley/API/MLS/Proposal.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Proposal.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Proposal
+module Wire.ConversationSubsystem.MLS.Proposal
( -- * Proposal processing
derefOrCheckProposal,
checkProposal,
@@ -38,7 +38,6 @@ import Data.Id
import Data.Map qualified as Map
import Data.Qualified
import Data.Set qualified as Set
-import Galley.API.MLS.IncomingMessage
import Galley.Types.Error
import Imports
import Polysemy
@@ -67,6 +66,7 @@ import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess
import Wire.ConversationStore (ConversationStore)
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.IncomingMessage
import Wire.ExternalAccess
import Wire.FederationAPIAccess (FederationAPIAccess)
import Wire.LegalHoldStore (LegalHoldStore)
diff --git a/services/galley/src/Galley/API/MLS/Removal.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Removal.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/Removal.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Removal.hs
index fbdc427bbc..3daa9b661e 100644
--- a/services/galley/src/Galley/API/MLS/Removal.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Removal.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Removal
+module Wire.ConversationSubsystem.MLS.Removal
( createAndSendRemoveProposals,
removeExtraneousClients,
removeClient,
@@ -31,9 +31,6 @@ import Data.Map qualified as Map
import Data.Proxy
import Data.Qualified
import Data.Set qualified as Set
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.Keys
-import Galley.API.MLS.Propagate
import Imports
import Polysemy
import Polysemy.Error
@@ -54,6 +51,9 @@ import Wire.API.MLS.SubConversation
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem.MLS.Conversation
+import Wire.ConversationSubsystem.MLS.Keys
+import Wire.ConversationSubsystem.MLS.Propagate
import Wire.ExternalAccess
import Wire.NotificationSubsystem
import Wire.ProposalStore
diff --git a/services/galley/src/Galley/API/MLS/Reset.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Reset.hs
similarity index 93%
rename from services/galley/src/Galley/API/MLS/Reset.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Reset.hs
index 18955e75c1..0f88ab7969 100644
--- a/services/galley/src/Galley/API/MLS/Reset.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Reset.hs
@@ -15,14 +15,10 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Reset (resetMLSConversation) where
+module Wire.ConversationSubsystem.MLS.Reset (resetMLSConversation) where
import Data.Id
import Data.Qualified
-import Galley.API.Action
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.Util
-import Galley.API.Update
import Galley.Types.Error
import Imports
import Polysemy
@@ -42,7 +38,10 @@ import Wire.API.Routes.Public.Galley.MLS
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.ConversationStore
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action
+import Wire.ConversationSubsystem.MLS.Enabled (assertMLSEnabled)
+import Wire.ConversationSubsystem.MLS.Util
+import Wire.ConversationSubsystem.Update
import Wire.ExternalAccess (ExternalAccess)
import Wire.FederationAPIAccess (FederationAPIAccess)
import Wire.NotificationSubsystem
@@ -52,10 +51,8 @@ import Wire.Sem.Random (Random)
import Wire.TeamSubsystem (TeamSubsystem)
resetMLSConversation ::
- ( Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
- Member Now r,
+ ( Member Now r,
Member (Input (Local ())) r,
- Member (ErrorS MLSNotEnabled) r,
Member (ErrorS MLSStaleMessage) r,
Member (ErrorS (ActionDenied LeaveConversation)) r,
Member (ErrorS ConvNotFound) r,
@@ -63,6 +60,8 @@ resetMLSConversation ::
Member (Error InternalError) r,
Member (ErrorS InvalidOperation) r,
Member (ErrorS MLSFederatedResetNotSupported) r,
+ Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
+ Member (ErrorS MLSNotEnabled) r,
Member BackendNotificationQueueAccess r,
Member ConversationStore r,
Member (FederationAPIAccess FederatorClient) r,
@@ -70,7 +69,6 @@ resetMLSConversation ::
Member (Error FederationError) r,
Member BrigAPIAccess r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member ProposalStore r,
Member Random r,
Member Resource r,
diff --git a/services/galley/src/Galley/API/MLS/SubConversation.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/SubConversation.hs
similarity index 94%
rename from services/galley/src/Galley/API/MLS/SubConversation.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/SubConversation.hs
index a404476e37..14574b31c2 100644
--- a/services/galley/src/Galley/API/MLS/SubConversation.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/SubConversation.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.SubConversation
+module Wire.ConversationSubsystem.MLS.SubConversation
( getSubConversation,
getLocalSubConversation,
deleteSubConversation,
@@ -35,11 +35,6 @@ import Control.Arrow
import Control.Monad.Codensity hiding (reset)
import Data.Id
import Data.Qualified
-import Galley.API.MLS
-import Galley.API.MLS.Conversation
-import Galley.API.MLS.GroupInfo
-import Galley.API.MLS.Removal
-import Galley.API.MLS.Util
import Imports
import Polysemy
import Polysemy.Error
@@ -65,6 +60,11 @@ import Wire.API.Routes.Public.Galley.MLS
import Wire.BackendNotificationQueueAccess
import Wire.ConversationStore qualified as Conversation
import Wire.ConversationStore.MLS.Types as Conversation
+import Wire.ConversationSubsystem.MLS.Conversation (mkMLSConversation)
+import Wire.ConversationSubsystem.MLS.Enabled (assertMLSEnabled)
+import Wire.ConversationSubsystem.MLS.GroupInfo (getGroupInfoFromRemoteConv)
+import Wire.ConversationSubsystem.MLS.Removal (createAndSendRemoveProposals)
+import Wire.ConversationSubsystem.MLS.Util (getLocalConvForUser, withCommitLock)
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess (ExternalAccess)
import Wire.FederationAPIAccess
@@ -169,10 +169,12 @@ getSubConversationGroupInfo ::
'[ Conversation.ConversationStore,
Error FederationError,
FederationAPIAccess FederatorClient,
- Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))
+ Input (Maybe (MLSKeysByPurpose MLSPrivateKeys)),
+ ErrorS 'MLSNotEnabled,
+ ErrorS 'ConvNotFound,
+ ErrorS 'MLSMissingGroupInfo
]
- r,
- Members MLSGroupInfoStaticErrors r
+ r
) =>
Local UserId ->
Qualified ConvId ->
@@ -187,8 +189,10 @@ getSubConversationGroupInfo lusr qcnvId subconv = do
qcnvId
getSubConversationGroupInfoFromLocalConv ::
- (Member Conversation.ConversationStore r) =>
- (Members MLSGroupInfoStaticErrors r) =>
+ ( Member Conversation.ConversationStore r,
+ Member (ErrorS 'ConvNotFound) r,
+ Member (ErrorS 'MLSMissingGroupInfo) r
+ ) =>
Qualified UserId ->
SubConvId ->
Local ConvId ->
diff --git a/services/galley/src/Galley/API/MLS/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs
similarity index 98%
rename from services/galley/src/Galley/API/MLS/Util.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs
index 742f820b1b..814603f64f 100644
--- a/services/galley/src/Galley/API/MLS/Util.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Util.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Util where
+module Wire.ConversationSubsystem.MLS.Util where
import Control.Comonad
import Control.Monad.Codensity
diff --git a/services/galley/src/Galley/API/MLS/Welcome.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Welcome.hs
similarity index 99%
rename from services/galley/src/Galley/API/MLS/Welcome.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Welcome.hs
index 44484dda0a..b16bb87e1a 100644
--- a/services/galley/src/Galley/API/MLS/Welcome.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/MLS/Welcome.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.MLS.Welcome
+module Wire.ConversationSubsystem.MLS.Welcome
( sendWelcomes,
sendLocalWelcomes,
)
diff --git a/services/galley/src/Galley/API/Message.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Message.hs
similarity index 97%
rename from services/galley/src/Galley/API/Message.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Message.hs
index ff384a45fe..214bdcf6ed 100644
--- a/services/galley/src/Galley/API/Message.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Message.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Message
+module Wire.ConversationSubsystem.Message
( UserType (..),
sendLocalMessages,
postQualifiedOtrMessage,
@@ -24,6 +24,7 @@ module Galley.API.Message
legacyClientMismatchStrategy,
Unqualify (..),
MessageMetadata (..),
+ IntraListing (..),
-- * Only exported for tests
checkMessageClients,
@@ -48,7 +49,6 @@ import Data.Range
import Data.Set qualified as Set
import Data.Set.Lens
import Data.Time.Clock (UTCTime)
-import Galley.API.LegalHold.Conflicts
import Galley.Types.Clients qualified as Clients
import Imports hiding (forkIO)
import Network.AMQP qualified as Q
@@ -57,6 +57,7 @@ import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Log
+import Wire.API.Conversation.Config (ConversationSubsystemConfig)
import Wire.API.Conversation.Protocol
import Wire.API.Error
import Wire.API.Error.Galley
@@ -68,7 +69,7 @@ import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Federation.Error
import Wire.API.Message
import Wire.API.Routes.Public.Galley.Messaging
-import Wire.API.Team.FeatureFlags (FanoutLimit)
+import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureFlags)
import Wire.API.Team.LegalHold
import Wire.API.Team.Member
import Wire.API.User.Client
@@ -76,22 +77,26 @@ import Wire.API.UserMap (UserMap (..))
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess
import Wire.ConversationStore
-import Wire.ConversationSubsystem qualified as ConvSubsystem
+import Wire.ConversationSubsystem.Internal qualified as ConvSubsystem
+import Wire.ConversationSubsystem.LegalholdConflicts
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess
import Wire.FederationAPIAccess
import Wire.NotificationSubsystem (BotMap, NotificationSubsystem, newMessagePush, runMessagePush)
-import Wire.Options.Galley
import Wire.Sem.Now (Now)
import Wire.Sem.Now qualified as Now
import Wire.StoredConversation
import Wire.TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (TeamSubsystem, getTeamMembersForFanout)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserClientIndexStore
data UserType = User | Bot -- FUTUREWORK: there is UserType in Wire.API.User now, should we use that? (there is also UserType variant for searcho/contacts, but there is a good reason for that one.)
+newtype IntraListing
+ = IntraListing {unIntraListing :: Bool}
+ deriving stock (Eq, Ord, Show)
+
userToProtectee :: UserType -> UserId -> LegalholdProtectee
userToProtectee User user = ProtectedUser user
userToProtectee Bot _ = UnprotectedBot
@@ -259,14 +264,15 @@ postBroadcast ::
Member (ErrorS 'NonBindingTeam) r,
Member (ErrorS 'BroadcastLimitExceeded) r,
Member ExternalAccess r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member Now r,
Member TeamStore r,
Member P.TinyLog r,
Member NotificationSubsystem r,
Member (Input FanoutLimit) r,
+ Member (Input ConversationSubsystemConfig) r,
Member TeamSubsystem r,
- Member ConvSubsystem.ConversationSubsystem r
+ Member UserClientIndexStore r
) =>
Local UserId ->
Maybe ConnId ->
@@ -354,7 +360,6 @@ postBroadcast lusr con msg = runError $ do
maybeFetchAllMembersInTeam ::
( Member (ErrorS 'BroadcastLimitExceeded) r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
TeamId ->
@@ -372,7 +377,8 @@ postQualifiedOtrMessage ::
Member (FederationAPIAccess FederatorClient) r,
Member BackendNotificationQueueAccess r,
Member ExternalAccess r,
- Member (Input Opts) r,
+ Member (Input IntraListing) r,
+ Member (Input FeatureFlags) r,
Member Now r,
Member P.TinyLog r,
Member NotificationSubsystem r,
@@ -411,7 +417,7 @@ postQualifiedOtrMessage senderType sender mconn lcnv msg =
Set.fromList $
map (tUntagged . qualifyAs lcnv) localMemberIds
<> map (tUntagged . (.id_)) conv.remoteMembers
- isInternal <- view (settings . intraListing) <$> input
+ IntraListing isInternal <- input
-- check if the sender is part of the conversation
unless (Set.member sender members) $
@@ -533,7 +539,7 @@ postQualifiedOtrMessage senderType sender mconn lcnv msg =
guardQualifiedLegalholdPolicyConflictsWrapper ::
( Member BrigAPIAccess r,
Member (Error (MessageNotSent MessageSendingStatus)) r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member P.TinyLog r,
Member TeamSubsystem r
) =>
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs
index afe039381b..a73b430d57 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/One2One.hs
@@ -19,7 +19,7 @@
module Wire.ConversationSubsystem.One2One
( one2OneConvId,
- iUpsertOne2OneConversation,
+ internalUpsertOne2OneConversation,
)
where
@@ -51,12 +51,12 @@ newConnectConversationWithRemote creator users =
groupId = Nothing
}
-iUpsertOne2OneConversation ::
+internalUpsertOne2OneConversation ::
forall r.
(Member ConversationStore r) =>
UpsertOne2OneConversationRequest ->
Sem r ()
-iUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do
+internalUpsertOne2OneConversation UpsertOne2OneConversationRequest {..} = do
let dolocal :: Local ConvId -> Sem r ()
dolocal lconvId = do
mbConv <- getConversation (tUnqualified lconvId)
diff --git a/services/galley/src/Galley/API/Query.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs
similarity index 94%
rename from services/galley/src/Galley/API/Query.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs
index 201b7572bd..ce8009d45b 100644
--- a/services/galley/src/Galley/API/Query.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Query.hs
@@ -18,7 +18,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Query
+module Wire.ConversationSubsystem.Query
( getBotConversation,
getUnqualifiedOwnConversation,
getOwnConversation,
@@ -27,9 +27,10 @@ module Galley.API.Query
getLocalConversationInternal,
getConversationRoles,
conversationIdsPageFromUnqualified,
- conversationIdsPageFromV2,
+ conversationIdsPaginated,
conversationIdsPageFrom,
getConversations,
+ getConversationsInternal,
listConversations,
iterateConversations,
getLocalSelf,
@@ -42,8 +43,8 @@ module Galley.API.Query
ensureConvAdmin,
getMLSSelfConversation,
getMLSSelfConversationWithError,
- getMLSOne2OneConversationV5,
- getMLSOne2OneConversationV6,
+ getMLSOne2OneOwnConversation,
+ getMLSOne2OneMLSConversation,
getMLSOne2OneConversationInternal,
getMLSOne2OneConversation,
isMLSOne2OneEstablished,
@@ -66,12 +67,6 @@ import Data.Qualified
import Data.Range
import Data.Set qualified as Set
import Data.Tagged
-import Galley.API.MLS
-import Galley.API.MLS.Enabled
-import Galley.API.MLS.One2One
-import Galley.API.Mapping
-import Galley.API.Mapping qualified as Mapping
-import Galley.API.Teams.Features.Get
import Galley.Types.Error
import Imports
import Polysemy
@@ -107,7 +102,10 @@ import Wire.CodeStore.Code (Code (codeConversation))
import Wire.CodeStore.Code qualified as Data
import Wire.ConversationStore qualified as ConversationStore
import Wire.ConversationStore.MLS.Types
-import Wire.ConversationSubsystem qualified as ConversationSubsystem
+import Wire.ConversationSubsystem.Fetch (getConversationIdsImpl)
+import Wire.ConversationSubsystem.MLS
+import Wire.ConversationSubsystem.MLS.Enabled (assertMLSEnabled, getMLSPrivateKeys, isMLSEnabled)
+import Wire.ConversationSubsystem.MLS.One2One (localMLSOne2OneConversation, remoteMLSOne2OneConversation)
import Wire.ConversationSubsystem.One2One
import Wire.ConversationSubsystem.Util
import Wire.FeaturesConfigSubsystem
@@ -119,7 +117,7 @@ import Wire.StoredConversation
import Wire.StoredConversation qualified as Data
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (TeamSubsystem, permissionCheck)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserList
import Wire.Util
@@ -162,7 +160,7 @@ getUnqualifiedOwnConversation ::
Sem r Public.OwnConversation
getUnqualifiedOwnConversation lusr cnv = do
c <- getConversationAsMember (tUntagged lusr) (qualifyAs lusr cnv)
- Mapping.conversationViewV9 lusr c
+ maybe (throwIfNotOwnConversation lusr cnv) pure $ ownConversationView lusr c
getUnqualifiedConversation ::
forall r.
@@ -175,7 +173,7 @@ getUnqualifiedConversation ::
ConvId ->
Sem r Public.Conversation
getUnqualifiedConversation lusr cnv =
- Mapping.conversationView (qualifyAs lusr ()) (Just lusr) . (.conv)
+ conversationView (qualifyAs lusr ()) (Just lusr) . (.conv)
<$> getConversationAsViewer (tUntagged lusr) (qualifyAs lusr cnv)
getConversation ::
@@ -318,9 +316,9 @@ getRemoteConversationsWithFailures ::
getRemoteConversationsWithFailures lusr convs = do
-- get self member statuses from the database
statusMap <- ConversationStore.getRemoteConversationStatus (tUnqualified lusr) convs
- let remoteView :: Remote RemoteConversationV2 -> OwnConversation
+ let remoteView :: Remote RemoteConversationView -> OwnConversation
remoteView rconv =
- Mapping.remoteConversationView
+ remoteConversationView
lusr
( Map.findWithDefault
defMemberStatus
@@ -334,14 +332,14 @@ getRemoteConversationsWithFailures lusr convs = do
| otherwise = [failedGetConversationLocally (map tUntagged locallyNotFound)]
-- request conversations from remote backends
- let rpc :: GetConversationsRequest -> FederatorClient 'Galley GetConversationsResponseV2
+ let rpc :: GetConversationsRequest -> FederatorClient 'Galley GetRemoteConversationViewsResponse
rpc req = do
mFedVersion <- getNegotiatedVersion
case mFedVersion of
Nothing -> error "impossible"
Just fedVersion ->
if fedVersion < Federation.V2
- then getConversationsResponseToV2 <$> fedClient @'Galley @"get-conversations@v1" req
+ then getConversationsResponseToView <$> fedClient @'Galley @"get-conversations@v1" req
else fedClient @'Galley @"get-conversations" req
resp <-
E.runFederatedConcurrentlyEither locallyFound $ \someConvs ->
@@ -352,8 +350,8 @@ getRemoteConversationsWithFailures lusr convs = do
where
handleFailure ::
(Member P.TinyLog r) =>
- Either (Remote [ConvId], FederationError) (Remote GetConversationsResponseV2) ->
- Sem r (Either FailedGetConversation [Remote RemoteConversationV2])
+ Either (Remote [ConvId], FederationError) (Remote GetRemoteConversationViewsResponse) ->
+ Sem r (Either FailedGetConversation [Remote RemoteConversationView])
handleFailure (Left (rcids, e)) = do
P.warn $
Logger.msg ("Error occurred while fetching remote conversations" :: ByteString)
@@ -401,14 +399,14 @@ conversationIdsPageFromUnqualified lusr start msize = do
--
-- FUTUREWORK: Move the body of this function to 'conversationIdsPageFrom' once
-- support for V2 is dropped.
-conversationIdsPageFromV2 ::
- (Member ConversationSubsystem.ConversationSubsystem r) =>
+conversationIdsPaginated ::
+ (Member ConversationStore.ConversationStore r) =>
ListGlobalSelfConvs ->
Local UserId ->
Public.GetPaginatedConversationIds ->
Sem r Public.ConvIdsPage
-conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {..} = do
- filterOut <$> ConversationSubsystem.getConversationIds lusr gmtprSize gmtprState
+conversationIdsPaginated listGlobalSelf lusr Public.GetMultiTablePageRequest {..} = do
+ filterOut <$> getConversationIdsImpl lusr gmtprSize gmtprState
where
-- MLS self-conversation of this user
selfConvId = mlsSelfConvId (tUnqualified lusr)
@@ -437,9 +435,8 @@ conversationIdsPageFromV2 listGlobalSelf lusr Public.GetMultiTablePageRequest {.
conversationIdsPageFrom ::
forall r.
( Member ConversationStore.ConversationStore r,
- Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error InternalError) r,
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
+ Member (Error InternalError) r,
Member P.TinyLog r
) =>
Local UserId ->
@@ -455,7 +452,7 @@ conversationIdsPageFrom lusr state = do
-- returned or attempted to be created; in that case we skip anything related
-- to it.
whenM isMLSEnabled $ void $ getMLSSelfConversation lusr
- conversationIdsPageFromV2 ListGlobalSelf lusr state
+ conversationIdsPaginated ListGlobalSelf lusr state
getConversations ::
( Member (Error InternalError) r,
@@ -469,7 +466,8 @@ getConversations ::
Sem r (Public.ConversationList Public.OwnConversation)
getConversations luser mids mstart msize = do
ConversationList cs more <- getConversationsInternal luser mids mstart msize
- flip ConversationList more <$> mapM (Mapping.conversationViewV9 luser) cs
+ ownConvs <- for cs (\c -> maybe (throwIfNotOwnConversation luser c.id_) pure $ ownConversationView luser c)
+ pure $ ConversationList ownConvs more
getConversationsInternal ::
(Member ConversationStore.ConversationStore r) =>
@@ -520,7 +518,10 @@ listConversations luser (Public.ListConversations ids) = do
localInternalConversations <-
ConversationStore.getConversations foundLocalIds
>>= filterM (\c -> pure $ isMember (tUnqualified luser) c.localMembers)
- localConversations <- mapM (Mapping.conversationViewV9 luser) localInternalConversations
+ localConversations <-
+ mapM
+ (\c -> maybe (throwIfNotOwnConversation luser c.id_) pure (ownConversationView luser c))
+ localInternalConversations
(remoteFailures, remoteConversations) <- getRemoteConversationsWithFailures luser remoteIds
let (failedConvsLocally, failedConvsRemotely) = partitionGetConversationFailures remoteFailures
@@ -711,9 +712,9 @@ getConversationGuestLinksFeatureStatus (Just tid) = getFeatureForTeam tid
getMLSSelfConversationWithError ::
forall r.
( Member ConversationStore.ConversationStore r,
- Member (Error InternalError) r,
- Member (ErrorS 'MLSNotEnabled) r,
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
+ Member (ErrorS MLSNotEnabled) r,
+ Member (Error InternalError) r,
Member P.TinyLog r
) =>
Local UserId ->
@@ -740,7 +741,7 @@ getMLSSelfConversation lusr = do
let selfConvId = mlsSelfConvId . tUnqualified $ lusr
mconv <- ConversationStore.getConversation selfConvId
cnv <- maybe (createMLSSelfConversation lusr) pure mconv
- conversationViewV9 lusr cnv
+ maybe (throwIfNotOwnConversation lusr cnv.id_) pure $ ownConversationView lusr cnv
createMLSSelfConversation ::
(Member ConversationStore.ConversationStore r) =>
@@ -767,7 +768,7 @@ createMLSSelfConversation lusr = do
-- uses the same function to calculate the conversation ID and corresponding
-- group ID, however we /do/ assume that the two backends agree on which of the
-- two is responsible for hosting the conversation.
-getMLSOne2OneConversationV5 ::
+getMLSOne2OneOwnConversation ::
( Member BrigAPIAccess r,
Member ConversationStore.ConversationStore r,
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
@@ -785,7 +786,7 @@ getMLSOne2OneConversationV5 ::
Local UserId ->
Qualified UserId ->
Sem r OwnConversation
-getMLSOne2OneConversationV5 lself qother = do
+getMLSOne2OneOwnConversation lself qother = do
if isLocal lself qother
then getMLSOne2OneConversationInternal lself qother
else throwS @MLSFederatedOne2OneNotSupported
@@ -811,7 +812,7 @@ getMLSOne2OneConversationInternal ::
getMLSOne2OneConversationInternal lself qother =
(.conversation) <$> getMLSOne2OneConversation lself qother Nothing
-getMLSOne2OneConversationV6 ::
+getMLSOne2OneMLSConversation ::
forall r.
( Member BrigAPIAccess r,
Member ConversationStore.ConversationStore r,
@@ -829,7 +830,7 @@ getMLSOne2OneConversationV6 ::
Local UserId ->
Qualified UserId ->
Sem r (MLSOne2OneConversation MLSPublicKey)
-getMLSOne2OneConversationV6 lself qother = do
+getMLSOne2OneMLSConversation lself qother = do
assertMLSEnabled
ensureConnectedOrSameTeam lself [qother]
let convId = one2OneConvId BaseProtocolMLSTag (tUntagged lself) qother
@@ -858,16 +859,16 @@ getMLSOne2OneConversation ::
Maybe MLSPublicKeyFormat ->
Sem r (MLSOne2OneConversation SomeKey)
getMLSOne2OneConversation lself qother fmt = do
- convWithUnformattedKeys <- getMLSOne2OneConversationV6 lself qother
+ convWithUnformattedKeys <- getMLSOne2OneMLSConversation lself qother
MLSOne2OneConversation convWithUnformattedKeys.conversation
<$> formatPublicKeys fmt convWithUnformattedKeys.publicKeys
getLocalMLSOne2OneConversation ::
( Member ConversationStore.ConversationStore r,
- Member (Error InternalError) r,
- Member P.TinyLog r,
Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
- Member (ErrorS MLSNotEnabled) r
+ Member (ErrorS MLSNotEnabled) r,
+ Member (Error InternalError) r,
+ Member P.TinyLog r
) =>
Local UserId ->
Local ConvId ->
@@ -877,7 +878,7 @@ getLocalMLSOne2OneConversation lself lconv = do
keys <- mlsKeysToPublic <$$> getMLSPrivateKeys
conv <- case mconv of
Nothing -> pure (localMLSOne2OneConversation lself lconv)
- Just conv -> conversationViewV9 lself conv
+ Just conv -> maybe (throwIfNotOwnConversation lself conv.id_) pure $ ownConversationView lself conv
pure $
MLSOne2OneConversation
{ conversation = conv,
diff --git a/services/galley/src/Galley/API/Update.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs
similarity index 86%
rename from services/galley/src/Galley/API/Update.hs
rename to libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs
index 66a7d0030e..96a798aeca 100644
--- a/services/galley/src/Galley/API/Update.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Update.hs
@@ -18,7 +18,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.API.Update
+module Wire.ConversationSubsystem.Update
( -- * Managing Conversations
acceptConv,
blockConv,
@@ -29,16 +29,11 @@ module Galley.API.Update
joinConversationByReusableCode,
joinConversationById,
addCodeUnqualified,
- addCodeUnqualifiedWithReqBody,
rmCodeUnqualified,
getCode,
- updateUnqualifiedConversationName,
updateConversationName,
- updateConversationReceiptModeUnqualified,
updateConversationReceiptMode,
- updateConversationMessageTimerUnqualified,
updateConversationMessageTimer,
- updateConversationAccessUnqualified,
updateConversationAccess,
updateConversationHistory,
updateChannelAddPermission,
@@ -49,16 +44,12 @@ module Galley.API.Update
updateCellsState,
-- * Managing Members
- addMembersUnqualified,
- addMembersUnqualifiedV2,
+ addQualifiedMembersUnqualified,
addMembers,
replaceMembers,
- updateUnqualifiedSelfMember,
updateSelfMember,
updateOtherMember,
- updateOtherMemberUnqualified,
removeMemberQualified,
- removeMemberUnqualified,
removeMemberFromLocalConv,
removeMemberFromRemoteConv,
@@ -67,7 +58,6 @@ module Galley.API.Update
postOtrMessageUnqualified,
postProteusBroadcast,
postOtrBroadcastUnqualified,
- memberTypingUnqualified,
memberTyping,
-- * External Services
@@ -90,13 +80,6 @@ import Data.Qualified
import Data.Set qualified as Set
import Data.Singletons
import Data.Vector qualified as V
-import Galley.API.Action
-import Galley.API.Action.Kick (kickMember)
-import Galley.API.Mapping
-import Galley.API.Message
-import Galley.API.Query qualified as Query
-import Galley.API.Teams.Features.Get
-import Galley.App
import Galley.Types.Error
import Imports hiding (forkIO)
import Polysemy
@@ -126,7 +109,7 @@ import Wire.API.Routes.Public.Galley.Messaging
import Wire.API.Routes.Public.Util (UpdateResult (..))
import Wire.API.ServantProto (RawProto (..))
import Wire.API.Team.Feature
-import Wire.API.Team.FeatureFlags (FanoutLimit)
+import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureFlags)
import Wire.API.Team.Member
import Wire.API.User.Client
import Wire.API.UserGroup
@@ -137,7 +120,10 @@ import Wire.CodeStore qualified as E
import Wire.CodeStore.Code
import Wire.ConversationStore (ConversationStore)
import Wire.ConversationStore qualified as E
-import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Action
+import Wire.ConversationSubsystem.Action.Kick (kickMember)
+import Wire.ConversationSubsystem.Message
+import Wire.ConversationSubsystem.Query qualified as Query
import Wire.ConversationSubsystem.Util
import Wire.ExternalAccess qualified as E
import Wire.FeaturesConfigSubsystem
@@ -156,7 +142,7 @@ import Wire.Sem.Random (Random)
import Wire.StoredConversation
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (TeamSubsystem, permissionCheck)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserClientIndexStore qualified as E
import Wire.UserGroupStore (UserGroupStore, getUserGroupsForConv)
@@ -180,7 +166,7 @@ acceptConv lusr conn cnv = do
conv <-
E.getConversation cnv >>= noteS @'ConvNotFound
conv' <- acceptOne2One lusr conv conn
- conversationViewV9 lusr conv'
+ maybe (throwIfNotOwnConversation lusr cnv) pure $ ownConversationView lusr conv'
blockConv ::
( Member ConversationStore r,
@@ -262,7 +248,7 @@ unblockConvUnqualified lusr conn cnv = do
unless (convType conv `elem` [ConnectConv, One2OneConv]) $
throwS @'InvalidOperation
conv' <- acceptOne2One lusr conv conn
- conversationViewV9 lusr conv'
+ maybe (throwIfNotOwnConversation lusr cnv) pure $ ownConversationView lusr conv'
unblockRemoteConv ::
(Member ConversationStore r) =>
@@ -291,8 +277,6 @@ type UpdateConversationAccessEffects =
E.FederationAPIAccess FederatorClient,
FireAndForget,
NotificationSubsystem,
- ConversationSubsystem,
- Input Env,
Input ConversationSubsystemConfig,
ProposalStore,
Random,
@@ -322,7 +306,10 @@ updateConversationHistory ::
Member (ErrorS ConvNotFound) r,
Member (ErrorS HistoryNotSupported) r,
Member ConversationStore r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member E.ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
+ Member Now r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -339,24 +326,6 @@ updateConversationHistory lusr con qcnv update = do
(Just con)
update.history
-updateConversationAccessUnqualified ::
- ( Members UpdateConversationAccessEffects r,
- Member Now r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- ConversationAccessData ->
- Sem r (UpdateResult Event)
-updateConversationAccessUnqualified lusr con cnv update =
- getUpdateResult . fmap lcuEvent $
- updateLocalConversationAccessData
- (qualifyAs lusr cnv)
- (tUntagged lusr)
- (Just con)
- update
-
updateConversationReceiptMode ::
( Member BrigAPIAccess r,
Member ConversationStore r,
@@ -367,9 +336,10 @@ updateConversationReceiptMode ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'MLSReadReceiptsNotAllowed) r,
Member E.ExternalAccess r,
+ Member BackendNotificationQueueAccess r,
+ Member Now r,
Member (E.FederationAPIAccess FederatorClient) r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member (Input (Local ())) r,
Member TinyLog r,
Member TeamSubsystem r
@@ -434,37 +404,16 @@ updateRemoteConversation rcnv lusr mconn action = getUpdateResult $ do
ConversationUpdateResponseUnreachableBackends e -> throw e
updateLocalStateOfRemoteConv (qualifyAs rcnv convUpdate) mconn >>= note NoChanges
-updateConversationReceiptModeUnqualified ::
- ( Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
- Member (Error InternalError) r,
- Member (ErrorS ('ActionDenied 'ModifyConversationReceiptMode)) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (ErrorS 'MLSReadReceiptsNotAllowed) r,
- Member E.ExternalAccess r,
- Member (E.FederationAPIAccess FederatorClient) r,
- Member NotificationSubsystem r,
- Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member TinyLog r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- ConversationReceiptModeUpdate ->
- Sem r (UpdateResult Event)
-updateConversationReceiptModeUnqualified lusr zcon cnv = updateConversationReceiptMode lusr zcon (tUntagged (qualifyAs lusr cnv))
-
updateConversationMessageTimer ::
( Member ConversationStore r,
Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'InvalidOperation) r,
Member (Error FederationError) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member E.ExternalAccess r,
+ Member Now r,
+ Member BackendNotificationQueueAccess r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -487,22 +436,6 @@ updateConversationMessageTimer lusr zcon qcnv update =
(\_ -> throw FederationNotImplemented)
qcnv
-updateConversationMessageTimerUnqualified ::
- ( Member ConversationStore r,
- Member (ErrorS ('ActionDenied 'ModifyConversationMessageTimer)) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (Error FederationError) r,
- Member ConversationSubsystem r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- ConversationMessageTimerUpdate ->
- Sem r (UpdateResult Event)
-updateConversationMessageTimerUnqualified lusr zcon cnv = updateConversationMessageTimer lusr zcon (tUntagged (qualifyAs lusr cnv))
-
deleteLocalConversation ::
( Member CodeStore r,
Member ConversationStore r,
@@ -511,7 +444,10 @@ deleteLocalConversation ::
Member (ErrorS ('ActionDenied 'DeleteConversation)) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'InvalidOperation) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member E.ExternalAccess r,
+ Member Now r,
+ Member BackendNotificationQueueAccess r,
Member ProposalStore r,
Member TeamSubsystem r
) =>
@@ -523,32 +459,6 @@ deleteLocalConversation lusr con lcnv =
getUpdateResult . fmap lcuEvent $
updateLocalConversationDelete lcnv (tUntagged lusr) (Just con)
-addCodeUnqualifiedWithReqBody ::
- forall r.
- ( Member CodeStore r,
- Member ConversationStore r,
- Member (ErrorS 'ConvAccessDenied) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'GuestLinksDisabled) r,
- Member (ErrorS 'CreateConversationCodeConflict) r,
- Member E.ExternalAccess r,
- Member NotificationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
- Member HashPassword r,
- Member (Input Opts) r,
- Member FeaturesConfigSubsystem r,
- Member RateLimit r,
- Member TeamSubsystem r
- ) =>
- UserId ->
- Maybe Text ->
- Maybe ConnId ->
- ConvId ->
- CreateConversationCodeRequest ->
- Sem r AddCodeResult
-addCodeUnqualifiedWithReqBody usr mbZHost mZcon cnv req = addCodeUnqualified (Just req) usr mbZHost mZcon cnv
-
addCodeUnqualified ::
forall r.
( Member CodeStore r,
@@ -561,7 +471,7 @@ addCodeUnqualified ::
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member Now r,
- Member (Input Opts) r,
+ Member (Input (Maybe GuestLinkTTLSeconds)) r,
Member HashPassword r,
Member FeaturesConfigSubsystem r,
Member RateLimit r,
@@ -590,7 +500,7 @@ addCode ::
Member HashPassword r,
Member NotificationSubsystem r,
Member Now r,
- Member (Input Opts) r,
+ Member (Input (Maybe GuestLinkTTLSeconds)) r,
Member FeaturesConfigSubsystem r,
Member RateLimit r,
Member TeamSubsystem r
@@ -612,7 +522,7 @@ addCode lusr mbZHost mZcon lcnv mReq = do
key <- E.makeKey (tUnqualified lcnv)
E.getCode key >>= \case
Nothing -> do
- ttl <- realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds . view (settings . guestLinkTTLSeconds) <$> input
+ ttl <- inputs (realToFrac . unGuestLinkTTLSeconds . fromMaybe defGuestLinkTTLSeconds)
code <- E.generateCode (tUnqualified lcnv) (Timeout ttl)
mPw <- for (mReq >>= (.password)) $ HashPassword.hashPassword8 (RateLimitUser (tUnqualified lusr))
E.createCode code mPw
@@ -742,7 +652,6 @@ updateConversationProtocolWithLocalUser ::
Member ConversationStore r,
Member TinyLog r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member E.ExternalAccess r,
Member (E.FederationAPIAccess FederatorClient) r,
Member Random r,
@@ -780,8 +689,9 @@ updateChannelAddPermission ::
Member (ErrorS 'InvalidOperation) r,
Member (Error FederationError) r,
Member E.ExternalAccess r,
+ Member Now r,
+ Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member (Input (Local ())) r,
Member TinyLog r,
Member (Error NonFederatingBackends) r,
@@ -824,11 +734,15 @@ joinConversationByReusableCode ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS 'TooManyMembers) r,
- Member ConversationSubsystem r,
+ Member (Error FederationError) r,
+ Member BackendNotificationQueueAccess r,
+ Member NotificationSubsystem r,
+ Member E.ExternalAccess r,
Member FeaturesConfigSubsystem r,
Member HashPassword r,
Member RateLimit r,
Member TeamSubsystem r,
+ Member Now r,
Member (Input ConversationSubsystemConfig) r
) =>
Local UserId ->
@@ -850,8 +764,12 @@ joinConversationById ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS 'TooManyMembers) r,
- Member ConversationSubsystem r,
+ Member (Error FederationError) r,
Member (Input ConversationSubsystemConfig) r,
+ Member BackendNotificationQueueAccess r,
+ Member NotificationSubsystem r,
+ Member E.ExternalAccess r,
+ Member Now r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -869,9 +787,13 @@ joinConversation ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS 'TooManyMembers) r,
- Member ConversationSubsystem r,
+ Member (Error FederationError) r,
Member (Input ConversationSubsystemConfig) r,
+ Member BackendNotificationQueueAccess r,
+ Member E.ExternalAccess r,
Member ConversationStore r,
+ Member Now r,
+ Member NotificationSubsystem r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -927,7 +849,6 @@ addMembers ::
Member (Error UnreachableBackends) r,
Member E.ExternalAccess r,
Member (E.FederationAPIAccess FederatorClient) r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member Now r,
Member LegalHoldStore r,
@@ -962,7 +883,7 @@ addMembers lusr zcon qcnv (InviteQualified users role) = do
getUpdateResult . fmap lcuEvent $
updateLocalConversationJoin lcnv (tUntagged lusr) (Just zcon) action
-addMembersUnqualifiedV2 ::
+addQualifiedMembersUnqualified ::
( Member BackendNotificationQueueAccess r,
Member BrigAPIAccess r,
Member ConversationStore r,
@@ -979,7 +900,6 @@ addMembersUnqualifiedV2 ::
Member (Error UnreachableBackends) r,
Member E.ExternalAccess r,
Member (E.FederationAPIAccess FederatorClient) r,
- Member ConversationSubsystem r,
Member NotificationSubsystem r,
Member Now r,
Member LegalHoldStore r,
@@ -997,51 +917,12 @@ addMembersUnqualifiedV2 ::
ConvId ->
InviteQualified ->
Sem r (UpdateResult Event)
-addMembersUnqualifiedV2 lusr zcon cnv (InviteQualified users role) = do
+addQualifiedMembersUnqualified lusr zcon cnv (InviteQualified users role) = do
let lcnv = qualifyAs lusr cnv
getUpdateResult . fmap lcuEvent $
updateLocalConversationJoin lcnv (tUntagged lusr) (Just zcon) $
ConversationJoin users role def
-addMembersUnqualified ::
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
- Member (ErrorS ('ActionDenied 'AddConversationMember)) r,
- Member (ErrorS 'ConvAccessDenied) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (ErrorS 'NotConnected) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS 'TooManyMembers) r,
- Member (ErrorS 'MissingLegalholdConsent) r,
- Member (ErrorS 'GroupIdVersionNotSupported) r,
- Member (Error UnreachableBackends) r,
- Member E.ExternalAccess r,
- Member (E.FederationAPIAccess FederatorClient) r,
- Member ConversationSubsystem r,
- Member NotificationSubsystem r,
- Member Now r,
- Member LegalHoldStore r,
- Member ProposalStore r,
- Member Random r,
- Member TeamStore r,
- Member TinyLog r,
- Member TeamCollaboratorsSubsystem r,
- Member FederationSubsystem r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- Invite ->
- Sem r (UpdateResult Event)
-addMembersUnqualified lusr zcon cnv (Invite users role) = do
- let qusers = fmap (tUntagged . qualifyAs lusr) users
- addMembers lusr zcon (tUntagged (qualifyAs lusr cnv)) (InviteQualified qusers role)
-
-- | Replace conversation members by computing the difference between desired and
-- current members, then executing removals followed by additions within a commit
-- lock.
@@ -1073,7 +954,6 @@ replaceMembers ::
Member TinyLog r,
Member TeamCollaboratorsSubsystem r,
Member UserGroupStore r,
- Member ConversationSubsystem r,
Member FederationSubsystem r,
Member TeamSubsystem r,
Member (Input ConversationSubsystemConfig) r
@@ -1177,22 +1057,6 @@ updateSelfMember lusr zcon qcnv update = do
misConvRoleName = Nothing
}
-updateUnqualifiedSelfMember ::
- ( Member ConversationStore r,
- Member (ErrorS 'ConvNotFound) r,
- Member E.ExternalAccess r,
- Member NotificationSubsystem r,
- Member Now r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- MemberUpdate ->
- Sem r ()
-updateUnqualifiedSelfMember lusr zcon cnv update = do
- let lcnv = qualifyAs lusr cnv
- updateSelfMember lusr zcon (tUntagged lcnv) update
-
updateOtherMemberLocalConv ::
( Member ConversationStore r,
Member (Error FederationError) r,
@@ -1201,7 +1065,10 @@ updateOtherMemberLocalConv ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'ConvMemberNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member BackendNotificationQueueAccess r,
+ Member E.ExternalAccess r,
+ Member Now r,
Member TeamSubsystem r
) =>
Local ConvId ->
@@ -1216,28 +1083,6 @@ updateOtherMemberLocalConv lcnv lusr con qvictim update = void . getUpdateResult
updateLocalConversationMemberUpdate lcnv (tUntagged lusr) (Just con) $
ConversationMemberUpdate qvictim update
-updateOtherMemberUnqualified ::
- ( Member ConversationStore r,
- Member (Error FederationError) r,
- Member (ErrorS ('ActionDenied 'ModifyOtherConversationMember)) r,
- Member (ErrorS 'InvalidTarget) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'ConvMemberNotFound) r,
- Member ConversationSubsystem r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- UserId ->
- OtherMemberUpdate ->
- Sem r ()
-updateOtherMemberUnqualified lusr zcon cnv victim update = do
- let lcnv = qualifyAs lusr cnv
- let lvictim = qualifyAs lusr victim
- updateOtherMemberLocalConv lcnv lusr zcon (tUntagged lvictim) update
-
updateOtherMember ::
( Member ConversationStore r,
Member (Error FederationError) r,
@@ -1246,7 +1091,10 @@ updateOtherMember ::
Member (ErrorS 'InvalidOperation) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'ConvMemberNotFound) r,
- Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
+ Member BackendNotificationQueueAccess r,
+ Member E.ExternalAccess r,
+ Member Now r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -1269,34 +1117,6 @@ updateOtherMemberRemoteConv ::
Sem r ()
updateOtherMemberRemoteConv _ _ _ _ _ = throw FederationNotImplemented
-removeMemberUnqualified ::
- ( Member BackendNotificationQueueAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
- Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member E.ExternalAccess r,
- Member (E.FederationAPIAccess FederatorClient) r,
- Member NotificationSubsystem r,
- Member ConversationSubsystem r,
- Member Now r,
- Member ProposalStore r,
- Member Random r,
- Member TinyLog r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- UserId ->
- Sem r (Maybe Event)
-removeMemberUnqualified lusr con cnv victim = do
- let lvictim = qualifyAs lusr victim
- lcnv = qualifyAs lusr cnv
- removeMemberQualified lusr con (tUntagged lcnv) (tUntagged lvictim)
-
removeMemberQualified ::
( Member BackendNotificationQueueAccess r,
Member ConversationStore r,
@@ -1307,7 +1127,6 @@ removeMemberQualified ::
Member E.ExternalAccess r,
Member (E.FederationAPIAccess FederatorClient) r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member Now r,
Member ProposalStore r,
Member Random r,
@@ -1382,7 +1201,6 @@ removeMemberFromLocalConv ::
Member (ErrorS 'InvalidOperation) r,
Member E.ExternalAccess r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member Now r,
Member ProposalStore r,
Member Random r,
@@ -1425,7 +1243,6 @@ removeMemberFromChannel ::
Member Now r,
Member E.ExternalAccess r,
Member NotificationSubsystem r,
- Member ConversationSubsystem r,
Member Random r,
Member TinyLog r,
Member (Error FederationError) r,
@@ -1462,7 +1279,8 @@ postProteusMessage ::
Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
Member E.ExternalAccess r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
+ Member (Input IntraListing) r,
Member Now r,
Member TinyLog r,
Member TeamSubsystem r
@@ -1486,13 +1304,14 @@ postProteusBroadcast ::
Member (ErrorS 'BroadcastLimitExceeded) r,
Member NotificationSubsystem r,
Member E.ExternalAccess r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member Now r,
Member TeamStore r,
Member TinyLog r,
Member (Input FanoutLimit) r,
Member TeamSubsystem r,
- Member ConversationSubsystem r
+ Member (Input ConversationSubsystemConfig) r,
+ Member E.UserClientIndexStore r
) =>
Local UserId ->
ConnId ->
@@ -1540,7 +1359,8 @@ postBotMessageUnqualified ::
Member BackendNotificationQueueAccess r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
+ Member (Input IntraListing) r,
Member TinyLog r,
Member Now r,
Member TeamSubsystem r
@@ -1568,13 +1388,14 @@ postOtrBroadcastUnqualified ::
Member (ErrorS 'BroadcastLimitExceeded) r,
Member NotificationSubsystem r,
Member E.ExternalAccess r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member Now r,
Member TeamStore r,
Member TinyLog r,
Member (Input FanoutLimit) r,
Member TeamSubsystem r,
- Member ConversationSubsystem r
+ Member (Input ConversationSubsystemConfig) r,
+ Member E.UserClientIndexStore r
) =>
Local UserId ->
ConnId ->
@@ -1595,7 +1416,8 @@ postOtrMessageUnqualified ::
Member BackendNotificationQueueAccess r,
Member E.ExternalAccess r,
Member NotificationSubsystem r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
+ Member (Input IntraListing) r,
Member Now r,
Member TinyLog r,
Member TeamSubsystem r
@@ -1620,7 +1442,10 @@ updateConversationName ::
Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'InvalidOperation) r,
- Member ConversationSubsystem r,
+ Member E.ExternalAccess r,
+ Member Now r,
+ Member BackendNotificationQueueAccess r,
+ Member NotificationSubsystem r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -1636,25 +1461,6 @@ updateConversationName lusr zcon qcnv convRename = do
qcnv
convRename
-updateUnqualifiedConversationName ::
- ( Member ConversationStore r,
- Member (Error FederationError) r,
- Member (Error InvalidInput) r,
- Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member ConversationSubsystem r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- ConversationRename ->
- Sem r (UpdateResult Event)
-updateUnqualifiedConversationName lusr zcon cnv rename = do
- let lcnv = qualifyAs lusr cnv
- updateLocalConversationName lusr zcon lcnv rename
-
updateLocalConversationName ::
( Member ConversationStore r,
Member (Error FederationError) r,
@@ -1662,7 +1468,10 @@ updateLocalConversationName ::
Member (ErrorS ('ActionDenied 'ModifyConversationName)) r,
Member (ErrorS 'ConvNotFound) r,
Member (ErrorS 'InvalidOperation) r,
- Member ConversationSubsystem r,
+ Member E.ExternalAccess r,
+ Member Now r,
+ Member BackendNotificationQueueAccess r,
+ Member NotificationSubsystem r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -1713,25 +1522,6 @@ memberTyping lusr zcon qcnv ts = do
)
qcnv
-memberTypingUnqualified ::
- ( Member NotificationSubsystem r,
- Member (ErrorS 'ConvNotFound) r,
- Member (Input (Local ())) r,
- Member Now r,
- Member ConversationStore r,
- Member (E.FederationAPIAccess FederatorClient) r,
- Member (Error FederationError) r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- ConnId ->
- ConvId ->
- TypingStatus ->
- Sem r ()
-memberTypingUnqualified lusr zcon cnv ts = do
- lcnv <- qualifyLocal cnv
- memberTyping lusr zcon (tUntagged lcnv) ts
-
addBot ::
forall r.
( Member E.UserClientIndexStore r,
diff --git a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs
index 16f70e955c..78d7019397 100644
--- a/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs
+++ b/libs/wire-subsystems/src/Wire/ConversationSubsystem/Util.hs
@@ -24,7 +24,6 @@ import Control.Lens (view, (^.))
import Control.Monad.Extra (allM, anyM)
import Control.Monad.Trans.Maybe
import Data.Bifunctor
-import Data.Code qualified as Code
import Data.Default
import Data.Domain (Domain)
import Data.Id as Id
@@ -34,7 +33,7 @@ import Data.List.Extra (chunksOf, nubOrd)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
-import Data.Misc (PlainTextPassword6, PlainTextPassword8)
+import Data.Misc (PlainTextPassword8)
import Data.Qualified
import Data.Set qualified as Set
import Data.Singletons
@@ -42,11 +41,14 @@ import Data.Text qualified as T
import Data.Time
import Galley.Types.Conversations.Roles
import Galley.Types.Error
-import Imports hiding (forkIO)
+import Imports
import Network.AMQP qualified as Q
import Polysemy
import Polysemy.Error
import Polysemy.Input
+import Polysemy.TinyLog (TinyLog)
+import Polysemy.TinyLog qualified as P
+import System.Logger.Message (msg, val, (+++))
import Wire.API.Connection
import Wire.API.Conversation hiding (Member, cnvAccess, cnvAccessRoles, cnvName, cnvType)
import Wire.API.Conversation qualified as Public
@@ -71,10 +73,8 @@ import Wire.API.Team.Collaborator qualified as CollaboratorPermission (Collabora
import Wire.API.Team.FeatureFlags
import Wire.API.Team.Member
import Wire.API.Team.Member qualified as Mem
-import Wire.API.Team.Member.Error
import Wire.API.Team.Role
import Wire.API.User hiding (userId)
-import Wire.API.User.Auth.ReAuth
import Wire.API.VersionInfo
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess
@@ -94,10 +94,19 @@ import Wire.Sem.Now qualified as Now
import Wire.StoredConversation as Data
import Wire.TeamCollaboratorsSubsystem
import Wire.TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.TeamSubsystem (ConsentGiven (..), TeamSubsystem, consentGiven, getLHStatus)
import Wire.TeamSubsystem qualified as TeamSubsystem
import Wire.UserList
+throwIfNotOwnConversation :: (Member TinyLog r, Member (Error InternalError) r) => Local UserId -> ConvId -> Sem r a
+throwIfNotOwnConversation luid cid = do
+ P.err . msg $
+ val "User "
+ +++ idToText (tUnqualified luid)
+ +++ val " is not a member of conv "
+ +++ idToText cid
+ throw BadMemberState
+
data NoChanges = NoChanges
ensureAccessRole ::
@@ -195,20 +204,6 @@ ensureConnected self others = do
ensureConnectedToLocals (tUnqualified self) (ulLocals others)
ensureConnectedToRemotes self (ulRemotes others)
-ensureConnectedToLocals ::
- ( Member (ErrorS 'NotConnected) r,
- Member BrigAPIAccess r
- ) =>
- UserId ->
- [UserId] ->
- Sem r ()
-ensureConnectedToLocals _ [] = pure ()
-ensureConnectedToLocals u uids = do
- (connsFrom, connsTo) <-
- getConnectionsUnqualifiedBidi [u] uids (Just Accepted) (Just Accepted)
- unless (length connsFrom == length uids && length connsTo == length uids) $
- throwS @'NotConnected
-
ensureConnectedToRemotes ::
( Member BrigAPIAccess r,
Member (ErrorS 'NotConnected) r
@@ -222,18 +217,6 @@ ensureConnectedToRemotes u remotes = do
when (length acceptedConns /= length remotes) $
throwS @'NotConnected
-ensureReAuthorised ::
- ( Member BrigAPIAccess r,
- Member (Error AuthenticationError) r
- ) =>
- UserId ->
- Maybe PlainTextPassword6 ->
- Maybe Code.Value ->
- Maybe VerificationAction ->
- Sem r ()
-ensureReAuthorised u secret mbAction mbCode =
- reauthUser u (ReAuthUser secret mbAction mbCode) >>= fromEither
-
ensureManageChannelsPermission :: (Member (ErrorS 'ConvNotFound) r) => StoredConversation -> TeamMember -> Sem r ()
ensureManageChannelsPermission conv tm = do
unless (hasManageChannelsPermission conv tm) $ throwS @'ConvNotFound
@@ -323,72 +306,6 @@ checkGroupIdSupport loc conv joinAction = void $ runMaybeT $ do
failOnFirstError :: (Member (ErrorS GroupIdVersionNotSupported) r) => [Either e x] -> Sem r ()
failOnFirstError = traverse_ $ either (\_ -> throwS @GroupIdVersionNotSupported) pure
--- | Same as 'permissionCheck', but for a statically known permission.
-permissionCheckS ::
- forall teamAssociation perm (p :: perm) r.
- ( SingKind perm,
- IsPerm teamAssociation (Demote perm),
- ( Member (ErrorS (PermError p)) r,
- Member (ErrorS 'NotATeamMember) r
- )
- ) =>
- Sing p ->
- Maybe teamAssociation ->
- Sem r teamAssociation
-permissionCheckS p =
- \case
- Just m -> do
- if m `hasPermission` fromSing p
- then pure m
- else throwS @(PermError p)
- -- FUTUREWORK: factor `noteS` out of this function.
- Nothing -> throwS @'NotATeamMember
-
--- | If a team member is not given throw 'notATeamMember'; if the given team
--- member does not have the given permission, throw 'operationDenied'.
--- Otherwise, return the team member.
-permissionCheck ::
- ( IsPerm teamAssociation perm,
- ( Member (ErrorS OperationDenied) r,
- Member (ErrorS 'NotATeamMember) r
- )
- ) =>
- perm ->
- Maybe teamAssociation ->
- Sem r teamAssociation
--- FUTUREWORK: factor `noteS` out of this function.
-permissionCheck p = \case
- Just m -> do
- if m `hasPermission` p
- then pure m
- else throwS @OperationDenied
- -- FUTUREWORK: factor `noteS` out of this function.
- Nothing -> throwS @'NotATeamMember
-
-assertTeamExists ::
- ( Member (ErrorS 'TeamNotFound) r,
- Member TeamStore r
- ) =>
- TeamId ->
- Sem r ()
-assertTeamExists tid = do
- teamExists <- isJust <$> getTeam tid
- if teamExists
- then pure ()
- else throwS @'TeamNotFound
-
-assertOnTeam ::
- ( Member (ErrorS 'NotATeamMember) r,
- Member TeamSubsystem r
- ) =>
- UserId ->
- TeamId ->
- Sem r ()
-assertOnTeam uid tid =
- TeamSubsystem.internalGetTeamMember uid tid >>= \case
- Nothing -> throwS @'NotATeamMember
- Just _ -> pure ()
-
-- | Try to accept a 1-1 conversation, promoting connect conversations as appropriate.
acceptOne2One ::
( Member ConversationStore r,
@@ -997,38 +914,6 @@ userLHEnabled = \case
UserLegalHoldDisabled -> False
UserLegalHoldNoConsent -> False
-data ConsentGiven = ConsentGiven | ConsentNotGiven
- deriving (Eq, Ord, Show)
-
-consentGiven :: UserLegalHoldStatus -> ConsentGiven
-consentGiven = \case
- UserLegalHoldDisabled -> ConsentGiven
- UserLegalHoldPending -> ConsentGiven
- UserLegalHoldEnabled -> ConsentGiven
- UserLegalHoldNoConsent -> ConsentNotGiven
-
-checkConsent ::
- (Member TeamSubsystem r) =>
- Map UserId TeamId ->
- UserId ->
- Sem r ConsentGiven
-checkConsent teamsOfUsers other = do
- consentGiven <$> getLHStatus (Map.lookup other teamsOfUsers) other
-
--- Get legalhold status of user. Defaults to 'defUserLegalHoldStatus' if user
--- doesn't belong to a team.
-getLHStatus ::
- (Member TeamSubsystem r) =>
- Maybe TeamId ->
- UserId ->
- Sem r UserLegalHoldStatus
-getLHStatus teamOfUser other = do
- case teamOfUser of
- Nothing -> pure defUserLegalHoldStatus
- Just team -> do
- mMember <- TeamSubsystem.internalGetTeamMember other team
- pure $ maybe defUserLegalHoldStatus (view legalHoldStatus) mMember
-
anyLegalholdActivated ::
( Member (Input ConversationSubsystemConfig) r,
Member TeamStore r,
@@ -1075,31 +960,6 @@ allLegalholdConsentGiven uids = do
eitherTeamMemberAndLHAllowedOrDefLHStatus teamsPage uid = do
fromMaybe (consentGiven defUserLegalHoldStatus == ConsentGiven) <$> (for (Map.lookup uid teamsPage) isTeamLegalholdWhitelisted)
--- | Add to every uid the legalhold status
-getLHStatusForUsers ::
- (Member TeamStore r, Member TeamSubsystem r) =>
- [UserId] ->
- Sem r [(UserId, UserLegalHoldStatus)]
-getLHStatusForUsers uids =
- mconcat
- <$> for
- (chunksOf 32 uids)
- ( \uidsChunk -> do
- teamsOfUsers <- getUsersTeams uidsChunk
- for uidsChunk $ \uid -> do
- (uid,) <$> getLHStatus (Map.lookup uid teamsOfUsers) uid
- )
-
-getTeamMembersForFanout ::
- ( Member (Input FanoutLimit) r,
- Member TeamSubsystem r
- ) =>
- TeamId ->
- Sem r TeamMemberList
-getTeamMembersForFanout tid = do
- lim <- input
- TeamSubsystem.internalGetTeamMembersWithLimit tid (Just lim)
-
ensureMemberLimit ::
( Foldable f,
( Member (ErrorS 'TooManyMembers) r,
@@ -1173,39 +1033,6 @@ notifyConversationUpdated lusr conn j conv = do
}
]
--- | Convert a local conversation member (as stored in the DB) to a publicly
--- facing 'Member' structure.
-localMemberToPublic :: Local x -> LocalMember -> Public.Member
-localMemberToPublic loc lm =
- Public.Member
- { memId = tUntagged . qualifyAs loc $ lm.id_,
- memService = lm.service,
- memOtrMutedStatus = msOtrMutedStatus st,
- memOtrMutedRef = msOtrMutedRef st,
- memOtrArchived = msOtrArchived st,
- memOtrArchivedRef = msOtrArchivedRef st,
- memHidden = msHidden st,
- memHiddenRef = msHiddenRef st,
- memConvRoleName = lm.convRoleName
- }
- where
- st = lm.status
-
--- | View for a given user of a stored conversation.
---
--- Returns 'Nothing' if the user is not part of the conversation.
-conversationViewMaybe :: Local UserId -> [OtherMember] -> [OtherMember] -> StoredConversation -> Maybe Public.OwnConversation
-conversationViewMaybe luid remoteOthers localOthers conv = do
- let selfs = filter (\m -> tUnqualified luid == m.id_) conv.localMembers
- self <- localMemberToPublic luid <$> listToMaybe selfs
- let others = filter (\oth -> tUntagged luid /= omQualifiedId oth) localOthers <> remoteOthers
- pure $
- Public.OwnConversation
- (tUntagged . qualifyAs luid $ conv.id_)
- conv.metadata
- (OwnConvMembers self others)
- conv.protocol
-
notifyConversationCreated ::
( Member NotificationSubsystem r,
Member ConversationStore r,
diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs
index d8824e685c..2b5da0c95f 100644
--- a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs
+++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem.hs
@@ -19,7 +19,8 @@
module Wire.FeaturesConfigSubsystem where
-import Data.Id (TeamId, UserId)
+import Data.Id (ConvId, TeamId, UserId)
+import Data.Proxy (Proxy)
import Data.Qualified (Local)
import Imports
import Polysemy
@@ -35,5 +36,27 @@ data FeaturesConfigSubsystem m a where
GetAllTeamFeaturesForTeamMember :: Local UserId -> TeamId -> FeaturesConfigSubsystem m AllTeamFeatures
GetAllTeamFeaturesForTeam :: TeamId -> FeaturesConfigSubsystem m AllTeamFeatures
GetAllTeamFeaturesForServer :: FeaturesConfigSubsystem m AllTeamFeatures
+ GuardSecondFactorDisabled ::
+ UserId ->
+ ConvId ->
+ FeaturesConfigSubsystem m ()
+ FeatureEnabledForTeam ::
+ forall cfg m.
+ (GetFeatureConfig cfg) =>
+ Proxy cfg ->
+ TeamId ->
+ FeaturesConfigSubsystem m Bool
+ GetAllTeamFeaturesForUser ::
+ UserId ->
+ FeaturesConfigSubsystem m AllTeamFeatures
+ GetSingleFeatureForUser ::
+ forall cfg m.
+ (GetFeatureConfig cfg) =>
+ UserId ->
+ FeaturesConfigSubsystem m (LockableFeature cfg)
+ GetFeatureInternal ::
+ (GetFeatureConfig cfg) =>
+ TeamId ->
+ FeaturesConfigSubsystem m (LockableFeature cfg)
makeSem ''FeaturesConfigSubsystem
diff --git a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs
index d3842f68bf..70936a806e 100644
--- a/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/FeaturesConfigSubsystem/Interpreter.hs
@@ -5,24 +5,31 @@
module Wire.FeaturesConfigSubsystem.Interpreter where
+import Control.Error (hush)
import Data.Aeson.Types qualified as A
import Data.Id
import Data.Qualified (tUnqualified)
import Data.SOP
+import Data.Tagged
import Data.Text.Lazy qualified as LT
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
+import Wire.API.Conversation (ConversationMetadata (..))
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Team.Feature
import Wire.API.Team.FeatureFlags
+import Wire.BrigAPIAccess (BrigAPIAccess)
+import Wire.ConversationStore qualified as ConversationStore
import Wire.FeaturesConfigSubsystem
import Wire.FeaturesConfigSubsystem.Types
import Wire.FeaturesConfigSubsystem.Utils
+import Wire.LegalHoldStore (LegalHoldStore)
import Wire.TeamFeatureStore
import Wire.TeamFeatureStore.Error (TeamFeatureStoreError (..))
+import Wire.TeamStore qualified as TeamStore
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.TeamSubsystem qualified as TeamSubsystem
@@ -30,8 +37,11 @@ runFeaturesConfigSubsystem ::
forall r a.
( Member TeamFeatureStore r,
Member TeamSubsystem r,
+ Member TeamStore.TeamStore r,
+ Member ConversationStore.ConversationStore r,
Member (Error TeamFeatureStoreError) r,
Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS 'AccessDenied) r,
GetFeatureConfigEffects r
) =>
Sem (FeaturesConfigSubsystem : r) a ->
@@ -54,6 +64,16 @@ runFeaturesConfigSubsystem = interpret $ \case
getAllTeamFeaturesImpl tid
GetAllTeamFeaturesForServer ->
getAllTeamFeaturesForServerImpl
+ GuardSecondFactorDisabled uid cid ->
+ guardSecondFactorDisabledImpl uid cid
+ FeatureEnabledForTeam (Proxy :: Proxy cfg) tid ->
+ featureEnabledForTeamImpl @cfg tid
+ GetAllTeamFeaturesForUser uid ->
+ getAllTeamFeaturesForUserImpl uid
+ GetSingleFeatureForUser uid ->
+ getSingleFeatureForUserImpl uid
+ GetFeatureInternal tid ->
+ getFeatureInternalImpl tid
-- Internal helpers
@@ -129,3 +149,138 @@ parseDbFeatureOrThrow feat =
mapError (TeamFeatureStoreErrorInternalError . LT.pack)
. fromEither
$ A.parseEither (const (parseDbFeature feat)) ()
+
+getFeatureInternalImpl ::
+ ( GetFeatureConfig cfg,
+ Member TeamFeatureStore r,
+ Member LegalHoldStore r,
+ Member TeamSubsystem r,
+ Member BrigAPIAccess r,
+ Member (Input FeatureFlags) r,
+ Member (Input (FeatureDefaults LegalholdConfig)) r,
+ Member (Input ExposeInvitationURLsAllowlist) r,
+ Member (Error TeamFeatureStoreError) r
+ ) =>
+ TeamId ->
+ Sem r (LockableFeature cfg)
+getFeatureInternalImpl tid = do
+ TeamSubsystem.assertTeamExists tid
+ getFeatureForTeamImpl tid
+
+getTeamAndCheckMembership ::
+ ( Member TeamStore.TeamStore r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member TeamSubsystem r
+ ) =>
+ UserId ->
+ Sem r (Maybe TeamId)
+getTeamAndCheckMembership uid = do
+ mTid <- TeamStore.getOneUserTeam uid
+ for_ mTid $ \tid -> do
+ zusrMembership <- TeamSubsystem.internalGetTeamMember uid tid
+ void $ maybe (throwS @'NotATeamMember) pure zusrMembership
+ TeamSubsystem.assertTeamExists tid
+ pure mTid
+
+getAllTeamFeatures ::
+ forall r.
+ ( Member TeamFeatureStore r,
+ Member LegalHoldStore r,
+ Member BrigAPIAccess r,
+ Member (Input FeatureFlags) r,
+ Member (Input (FeatureDefaults LegalholdConfig)) r,
+ Member (Input ExposeInvitationURLsAllowlist) r,
+ Member (Error TeamFeatureStoreError) r
+ ) =>
+ TeamId ->
+ Sem r AllTeamFeatures
+getAllTeamFeatures tid = getAllTeamFeaturesImpl tid
+
+getAllTeamFeaturesForUserImpl ::
+ forall r.
+ ( Member (ErrorS 'NotATeamMember) r,
+ Member TeamStore.TeamStore r,
+ Member TeamSubsystem r,
+ Member TeamFeatureStore r,
+ Member (Error TeamFeatureStoreError) r,
+ GetFeatureConfigEffects r
+ ) =>
+ UserId ->
+ Sem r AllTeamFeatures
+getAllTeamFeaturesForUserImpl uid = do
+ mTid <- getTeamAndCheckMembership uid
+ case mTid of
+ Nothing -> hsequence' $ hcpure (Proxy @(GetAllTeamFeaturesForUserConstraints r)) $ Comp $ getFeatureForUser uid
+ Just tid -> getAllTeamFeatures tid
+
+getSingleFeatureForUserImpl ::
+ forall cfg r.
+ ( GetFeatureConfig cfg,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (Error TeamFeatureStoreError) r,
+ Member TeamStore.TeamStore r,
+ Member TeamSubsystem r,
+ Member TeamFeatureStore r,
+ Member BrigAPIAccess r,
+ Member LegalHoldStore r,
+ Member (Input FeatureFlags) r,
+ Member (Input (FeatureDefaults LegalholdConfig)) r,
+ Member (Input ExposeInvitationURLsAllowlist) r
+ ) =>
+ UserId ->
+ Sem r (LockableFeature cfg)
+getSingleFeatureForUserImpl uid = do
+ mTid <- getTeamAndCheckMembership uid
+ getFeatureForTeamUserImpl @cfg uid mTid
+
+-- | If second factor auth is enabled, make sure that end-points that don't support it, but
+-- should, are blocked completely. (This is a workaround until we have 2FA for those
+-- end-points as well.)
+--
+-- This function exists to resolve a cyclic dependency.
+guardSecondFactorDisabledImpl ::
+ forall r.
+ ( Member (ErrorS 'AccessDenied) r,
+ Member (Error TeamFeatureStoreError) r,
+ Member ConversationStore.ConversationStore r,
+ Member TeamSubsystem r,
+ Member TeamFeatureStore r,
+ Member BrigAPIAccess r,
+ Member LegalHoldStore r,
+ Member (Input FeatureFlags) r,
+ Member (Input (FeatureDefaults LegalholdConfig)) r,
+ Member (Input ExposeInvitationURLsAllowlist) r
+ ) =>
+ UserId ->
+ ConvId ->
+ Sem r ()
+guardSecondFactorDisabledImpl uid cid = do
+ mTid <- fmap hush . runError @() $ do
+ convData <- ConversationStore.getConversationMetadata cid >>= note ()
+ tid <- note () convData.cnvmTeam
+ mapError (unTagged @'TeamNotFound @()) $ TeamSubsystem.assertTeamExists tid
+ pure tid
+
+ tf <- getFeatureForTeamUserImpl @SndFactorPasswordChallengeConfig uid mTid
+ case tf.status of
+ FeatureStatusDisabled -> pure ()
+ FeatureStatusEnabled -> throwS @'AccessDenied
+
+featureEnabledForTeamImpl ::
+ forall cfg r.
+ ( GetFeatureConfig cfg,
+ Member TeamSubsystem r,
+ Member TeamFeatureStore r,
+ Member LegalHoldStore r,
+ Member BrigAPIAccess r,
+ Member (Input FeatureFlags) r,
+ Member (Input (FeatureDefaults LegalholdConfig)) r,
+ Member (Input ExposeInvitationURLsAllowlist) r,
+ Member (Error TeamFeatureStoreError) r
+ ) =>
+ TeamId ->
+ Sem r Bool
+featureEnabledForTeamImpl tid =
+ (==) FeatureStatusEnabled
+ . (.status)
+ <$> getFeatureInternalImpl @cfg tid
diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs
index f70fa3addf..e3fa6bc3bc 100644
--- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs
+++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess.hs
@@ -22,6 +22,7 @@ module Wire.GalleyAPIAccess where
import Data.Currency qualified as Currency
import Data.Id
import Data.Json.Util (UTCTimeMillis)
+import Data.LegalHold (UserLegalHoldStatus)
import Data.Qualified
import Data.Range
import Imports
@@ -104,6 +105,9 @@ data GalleyAPIAccess m a where
GetTeam ::
TeamId ->
GalleyAPIAccess m Team.TeamData
+ FindTeam ::
+ TeamId ->
+ GalleyAPIAccess m (Maybe Team.TeamData)
GetTeamName ::
TeamId ->
GalleyAPIAccess m Team.TeamName
@@ -166,5 +170,7 @@ data GalleyAPIAccess m a where
GetConversationConfig ::
GalleyAPIAccess m ConversationSubsystemConfig
GuardLegalHold :: LegalholdProtectee -> UserClients -> GalleyAPIAccess m ()
+ GetUserLHStatus :: Maybe TeamId -> UserId -> GalleyAPIAccess m UserLegalHoldStatus
+ GetUsersLHStatus :: [UserId] -> GalleyAPIAccess m [(UserId, UserLegalHoldStatus)]
makeSem ''GalleyAPIAccess
diff --git a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs
index 3479c082df..ae8f54d772 100644
--- a/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs
+++ b/libs/wire-subsystems/src/Wire/GalleyAPIAccess/Rpc.hs
@@ -27,6 +27,7 @@ import Data.Coerce (coerce)
import Data.Currency qualified as Currency
import Data.Id
import Data.Json.Util (UTCTimeMillis)
+import Data.LegalHold (UserLegalHoldStatus)
import Data.Qualified
import Data.Range
import Imports
@@ -38,6 +39,7 @@ import Network.Wai.Utilities.Error qualified as Wai
import Polysemy
import Polysemy.Error
import Polysemy.Input
+import Polysemy.TinyLog (TinyLog, debug)
import Servant.API (toHeader)
import System.Logger.Message
import Util.Options
@@ -66,7 +68,8 @@ import Wire.Rpc
interpretGalleyAPIAccessToRpc ::
( Member (Error ParseException) r,
Member Rpc r,
- Member (Error ClientError) r
+ Member (Error ClientError) r,
+ Member TinyLog r
) =>
Set Version ->
Endpoint ->
@@ -89,6 +92,7 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
SelectTeamMembers tid uids -> selectTeamMembers tid uids
GetTeamId id' -> getTeamId id'
GetTeam id' -> getTeam id'
+ FindTeam id' -> findTeam id'
GetTeamName id' -> getTeamName id'
GetTeamLegalHoldStatus id' -> getTeamLegalHoldStatus id'
GetTeamSearchVisibility id' -> getTeamSearchVisibility id'
@@ -109,6 +113,8 @@ interpretGalleyAPIAccessToRpc disabledVersions galleyEndpoint =
GetTeamContacts uid -> getTeamContacts uid
GetConversationConfig -> getConversationConfig
GuardLegalHold protectee userClient -> guardLegalhold protectee userClient
+ GetUserLHStatus mtid uid -> getUserLHStatus mtid uid
+ GetUsersLHStatus uids -> getUsersLHStatus uids
getUserLegalholdStatus ::
( Member (Error ParseException) r,
@@ -132,7 +138,7 @@ galleyRequest req = do
ep <- input
rpcWithRetries "galley" ep req
--- | Calls 'Galley.API.createSelfConversationH'.
+-- | Calls 'Wire.ConversationSubsystem.createSelfConversationH'.
createSelfConv ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -148,7 +154,7 @@ createSelfConv v u = do
. zUser u
. expect2xx
--- | Calls 'Galley.API.getConversationH'.
+-- | Calls 'Wire.ConversationSubsystem.getConversationH'.
getConv ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -175,7 +181,7 @@ getConv v usr lcnv = do
. zUser usr
. expect [status200, status404]
--- | Calls 'Galley.API.getTeamConversationH'.
+-- | Calls 'Wire.ConversationSubsystem.getTeamConversationH'.
getTeamConv ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -204,7 +210,7 @@ getTeamConv v usr tid cnv = do
. zUser usr
. expect [status200, status404]
--- | Calls 'Galley.API.addClientH'.
+-- | Calls 'Wire.ConversationSubsystem.addClientH'.
newClient ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -219,7 +225,7 @@ newClient u c = do
. zUser u
. expect2xx
--- | Calls 'Galley.API.canUserJoinTeamH'.
+-- | Calls 'Wire.ConversationSubsystem.canUserJoinTeamH'.
checkUserCanJoinTeam ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -239,7 +245,7 @@ checkUserCanJoinTeam tid = do
. paths ["i", "teams", toByteString' tid, "members", "check"]
. header "Content-Type" "application/json"
--- | Calls 'Galley.API.uncheckedAddTeamMemberH'.
+-- | Calls 'Wire.ConversationSubsystem.uncheckedAddTeamMemberH'.
addTeamMember ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -265,7 +271,7 @@ addTeamMember u tid minvmeta role = do
. expect [status200, status403]
. lbytes (encode bdy)
--- | Calls 'Galley.API.createBindingTeamH'.
+-- | Calls 'Wire.ConversationSubsystem.createBindingTeamH'.
createTeam ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -285,7 +291,7 @@ createTeam u t teamid = do
. expect2xx
. lbytes (encode t)
--- | Calls 'Galley.API.uncheckedGetTeamMemberH'.
+-- | Calls 'Wire.ConversationSubsystem.uncheckedGetTeamMemberH'.
getTeamMember ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -306,7 +312,7 @@ getTeamMember u tid = do
. zUser u
. expect [status200, status404]
--- | Calls 'Galley.API.uncheckedGetTeamMembersH'.
+-- | Calls 'Wire.ConversationSubsystem.uncheckedGetTeamMembersH'.
--
-- | TODO: is now truncated. this is (only) used for team suspension / unsuspension, which
-- means that only the first 2000 members of a team (according to some arbitrary order) will
@@ -393,7 +399,7 @@ memberIsTeamOwner tid uid = do
. paths ["i", "teams", toByteString' tid, "is-team-owner", toByteString' uid]
pure $ responseStatus r /= status403
--- | Calls 'Galley.API.getBindingTeamIdH'.
+-- | Calls 'Wire.ConversationSubsystem.getBindingTeamIdH'.
getTeamId ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -412,7 +418,7 @@ getTeamId u = do
. paths ["i", "users", toByteString' u, "team"]
. expect [status200, status404]
--- | Calls 'Galley.API.getTeamInternalH'.
+-- | Calls 'Wire.ConversationSubsystem.getTeamInternalH'.
getTeam ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -428,7 +434,26 @@ getTeam tid = do
. paths ["i", "teams", toByteString' tid]
. expect2xx
--- | Calls 'Galley.API.getTeamInternalH'.
+-- | Like 'getTeam' but returns 'Nothing' on 404 instead of throwing.
+findTeam ::
+ ( Member (Error ParseException) r,
+ Member Rpc r,
+ Member (Input Endpoint) r
+ ) =>
+ TeamId ->
+ Sem r (Maybe Team.TeamData)
+findTeam tid = do
+ rs <- galleyRequest req
+ case Bilge.statusCode rs of
+ 200 -> Just <$> decodeBodyOrThrow "galley" rs
+ _ -> pure Nothing
+ where
+ req =
+ method GET
+ . paths ["i", "teams", toByteString' tid]
+ . expect [status200, status404]
+
+-- | Calls 'Wire.ConversationSubsystem.getTeamInternalH'.
getTeamName ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -444,7 +469,7 @@ getTeamName tid = do
. paths ["i", "teams", toByteString' tid, "name"]
. expect2xx
--- | Calls 'Galley.API.getTeamFeatureStatusH'.
+-- | Calls 'Wire.ConversationSubsystem.getTeamFeatureStatusH'.
getTeamLegalHoldStatus ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -460,7 +485,7 @@ getTeamLegalHoldStatus tid = do
. paths ["i", "teams", toByteString' tid, "features", featureNameBS @LegalholdConfig]
. expect2xx
--- | Calls 'Galley.API.getSearchVisibilityInternalH'.
+-- | Calls 'Wire.ConversationSubsystem.getSearchVisibilityInternalH'.
getTeamSearchVisibility ::
( Member (Error ParseException) r,
Member Rpc r,
@@ -541,7 +566,7 @@ getConfiguredFeatureFlags = do
. expect2xx
)
--- | Calls 'Galley.API.updateTeamStatusH'.
+-- | Calls 'Wire.ConversationSubsystem.updateTeamStatusH'.
changeTeamStatus ::
( Member Rpc r,
Member (Input Endpoint) r
@@ -748,3 +773,48 @@ guardLegalhold protectee userClients = do
. paths ["i", "guard-legalhold-policy-conflicts"]
. header "Content-Type" "application/json"
. lbytes (encode $ GuardLegalholdPolicyConflicts protectee userClients)
+
+getUserLHStatus ::
+ ( Member (Error ParseException) r,
+ Member Rpc r,
+ Member (Input Endpoint) r,
+ Member TinyLog r
+ ) =>
+ Maybe TeamId ->
+ UserId ->
+ Sem r UserLegalHoldStatus
+getUserLHStatus mtid uid = do
+ debug $
+ remote "galley"
+ . field "user" (toByteString uid)
+ . msg (val "Get user legalhold status")
+ galleyRequest req >>= decodeBodyOrThrow "galley"
+ where
+ req =
+ method GET
+ . paths ["i", "users", toByteString' uid, "lh-status"]
+ . maybe id (queryItem "team_id" . toByteString') mtid
+ . expect2xx
+
+getUsersLHStatus ::
+ ( Member (Error ParseException) r,
+ Member Rpc r,
+ Member (Input Endpoint) r,
+ Member TinyLog r
+ ) =>
+ [UserId] ->
+ Sem r [(UserId, UserLegalHoldStatus)]
+getUsersLHStatus uids = do
+ debug $
+ remote "galley"
+ . msg (val "Get users legalhold status")
+ let bdy = UserIds uids
+ entries :: [UserLegalHoldStatusEntry] <- galleyRequest (req bdy) >>= decodeBodyOrThrow "galley"
+ pure $ map (\e -> (e.ulhseUser, e.ulhseStatus)) entries
+ where
+ req bdy =
+ method POST
+ . paths ["i", "users", "lh-status"]
+ . header "Content-Type" "application/json"
+ . lbytes (encode bdy)
+ . expect2xx
diff --git a/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs
index 45d06de2ca..9fa3d15168 100644
--- a/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/MeetingsSubsystem/Interpreter.hs
@@ -122,7 +122,7 @@ createMeetingImpl zUser newMeeting = do
}
-- Create and store the conversation via ConversationSubsystem
- storedConv <- ConversationSubsystem.createGroupConversation zUser Nothing newConv
+ storedConv <- ConversationSubsystem.internalCreateGroupConversation zUser Nothing newConv
-- Store meeting (trial status is provided by caller)
storedMeeting <-
diff --git a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs
index c93258449c..adb170507d 100644
--- a/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/NotificationSubsystem/Interpreter.hs
@@ -23,7 +23,6 @@ import Data.Aeson
import Data.Id
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NonEmpty
-import Data.Proxy
import Data.Range
import Data.Set qualified as Set
import Data.Time.Clock.DiffTime
@@ -38,6 +37,7 @@ import Polysemy.TinyLog qualified as P
import System.Logger.Class as Log
import Wire.API.Push.V2 hiding (Push (..), Recipient, newPush)
import Wire.API.Push.V2 qualified as V2
+import Wire.API.Team.FeatureFlags (defaultFanoutLimit)
import Wire.API.Team.HardTruncationLimit (HardTruncationLimit)
import Wire.GundeckAPIAccess (GundeckAPIAccess)
import Wire.GundeckAPIAccess qualified as GundeckAPIAccess
@@ -75,9 +75,6 @@ defaultNotificationSubsystemConfig :: RequestId -> NotificationSubsystemConfig
defaultNotificationSubsystemConfig reqId =
NotificationSubsystemConfig defaultFanoutLimit defaultChunkSize defaultSlowPushDelay reqId
-defaultFanoutLimit :: Range 1 HardTruncationLimit Int32
-defaultFanoutLimit = toRange (Proxy @HardTruncationLimit)
-
defaultChunkSize :: Natural
defaultChunkSize = 128
diff --git a/libs/wire-subsystems/src/Wire/Options/Galley.hs b/libs/wire-subsystems/src/Wire/Options/Galley.hs
index 8383ee97e4..6b30fff097 100644
--- a/libs/wire-subsystems/src/Wire/Options/Galley.hs
+++ b/libs/wire-subsystems/src/Wire/Options/Galley.hs
@@ -56,21 +56,22 @@ module Wire.Options.Galley
logNetStrings,
logFormat,
guestLinkTTLSeconds,
- defGuestLinkTTLSeconds,
passwordHashingOptions,
passwordHashingRateLimit,
checkGroupInfo,
meetings,
validityPeriod,
postgresMigration,
- GuestLinkTTLSeconds (..),
PostgresMigrationOpts (..),
StorageLocation (..),
+ GuestLinkTTLSeconds (..),
+ defGuestLinkTTLSeconds,
+ conversationCodeURISettings,
)
where
import Control.Lens hiding (Level, (.=))
-import Data.Aeson
+import Data.Aeson (FromJSON (..))
import Data.Aeson.TH (deriveFromJSON)
import Data.Domain (Domain)
import Data.Id (TeamId)
@@ -86,7 +87,7 @@ import Wire.API.Conversation.Protocol
import Wire.API.Routes.Version
import Wire.API.Team.FeatureFlags
import Wire.API.Team.Member
-import Wire.Options.Keys
+import Wire.Options.Keys (MLSPrivateKeyPaths)
import Wire.PostgresMigrationOpts
import Wire.RateLimit.Interpreter (RateLimitConfig)
@@ -102,6 +103,10 @@ instance FromJSON GuestLinkTTLSeconds where
then pure $ GuestLinkTTLSeconds n
else fail "GuestLinkTTLSeconds must be in (0, 31536000]"
+-- | Default guest link TTL in days. 365 days if not set.
+defGuestLinkTTLSeconds :: GuestLinkTTLSeconds
+defGuestLinkTTLSeconds = GuestLinkTTLSeconds $ 60 * 60 * 24 * 365 -- 1 year
+
data Settings = Settings
{ -- | Number of connections for the HTTP client pool
_httpPoolSize :: !Int,
@@ -184,10 +189,6 @@ makeLenses ''MeetingsConfig
defConcurrentDeletionEvents :: Int
defConcurrentDeletionEvents = 128
--- | Default guest link TTL in days. 365 days if not set.
-defGuestLinkTTLSeconds :: GuestLinkTTLSeconds
-defGuestLinkTTLSeconds = GuestLinkTTLSeconds $ 60 * 60 * 24 * 365 -- 1 year
-
data JournalOpts = JournalOpts
{ -- | SQS queue name to send team events
_queueName :: !Text,
@@ -241,3 +242,13 @@ data Opts = Opts
deriveFromJSON toOptionFieldName ''Opts
makeLenses ''Opts
+
+conversationCodeURISettings :: (Applicative m) => Opts -> m (Either HttpsUrl (Map Text HttpsUrl))
+conversationCodeURISettings opts =
+ case (opts._settings._conversationCodeURI, opts._settings._multiIngress) of
+ (Nothing, Nothing) -> error errMsg
+ (Nothing, Just mi) -> pure (Right mi)
+ (Just uri, Nothing) -> pure (Left uri)
+ (Just _, Just _) -> error errMsg
+ where
+ errMsg = "Either conversationCodeURI or multiIngress needs to be set."
diff --git a/libs/wire-subsystems/src/Wire/StoredConversation.hs b/libs/wire-subsystems/src/Wire/StoredConversation.hs
index 5af3bb2bac..1fdbe37284 100644
--- a/libs/wire-subsystems/src/Wire/StoredConversation.hs
+++ b/libs/wire-subsystems/src/Wire/StoredConversation.hs
@@ -30,9 +30,11 @@ import Data.Time (UTCTime)
import Data.UUID.Tagged qualified as U
import Imports
import Wire.API.Conversation
+import Wire.API.Conversation qualified as Public
import Wire.API.Conversation.CellsState
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
+import Wire.API.Federation.API.Galley
import Wire.API.History
import Wire.API.MLS.CipherSuite
import Wire.API.MLS.Group.Serialisation qualified as MLS
@@ -352,6 +354,135 @@ defAccess One2OneConv (Just []) = [PrivateAccess]
defAccess RegularConv (Just []) = defRegularConvAccess
defAccess _ (Just xs@(_ : _)) = xs
+-- MAPPING -------------------------------------------------------------------
+
+-- | View for a given user of a stored conversation.
+--
+-- Throws @BadMemberState@ when the user is not part of the conversation.
+ownConversationView ::
+ Local UserId ->
+ StoredConversation ->
+ Maybe OwnConversation
+ownConversationView luid conv = do
+ let remoteOthers = map remoteMemberToOther $ conv.remoteMembers
+ localOthers = map (localMemberToOther (tDomain luid)) $ conv.localMembers
+ conversationViewWithCachedOthers remoteOthers localOthers conv luid
+
+conversationView ::
+ Local x ->
+ Maybe (Local UserId) ->
+ StoredConversation ->
+ Conversation
+conversationView l luid conv =
+ let remoteMembers = map remoteMemberToOther $ conv.remoteMembers
+ localMembers = map (localMemberToOther (tDomain l)) $ conv.localMembers
+ selfs = filter (\m -> fmap tUnqualified luid == Just m.id_) (conv.localMembers)
+ mSelf = localMemberToPublic l <$> listToMaybe selfs
+ others = filter (\oth -> (tUntagged <$> luid) /= Just (omQualifiedId oth)) localMembers <> remoteMembers
+ in Conversation
+ { members = ConvMembers mSelf others,
+ qualifiedId = (tUntagged . qualifyAs l $ conv.id_),
+ metadata = conv.metadata,
+ protocol = conv.protocol
+ }
+
+-- | Like 'conversationView' but optimized for situations which could benefit
+-- from pre-computing the list of @OtherMember@s in the conversation. For
+-- instance, creating @ConversationView@ for more than 1 member of the same conversation.
+conversationViewWithCachedOthers ::
+ [OtherMember] ->
+ [OtherMember] ->
+ StoredConversation ->
+ Local UserId ->
+ Maybe OwnConversation
+conversationViewWithCachedOthers remoteOthers localOthers conv luid = do
+ conversationViewMaybe luid remoteOthers localOthers conv
+
+-- | View for a given user of a stored conversation.
+--
+-- Returns 'Nothing' if the user is not part of the conversation.
+conversationViewMaybe :: Local UserId -> [OtherMember] -> [OtherMember] -> StoredConversation -> Maybe OwnConversation
+conversationViewMaybe luid remoteOthers localOthers conv = do
+ let selfs = filter (\m -> tUnqualified luid == m.id_) conv.localMembers
+ self <- localMemberToPublic luid <$> listToMaybe selfs
+ let others = filter (\oth -> tUntagged luid /= omQualifiedId oth) localOthers <> remoteOthers
+ pure $
+ OwnConversation
+ (tUntagged . qualifyAs luid $ conv.id_)
+ conv.metadata
+ (OwnConvMembers self others)
+ conv.protocol
+
+-- | View for a local user of a remote conversation.
+remoteConversationView ::
+ Local UserId ->
+ MemberStatus ->
+ Remote RemoteConversationView ->
+ OwnConversation
+remoteConversationView uid status (tUntagged -> Qualified rconv rDomain) =
+ let mems = rconv.members
+ others = mems.others
+ self =
+ localMemberToPublic
+ uid
+ LocalMember
+ { id_ = tUnqualified uid,
+ service = Nothing,
+ status = status,
+ convRoleName = mems.selfRole
+ }
+ in OwnConversation
+ (Qualified rconv.id rDomain)
+ rconv.metadata
+ (OwnConvMembers self others)
+ rconv.protocol
+
+-- | Convert a local conversation member (as stored in the DB) to a publicly
+-- facing 'Member' structure.
+localMemberToPublic :: Local x -> LocalMember -> Public.Member
+localMemberToPublic loc lm =
+ Public.Member
+ { memId = tUntagged . qualifyAs loc $ lm.id_,
+ memService = lm.service,
+ memOtrMutedStatus = msOtrMutedStatus st,
+ memOtrMutedRef = msOtrMutedRef st,
+ memOtrArchived = msOtrArchived st,
+ memOtrArchivedRef = msOtrArchivedRef st,
+ memHidden = msHidden st,
+ memHiddenRef = msHiddenRef st,
+ memConvRoleName = lm.convRoleName
+ }
+ where
+ st = lm.status
+
+-- | Convert a local conversation to a structure to be returned to a remote
+-- backend.
+--
+-- This returns 'Nothing' if the given remote user is not part of the conversation.
+conversationToRemote ::
+ Domain ->
+ Remote UserId ->
+ StoredConversation ->
+ Maybe RemoteConversationView
+conversationToRemote localDomain ruid conv = do
+ let (selfs, rothers) = partition (\r -> r.id_ == ruid) (conv.remoteMembers)
+ lothers = conv.localMembers
+ selfRole' <- (.convRoleName) <$> listToMaybe selfs
+ let others' =
+ map (localMemberToOther localDomain) lothers
+ <> map remoteMemberToOther rothers
+ pure $
+ RemoteConversationView
+ { id = conv.id_,
+ metadata = conv.metadata,
+ members =
+ RemoteConvMembers
+ { selfRole = selfRole',
+ others = others'
+ },
+ protocol = conv.protocol
+ }
+
-- BotMember ------------------------------------------------------------------
-- | For now we assume bots to always be local
diff --git a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs
index c42d8c58d1..d7e7b9e468 100644
--- a/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/TeamInvitationSubsystem/Interpreter.hs
@@ -286,7 +286,7 @@ logInvitationRequest context action =
-- | Privilege escalation detection (make sure no `RoleMember` user creates a `RoleOwner`).
--
--- There is some code duplication with 'Galley.API.Teams.ensureNotElevated'.
+-- There is some code duplication with 'Wire.ConversationSubsystem.Teams.ensureNotElevated'.
ensurePermissionToAddUser ::
( Member (Error TeamInvitationSubsystemError) r,
Member TeamSubsystem r
diff --git a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs
index 7c7213aee7..cd4fa9a7ca 100644
--- a/libs/wire-subsystems/src/Wire/TeamSubsystem.hs
+++ b/libs/wire-subsystems/src/Wire/TeamSubsystem.hs
@@ -20,13 +20,30 @@
module Wire.TeamSubsystem where
import Data.Id
+import Data.LegalHold
+import Data.Map qualified as Map
import Data.Qualified
import Data.Range
+import Data.Singletons (Demote, Sing, SingKind, fromSing)
import Imports
import Polysemy
+import Wire.API.Error
+import Wire.API.Error.Galley
+import Wire.API.Team.LegalHold (UserLegalHoldStatusResponse)
import Wire.API.Team.Member
+import Wire.API.Team.Member.Error
import Wire.API.Team.Member.Info (TeamMemberInfoList)
+data PermissionCheckArgs teamAssociation where
+ PermissionCheckArgs ::
+ forall k (p :: k) teamAssociation.
+ ( SingKind k,
+ IsPerm teamAssociation (Demote k)
+ ) =>
+ Sing p ->
+ Maybe teamAssociation ->
+ PermissionCheckArgs teamAssociation
+
data TeamSubsystem m a where
InternalGetTeamMember :: UserId -> TeamId -> TeamSubsystem m (Maybe TeamMember)
InternalGetTeamMembersWithLimit :: TeamId -> Maybe (Range 1 HardTruncationLimit Int32) -> TeamSubsystem m TeamMemberList
@@ -35,5 +52,95 @@ data TeamSubsystem m a where
InternalGetTeamAdmins :: TeamId -> TeamSubsystem m TeamMemberList
InternalGetOneUserTeam :: UserId -> TeamSubsystem m (Maybe TeamId)
InternalFinalizeDeleteTeam :: Local UserId -> Maybe ConnId -> TeamId -> TeamSubsystem m ()
+ GetUserStatus ::
+ Local UserId ->
+ TeamId ->
+ UserId ->
+ TeamSubsystem m UserLegalHoldStatusResponse
+ GetTeamMembersForFanout ::
+ TeamId ->
+ TeamSubsystem m TeamMemberList
+ AssertTeamExists ::
+ TeamId ->
+ TeamSubsystem m ()
+ GetLHStatusForUsers ::
+ [UserId] ->
+ TeamSubsystem m [(UserId, UserLegalHoldStatus)]
+ GetLHStatus ::
+ Maybe TeamId ->
+ UserId ->
+ TeamSubsystem m UserLegalHoldStatus
makeSem ''TeamSubsystem
+
+assertOnTeam ::
+ ( Member (ErrorS 'NotATeamMember) r,
+ Member TeamSubsystem r
+ ) =>
+ UserId ->
+ TeamId ->
+ Sem r ()
+assertOnTeam uid tid =
+ internalGetTeamMember uid tid >>= \case
+ Nothing -> throwS @'NotATeamMember
+ Just _ -> pure ()
+
+-- | If a team member is not given throw 'notATeamMember'; if the given team
+-- member does not have the given permission, throw 'operationDenied'.
+-- Otherwise, return the team member.
+permissionCheck ::
+ ( IsPerm teamAssociation perm,
+ ( Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r
+ )
+ ) =>
+ perm ->
+ Maybe teamAssociation ->
+ Sem r teamAssociation
+-- FUTUREWORK: factor `noteS` out of this function.
+permissionCheck p = \case
+ Just m -> do
+ if m `hasPermission` p
+ then pure m
+ else throwS @OperationDenied
+ -- FUTUREWORK: factor `noteS` out of this function.
+ Nothing -> throwS @'NotATeamMember
+
+-- | Same as 'permissionCheck', but for a statically known permission.
+permissionCheckS ::
+ forall teamAssociation perm (p :: perm) r.
+ ( SingKind perm,
+ IsPerm teamAssociation (Demote perm),
+ ( Member (ErrorS (PermError p)) r,
+ Member (ErrorS 'NotATeamMember) r
+ )
+ ) =>
+ Sing p ->
+ Maybe teamAssociation ->
+ Sem r teamAssociation
+permissionCheckS p =
+ \case
+ Just m -> do
+ if m `hasPermission` fromSing p
+ then pure m
+ else throwS @(PermError p)
+ -- FUTUREWORK: factor `noteS` out of this function.
+ Nothing -> throwS @'NotATeamMember
+
+data ConsentGiven = ConsentGiven | ConsentNotGiven
+ deriving (Eq, Ord, Show)
+
+consentGiven :: UserLegalHoldStatus -> ConsentGiven
+consentGiven = \case
+ UserLegalHoldDisabled -> ConsentGiven
+ UserLegalHoldPending -> ConsentGiven
+ UserLegalHoldEnabled -> ConsentGiven
+ UserLegalHoldNoConsent -> ConsentNotGiven
+
+checkConsent ::
+ (Member TeamSubsystem r) =>
+ Map UserId TeamId ->
+ UserId ->
+ Sem r ConsentGiven
+checkConsent teamsOfUsers other = do
+ consentGiven <$> getLHStatus (Map.lookup other teamsOfUsers) other
diff --git a/libs/wire-subsystems/src/Wire/TeamSubsystem/GalleyAPI.hs b/libs/wire-subsystems/src/Wire/TeamSubsystem/GalleyAPI.hs
index 0f4e4342cc..31ff34a886 100644
--- a/libs/wire-subsystems/src/Wire/TeamSubsystem/GalleyAPI.hs
+++ b/libs/wire-subsystems/src/Wire/TeamSubsystem/GalleyAPI.hs
@@ -19,11 +19,18 @@ module Wire.TeamSubsystem.GalleyAPI where
import Imports
import Polysemy
+import Wire.API.Error
+import Wire.API.Error.Galley
import Wire.GalleyAPIAccess (GalleyAPIAccess)
import Wire.GalleyAPIAccess qualified as GalleyAPIAccess
import Wire.TeamSubsystem
-interpretTeamSubsystemToGalleyAPI :: (Member GalleyAPIAccess r) => InterpreterFor TeamSubsystem r
+interpretTeamSubsystemToGalleyAPI ::
+ ( Member GalleyAPIAccess r,
+ Member (ErrorS 'TeamMemberNotFound) r,
+ Member (ErrorS 'TeamNotFound) r
+ ) =>
+ InterpreterFor TeamSubsystem r
interpretTeamSubsystemToGalleyAPI = interpret $ \case
InternalGetTeamMember userId teamId -> GalleyAPIAccess.getTeamMember userId teamId
InternalGetTeamMembersWithLimit teamId maxResults -> GalleyAPIAccess.getTeamMembersWithLimit teamId maxResults
@@ -32,3 +39,17 @@ interpretTeamSubsystemToGalleyAPI = interpret $ \case
InternalGetTeamAdmins teamId -> GalleyAPIAccess.getTeamAdmins teamId
InternalGetOneUserTeam userId -> GalleyAPIAccess.getTeamId userId
InternalFinalizeDeleteTeam lusr mcon teamId -> GalleyAPIAccess.finalizeDeleteTeam lusr mcon teamId
+ GetUserStatus lusr tid uid -> do
+ GalleyAPIAccess.getTeamMember uid tid >>= \case
+ Nothing -> throwS @'TeamMemberNotFound
+ Just _ -> do
+ GalleyAPIAccess.getUserLegalholdStatus lusr tid >>= \case
+ Nothing -> throwS @'TeamNotFound
+ Just status -> pure status
+ GetTeamMembersForFanout tid ->
+ GalleyAPIAccess.getTeamMembersWithLimit tid Nothing
+ AssertTeamExists tid -> do
+ found <- isJust <$> GalleyAPIAccess.findTeam tid
+ unless found $ throwS @'TeamNotFound
+ GetLHStatusForUsers uids -> GalleyAPIAccess.getUsersLHStatus uids
+ GetLHStatus mtid uid -> GalleyAPIAccess.getUserLHStatus mtid uid
diff --git a/libs/wire-subsystems/src/Wire/TeamSubsystem/Interpreter.hs b/libs/wire-subsystems/src/Wire/TeamSubsystem/Interpreter.hs
index 749bfd978d..f598ec35d7 100644
--- a/libs/wire-subsystems/src/Wire/TeamSubsystem/Interpreter.hs
+++ b/libs/wire-subsystems/src/Wire/TeamSubsystem/Interpreter.hs
@@ -18,22 +18,34 @@
module Wire.TeamSubsystem.Interpreter where
import Control.Lens (view, (%~), (^.))
+import Data.ByteString.Conversion (toByteString')
import Data.Default
import Data.Id
import Data.Json.Util
-import Data.LegalHold (UserLegalHoldStatus (..))
+import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus)
import Data.List.Extra qualified as List
import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Map qualified as Map
import Data.Qualified
import Data.Time
+import Galley.Types.Error
import Imports
import Polysemy
+import Polysemy.Error
import Polysemy.Input
+import Polysemy.TinyLog qualified as P
+import System.Logger.Class qualified as Log
+import Wire.API.Error
+import Wire.API.Error.Galley
import Wire.API.Event.Conversation qualified as Conv
import Wire.API.Event.Team
+import Wire.API.Team.FeatureFlags (FanoutLimit)
import Wire.API.Team.HardTruncationLimit
+import Wire.API.Team.LegalHold
+import Wire.API.Team.LegalHold qualified as Public
import Wire.API.Team.Member
import Wire.API.Team.Member.Info (TeamMemberInfoList (TeamMemberInfoList))
+import Wire.API.User.Client.Prekey
import Wire.BrigAPIAccess
import Wire.BrigAPIAccess qualified as Brig
import Wire.ConversationStore
@@ -42,6 +54,7 @@ import Wire.ExternalAccess
import Wire.ExternalAccess qualified as ExternalAccess
import Wire.LegalHoldStore (LegalHoldStore)
import Wire.LegalHoldStore qualified as LH
+import Wire.LegalHoldStore qualified as LegalHoldData
import Wire.NotificationSubsystem
import Wire.Sem.Now
import Wire.Sem.Now qualified as Now
@@ -65,7 +78,12 @@ interpretTeamSubsystem ::
Member Now r,
Member SparAPIAccess r,
Member ConversationStore r,
- Member TeamJournal r
+ Member TeamJournal r,
+ Member (Input FanoutLimit) r,
+ Member (Error InternalError) r,
+ Member (ErrorS 'TeamNotFound) r,
+ Member (ErrorS 'TeamMemberNotFound) r,
+ Member P.TinyLog r
) =>
TeamSubsystemConfig ->
InterpreterFor TeamSubsystem r
@@ -79,23 +97,23 @@ interpretTeamSubsystemWithInputConfig ::
Member ExternalAccess r,
Member NotificationSubsystem r,
Member (Input TeamSubsystemConfig) r,
+ Member (Input FanoutLimit) r,
Member Now r,
Member SparAPIAccess r,
Member ConversationStore r,
- Member TeamJournal r
+ Member TeamJournal r,
+ Member (Error InternalError) r,
+ Member (ErrorS 'TeamNotFound) r,
+ Member (ErrorS 'TeamMemberNotFound) r,
+ Member P.TinyLog r
) =>
InterpreterFor TeamSubsystem r
interpretTeamSubsystemWithInputConfig =
interpret $ \case
- InternalGetTeamMember uid tid -> do
- tms <- TeamStore.getTeamMember tid uid
- for tms $ \tm -> do
- hasImplicitConsent <- LH.isTeamLegalholdWhitelisted tid
- pure $ if hasImplicitConsent then grantImplicitConsent tm else tm
- InternalGetTeamMembersWithLimit tid maxResults -> do
- tmList <- TeamStore.getTeamMembersWithLimit tid (fromMaybe hardTruncationLimitRange maxResults)
- ms <- adjustMembersForImplicitConsent tid (tmList ^. teamMembers)
- pure $ newTeamMemberList ms (tmList ^. teamMemberListType)
+ InternalGetTeamMember uid tid ->
+ internalGetTeamMemberImpl uid tid
+ InternalGetTeamMembersWithLimit tid maxResults ->
+ internalGetTeamMembersWithLimitImpl tid maxResults
InternalSelectTeamMemberInfos tid uids -> TeamMemberInfoList <$> TeamStore.selectTeamMemberInfos tid uids
InternalSelectTeamMembers tid uids -> do
tms <- TeamStore.selectTeamMembers tid uids
@@ -106,9 +124,20 @@ interpretTeamSubsystemWithInputConfig =
>>= TeamStore.selectTeamMembers tid
>>= adjustMembersForImplicitConsent tid
pure $ newTeamMemberList admins ListComplete
- InternalGetOneUserTeam uid -> TeamStore.getOneUserTeam uid
+ InternalGetOneUserTeam uid ->
+ TeamStore.getOneUserTeam uid
InternalFinalizeDeleteTeam luid mcon tid ->
internalFinalizeDeleteTeamImpl luid mcon tid
+ GetUserStatus lzusr tid uid ->
+ getUserStatusImpl lzusr tid uid
+ AssertTeamExists tid ->
+ assertTeamExistsImpl tid
+ GetTeamMembersForFanout tid ->
+ getTeamMembersForFanoutImpl tid
+ GetLHStatus teamOfUser other ->
+ getLHStatusImpl teamOfUser other
+ GetLHStatusForUsers uids ->
+ getLHStatusForUsersImpl uids
adjustMembersForImplicitConsent :: (Member LegalHoldStore r) => TeamId -> [TeamMember] -> Sem r [TeamMember]
adjustMembersForImplicitConsent tid ms = do
@@ -123,6 +152,31 @@ grantImplicitConsent =
UserLegalHoldPending -> UserLegalHoldPending
UserLegalHoldEnabled -> UserLegalHoldEnabled
+internalGetTeamMemberImpl ::
+ ( Member TeamStore r,
+ Member LegalHoldStore r
+ ) =>
+ UserId ->
+ TeamId ->
+ Sem r (Maybe TeamMember)
+internalGetTeamMemberImpl uid tid = do
+ tms <- TeamStore.getTeamMember tid uid
+ for tms $ \tm -> do
+ hasImplicitConsent <- LH.isTeamLegalholdWhitelisted tid
+ pure $ if hasImplicitConsent then grantImplicitConsent tm else tm
+
+internalGetTeamMembersWithLimitImpl ::
+ ( Member TeamStore r,
+ Member LegalHoldStore r
+ ) =>
+ TeamId ->
+ Maybe FanoutLimit ->
+ Sem r TeamMemberList
+internalGetTeamMembersWithLimitImpl tid maxResults = do
+ tmList <- TeamStore.getTeamMembersWithLimit tid (fromMaybe hardTruncationLimitRange maxResults)
+ ms <- adjustMembersForImplicitConsent tid (tmList ^. teamMembers)
+ pure $ newTeamMemberList ms (tmList ^. teamMemberListType)
+
-- This function is "unchecked" because it does not validate that the user has the `DeleteTeam` permission.
internalFinalizeDeleteTeamImpl ::
forall r.
@@ -204,3 +258,98 @@ internalFinalizeDeleteTeamImpl lusr zcon tid = do
let ee' = map (,e) bots
let pp' = (p {conn = zcon}) : pp
pure (pp', ee' ++ ee)
+
+-- | Learn whether a user has LH enabled and fetch pre-keys.
+-- Note that this is accessible to ANY authenticated user, even ones outside the team
+getUserStatusImpl ::
+ forall r.
+ ( Member (Error InternalError) r,
+ Member (ErrorS 'TeamMemberNotFound) r,
+ Member LegalHoldData.LegalHoldStore r,
+ Member TeamStore r,
+ Member P.TinyLog r
+ ) =>
+ Local UserId ->
+ TeamId ->
+ UserId ->
+ Sem r Public.UserLegalHoldStatusResponse
+getUserStatusImpl _lzusr tid uid = do
+ teamMember <- noteS @'TeamMemberNotFound =<< internalGetTeamMemberImpl uid tid
+ let status = view legalHoldStatus teamMember
+ (mlk, lcid) <- case status of
+ UserLegalHoldNoConsent -> pure (Nothing, Nothing)
+ UserLegalHoldDisabled -> pure (Nothing, Nothing)
+ UserLegalHoldPending -> makeResponseDetails
+ UserLegalHoldEnabled -> makeResponseDetails
+ pure $ UserLegalHoldStatusResponse status mlk lcid
+ where
+ makeResponseDetails :: Sem r (Maybe LastPrekey, Maybe ClientId)
+ makeResponseDetails = do
+ mLastKey <- fmap snd <$> LegalHoldData.selectPendingPrekeys uid
+ lastKey <- case mLastKey of
+ Nothing -> do
+ P.err
+ . Log.msg
+ $ "expected to find a prekey for user: "
+ <> toByteString' uid
+ <> " but none was found"
+ throw NoPrekeyForUser
+ Just lstKey -> pure lstKey
+ let clientId = clientIdFromPrekey . unpackLastPrekey $ lastKey
+ pure (Just lastKey, Just clientId)
+
+assertTeamExistsImpl ::
+ ( Member (ErrorS 'TeamNotFound) r,
+ Member TeamStore r
+ ) =>
+ TeamId ->
+ Sem r ()
+assertTeamExistsImpl tid = do
+ teamExists <- isJust <$> TeamStore.getTeam tid
+ if teamExists
+ then pure ()
+ else throwS @'TeamNotFound
+
+getTeamMembersForFanoutImpl ::
+ ( Member TeamStore r,
+ Member LegalHoldStore r,
+ Member (Input FanoutLimit) r
+ ) =>
+ TeamId ->
+ Sem r TeamMemberList
+getTeamMembersForFanoutImpl tid = do
+ lim <- input
+ internalGetTeamMembersWithLimitImpl tid (Just lim)
+
+-- Get legalhold status of user. Defaults to 'defUserLegalHoldStatus' if user
+-- doesn't belong to a team.
+getLHStatusImpl ::
+ ( Member TeamStore r,
+ Member LegalHoldStore r
+ ) =>
+ Maybe TeamId ->
+ UserId ->
+ Sem r UserLegalHoldStatus
+getLHStatusImpl teamOfUser other = do
+ case teamOfUser of
+ Nothing -> pure defUserLegalHoldStatus
+ Just team -> do
+ mMember <- internalGetTeamMemberImpl other team
+ pure $ maybe defUserLegalHoldStatus (view legalHoldStatus) mMember
+
+-- | Add to every uid the legalhold status
+getLHStatusForUsersImpl ::
+ ( Member TeamStore r,
+ Member LegalHoldStore r
+ ) =>
+ [UserId] ->
+ Sem r [(UserId, UserLegalHoldStatus)]
+getLHStatusForUsersImpl uids =
+ mconcat
+ <$> for
+ (List.chunksOf 32 uids)
+ ( \uidsChunk -> do
+ teamsOfUsers <- TeamStore.getUsersTeams uidsChunk
+ for uidsChunk $ \uid -> do
+ (uid,) <$> getLHStatusImpl (Map.lookup uid teamsOfUsers) uid
+ )
diff --git a/libs/wire-subsystems/src/Wire/UserClientIndexStore.hs b/libs/wire-subsystems/src/Wire/UserClientIndexStore.hs
index f0bde2b224..1ba2898eca 100644
--- a/libs/wire-subsystems/src/Wire/UserClientIndexStore.hs
+++ b/libs/wire-subsystems/src/Wire/UserClientIndexStore.hs
@@ -17,21 +17,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Wire.UserClientIndexStore
- ( -- * UserClientIndexStore Effect
- UserClientIndexStore (..),
-
- -- * Create client
- createClient,
-
- -- * Get client
- getClients,
-
- -- * Delete client
- deleteClient,
- deleteClients,
- )
-where
+module Wire.UserClientIndexStore where
import Data.Id
import Galley.Types.Clients
diff --git a/services/galley/test/unit/Test/Galley/API/Message.hs b/libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/MessageSpec.hs
similarity index 56%
rename from services/galley/test/unit/Test/Galley/API/Message.hs
rename to libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/MessageSpec.hs
index 18c9512c66..55e9b03d7c 100644
--- a/services/galley/test/unit/Test/Galley/API/Message.hs
+++ b/libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/MessageSpec.hs
@@ -15,7 +15,7 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Test.Galley.API.Message where
+module Wire.ConversationSubsystem.MessageSpec where
import Control.Lens
import Data.Domain
@@ -23,27 +23,23 @@ import Data.Id
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Set.Lens
-import Data.UUID.Types
-import Galley.API.Message
+import Data.UUID qualified as UUID
import Imports
-import Test.Tasty
-import Test.Tasty.QuickCheck
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck ((===), (==>))
import Wire.API.Message
import Wire.API.User.Client (QualifiedUserClients (..))
+import Wire.ConversationSubsystem.Message
-tests :: TestTree
-tests =
- testGroup
- "Galley.API.Message"
- [ testGroup
- "checkMessageClients"
- [ checkMessageClientSuccess,
- checkMessageClientEverythingReported,
- checkMessageClientRedundantSender,
- checkMessageClientMissingSubsetOfStrategy
- ],
- testBuildFailedToSend
- ]
+spec :: Spec
+spec = describe "Galley.API.Message" do
+ describe "checkMessageClients" do
+ checkMessageClientSuccess
+ checkMessageClientEverythingReported
+ checkMessageClientRedundantSender
+ checkMessageClientMissingSubsetOfStrategy
+ testBuildFailedToSend
flatten :: Map Domain (Map UserId (Set ClientId)) -> Set (Domain, UserId, ClientId)
flatten =
@@ -57,8 +53,8 @@ type QualifiedUserClient = (Domain, UserId, ClientId)
recipientSetToMap :: Set QualifiedUserClient -> Map (Domain, UserId) (Set ClientId)
recipientSetToMap = Set.foldr (\(d, u, c) m -> Map.insertWith Set.union (d, u) (Set.singleton c) m) mempty
-checkMessageClientSuccess :: TestTree
-checkMessageClientSuccess = testProperty "success" $
+checkMessageClientSuccess :: Spec
+checkMessageClientSuccess = prop "success" $
\(sender :: QualifiedUserClient) (msg :: Map QualifiedUserClient ByteString) (strat :: ClientMismatchStrategy) ->
let expectedRecipients = Map.keysSet msg
expectedRecipientMap = recipientSetToMap expectedRecipients
@@ -66,8 +62,8 @@ checkMessageClientSuccess = testProperty "success" $
checkMessageClients sender expectedRecipientMap msg strat
=== (True, msg, QualifiedMismatch mempty mempty mempty)
-checkMessageClientRedundantSender :: TestTree
-checkMessageClientRedundantSender = testProperty "sender should be part of redundant" $
+checkMessageClientRedundantSender :: Spec
+checkMessageClientRedundantSender = prop "sender should be part of redundant" $
\(msg0 :: Map QualifiedUserClient ByteString) (sender :: QualifiedUserClient) (strat :: ClientMismatchStrategy) ->
let msg = Map.insert sender "msg to self" msg0
expectedRecipients = Map.keysSet msg0
@@ -79,8 +75,8 @@ checkMessageClientRedundantSender = testProperty "sender should be part of redun
-- expected'' are used along with msg to generate expected, this ensures that we
-- don't always get a disjoint set between the intended recipietns and expected
-- recipients.
-checkMessageClientEverythingReported :: TestTree
-checkMessageClientEverythingReported = testProperty "all intended and expected recipients should be part of valid and extras" $
+checkMessageClientEverythingReported :: Spec
+checkMessageClientEverythingReported = prop "all intended and expected recipients should be part of valid and extras" $
\(sender :: QualifiedUserClient) (expected' :: Set QualifiedUserClient) (msg0 :: Map QualifiedUserClient ByteString) (msg' :: Map QualifiedUserClient ByteString) ->
let expectedRecipients = Map.keysSet msg0 <> expected'
expectedRecipientMap = recipientSetToMap expectedRecipients
@@ -92,8 +88,8 @@ checkMessageClientEverythingReported = testProperty "all intended and expected r
in validRecipients <> extraRecipients
=== intendedRecipients <> expectedRecipients
-checkMessageClientMissingSubsetOfStrategy :: TestTree
-checkMessageClientMissingSubsetOfStrategy = testProperty "missing clients should be a subset of the clients determined by the strategy" $
+checkMessageClientMissingSubsetOfStrategy :: Spec
+checkMessageClientMissingSubsetOfStrategy = prop "missing clients should be a subset of the clients determined by the strategy" $
\(sender :: QualifiedUserClient) (expected' :: Set QualifiedUserClient) (msg0 :: Map QualifiedUserClient ByteString) (msg' :: Map QualifiedUserClient ByteString) (strat :: ClientMismatchStrategy) ->
let expected = Map.keysSet msg0 <> expected'
expectedMap = recipientSetToMap expected
@@ -103,52 +99,38 @@ checkMessageClientMissingSubsetOfStrategy = testProperty "missing clients should
missing = flatten . qualifiedUserClients $ qmMissing mismatch
in Set.isSubsetOf missing stratClients
-testBuildFailedToSend :: TestTree
-testBuildFailedToSend =
- testGroup
- "build failed to send map for post message qualified"
- [ testProperty
- "Empty case - trivial"
- $ collectFailedToSend []
- === mempty,
- testProperty
- "Empty case - single empty map"
- $ collectFailedToSend [mempty]
- === mempty,
- testProperty
- "Empty case - multiple empty maps"
- $ collectFailedToSend [mempty, mempty]
- === mempty,
- testProperty
- "Single domain"
- $ collectFailedToSend [Map.singleton (Domain "foo") mempty]
- === Map.singleton (Domain "foo") mempty,
- testProperty
- "Single domain duplicated"
- $ collectFailedToSend [Map.singleton (Domain "foo") mempty, Map.singleton (Domain "foo") mempty]
- === Map.singleton (Domain "foo") mempty,
- testProperty
- "Mutliple domains in multiple maps"
- $ collectFailedToSend [Map.singleton (Domain "foo") mempty, Map.singleton (Domain "bar") mempty]
- === Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)],
- testProperty
- "Mutliple domains in single map"
- $ collectFailedToSend [Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)]]
- === Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)],
- testProperty
- "Single domain duplicated with unique sub-maps"
- $ collectFailedToSend
- [ Map.singleton (Domain "foo") $ Map.singleton idA mempty,
- Map.singleton (Domain "foo") $ Map.singleton idB mempty
- ]
- === Map.singleton
- (Domain "foo")
- ( Map.fromList
- [ (idA, mempty),
- (idB, mempty)
- ]
- )
- ]
+testBuildFailedToSend :: Spec
+testBuildFailedToSend = describe "build failed to send map for post message qualified" do
+ prop "Empty case - trivial" $
+ collectFailedToSend [] === mempty
+ prop "Empty case - single empty map" $
+ collectFailedToSend [mempty] === mempty
+ prop "Empty case - multiple empty maps" $
+ collectFailedToSend [mempty, mempty] === mempty
+ prop "Single domain" $
+ collectFailedToSend [Map.singleton (Domain "foo") mempty]
+ === Map.singleton (Domain "foo") mempty
+ prop "Single domain duplicated" $
+ collectFailedToSend [Map.singleton (Domain "foo") mempty, Map.singleton (Domain "foo") mempty]
+ === Map.singleton (Domain "foo") mempty
+ prop "Mutliple domains in multiple maps" $
+ collectFailedToSend [Map.singleton (Domain "foo") mempty, Map.singleton (Domain "bar") mempty]
+ === Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)]
+ prop "Mutliple domains in single map" $
+ collectFailedToSend [Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)]]
+ === Map.fromList [(Domain "foo", mempty), (Domain "bar", mempty)]
+ prop "Single domain duplicated with unique sub-maps" $
+ collectFailedToSend
+ [ Map.singleton (Domain "foo") $ Map.singleton idA mempty,
+ Map.singleton (Domain "foo") $ Map.singleton idB mempty
+ ]
+ === Map.singleton
+ (Domain "foo")
+ ( Map.fromList
+ [ (idA, mempty),
+ (idB, mempty)
+ ]
+ )
where
- idA = Id $ fromJust $ Data.UUID.Types.fromString "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa"
- idB = Id $ fromJust $ Data.UUID.Types.fromString "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb"
+ idA = Id $ fromJust $ UUID.fromString "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa"
+ idB = Id $ fromJust $ UUID.fromString "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb"
diff --git a/services/galley/test/unit/Test/Galley/API/One2One.hs b/libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/One2OneSpec.hs
similarity index 80%
rename from services/galley/test/unit/Test/Galley/API/One2One.hs
rename to libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/One2OneSpec.hs
index 88a0df0ff5..20c6658d77 100644
--- a/services/galley/test/unit/Test/Galley/API/One2One.hs
+++ b/libs/wire-subsystems/test/unit/Wire/ConversationSubsystem/One2OneSpec.hs
@@ -16,36 +16,33 @@
-- with this program. If not, see .
-- | Tests for one-to-one conversations
-module Test.Galley.API.One2One where
+module Wire.ConversationSubsystem.One2OneSpec where
import Data.Id
import Data.List.Extra
import Data.Qualified
import Imports
-import Test.Tasty
-import Test.Tasty.HUnit (Assertion, testCase, (@?=))
-import Test.Tasty.QuickCheck
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
import Wire.API.User
import Wire.ConversationSubsystem.One2One (one2OneConvId)
-tests :: TestTree
-tests =
- testGroup
- "one2OneConvId"
- [ testProperty "symmetry" one2OneConvIdSymmetry,
- testCase "non-collision" one2OneConvIdNonCollision
- ]
+spec :: Spec
+spec = describe "one2OneConvId" do
+ prop "symmetry" one2OneConvIdSymmetry
+ it "non-collision" one2OneConvIdNonCollision
one2OneConvIdSymmetry :: BaseProtocolTag -> Qualified UserId -> Qualified UserId -> Property
one2OneConvIdSymmetry proto quid1 quid2 = one2OneConvId proto quid1 quid2 === one2OneConvId proto quid2 quid1
-- | Make sure that we never get the same conversation ID for a pair of
-- (assumingly) distinct qualified user IDs
-one2OneConvIdNonCollision :: Assertion
+one2OneConvIdNonCollision :: IO ()
one2OneConvIdNonCollision = do
let len = 10_000
-- A generator of lists of length 'len' of qualified user ID pairs
let gen = vectorOf len arbitrary
quids <- nubOrd <$> generate gen
let hashes = nubOrd (fmap (uncurry (one2OneConvId BaseProtocolProteusTag)) quids)
- length hashes @?= length quids
+ length hashes `shouldBe` length quids
diff --git a/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs
index 5c45b433bc..78ff882c60 100644
--- a/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs
+++ b/libs/wire-subsystems/test/unit/Wire/MeetingsSubsystem/InterpreterSpec.hs
@@ -25,6 +25,7 @@ import Data.Map qualified as Map
import Data.Qualified
import Data.Range (checked, unsafeRange)
import Data.Set qualified as Set
+import Data.Tagged (Tagged)
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock
import Imports
@@ -36,6 +37,8 @@ import Test.Hspec
import Test.Hspec.QuickCheck (prop)
import Test.QuickCheck (counterexample, ioProperty, (.&&.), (===), (==>))
import Text.Email.Parser (unsafeEmailAddress)
+import Wire.API.Error (ErrorS)
+import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound))
import Wire.API.Meeting qualified as API
import Wire.API.Team.Feature
import Wire.API.Team.Member (TeamMember, mkTeamMember)
@@ -68,6 +71,8 @@ type TestStack =
State UTCTime,
Random,
State StdGen,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound,
Embed IO
]
@@ -81,6 +86,11 @@ interpretFeaturesConfigSubsystemPure configs = interpret $ \case
GetAllTeamFeaturesForTeamMember _luid _tid -> pure def
GetAllTeamFeaturesForTeam _tid -> pure def
GetAllTeamFeaturesForServer -> pure def
+ GuardSecondFactorDisabled _ _ -> error "not implemented"
+ FeatureEnabledForTeam _ _ -> error "not implemented"
+ GetAllTeamFeaturesForUser _ -> error "not implemented"
+ GetSingleFeatureForUser _ -> error "not implemented"
+ GetFeatureInternal _ -> error "not implemented"
runTestStack ::
UTCTime ->
@@ -91,6 +101,9 @@ runTestStack ::
IO (Either MeetingError a)
runTestStack now gen teams configs =
runM
+ . fmap (either (error . show) (either (error . show) Imports.id))
+ . runError @(Tagged 'TeamNotFound ())
+ . runError @(Tagged 'TeamMemberNotFound ())
. evalState gen
. randomToStatefulStdGen
. evalState now
diff --git a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs
index d64f1e10b5..88624c7019 100644
--- a/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs
+++ b/libs/wire-subsystems/test/unit/Wire/MiniBackend.hs
@@ -59,6 +59,7 @@ import Data.Map.Lazy qualified as LM
import Data.Map.Strict qualified as M
import Data.Proxy
import Data.Qualified
+import Data.Tagged (Tagged)
import Data.Time
import Data.Type.Equality
import Data.Vector qualified as Vector
@@ -77,6 +78,9 @@ import System.Logger qualified as Log
import Test.QuickCheck
import Type.Reflection
import Wire.API.Allowlists (AllowlistEmailDomains)
+import Wire.API.Conversation.Config (ConversationSubsystemConfig (..))
+import Wire.API.Error (ErrorS)
+import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound))
import Wire.API.Federation.API
import Wire.API.Federation.Component
import Wire.API.Federation.Error
@@ -96,10 +100,13 @@ import Wire.AuthenticationSubsystem
import Wire.AuthenticationSubsystem.Config
import Wire.AuthenticationSubsystem.Cookie.Limit
import Wire.AuthenticationSubsystem.Interpreter
+import Wire.BackendNotificationQueueAccess (BackendNotificationQueueAccess)
import Wire.BlockListStore
+import Wire.BrigAPIAccess (BrigAPIAccess)
import Wire.ClientStore
import Wire.ClientSubsystem
import Wire.ClientSubsystem.Interpreter
+import Wire.ConversationSubsystem (ConversationSubsystem)
import Wire.DeleteQueue
import Wire.DeleteQueue.InMemory
import Wire.DomainRegistrationStore qualified as DRS
@@ -132,6 +139,7 @@ import Wire.TeamCollaboratorsSubsystem
import Wire.TeamCollaboratorsSubsystem.Interpreter
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.TeamSubsystem.GalleyAPI
+import Wire.UserClientIndexStore (UserClientIndexStore)
import Wire.UserGroupStore (UserGroupStore)
import Wire.UserKeyStore
import Wire.UserStore
@@ -242,7 +250,8 @@ data MiniBackendParams r = MiniBackendParams
teams :: Map TeamId [TeamMember],
galleyConfigs :: AllTeamFeatures,
usrCfg :: UserSubsystemConfig,
- appCfg :: AppSubsystemConfig
+ appCfg :: AppSubsystemConfig,
+ conversationCfg :: ConversationSubsystemConfig
}
-- | `MiniBackendLowerEffects` is not a long, flat list, but a tree of effects. This way we
@@ -253,7 +262,13 @@ data MiniBackendParams r = MiniBackendParams
-- organize along effect types ("all `State`s"), but the domain ("everything about block
-- lists").
type MiniBackendLowerEffects =
- '[ TeamSubsystem,
+ '[ ClientSubsystem,
+ Input ConversationSubsystemConfig,
+ BrigAPIAccess,
+ UserClientIndexStore,
+ BackendNotificationQueueAccess,
+ ConversationSubsystem,
+ TeamSubsystem,
EmailSubsystem,
NotificationSubsystem,
VerificationCodeSubsystem,
@@ -281,7 +296,9 @@ type MiniBackendLowerEffects =
Events,
CryptoSign,
Random,
- Now
+ Now,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound
]
`Append` InputEffects
`Append` '[ Metrics
@@ -305,6 +322,10 @@ miniBackendLowerEffectsInterpreters mb@(MiniBackendParams {..}) =
. stateEffectsInterpreters mb
. ignoreMetrics
. inputEffectsInterpreters usrCfg appCfg localBackend.teamIdps
+ . fmap (either (error . show) Imports.id)
+ . runError @(Tagged 'TeamNotFound ())
+ . fmap (either (error . show) Imports.id)
+ . runError @(Tagged 'TeamMemberNotFound ())
. interpretNowConst (UTCTime (ModifiedJulianDay 0) 0)
. runRandomPure
. runCryptoSignUnsafe
@@ -334,6 +355,29 @@ miniBackendLowerEffectsInterpreters mb@(MiniBackendParams {..}) =
. inMemoryNotificationSubsystemInterpreter
. noopEmailSubsystemInterpreter
. interpretTeamSubsystemToGalleyAPI
+ . mockConversationSubsystem
+ . mockBackendNotificationQueueAccess
+ . mockUserClientIndexStore
+ . mockBrigAPIAccess
+ . runInputConst conversationCfg
+ . runClientSubsystem undefined undefined
+ where
+ -- Mock BrigAPIAccess interpreter for tests
+ mockBrigAPIAccess :: forall r'. InterpreterFor BrigAPIAccess r'
+ mockBrigAPIAccess = interpret $ \case
+ _ -> error "Unimplemented BrigAPIAccess operation in mock"
+ -- Mock UserClientIndexStore interpreter for tests
+ mockUserClientIndexStore :: forall r'. InterpreterFor UserClientIndexStore r'
+ mockUserClientIndexStore = interpret $ \case
+ _ -> error "Unimplemented UserClientIndexStore operation in mock"
+ -- Mock BackendNotificationQueueAccess interpreter for tests
+ mockBackendNotificationQueueAccess :: forall r'. InterpreterFor BackendNotificationQueueAccess r'
+ mockBackendNotificationQueueAccess = interpret $ \case
+ _ -> error "Unimplemented BackendNotificationQueueAccess operation in mock"
+ -- Mock ConversationSubsystem interpreter for tests
+ mockConversationSubsystem :: forall r'. InterpreterFor ConversationSubsystem r'
+ mockConversationSubsystem = interpretH $ \case
+ _ -> error "Unimplemented ConversationSubsystem operation in mock"
type StateEffects =
'[ State [Push],
@@ -643,6 +687,14 @@ interpretFederationStackState localBackend backends teams usrCfg =
localBackend = localBackend,
galleyConfigs = def,
appCfg = def,
+ conversationCfg =
+ ConversationSubsystemConfig
+ { listClientsUsingBrig = False,
+ legalholdDefaults = def,
+ mlsKeys = Nothing,
+ maxConvSize = 10,
+ federationProtocols = Nothing
+ },
..
}
@@ -705,6 +757,14 @@ interpretNoFederationStackState localBackend teams galleyConfigs usrCfg =
localBackend = localBackend,
galleyConfigs = galleyConfigs,
appCfg = def,
+ conversationCfg =
+ ConversationSubsystemConfig
+ { listClientsUsingBrig = False,
+ legalholdDefaults = def,
+ mlsKeys = Nothing,
+ maxConvSize = 10,
+ federationProtocols = Nothing
+ },
..
}
diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/ConversationSubsystem.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/ConversationSubsystem.hs
index 74230077f5..e0dfadc71c 100644
--- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/ConversationSubsystem.hs
+++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/ConversationSubsystem.hs
@@ -41,8 +41,8 @@ type ConversationMembers = Map ConvId (Set UserId)
inMemoryConversationSubsystemInterpreter ::
(Member (State (Map ConvId StoredConversation)) r, Member (State ConversationMembers) r, Member Random r) =>
InterpreterFor ConversationSubsystem r
-inMemoryConversationSubsystemInterpreter = interpret $ \case
- CreateGroupConversation lusr _mconn newConv -> do
+inMemoryConversationSubsystemInterpreter = interpretH $ \case
+ InternalCreateGroupConversation lusr _mconn newConv -> do
cid <- Random.newId
let conv =
StoredConversation
@@ -71,8 +71,8 @@ inMemoryConversationSubsystemInterpreter = interpret $ \case
}
modify (Map.insert cid conv)
modify (Map.insert cid (Set.singleton (tUnqualified lusr)))
- pure conv
+ pureT conv
InternalGetLocalMember cid uid -> do
members <- gets (Map.lookup cid)
- pure $ if Set.member uid (fromMaybe Set.empty members) then Just (newMember uid) else Nothing
+ pureT $ if Set.member uid (fromMaybe Set.empty members) then Just (newMember uid) else Nothing
_ -> error "ConversationSubsystem: not implemented in mock"
diff --git a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs
index 2f08144ef8..4d79967500 100644
--- a/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs
+++ b/libs/wire-subsystems/test/unit/Wire/MockInterpreters/GalleyAPIAccess.hs
@@ -56,6 +56,7 @@ miniGalleyAPIAccess teams configs = interpret $ \case
(\members -> any (\member -> member ^. userId == uid) members)
teams
GetTeam _ -> error "GetTeam not implemented in miniGalleyAPIAccess"
+ FindTeam _ -> error "FindTeam not implemented in miniGalleyAPIAccess"
GetTeamName _ -> error "GetTeamName not implemented in miniGalleyAPIAccess"
GetTeamLegalHoldStatus _ -> error "GetTeamLegalHoldStatus not implemented in miniGalleyAPIAccess"
GetUserLegalholdStatus _ _ -> error "GetUserLegalholdStatus not implemented in miniGalleyAPIAccess"
@@ -92,6 +93,8 @@ miniGalleyAPIAccess teams configs = interpret $ \case
maxConvSize = 500,
listClientsUsingBrig = False
}
+ GetUserLHStatus _ _ -> error "GetUserLHStatus not implemented in miniGalleyAPIAccess"
+ GetUsersLHStatus _ -> error "GetUsersLHStatus not implemented in miniGalleyAPIAccess"
GuardLegalHold {} -> pure ()
-- this is called but the result is not needed in unit tests
diff --git a/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs
index 31ebb431d5..fba4f321bd 100644
--- a/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs
+++ b/libs/wire-subsystems/test/unit/Wire/SAMLEmailSubsystem/InterpreterSpec.hs
@@ -6,6 +6,7 @@ import Data.LegalHold (UserLegalHoldStatus (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as Map
import Data.Set qualified as Set
+import Data.Tagged (Tagged)
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding (decodeUtf8)
import Data.Text.Lazy.IO qualified as TL
@@ -14,6 +15,7 @@ import Data.X509.CertificateStore qualified as X509
import Imports
import Network.Mail.Mime (Address (..), Mail (..), Part (..), PartContent (..))
import Polysemy
+import Polysemy.Error (runError)
import Polysemy.State
import SAML2.WebSSO
import System.FilePath
@@ -23,6 +25,8 @@ import Test.Hspec.QuickCheck
import Test.QuickCheck
import Text.Email.Parser (unsafeEmailAddress)
import URI.ByteString
+import Wire.API.Error (ErrorS)
+import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound))
import Wire.API.Locale
import Wire.API.Password
import Wire.API.Routes.Internal.Brig (IdpChangedNotification (..))
@@ -347,6 +351,8 @@ runInterpreters ::
Logger (Logger.Msg -> Logger.Msg),
EmailSending,
State [Mail],
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound,
Embed IO
]
a ->
@@ -355,6 +361,9 @@ runInterpreters users teamMap teamTemplates branding action = do
lr <- newLogRecorder
(mails, res) <-
runM
+ . fmap (either (error . show) (either (error . show) Imports.id))
+ . runError @(Tagged 'TeamNotFound ())
+ . runError @(Tagged 'TeamMemberNotFound ())
. runState @[Mail] [] -- Use runState to capture and return the Mail state
. recordingEmailSendingInterpreter
. recordLogs lr
diff --git a/libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs
index 3cdf8408a4..6861f09779 100644
--- a/libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs
+++ b/libs/wire-subsystems/test/unit/Wire/ScimSubsystem/InterpreterSpec.hs
@@ -75,10 +75,10 @@ runDependenciesSafe ::
[StoredUser] ->
Map TeamId [TeamMember] ->
Sem AllDependencies a ->
- Either UGS.UserGroupSubsystemError (Either ScimSubsystemError a)
+ Either UGS.LocalErrors (Either ScimSubsystemError a)
runDependenciesSafe initialUsers initialTeams =
run
- . runError
+ . UGS.runLocalErrors
. UGS.interpretDependencies initialUsers initialTeams
. UGS.interpretUserGroupSubsystem
. mockBrigAPIAccess initialUsers
diff --git a/services/galley/test/unit/Test/Galley/Mapping.hs b/libs/wire-subsystems/test/unit/Wire/StoredConversationSpec.hs
similarity index 54%
rename from services/galley/test/unit/Test/Galley/Mapping.hs
rename to libs/wire-subsystems/test/unit/Wire/StoredConversationSpec.hs
index 575995457a..eaee1a974f 100644
--- a/services/galley/test/unit/Test/Galley/Mapping.hs
+++ b/libs/wire-subsystems/test/unit/Wire/StoredConversationSpec.hs
@@ -18,86 +18,77 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Test.Galley.Mapping where
+module Wire.StoredConversationSpec where
import Data.Containers.ListUtils (nubOrdOn)
import Data.Domain
import Data.Id
import Data.Qualified
import Data.Set qualified as Set
-import Galley.API.Mapping
-import Galley.Types.Error (InternalError)
import Imports
-import Polysemy (Sem)
-import Polysemy qualified as P
-import Polysemy.Error qualified as P
-import Polysemy.TinyLog qualified as P
-import Test.Tasty
-import Test.Tasty.QuickCheck
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck (Arbitrary (..), Gen, listOf, (==>))
import Wire.API.Conversation
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
import Wire.API.Federation.API.Galley
( RemoteConvMembers (..),
- RemoteConversationV2 (..),
+ RemoteConversationView (..),
)
-import Wire.Sem.Logger qualified as P
import Wire.StoredConversation
-run :: Sem '[P.TinyLog, P.Error InternalError] a -> Either InternalError a
-run = P.run . P.runError . P.discardLogs
-
-tests :: TestTree
-tests =
- testGroup
- "ConversationMapping"
- [ testProperty "conversation view V9 for a valid user is non-empty" $
- \(ConvWithLocalUser c luid) -> isRight (run (conversationViewV9 luid c)),
- testProperty "conversation view V10 for a valid user is non-empty" $
- \(ConvWithLocalUser c luid) -> isRight (run (pure $ conversationView (qualifyAs luid ()) (Just luid) c)),
- testProperty "self user in conversation view is correct" $
- \(ConvWithLocalUser c luid) ->
- fmap (memId . cmSelf . cnvMembers) (run (conversationViewV9 luid c))
- == Right (tUntagged luid),
- testProperty "conversation view metadata is correct" $
- \(ConvWithLocalUser c luid) ->
- fmap cnvMetadata (run (conversationViewV9 luid c))
- == Right c.metadata,
- testProperty "other members in conversation view do not contain self" $
- \(ConvWithLocalUser c luid) -> case run $ conversationViewV9 luid c of
- Left _ -> False
- Right cnv ->
- tUntagged luid
- `notElem` map omQualifiedId (cmOthers (cnvMembers cnv)),
- testProperty "conversation view contains all users" $
- \(ConvWithLocalUser c luid) ->
- fmap (sort . cnvUids) (run (conversationViewV9 luid c))
- == Right (sort (convUids (tDomain luid) c)),
- testProperty "conversation view for an invalid user is empty" $
- \(RandomConversation c) luid ->
- notElem (tUnqualified luid) (map (.id_) c.localMembers) ==>
- isLeft (run (conversationViewV9 luid c)),
- testProperty "remote conversation view for a valid user is non-empty" $
- \(ConvWithRemoteUser c ruid) dom ->
- qDomain (tUntagged ruid) /= dom ==>
- isJust (conversationToRemote dom ruid c),
- testProperty "self user role in remote conversation view is correct" $
- \(ConvWithRemoteUser c ruid) dom ->
- qDomain (tUntagged ruid) /= dom ==>
- fmap (selfRole . (.members)) (conversationToRemote dom ruid c)
- == Just roleNameWireMember,
- testProperty "remote conversation view metadata is correct" $
- \(ConvWithRemoteUser c ruid) dom ->
- qDomain (tUntagged ruid) /= dom ==>
- fmap (.metadata) (conversationToRemote dom ruid c)
- == Just c.metadata,
- testProperty "remote conversation view does not contain self" $
- \(ConvWithRemoteUser c ruid) dom -> case conversationToRemote dom ruid c of
- Nothing -> False
- Just rcnv ->
- tUntagged ruid
- `notElem` map omQualifiedId rcnv.members.others
- ]
+spec :: Spec
+spec = describe "ConversationMapping" do
+ prop "conversation view V9 for a valid user is non-empty" $
+ \(ConvWithLocalUser c luid) -> isJust (ownConversationView luid c)
+ prop "conversation view V10 for a valid user is non-empty" $
+ \(ConvWithLocalUser c luid) -> isJust (pure $ conversationView (qualifyAs luid ()) (Just luid) c)
+ prop "self user in conversation view is correct" $
+ \(ConvWithLocalUser c luid) ->
+ fmap (memId . cmSelf . cnvMembers) (ownConversationView luid c)
+ == Just (tUntagged luid)
+ prop "conversation view metadata is correct" $
+ \(ConvWithLocalUser c luid) ->
+ fmap cnvMetadata (ownConversationView luid c)
+ == Just c.metadata
+ prop "other members in conversation view do not contain self" $
+ \(ConvWithLocalUser c luid) -> case ownConversationView luid c of
+ Nothing -> False
+ Just cnv ->
+ tUntagged luid
+ `notElem` map omQualifiedId (cmOthers (cnvMembers cnv))
+ prop "conversation view contains all users" $
+ \(ConvWithLocalUser c luid) ->
+ fmap (sort . cnvUids) (ownConversationView luid c)
+ == Just (sort (convUids (tDomain luid) c))
+ prop "conversation view for an invalid user is empty" $
+ \(RandomConversation c) luid ->
+ notElem (tUnqualified luid) (map (.id_) c.localMembers) ==>
+ isNothing (ownConversationView luid c)
+ prop "remote conversation view for a valid user is non-empty" $
+ \(ConvWithRemoteUser c ruid) dom ->
+ qDomain (tUntagged ruid)
+ /= dom
+ ==> isJust (conversationToRemote dom ruid c)
+ prop "self user role in remote conversation view is correct" $
+ \(ConvWithRemoteUser c ruid) dom ->
+ qDomain (tUntagged ruid)
+ /= dom
+ ==> fmap (selfRole . (.members)) (conversationToRemote dom ruid c)
+ == Just roleNameWireMember
+ prop "remote conversation view metadata is correct" $
+ \(ConvWithRemoteUser c ruid) dom ->
+ qDomain (tUntagged ruid)
+ /= dom
+ ==> fmap (.metadata) (conversationToRemote dom ruid c)
+ == Just c.metadata
+ prop "remote conversation view does not contain self" $
+ \(ConvWithRemoteUser c ruid) dom -> case conversationToRemote dom ruid c of
+ Nothing -> False
+ Just rcnv ->
+ tUntagged ruid
+ `notElem` map omQualifiedId rcnv.members.others
cnvUids :: OwnConversation -> [Qualified UserId]
cnvUids c =
diff --git a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs
index dd2cf24f72..ce135460d0 100644
--- a/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs
+++ b/libs/wire-subsystems/test/unit/Wire/TeamInvitationSubsystem/InterpreterSpec.hs
@@ -26,6 +26,7 @@ import Data.Id
import Data.LegalHold
import Data.Map qualified as Map
import Data.Qualified
+import Data.Tagged (Tagged)
import Data.Text.Encoding
import Data.Time
import Imports
@@ -38,6 +39,8 @@ import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
import Wire.API.EnterpriseLogin
+import Wire.API.Error (ErrorS)
+import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound))
import Wire.API.Team.Invitation
import Wire.API.Team.Member
import Wire.API.Team.Permission
@@ -62,8 +65,7 @@ import Wire.UserSubsystem
import Wire.Util
type AllEffects =
- [ Error TeamInvitationSubsystemError,
- EnterpriseLoginSubsystem,
+ [ EnterpriseLoginSubsystem,
TinyLog,
TeamSubsystem,
GalleyAPIAccess,
@@ -75,6 +77,9 @@ type AllEffects =
State (Map (InvitationCode) StoredInvitation),
Now,
State UTCTime,
+ Error TeamInvitationSubsystemError,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound,
EmailSubsystem,
State (Map EmailAddress [SentMail]),
UserSubsystem,
@@ -89,7 +94,7 @@ data RunAllEffectsArgs = RunAllEffectsArgs
}
deriving (Eq, Show)
-runAllEffects :: RunAllEffectsArgs -> Sem AllEffects a -> Either TeamInvitationSubsystemError a
+runAllEffects :: RunAllEffectsArgs -> Sem AllEffects a -> Either LocalErrors a
runAllEffects args =
run
. runInMemoryUserKeyStoreIntepreterWithStoredUsers args.initialUsers
@@ -97,6 +102,7 @@ runAllEffects args =
. inMemoryUserSubsystemInterpreter
. evalState mempty
. noopEmailSubsystemInterpreter
+ . runLocalErrors
. evalState defaultTime
. interpretNowAsState
. evalState mempty
@@ -109,7 +115,26 @@ runAllEffects args =
. interpretTeamSubsystemToGalleyAPI
. discardTinyLogs
. enterpriseLoginSubsystemTestInterpreter args.constGuardResult
- . runError
+
+data LocalErrors
+ = ETeamMemberNotFound
+ | ETeamNotFound
+ | ESubsystem TeamInvitationSubsystemError
+ deriving stock (Eq, Show)
+
+runLocalErrors ::
+ Sem (Error TeamInvitationSubsystemError ': ErrorS 'TeamMemberNotFound ': ErrorS 'TeamNotFound ': r) a ->
+ Sem r (Either LocalErrors a)
+runLocalErrors = fmap toLocalErrors . runError . runError . runError
+ where
+ toLocalErrors ::
+ Either (Tagged 'TeamNotFound ()) (Either (Tagged 'TeamMemberNotFound ()) (Either TeamInvitationSubsystemError a)) ->
+ Either LocalErrors a
+ toLocalErrors = \case
+ Right (Right (Right a)) -> Right a
+ Right (Right (Left e)) -> Left (ESubsystem e)
+ Right (Left _) -> Left ETeamMemberNotFound
+ Left _ -> Left ETeamNotFound
spec :: Spec
spec = do
@@ -192,7 +217,7 @@ spec = do
-- run the test
--
- outcome :: Either TeamInvitationSubsystemError ()
+ outcome :: Either LocalErrors ()
outcome = runAllEffects args . runTeamInvitationSubsystem cfg $ do
void $ inviteUser inviterLuid tid invReq
@@ -201,11 +226,11 @@ spec = do
teamNotAllowedOrWrongTeamIdFails =
outcome === case domRegUpd.teamInvite of
Allowed -> Right ()
- NotAllowed -> Left TeamInvitationNotAllowedForEmail
+ NotAllowed -> Left (ESubsystem TeamInvitationNotAllowedForEmail)
Team allowedTid ->
if allowedTid == tid
then Right ()
- else Left TeamInvitationNotAllowedForEmail
+ else Left (ESubsystem TeamInvitationNotAllowedForEmail)
backendRedirectOrNoRegistrationFails = case domRegUpd.domainRedirect of
Backend _ _ ->
@@ -213,7 +238,7 @@ spec = do
teamNotAllowedOrWrongTeamIdFails
NoRegistration ->
if isJust preExistingPersonalAccount
- then outcome === Left TeamInvitationNotAllowedForEmail
+ then outcome === Left (ESubsystem TeamInvitationNotAllowedForEmail)
else teamNotAllowedOrWrongTeamIdFails
_ -> teamNotAllowedOrWrongTeamIdFails
@@ -283,7 +308,7 @@ spec = do
constGuardResult = Nothing
}
- outcome :: Either TeamInvitationSubsystemError ()
+ outcome :: Either LocalErrors ()
outcome = runAllEffects interpreterArgs . runTeamInvitationSubsystem config $ do
void $ inviteUser inviterLuid tid invitationRequest
- in pure $ outcome === Left TeamInvitationBlockedDomain
+ in pure $ outcome === Left (ESubsystem TeamInvitationBlockedDomain)
diff --git a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs b/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs
index c4288743fe..404c0931af 100644
--- a/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs
+++ b/libs/wire-subsystems/test/unit/Wire/UserGroupSubsystem/InterpreterSpec.hs
@@ -33,6 +33,7 @@ import Data.Map qualified as Map
import Data.Qualified
import Data.Range
import Data.Set qualified as Set
+import Data.Tagged (Tagged)
import Data.UUID qualified as UUID
import Data.Vector qualified as V
import Imports
@@ -46,6 +47,8 @@ import System.Timeout (timeout)
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck
+import Wire.API.Error (ErrorS)
+import Wire.API.Error.Galley (GalleyError (TeamMemberNotFound, TeamNotFound))
import Wire.API.Pagination
import Wire.API.Push.V2 (RecipientClients (RecipientClientsAll), Route (RouteAny))
import Wire.API.Team.Member as TM
@@ -80,26 +83,34 @@ type AllDependencies =
BackgroundJobsPublisher.BackgroundJobsPublisher,
State [Push],
Random.Random,
- Error UserGroupSubsystemError
+ Error UserGroupSubsystemError,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound
]
-runDependenciesFailOnError :: (HasCallStack) => [StoredUser] -> Map TeamId [TeamMember] -> Sem AllDependencies (IO ()) -> IO ()
-runDependenciesFailOnError usrs team = either (error . ("no assertion: " <>) . show) Imports.id . runDependencies usrs team
+runDependenciesFailOnError ::
+ (HasCallStack) =>
+ [StoredUser] ->
+ Map TeamId [TeamMember] ->
+ Sem AllDependencies (IO ()) ->
+ IO ()
+runDependenciesFailOnError usrs team =
+ either (error . ("no assertion: " <>) . show) Imports.id . runDependencies usrs team
runDependencies ::
[StoredUser] ->
Map TeamId [TeamMember] ->
Sem AllDependencies a ->
- Either UserGroupSubsystemError a
+ Either LocalErrors a
runDependencies initialUsers initialTeams =
- run . runError . interpretDependencies initialUsers initialTeams
+ run . runLocalErrors . interpretDependencies initialUsers initialTeams
interpretDependencies ::
forall r a.
[StoredUser] ->
Map TeamId [TeamMember] ->
Sem (AllDependencies `Append` r) a ->
- Sem ('[Error UserGroupSubsystemError] `Append` r) a
+ Sem ('[Error UserGroupSubsystemError, ErrorS 'TeamMemberNotFound, ErrorS 'TeamNotFound] `Append` r) a
interpretDependencies initialUsers initialTeams =
Random.randomToNull
. evalState mempty
@@ -116,10 +127,10 @@ runDependenciesWithReturnState ::
[StoredUser] ->
Map TeamId [TeamMember] ->
Sem AllDependencies a ->
- Either UserGroupSubsystemError ([Push], a)
+ Either LocalErrors ([Push], a)
runDependenciesWithReturnState initialUsers initialTeams =
run
- . runError
+ . runLocalErrors
. Random.randomToNull
. runState mempty
. noopBackgroundJobsPublisher
@@ -131,6 +142,26 @@ runDependenciesWithReturnState initialUsers initialTeams =
. interpretTeamSubsystemToGalleyAPI
. runInMemoryUserSubsytemInterpreter initialUsers mempty
+data LocalErrors
+ = ETeamMemberNotFound
+ | ETeamNotFound
+ | ESubsystem UserGroupSubsystemError
+ deriving stock (Eq, Show)
+
+runLocalErrors ::
+ Sem (Error UserGroupSubsystemError ': ErrorS 'TeamMemberNotFound ': ErrorS 'TeamNotFound ': r) a ->
+ Sem r (Either LocalErrors a)
+runLocalErrors = fmap toLocalErrors . runError . runError . runError
+ where
+ toLocalErrors ::
+ Either (Tagged 'TeamNotFound ()) (Either (Tagged 'TeamMemberNotFound ()) (Either UserGroupSubsystemError a)) ->
+ Either LocalErrors a
+ toLocalErrors = \case
+ Right (Right (Right a)) -> Right a
+ Right (Right (Left e)) -> Left (ESubsystem e)
+ Right (Left _) -> Left ETeamMemberNotFound
+ Left _ -> Left ETeamNotFound
+
expectRight :: (Show err) => Either err Property -> Property
expectRight = \case
Left err -> counterexample ("Unexpected error: " <> show err) False
@@ -231,7 +262,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
prop "only team admins should be able to create a group" $
\((WithMods team) :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam) newUserGroupName ->
- expectLeft UserGroupNotATeamAdmin
+ expectLeft (ESubsystem UserGroupNotATeamAdmin)
. runDependencies (allUsers team) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
@@ -243,7 +274,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
prop "only team members are allowed in the group" $ \team otherUsers newUserGroupName ->
let othersWithoutTeamMembers = filter (\u -> u.teamId /= Just team.tid) otherUsers
in notNull othersWithoutTeamMembers
- ==> expectLeft UserGroupMemberIsNotInTheSameTeam
+ ==> expectLeft (ESubsystem UserGroupMemberIsNotInTheSameTeam)
. runDependencies (allUsers team <> otherUsers) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
@@ -535,7 +566,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
prop "only team admins should be able to update a group" $
\((WithMods team) :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam) newUserGroupName newUserGroupName2 ->
- expectLeft UserGroupNotATeamAdmin
+ expectLeft (ESubsystem UserGroupNotATeamAdmin)
. runDependencies (allUsers team) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
@@ -603,7 +634,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
prop "only team admins can delete user groups" $
\((WithMods team) :: WithMods '[AtLeastOneNonAdmin] ArbitraryTeam) groupName ->
- expectLeft UserGroupNotATeamAdmin
+ expectLeft (ESubsystem UserGroupNotATeamAdmin)
. runDependencies (allUsers team) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
@@ -662,7 +693,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
newGroupName
(team2 :: ArbitraryTeam)
(addOrRemove :: Bool) ->
- expectLeft UserGroupMemberIsNotInTheSameTeam
+ expectLeft (ESubsystem UserGroupMemberIsNotInTheSameTeam)
. runDependencies (allUsers team) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
@@ -675,7 +706,7 @@ spec = timeoutHook $ describe "UserGroupSubsystem.Interpreter" do
newGroupName
(team2 :: ArbitraryTeam)
(addOrRemove :: Bool) ->
- expectLeft UserGroupNotFound
+ expectLeft (ESubsystem UserGroupNotFound)
. runDependencies (allUsers team) (galleyTeam team)
. interpretUserGroupSubsystem
$ do
diff --git a/libs/wire-subsystems/wire-subsystems.cabal b/libs/wire-subsystems/wire-subsystems.cabal
index 8ba7efffda..dd2e897a6c 100644
--- a/libs/wire-subsystems/wire-subsystems.cabal
+++ b/libs/wire-subsystems/wire-subsystems.cabal
@@ -104,6 +104,7 @@ common common-all
, bytestring-conversion
, case-insensitive
, cassandra-util
+ , comonad
, conduit
, constraints
, containers
@@ -142,6 +143,7 @@ common common-all
, imports
, iproute
, iso639
+ , kan-extensions
, lens
, lens-aeson
, lrucaching
@@ -255,12 +257,47 @@ library
Wire.ConversationStore.MLS.Types
Wire.ConversationStore.Postgres
Wire.ConversationSubsystem
+ Wire.ConversationSubsystem.Action
+ Wire.ConversationSubsystem.Action.Kick
+ Wire.ConversationSubsystem.Action.Leave
+ Wire.ConversationSubsystem.Action.Notify
+ Wire.ConversationSubsystem.Action.Reset
+ Wire.ConversationSubsystem.Clients
+ Wire.ConversationSubsystem.Create
Wire.ConversationSubsystem.CreateInternal
+ Wire.ConversationSubsystem.Errors
+ Wire.ConversationSubsystem.Federation
Wire.ConversationSubsystem.Fetch
Wire.ConversationSubsystem.Internal
Wire.ConversationSubsystem.Interpreter
+ Wire.ConversationSubsystem.LegalholdConflicts
+ Wire.ConversationSubsystem.Message
+ Wire.ConversationSubsystem.MLS
+ Wire.ConversationSubsystem.MLS.CheckClients
+ Wire.ConversationSubsystem.MLS.Commit.Core
+ Wire.ConversationSubsystem.MLS.Commit.ExternalCommit
+ Wire.ConversationSubsystem.MLS.Commit.InternalCommit
+ Wire.ConversationSubsystem.MLS.Conversation
+ Wire.ConversationSubsystem.MLS.Enabled
+ Wire.ConversationSubsystem.MLS.GroupInfo
+ Wire.ConversationSubsystem.MLS.GroupInfoCheck
+ Wire.ConversationSubsystem.MLS.IncomingMessage
+ Wire.ConversationSubsystem.MLS.Keys
+ Wire.ConversationSubsystem.MLS.Message
+ Wire.ConversationSubsystem.MLS.Migration
+ Wire.ConversationSubsystem.MLS.One2One
+ Wire.ConversationSubsystem.MLS.OutOfSync
+ Wire.ConversationSubsystem.MLS.Propagate
+ Wire.ConversationSubsystem.MLS.Proposal
+ Wire.ConversationSubsystem.MLS.Removal
+ Wire.ConversationSubsystem.MLS.Reset
+ Wire.ConversationSubsystem.MLS.SubConversation
+ Wire.ConversationSubsystem.MLS.Util
+ Wire.ConversationSubsystem.MLS.Welcome
Wire.ConversationSubsystem.Notify
Wire.ConversationSubsystem.One2One
+ Wire.ConversationSubsystem.Query
+ Wire.ConversationSubsystem.Update
Wire.ConversationSubsystem.Util
Wire.CustomBackendStore
Wire.CustomBackendStore.Cassandra
@@ -536,6 +573,8 @@ test-suite wire-subsystems-tests
Wire.AuthenticationSubsystem.InterpreterSpec
Wire.BrigAPIAccess.RpcSpec
Wire.ClientSubsystem.InterpreterSpec
+ Wire.ConversationSubsystem.MessageSpec
+ Wire.ConversationSubsystem.One2OneSpec
Wire.EnterpriseLoginSubsystem.InterpreterSpec
Wire.FederationSubsystem.InternalsSpec
Wire.HashPassword.InterpreterSpec
@@ -585,6 +624,7 @@ test-suite wire-subsystems-tests
Wire.RateLimited.InterpreterSpec
Wire.SAMLEmailSubsystem.InterpreterSpec
Wire.ScimSubsystem.InterpreterSpec
+ Wire.StoredConversationSpec
Wire.TeamCollaboratorsSubsystem.InterpreterSpec
Wire.TeamInvitationSubsystem.InterpreterSpec
Wire.UserGroupSubsystem.InterpreterSpec
diff --git a/services/background-worker/src/Wire/BackgroundWorker/Env.hs b/services/background-worker/src/Wire/BackgroundWorker/Env.hs
index 20dc97d126..981ae2139f 100644
--- a/services/background-worker/src/Wire/BackgroundWorker/Env.hs
+++ b/services/background-worker/src/Wire/BackgroundWorker/Env.hs
@@ -26,7 +26,9 @@ import Control.Monad.Base
import Control.Monad.Catch
import Control.Monad.Trans.Control
import Data.Domain (Domain)
+import Data.Id (TeamId)
import Data.Map.Strict qualified as Map
+import Data.Misc (HttpsUrl)
import HTTP2.Client.Manager
import Hasql.Pool qualified as Hasql
import Hasql.Pool.Extended
@@ -43,9 +45,13 @@ import System.Logger qualified as Log
import System.Logger.Class (Logger, MonadLogger (..))
import System.Logger.Extended qualified as Log
import Util.Options
+import Wire.API.Conversation.Protocol (ProtocolTag)
+import Wire.API.Team.FeatureFlags (FanoutLimit)
import Wire.BackgroundWorker.Options
+import Wire.Options.Galley (GuestLinkTTLSeconds, conversationCodeURISettings)
import Wire.Options.Galley qualified as Galley
import Wire.PostgresMigrationOpts
+import Wire.RateLimit.Interpreter (RateLimitEnv, newRateLimitEnv)
type IsWorking = Bool
@@ -87,7 +93,17 @@ data Env = Env
gundeckEndpoint :: Endpoint,
sparEndpoint :: Endpoint,
galleyEndpoint :: Endpoint,
- brigEndpoint :: Endpoint
+ brigEndpoint :: Endpoint,
+ maxTeamSize :: !Word32,
+ maxFanoutSize :: !(Maybe FanoutLimit),
+ exposeInvitationURLsTeamAllowlist :: !(Maybe [TeamId]),
+ intraListing :: !Bool,
+ federationProtocols :: !(Maybe [ProtocolTag]),
+ guestLinkTTLSeconds :: !(Maybe GuestLinkTTLSeconds),
+ passwordHashingOptions :: !PasswordHashingOptions,
+ checkGroupInfo :: !(Maybe Bool),
+ convCodeURI :: Either HttpsUrl (Map Text HttpsUrl),
+ passwordHashingRateLimitEnv :: RateLimitEnv
}
data BackendNotificationMetrics = BackendNotificationMetrics
@@ -138,6 +154,14 @@ mkEnv opts galleyOpts = do
galleyEndpoint = opts.galley
gundeckEndpoint = opts.gundeck
sparEndpoint = opts.spar
+ maxTeamSize = galleyOpts._settings._maxTeamSize
+ maxFanoutSize = galleyOpts._settings._maxFanoutSize
+ exposeInvitationURLsTeamAllowlist = galleyOpts._settings._exposeInvitationURLsTeamAllowlist
+ intraListing = galleyOpts._settings._intraListing
+ federationProtocols = galleyOpts._settings._federationProtocols
+ guestLinkTTLSeconds = galleyOpts._settings._guestLinkTTLSeconds
+ passwordHashingOptions = galleyOpts._settings._passwordHashingOptions
+ checkGroupInfo = galleyOpts._settings._checkGroupInfo
workerRunningGauge <- mkWorkerRunningGauge
hasqlPool <- initPostgresPool opts.postgresqlPool galleyOpts._postgresql galleyOpts._postgresqlPassword
amqpJobsPublisherChannel <-
@@ -146,6 +170,8 @@ mkEnv opts galleyOpts = do
amqpBackendNotificationsChannel <-
mkRabbitMqChannelMVar logger (Just "background-worker-backend-notifications") $
either id demoteOpts opts.rabbitmq.unRabbitMqOpts
+ convCodeURI <- conversationCodeURISettings galleyOpts
+ passwordHashingRateLimitEnv <- newRateLimitEnv galleyOpts._settings._passwordHashingRateLimit
pure Env {..}
initHttp2Manager :: IO Http2Manager
diff --git a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs
index 4c13bf2d04..842dec6ec8 100644
--- a/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs
+++ b/services/background-worker/src/Wire/BackgroundWorker/Jobs/Registry.hs
@@ -22,6 +22,7 @@ where
import Bilge qualified
import Bilge.Retry
+import Cassandra (ClientState)
import Control.Monad.Catch
import Control.Retry
import Data.ByteString qualified as BS
@@ -32,27 +33,33 @@ import Data.Qualified
import Data.Tagged (Tagged)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
-import Galley.Types.Error (InternalError, InvalidInput, internalErrorDescription, legalHoldServiceUnavailable)
+import Galley.Types.Error (InternalError, internalErrorDescription, legalHoldServiceUnavailable)
import Hasql.Pool (UsageError)
+import Hasql.Pool qualified as Hasql
import Imports
import Network.HTTP.Client qualified as Http
+import Network.Wai.Utilities.JSONResponse (JSONResponse (..))
import OpenSSL.Session qualified as SSL
import Polysemy
import Polysemy.Async (asyncToIOFinal)
import Polysemy.Conc
import Polysemy.Error
import Polysemy.Input
+import Polysemy.Resource (resourceToIOFinal)
import Polysemy.TinyLog qualified as P
import Ssl.Util
import System.Logger as Logger
import System.Logger.Class qualified as Log
import URI.ByteString (uriPath)
import Wire.API.BackgroundJobs (Job (..))
-import Wire.API.Conversation.Config (ConversationSubsystemConfig)
+import Wire.API.Conversation.Config (ConversationSubsystemConfig (..))
+import Wire.API.Error (APIError (toResponse), DynError (..))
import Wire.API.Error.Galley
import Wire.API.Federation.Error (FederationError)
+import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
import Wire.API.Team.Collaborator (TeamCollaboratorsError)
-import Wire.API.Team.FeatureFlags (FeatureDefaults (FeatureLegalHoldDisabledPermanently))
+import Wire.API.Team.Feature (LegalholdConfig)
+import Wire.API.Team.FeatureFlags (FanoutLimit, FeatureDefaults (FeatureLegalHoldDisabledPermanently), currentFanoutLimit)
import Wire.BackendNotificationQueueAccess.RabbitMq qualified as BackendNotificationQueueAccess
import Wire.BackgroundJobsPublisher.RabbitMQ (interpretBackgroundJobsPublisherRabbitMQ)
import Wire.BackgroundJobsRunner (runJob)
@@ -60,23 +67,32 @@ import Wire.BackgroundJobsRunner.Interpreter hiding (runJob)
import Wire.BackgroundWorker.Env (AppT, Env (..))
import Wire.BrigAPIAccess.Rpc
import Wire.ClientSubsystem.Error (ClientError)
+import Wire.CodeStore.Cassandra (interpretCodeStoreToCassandra)
+import Wire.CodeStore.DualWrite (interpretCodeStoreToCassandraAndPostgres)
+import Wire.CodeStore.Postgres (interpretCodeStoreToPostgres)
import Wire.ConversationStore.Cassandra
import Wire.ConversationStore.Postgres (interpretConversationStoreToPostgres)
-import Wire.ConversationSubsystem.Interpreter (interpretConversationSubsystem)
+import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemError, GroupInfoCheckEnabled (..), IntraListing (..), interpretConversationSubsystem)
import Wire.ExternalAccess.External
import Wire.FeaturesConfigSubsystem (getAllTeamFeaturesForServer)
import Wire.FeaturesConfigSubsystem.Interpreter (runFeaturesConfigSubsystem)
import Wire.FeaturesConfigSubsystem.Types (ExposeInvitationURLsAllowlist (..))
import Wire.FederationAPIAccess.Interpreter (FederationAPIAccessConfig (..), interpretFederationAPIAccess)
+import Wire.FederationSubsystem.Interpreter (runFederationSubsystem)
import Wire.FireAndForget (interpretFireAndForget)
import Wire.GalleyAPIAccess
import Wire.GalleyAPIAccess.Rpc (interpretGalleyAPIAccessToRpc)
import Wire.GundeckAPIAccess
+import Wire.HashPassword.Interpreter (runHashPassword)
import Wire.LegalHoldStore.Cassandra (interpretLegalHoldStoreToCassandra)
import Wire.LegalHoldStore.Env (LegalHoldEnv (..))
import Wire.NotificationSubsystem.Interpreter
+import Wire.Options.Galley (GuestLinkTTLSeconds)
import Wire.ParseException
import Wire.PostgresMigrationOpts
+import Wire.ProposalStore.Cassandra (interpretProposalStoreToCassandra)
+import Wire.RateLimit (RateLimitExceeded)
+import Wire.RateLimit.Interpreter (interpretRateLimit)
import Wire.Rpc
import Wire.Sem.Concurrency (ConcurrencySafety (Unsafe))
import Wire.Sem.Concurrency.IO (unsafelyPerformConcurrency)
@@ -174,45 +190,53 @@ dispatchJob job = do
let makeReq fpr url rb = makeVerifiedRequestIO env.logger extEnv fpr url rb
makeReqFresh fpr url rb = makeVerifiedRequestFreshManagerIO env.logger fpr url rb
in LegalHoldEnv {makeVerifiedRequest = makeReq, makeVerifiedRequestFreshManager = makeReqFresh}
+ convCodesStoreInterpreter =
+ case env.postgresMigration.conversationCodes of
+ CassandraStorage -> interpretCodeStoreToCassandra
+ MigrationToPostgresql -> interpretCodeStoreToCassandraAndPostgres
+ PostgresqlStorage -> interpretCodeStoreToPostgres
runFinal @IO
. unsafelyPerformConcurrency @_ @'Unsafe
. embedToFinal @IO
. asyncToIOFinal
. interpretRace
. runDelay
+ . resourceToIOFinal
. runError
+ . mapError @DynError (.eMessage)
+ . mapError @JSONResponse (T.pack . show . (.value))
+ . mapError @ConversationSubsystemError toResponse
. mapError @ClientError (T.pack . displayException)
. mapError @FederationError (T.pack . displayException)
. mapError @UsageError (T.pack . show)
. mapError @ParseException (T.pack . displayException)
- . mapError (const ("Invalid input" :: Text) :: InvalidInput -> Text)
. mapError @MigrationError (T.pack . show)
. mapError @InternalError (TL.toStrict . internalErrorDescription)
. mapError @UnreachableBackends (T.pack . show)
. mapError @TeamCollaboratorsError (const ("Team collaborators error" :: Text))
. mapError @TeamFeatureStoreError (const ("Team feature store error" :: Text))
- . mapError @(Tagged HistoryNotSupported ()) (const ("History not supported" :: Text))
- . mapError @(Tagged OperationDenied ()) (const ("Operation denied" :: Text))
. mapError @(Tagged 'NotATeamMember ()) (const ("Not a team member" :: Text))
. mapError @(Tagged 'ConvAccessDenied ()) (const ("Conversation access denied" :: Text))
- . mapError @(Tagged 'NotConnected ()) (const ("Not connected" :: Text))
- . mapError @(Tagged 'MLSNotEnabled ()) (const ("MLS not enabled" :: Text))
- . mapError @(Tagged 'MLSNonEmptyMemberList ()) (const ("MLS non-empty member list" :: Text))
- . mapError @(Tagged 'MissingLegalholdConsent ()) (const ("Missing legalhold consent" :: Text))
- . mapError @(Tagged 'NonBindingTeam ()) (const ("Non-binding team" :: Text))
- . mapError @(Tagged 'NoBindingTeamMembers ()) (const ("No binding team members" :: Text))
. mapError @(Tagged 'TeamNotFound ()) (const ("Team not found" :: Text))
- . mapError @(Tagged 'InvalidOperation ()) (const ("Invalid operation" :: Text))
- . mapError @(Tagged 'ConvNotFound ()) (const ("Conversation not found" :: Text))
- . mapError @(Tagged 'ChannelsNotEnabled ()) (const ("Channels not enabled" :: Text))
- . mapError @(Tagged 'NotAnMlsConversation ()) (const ("Not an MLS conversation" :: Text))
+ . mapError @(Tagged 'TeamMemberNotFound ()) (const ("Team member not found" :: Text))
+ . mapError @(Tagged 'AccessDenied ()) (const ("Access denied" :: Text))
+ . mapError @NonFederatingBackends (const ("Non federating backends" :: Text))
+ . mapError @UnreachableBackendsLegacy (const ("Unreachable backends legacy" :: Text))
+ . mapError @RateLimitExceeded (const ("Rate limit exceeded" :: Text))
. interpretTinyLog env job.requestId job.jobId
- . runInputConst env.hasqlPool
- . runInputConst (toLocalUnsafe env.federationDomain ())
- . runInputConst (FeatureLegalHoldDisabledPermanently)
- . runInputConst env.cassandraGalley
- . runInputConst legalHoldEnv
- . runInputConst (ExposeInvitationURLsAllowlist [])
+ . runInputConst @Hasql.Pool env.hasqlPool
+ . runInputConst @(Local ()) (toLocalUnsafe env.federationDomain ())
+ . runInputConst @(FeatureDefaults LegalholdConfig) FeatureLegalHoldDisabledPermanently
+ . runInputConst @ClientState env.cassandraGalley
+ . runInputConst @LegalHoldEnv legalHoldEnv
+ . runInputConst @ExposeInvitationURLsAllowlist (ExposeInvitationURLsAllowlist $ fromMaybe [] env.exposeInvitationURLsTeamAllowlist)
+ . runInputConst @(Either HttpsUrl (Map Text HttpsUrl)) env.convCodeURI
+ . runInputConst @IntraListing (IntraListing env.intraListing)
+ . runInputConst @(Maybe GroupInfoCheckEnabled) (GroupInfoCheckEnabled <$> env.checkGroupInfo)
+ . runInputConst @(Maybe GuestLinkTTLSeconds) env.guestLinkTTLSeconds
+ . runInputConst @FanoutLimit (currentFanoutLimit env.maxTeamSize env.maxFanoutSize)
+ . interpretMLSCommitLockStoreToCassandra env.cassandraGalley
+ . interpretProposalStoreToCassandra
. interpretServiceStoreToCassandra env.cassandraBrig
. interpretUserGroupStoreToPostgres
. interpretTeamFeatureStoreToCassandra
@@ -235,12 +259,20 @@ dispatchJob job = do
. interpretBrigAccess env.brigEndpoint
. interpretGalleyAPIAccessToRpc mempty env.galleyEndpoint
. runInputSem getConversationSubsystemConfig
+ . runInputSem @(Maybe (MLSKeysByPurpose MLSPrivateKeys)) (inputs @ConversationSubsystemConfig (.mlsKeys))
. runInputSem getConfiguredFeatureFlags
+ . runHashPassword env.passwordHashingOptions
+ . interpretRateLimit env.passwordHashingRateLimitEnv
+ . convCodesStoreInterpreter
. interpretExternalAccess extEnv
. interpretSparAPIAccessToRpc env.sparEndpoint
. runNotificationSubsystemGundeck (defaultNotificationSubsystemConfig job.requestId)
. interpretFederationAPIAccess federationAPIAccessConfig
. interpretTeamSubsystem teamSubsystemConfig
+ . ( \m -> do
+ p <- inputs @ConversationSubsystemConfig (.federationProtocols)
+ runFederationSubsystem p m
+ )
. runFeaturesConfigSubsystem
. runInputSem getAllTeamFeaturesForServer
. interpretTeamCollaboratorsSubsystem
@@ -252,6 +284,7 @@ dispatchJob job = do
Sem r ConversationSubsystemConfig
getConversationSubsystemConfig = getConversationConfig
+ backendQueueEnv :: Env -> BackendNotificationQueueAccess.Env
backendQueueEnv env =
BackendNotificationQueueAccess.Env
{ channelMVar = env.amqpBackendNotificationsChannel,
diff --git a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs
index 30a9c04573..a3730bdaf2 100644
--- a/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs
+++ b/services/background-worker/test/Test/Wire/BackendNotificationPusherSpec.hs
@@ -57,7 +57,7 @@ import Test.Hspec
import Test.QuickCheck
import Test.Wire.Util
import UnliftIO.Async
-import Util.Options
+import Util.Options (Endpoint (..), PasswordHashingOptions (..))
import Wire.API.Conversation.Action
import Wire.API.Federation.API
import Wire.API.Federation.API.Brig
@@ -70,6 +70,7 @@ import Wire.BackgroundWorker.Env
import Wire.BackgroundWorker.Options
import Wire.BackgroundWorker.Util
import Wire.PostgresMigrationOpts
+import Wire.RateLimit.Interpreter (newRateLimitEnv)
spec :: Spec
spec = do
@@ -371,7 +372,17 @@ spec = do
brigEndpoint = undefined
sparEndpoint = undefined
galleyEndpoint = undefined
-
+ maxTeamSize = 1000
+ maxFanoutSize = Nothing
+ exposeInvitationURLsTeamAllowlist = Nothing
+ intraListing = True
+ federationProtocols = Nothing
+ guestLinkTTLSeconds = Nothing
+ passwordHashingOptions = PasswordHashingScrypt
+ checkGroupInfo = Nothing
+ convCodeURI = Left (fromRight (error "Failed to parse test HttpsUrl") $ httpsUrlFromText "https://localhost")
+
+ passwordHashingRateLimitEnv <- newRateLimitEnv defTestRateLimitConfig
backendNotificationMetrics <- mkBackendNotificationMetrics
workerRunningGauge <- mkWorkerRunningGauge
domains <- runAppT Env {..} $ getRemoteDomains (fromJust rabbitmqAdminClient)
@@ -412,6 +423,17 @@ spec = do
brigEndpoint = undefined
sparEndpoint = undefined
galleyEndpoint = undefined
+ maxTeamSize = 1000
+ maxFanoutSize = Nothing
+ exposeInvitationURLsTeamAllowlist = Nothing
+ intraListing = True
+ federationProtocols = Nothing
+ guestLinkTTLSeconds = Nothing
+ passwordHashingOptions = PasswordHashingScrypt
+ checkGroupInfo = Nothing
+ convCodeURI = Left (fromRight (error "Failed to parse test HttpsUrl") $ httpsUrlFromText "https://localhost")
+
+ passwordHashingRateLimitEnv <- newRateLimitEnv defTestRateLimitConfig
backendNotificationMetrics <- mkBackendNotificationMetrics
workerRunningGauge <- mkWorkerRunningGauge
domainsThread <- async $ runAppT Env {..} $ getRemoteDomains (fromJust rabbitmqAdminClient)
diff --git a/services/background-worker/test/Test/Wire/Util.hs b/services/background-worker/test/Test/Wire/Util.hs
index 9810b9c265..6aa6afa8c9 100644
--- a/services/background-worker/test/Test/Wire/Util.hs
+++ b/services/background-worker/test/Test/Wire/Util.hs
@@ -26,11 +26,12 @@ import Data.Range
import Imports
import Network.HTTP.Client hiding (Proxy)
import System.Logger.Class qualified as Logger
-import Util.Options (Endpoint (..))
+import Util.Options (Endpoint (..), PasswordHashingOptions (..))
import Wire.BackgroundWorker.Env hiding (federatorInternal)
import Wire.BackgroundWorker.Env qualified as E
import Wire.BackgroundWorker.Options
import Wire.PostgresMigrationOpts
+import Wire.RateLimit.Interpreter (RateLimitConfig (..), TokenBucketConfig (..), newRateLimitEnv)
testEnv :: IO Env
testEnv = do
@@ -68,8 +69,30 @@ testEnv = do
brigEndpoint = undefined
sparEndpoint = Endpoint "localhost" 0
galleyEndpoint = undefined
+ maxTeamSize = 1000
+ maxFanoutSize = Nothing
+ exposeInvitationURLsTeamAllowlist = Nothing
+ intraListing = True
+ federationProtocols = Nothing
+ guestLinkTTLSeconds = Nothing
+ passwordHashingOptions = PasswordHashingScrypt
+ checkGroupInfo = Nothing
+ convCodeURI = Left (fromRight (error "Failed to parse test HttpsUrl") $ httpsUrlFromText "https://localhost")
+ passwordHashingRateLimitEnv <- newRateLimitEnv defTestRateLimitConfig
pure Env {..}
+defTestRateLimitConfig :: RateLimitConfig
+defTestRateLimitConfig =
+ RateLimitConfig
+ { ipv4CidrBlock = 32,
+ ipv6CidrBlock = 128,
+ ipAddressExceptions = [],
+ maxRateLimitedKeys = 1000,
+ ipAddrLimit = TokenBucketConfig {burst = 100, inverseRate = 1_000_000},
+ userLimit = TokenBucketConfig {burst = 100, inverseRate = 1_000_000},
+ internalLimit = TokenBucketConfig {burst = 100, inverseRate = 1_000_000}
+ }
+
runTestAppT :: AppT IO a -> Int -> IO a
runTestAppT app port = do
baseEnv <- testEnv
diff --git a/services/brig/src/Brig/CanonicalInterpreter.hs b/services/brig/src/Brig/CanonicalInterpreter.hs
index a5eb8d4f30..270f1a7aff 100644
--- a/services/brig/src/Brig/CanonicalInterpreter.hs
+++ b/services/brig/src/Brig/CanonicalInterpreter.hs
@@ -42,6 +42,7 @@ import Data.ZAuth.CryptoSign (CryptoSign, runCryptoSign)
import Hasql.Pool (UsageError)
import Hasql.Pool qualified as Hasql
import Imports
+import Network.Wai.Utilities.Error qualified as Wai
import Polysemy
import Polysemy.Async
import Polysemy.Conc
@@ -50,6 +51,8 @@ import Polysemy.Error (Error, errorToIOFinal, mapError, runError)
import Polysemy.Input (Input, runInputConst)
import Polysemy.Internal.Kind
import Polysemy.TinyLog (TinyLog)
+import Wire.API.Error (ErrorS, errorToWai)
+import Wire.API.Error.Galley
import Wire.API.Federation.Client qualified
import Wire.API.Federation.Error
import Wire.API.Team.Collaborator
@@ -209,6 +212,9 @@ type BrigLowerLevelEffects =
Error VerificationCodeSubsystemError,
Error PropertySubsystemError,
Error RateLimitExceeded,
+ ErrorS 'TeamMemberNotFound,
+ ErrorS 'TeamNotFound,
+ Error Wai.Error,
Wire.FederationAPIAccess.FederationAPIAccess Wire.API.Federation.Client.FederatorClient,
DomainVerificationChallengeStore,
DomainRegistrationStore,
@@ -437,6 +443,9 @@ runBrigToIO e (AppT ma) = do
. interpretDomainRegistrationStoreToCassandra e.casClient
. interpretDomainVerificationChallengeStoreToCassandra e.casClient e.settings.challengeTTL
. interpretFederationAPIAccess federationApiAccessConfig
+ . mapError StdError -- Wai.Error
+ . mapError (const $ errorToWai @'TeamNotFound) -- ErrorS 'TeamNotFound
+ . mapError (const $ errorToWai @'TeamMemberNotFound) -- ErrorS 'TeamMemberNotFound
. mapError rateLimitExceededToHttpError
. mapError propertySubsystemErrorToHttpError
. mapError verificationCodeSubsystemErrorToHttpError
diff --git a/services/galley/default.nix b/services/galley/default.nix
index 2aff917965..716691efca 100644
--- a/services/galley/default.nix
+++ b/services/galley/default.nix
@@ -18,7 +18,6 @@
, cassandra-util
, cassava
, cereal
-, comonad
, conduit
, containers
, cookie
@@ -34,7 +33,6 @@
, galley-types
, gitignoreSource
, hasql-pool
-, hex
, hs-opentelemetry-instrumentation-wai
, hs-opentelemetry-sdk
, HsOpenSSL
@@ -88,7 +86,6 @@
, tasty-ant-xml
, tasty-cannon
, tasty-hunit
-, tasty-quickcheck
, temporary
, text
, time
@@ -103,8 +100,6 @@
, uri-bytestring
, utf8-string
, uuid
-, uuid-types
-, vector
, wai
, wai-extra
, wai-middleware-gunzip
@@ -134,16 +129,13 @@ mkDerivation {
bytestring-conversion
cassandra-util
cassava
- comonad
containers
data-default
errors
exceptions
extended
- extra
galley-types
hasql-pool
- hex
hs-opentelemetry-instrumentation-wai
hs-opentelemetry-sdk
HsOpenSSL
@@ -169,11 +161,9 @@ mkDerivation {
servant
servant-server
singletons
- sop-core
split
ssl-util
stm
- tagged
text
time
tinylog
@@ -184,7 +174,6 @@ mkDerivation {
uri-bytestring
utf8-string
uuid
- vector
wai
wai-extra
wai-middleware-gunzip
@@ -277,24 +266,6 @@ mkDerivation {
wire-subsystems
yaml
];
- testHaskellDepends = [
- base
- containers
- extra
- galley-types
- imports
- lens
- polysemy
- polysemy-wire-zoo
- tasty
- tasty-hunit
- tasty-quickcheck
- types-common
- uuid-types
- wire-api
- wire-api-federation
- wire-subsystems
- ];
description = "Conversations";
license = lib.licenses.agpl3Only;
}
diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal
index 8f706554d4..760d46ae5d 100644
--- a/services/galley/galley.cabal
+++ b/services/galley/galley.cabal
@@ -73,46 +73,12 @@ library
-- cabal-fmt: expand src
exposed-modules:
- Galley.API.Action
- Galley.API.Action.Kick
- Galley.API.Action.Leave
- Galley.API.Action.Notify
- Galley.API.Action.Reset
- Galley.API.Clients
- Galley.API.Create
Galley.API.CustomBackend
Galley.API.Federation
- Galley.API.Federation.Handlers
Galley.API.Internal
Galley.API.LegalHold
- Galley.API.LegalHold.Conflicts
- Galley.API.LegalHold.Get
Galley.API.LegalHold.Team
- Galley.API.Mapping
Galley.API.Meetings
- Galley.API.Message
- Galley.API.MLS
- Galley.API.MLS.CheckClients
- Galley.API.MLS.Commit.Core
- Galley.API.MLS.Commit.ExternalCommit
- Galley.API.MLS.Commit.InternalCommit
- Galley.API.MLS.Conversation
- Galley.API.MLS.Enabled
- Galley.API.MLS.GroupInfo
- Galley.API.MLS.GroupInfoCheck
- Galley.API.MLS.IncomingMessage
- Galley.API.MLS.Keys
- Galley.API.MLS.Message
- Galley.API.MLS.Migration
- Galley.API.MLS.One2One
- Galley.API.MLS.OutOfSync
- Galley.API.MLS.Propagate
- Galley.API.MLS.Proposal
- Galley.API.MLS.Removal
- Galley.API.MLS.Reset
- Galley.API.MLS.SubConversation
- Galley.API.MLS.Util
- Galley.API.MLS.Welcome
Galley.API.Public.Bot
Galley.API.Public.Conversation
Galley.API.Public.CustomBackend
@@ -126,13 +92,10 @@ library
Galley.API.Public.TeamConversation
Galley.API.Public.TeamMember
Galley.API.Public.TeamNotification
- Galley.API.Query
Galley.API.Teams
Galley.API.Teams.Export
Galley.API.Teams.Features
- Galley.API.Teams.Features.Get
Galley.API.Teams.Notifications
- Galley.API.Update
Galley.App
Galley.Cassandra
Galley.Effects.Queue
@@ -241,16 +204,13 @@ library
, bytestring-conversion >=0.2
, cassandra-util >=0.16.2
, cassava >=0.5.2
- , comonad
, containers >=0.5
, data-default
, errors >=2.0
, exceptions >=0.4
, extended
- , extra >=1.3
, galley-types >=0.65.0
, hasql-pool
- , hex
, hs-opentelemetry-instrumentation-wai
, hs-opentelemetry-sdk
, HsOpenSSL >=0.11
@@ -276,11 +236,9 @@ library
, servant
, servant-server
, singletons
- , sop-core
, split >=0.2
, ssl-util >=0.1
, stm >=2.4
- , tagged
, text >=0.11
, time >=1.4
, tinylog >=0.10
@@ -291,7 +249,6 @@ library
, uri-bytestring >=0.2
, utf8-string
, uuid >=1.3
- , vector
, wai >=3.0
, wai-extra >=3.0
, wai-middleware-gunzip >=0.0.2
@@ -520,35 +477,3 @@ executable galley-schema
if flag(static)
ld-options: -static
-
-test-suite galley-tests
- import: common-all
- type: exitcode-stdio-1.0
- main-is: ../unit.hs
- other-modules:
- Paths_galley
- Run
- Test.Galley.API.Message
- Test.Galley.API.One2One
- Test.Galley.Mapping
-
- ghc-options: -threaded -with-rtsopts=-N -Wno-x-partial
- hs-source-dirs: test/unit
- build-depends:
- , base
- , containers
- , extra >=1.3
- , galley
- , galley-types
- , imports
- , lens
- , polysemy
- , polysemy-wire-zoo
- , tasty
- , tasty-hunit
- , tasty-quickcheck
- , types-common
- , uuid-types
- , wire-api
- , wire-api-federation
- , wire-subsystems
diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
deleted file mode 100644
index 638e2b56cf..0000000000
--- a/services/galley/src/Galley/API/Create.hs
+++ /dev/null
@@ -1,140 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2022 Wire Swiss GmbH
---
--- This program is free software: you can redistribute it and/or modify it under
--- the terms of the GNU Affero General Public License as published by the Free
--- Software Foundation, either version 3 of the License, or (at your option) any
--- later version.
---
--- This program is distributed in the hope that it will be useful, but WITHOUT
--- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
--- details.
---
--- You should have received a copy of the GNU Affero General Public License along
--- with this program. If not, see .
-
-module Galley.API.Create where
-
-import Data.Id
-import Data.Qualified
-import Data.Set qualified as Set
-import Galley.API.Mapping
-import Galley.Types.Error
-import Imports
-import Polysemy
-import Polysemy.Error
-import Polysemy.TinyLog qualified as P
-import Wire.API.Conversation (CreateGroupConversation (..), CreateGroupOwnConversation (..), NewConv, NewOne2OneConv)
-import Wire.API.Conversation qualified as Public
-import Wire.API.Error.Galley (UnreachableBackendsLegacy (..))
-import Wire.API.Event.Conversation (Connect)
-import Wire.API.FederationStatus (RemoteDomains (..))
-import Wire.API.Routes.Public.Galley.Conversation
-import Wire.API.Routes.Public.Util (ResponseForExistedCreated (..))
-import Wire.API.User (baseProtocolToProtocol)
-import Wire.ConversationSubsystem qualified as ConversationSubsystem
-import Wire.FederationSubsystem (FederationSubsystem, checkFederationStatus, enforceFederationProtocol)
-
-----------------------------------------------------------------------------
--- API Handlers
-
-createGroupConversationUpToV3 ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error UnreachableBackendsLegacy) r,
- Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- Maybe ConnId ->
- NewConv ->
- Sem r (ConversationResponse Public.OwnConversation)
-createGroupConversationUpToV3 lusr conn newConv = mapError UnreachableBackendsLegacy $ do
- dbConv <- ConversationSubsystem.createGroupConversation lusr conn newConv
- Created <$> conversationViewV9 lusr dbConv
-
-createGroupOwnConversation ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error InternalError) r,
- Member FederationSubsystem r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- Maybe ConnId ->
- NewConv ->
- Sem r CreateGroupConversationResponseV9
-createGroupOwnConversation lusr conn newConv = do
- let remoteDomains = void <$> snd (partitionQualified lusr $ newConv.newConvQualifiedUsers)
- enforceFederationProtocol (baseProtocolToProtocol newConv.newConvProtocol) remoteDomains
- checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains)
- dbConv <- ConversationSubsystem.createGroupConversation lusr conn newConv
- GroupConversationCreatedV9 <$> (CreateGroupOwnConversation <$> conversationViewV9 lusr dbConv <*> pure mempty)
-
-createGroupConversation ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member FederationSubsystem r
- ) =>
- Local UserId ->
- Maybe ConnId ->
- NewConv ->
- Sem r CreateGroupConversation
-createGroupConversation lusr conn newConv = do
- let remoteDomains = void <$> snd (partitionQualified lusr $ newConv.newConvQualifiedUsers)
- enforceFederationProtocol (baseProtocolToProtocol newConv.newConvProtocol) remoteDomains
- checkFederationStatus (RemoteDomains $ Set.fromList remoteDomains)
- dbConv <- ConversationSubsystem.createGroupConversation lusr conn newConv
- pure $
- CreateGroupConversation
- { conversation = conversationView (qualifyAs lusr ()) (Just lusr) dbConv,
- failedToAdd = mempty
- }
-
-createProteusSelfConversation ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- Sem r (ConversationResponse Public.OwnConversation)
-createProteusSelfConversation lusr = do
- (c, created) <- ConversationSubsystem.createProteusSelfConversation lusr
- if created
- then Created <$> conversationViewV9 lusr c
- else Existed <$> conversationViewV9 lusr c
-
-createOne2OneConversation ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- ConnId ->
- NewOne2OneConv ->
- Sem r (ConversationResponse Public.OwnConversation)
-createOne2OneConversation lusr zcon j = do
- (c, created) <- ConversationSubsystem.createOne2OneConversation lusr zcon j
- if created
- then Created <$> conversationViewV9 lusr c
- else Existed <$> conversationViewV9 lusr c
-
-----------------------------------------------------------------------------
--- Helpers
-
-createConnectConversation ::
- ( Member ConversationSubsystem.ConversationSubsystem r,
- Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- Maybe ConnId ->
- Connect ->
- Sem r (ConversationResponse Public.OwnConversation)
-createConnectConversation lusr conn j = do
- (c, created) <- ConversationSubsystem.createConnectConversation lusr conn j
- if created
- then Created <$> conversationViewV9 lusr c
- else Existed <$> conversationViewV9 lusr c
diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index 560000626d..d1e47cae92 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -17,15 +17,19 @@
module Galley.API.Federation where
-import Galley.API.Federation.Handlers
+import Data.Domain
import Galley.App
+import Imports
import Polysemy
import Servant (ServerT)
import Servant.API
import Wire.API.Federation.API
+import Wire.API.Federation.API.Common (EmptyResponse (..))
+import Wire.API.Federation.API.Galley
import Wire.API.Federation.Endpoint
import Wire.API.Federation.Version
import Wire.API.Routes.Named
+import Wire.ConversationSubsystem as ConversationSubsystem
type FederationAPI = "federation" :> FedApi 'Galley
@@ -33,26 +37,42 @@ type FederationAPI = "federation" :> FedApi 'Galley
federationSitemap ::
ServerT FederationAPI (Sem GalleyEffects)
federationSitemap =
- Named @"on-conversation-created" onConversationCreated
- :<|> Named @"get-conversations@v1" getConversationsV1
- :<|> Named @"get-conversations" getConversations
- :<|> Named @"leave-conversation" leaveConversation
- :<|> Named @"send-message" sendMessage
- :<|> Named @"update-conversation" updateConversation
- :<|> Named @"mls-welcome" mlsSendWelcome
- :<|> Named @"send-mls-message" sendMLSMessage
- :<|> Named @"send-mls-commit-bundle" sendMLSCommitBundle
- :<|> Named @"query-group-info" queryGroupInfo
- :<|> Named @"update-typing-indicator" updateTypingIndicator
- :<|> Named @"on-typing-indicator-updated" onTypingIndicatorUpdated
- :<|> Named @"get-sub-conversation" getSubConversationForRemoteUser
- :<|> Named @"delete-sub-conversation" deleteSubConversationForRemoteUser
- :<|> Named @"leave-sub-conversation" leaveSubConversation
- :<|> Named @"get-one2one-conversation@v1" getOne2OneConversationV1
- :<|> Named @"get-one2one-conversation" getOne2OneConversation
- :<|> Named @"on-client-removed" onClientRemoved
- :<|> Named @"on-message-sent" onMessageSent
- :<|> Named @"on-mls-message-sent" onMLSMessageSent
+ Named @"on-conversation-created" federationOnConversationCreated
+ :<|> Named @"get-conversations@v1" federationGetLegacyConversations
+ :<|> Named @"get-conversations" federationGetConversations
+ :<|> Named @"leave-conversation" federationLeaveConversation
+ :<|> Named @"send-message" federationSendMessage
+ :<|> Named @"update-conversation" federationUpdateConversation
+ :<|> Named @"mls-welcome" federationMlsSendWelcome
+ :<|> Named @"send-mls-message" federationSendMLSMessage
+ :<|> Named @"send-mls-commit-bundle" federationSendMLSCommitBundle
+ :<|> Named @"query-group-info" federationQueryGroupInfo
+ :<|> Named @"update-typing-indicator" federationUpdateTypingIndicator
+ :<|> Named @"on-typing-indicator-updated" federationOnTypingIndicatorUpdated
+ :<|> Named @"get-sub-conversation" federationGetSubConversationForRemoteUser
+ :<|> Named @"delete-sub-conversation" federationDeleteSubConversationForRemoteUser
+ :<|> Named @"leave-sub-conversation" federationLeaveSubConversation
+ :<|> Named @"get-one2one-conversation@v1" federationGetLegacyOne2OneConversation
+ :<|> Named @"get-one2one-conversation" federationGetOne2OneConversation
+ :<|> Named @"on-client-removed" federationOnClientRemoved
+ :<|> Named @"on-message-sent" federationOnMessageSent
+ :<|> Named @"on-mls-message-sent" federationOnMLSMessageSent
:<|> Named @(Versioned 'V0 "on-conversation-updated") onConversationUpdatedV0
- :<|> Named @"on-conversation-updated" onConversationUpdated
- :<|> Named @"on-user-deleted-conversations" onUserDeleted
+ :<|> Named @"on-conversation-updated" federationOnConversationUpdated
+ :<|> Named @"on-user-deleted-conversations" federationOnUserDeleted
+
+onConversationUpdatedV0 ::
+ (Member ConversationSubsystem r) =>
+ Domain ->
+ ConversationUpdateV0 ->
+ Sem r EmptyResponse
+onConversationUpdatedV0 domain cu =
+ federationOnConversationUpdated domain (conversationUpdateFromV0 cu)
+
+federationGetLegacyConversations ::
+ (Member ConversationSubsystem r) =>
+ Domain ->
+ GetConversationsRequest ->
+ Sem r GetConversationsResponse
+federationGetLegacyConversations domain req =
+ getConversationsResponseFromView <$> ConversationSubsystem.federationGetConversations domain req
diff --git a/services/galley/src/Galley/API/Internal.hs b/services/galley/src/Galley/API/Internal.hs
index 280fc91d94..221da66c5b 100644
--- a/services/galley/src/Galley/API/Internal.hs
+++ b/services/galley/src/Galley/API/Internal.hs
@@ -37,22 +37,15 @@ import Data.Qualified
import Data.Range
import Data.Singletons
import Data.Time
-import Galley.API.Action
-import Galley.API.Clients qualified as Clients
-import Galley.API.Create qualified as Create
import Galley.API.LegalHold (unsetTeamLegalholdWhitelistedH)
-import Galley.API.LegalHold.Conflicts
-import Galley.API.MLS.Removal
import Galley.API.Public.Servant
-import Galley.API.Query qualified as Query
import Galley.API.Teams
import Galley.API.Teams qualified as Teams
import Galley.API.Teams.Features
-import Galley.API.Teams.Features.Get
-import Galley.API.Update qualified as Update
import Galley.App
import Galley.Monad
import Galley.Queue qualified as Q
+import Galley.Types.Clients
import Galley.Types.Error
import Imports hiding (head)
import Network.AMQP qualified as Q
@@ -73,7 +66,6 @@ import Wire.API.Event.LeaveReason
import Wire.API.Federation.API
import Wire.API.Federation.API.Galley
import Wire.API.Federation.Error
-import Wire.API.MLS.Keys (MLSKeysByPurpose, MLSPrivateKeys)
import Wire.API.Push.V2 qualified as PushV2
import Wire.API.Routes.API
import Wire.API.Routes.Internal.Brig.EJPD
@@ -82,31 +74,28 @@ import Wire.API.Routes.Internal.Galley.TeamsIntra
import Wire.API.Routes.MultiTablePaging (mtpHasMore, mtpPagingState, mtpResults)
import Wire.API.Routes.MultiTablePaging qualified as MTP
import Wire.API.Team.Feature
-import Wire.API.Team.FeatureFlags (FanoutLimit)
+import Wire.API.Team.FeatureFlags (FeatureFlags)
+import Wire.API.Team.LegalHold (UserLegalHoldStatusEntry (..))
import Wire.API.User (UserIds (cUsers))
import Wire.API.User.Client
import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess (BrigAPIAccess)
-import Wire.ConversationStore
+import Wire.ConversationStore hiding (getConversations)
import Wire.ConversationStore qualified as ConversationStore
import Wire.ConversationStore.MLS.Types
-import Wire.ConversationSubsystem
-import Wire.ConversationSubsystem.One2One
-import Wire.ConversationSubsystem.Util
+import Wire.ConversationSubsystem as Conv
+import Wire.ConversationSubsystem.LegalholdConflicts (LegalholdConflicts, LegalholdConflictsOldClients)
import Wire.CustomBackendStore
-import Wire.ExternalAccess (ExternalAccess)
-import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem)
+import Wire.FeaturesConfigSubsystem
import Wire.FederationSubsystem (getFederationStatus)
import Wire.LegalHoldStore as LegalHoldStore
import Wire.ListItems
import Wire.NotificationSubsystem
-import Wire.Options.Galley hiding (brig)
-import Wire.ProposalStore (ProposalStore)
+import Wire.Options.Galley qualified
import Wire.Sem.Now (Now)
import Wire.Sem.Now qualified as Now
import Wire.Sem.Paging
import Wire.Sem.Paging.Cassandra
-import Wire.Sem.Random (Random)
import Wire.ServiceStore
import Wire.StoredConversation
import Wire.StoredConversation qualified as Data
@@ -114,7 +103,7 @@ import Wire.TeamStore
import Wire.TeamStore qualified as E
import Wire.TeamSubsystem (TeamSubsystem)
import Wire.TeamSubsystem qualified as TeamSubsystem
-import Wire.UserClientIndexStore
+import Wire.UserClientIndexStore as UserClientIndexStore
import Wire.UserList
import Wire.Util
@@ -123,13 +112,13 @@ internalAPI =
hoistAPI @InternalAPIBase Imports.id $
mkNamedAPI @"status" (pure ())
<@> mkNamedAPI @"delete-user" rmUser
- <@> mkNamedAPI @"connect" Create.createConnectConversation
+ <@> mkNamedAPI @"connect" createConnectConversation
<@> mkNamedAPI @"get-conversation-clients" iGetMLSClientListForConv
<@> mkNamedAPI @"guard-legalhold-policy-conflicts" guardLegalholdPolicyConflictsH
<@> legalholdWhitelistedTeamsAPI
<@> iTeamsAPI
<@> miscAPI
- <@> mkNamedAPI @"upsert-one2one" iUpsertOne2OneConversation
+ <@> mkNamedAPI @"upsert-one2one" internalUpsertOne2OneConversation
<@> featureAPI
<@> federationAPI
<@> conversationAPI
@@ -145,23 +134,20 @@ getConversationConfigH = input
iEJPDAPI :: API IEJPDAPI GalleyEffects
iEJPDAPI = mkNamedAPI @"get-conversations-by-user" ejpdGetConvInfo
--- | An unpaginated, internal http interface to `Query.conversationIdsPageFrom`. Used for
+-- | An unpaginated, internal http interface to `conversationIdsPageFrom`. Used for
-- EJPD reports. Called locally with very little data for each conv, so we don't expect
-- pagination to ever be needed.
ejpdGetConvInfo ::
forall r.
( Member ConversationStore r,
Member ConversationSubsystem r,
- Member (Error InternalError) r,
- Member (Input (Local ())) r,
- Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
- Member P.TinyLog r
+ Member (Input (Local ())) r
) =>
UserId ->
Sem r [EJPDConvInfo]
ejpdGetConvInfo uid = do
luid <- qualifyLocal uid
- firstPage <- Query.conversationIdsPageFrom luid initialPageRequest
+ firstPage <- conversationIdsPageFrom luid initialPageRequest
getPages luid firstPage
where
initialPageRequest = mkPageRequest (MTP.MultiTablePagingState MTP.PagingLocals Nothing)
@@ -184,7 +170,7 @@ ejpdGetConvInfo uid = do
renderedPage <- mapMaybe mk <$> ConversationStore.getConversations (fst $ partitionQualified luid convids)
if MTP.mtpHasMore page
then do
- newPage <- Query.conversationIdsPageFrom luid (mkPageRequest . MTP.mtpPagingState $ page)
+ newPage <- conversationIdsPageFrom luid (mkPageRequest . MTP.mtpPagingState $ page)
morePages <- getPages luid newPage
pure $ renderedPage <> morePages
else pure renderedPage
@@ -195,14 +181,14 @@ federationAPI =
conversationAPI :: API IConversationAPI GalleyEffects
conversationAPI =
- mkNamedAPI @"conversation-get-member" Query.internalGetMember
- <@> mkNamedAPI @"conversation-accept-v2" Update.acceptConv
- <@> mkNamedAPI @"conversation-block" Update.blockConv
- <@> mkNamedAPI @"conversation-unblock" Update.unblockConv
- <@> mkNamedAPI @"conversation-meta" Query.getConversationMeta
- <@> mkNamedAPI @"conversation-mls-one-to-one" Query.getMLSOne2OneConversationInternal
- <@> mkNamedAPI @"conversation-mls-one-to-one-established" Query.isMLSOne2OneEstablished
- <@> mkNamedAPI @"get-conversation-by-id" Query.getLocalConversationInternal
+ mkNamedAPI @"conversation-get-member" internalGetMember
+ <@> mkNamedAPI @"conversation-accept-v2" acceptConv
+ <@> mkNamedAPI @"conversation-block" blockConv
+ <@> mkNamedAPI @"conversation-unblock" unblockConv
+ <@> mkNamedAPI @"conversation-meta" getConversationMeta
+ <@> mkNamedAPI @"conversation-mls-one-to-one" getMLSOne2OneConversationInternal
+ <@> mkNamedAPI @"conversation-mls-one-to-one-established" isMLSOne2OneEstablished
+ <@> mkNamedAPI @"get-conversation-by-id" getLocalConversationInternal
<@> mkNamedAPI @"is-conversation-out-of-sync" ConversationStore.isConversationOutOfSync
legalholdWhitelistedTeamsAPI :: API ILegalholdWhitelistedTeamsAPI GalleyEffects
@@ -244,22 +230,24 @@ iTeamsAPI = mkAPI $ \tid -> hoistAPIHandler Imports.id (base tid)
<@> mkNamedAPI @"finalize-delete-team" (\lusr mconn -> TeamSubsystem.internalFinalizeDeleteTeam lusr mconn tid $> NoContent)
<@> hoistAPISegment
( mkNamedAPI @"get-search-visibility-internal" (Teams.getSearchVisibilityInternal tid)
- <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam @SearchVisibilityAvailableConfig) tid)
+ <@> mkNamedAPI @"set-search-visibility-internal" (Teams.setSearchVisibilityInternal (featureEnabledForTeam (Proxy @SearchVisibilityAvailableConfig)) tid)
)
miscAPI :: API IMiscAPI GalleyEffects
miscAPI =
mkNamedAPI @"get-team-members" Teams.getBindingTeamMembers
<@> mkNamedAPI @"get-team-id" lookupBindingTeam
- <@> mkNamedAPI @"test-get-clients" Clients.getClients
+ <@> mkNamedAPI @"test-get-clients" (\uid -> clientIds uid <$> getClients [uid])
<@> mkNamedAPI @"test-add-client" createClient
- <@> mkNamedAPI @"test-delete-client" Clients.rmClient
+ <@> mkNamedAPI @"remove-client" removeClient
<@> mkNamedAPI @"add-service" createService
<@> mkNamedAPI @"delete-service" deleteService
- <@> mkNamedAPI @"i-add-bot" Update.addBot
- <@> mkNamedAPI @"delete-bot" Update.rmBot
+ <@> mkNamedAPI @"i-add-bot" addBot
+ <@> mkNamedAPI @"delete-bot" rmBot
<@> mkNamedAPI @"put-custom-backend" setCustomBackend
<@> mkNamedAPI @"delete-custom-backend" deleteCustomBackend
+ <@> mkNamedAPI @"get-user-lh-status" (\uid mtid -> TeamSubsystem.getLHStatus mtid uid)
+ <@> mkNamedAPI @"get-users-lh-status" (\userIds -> map (uncurry UserLegalHoldStatusEntry) <$> TeamSubsystem.getLHStatusForUsers (cUsers userIds))
featureAPI1Full ::
forall cfg r.
@@ -341,7 +329,7 @@ featureAPI =
<@> mkNamedAPI @"get-configured-feature-flags" getConfiguredFeatureFlags
cellsAPI :: API ICellsAPI GalleyEffects
-cellsAPI = mkNamedAPI @"set-cells-state" Update.updateCellsState
+cellsAPI = mkNamedAPI @"set-cells-state" updateCellsState
getConfiguredFeatureFlags ::
forall r.
@@ -360,20 +348,13 @@ rmUser ::
Member ConversationStore r,
Member (Error DynError) r,
Member (Error FederationError) r,
- Member (Error InternalError) r,
- Member ExternalAccess r,
Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member (Input (Maybe (MLSKeysByPurpose MLSPrivateKeys))) r,
+ Member TeamSubsystem r,
Member Now r,
Member (ListItems p2 TeamId) r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member TeamStore r,
- Member (Input FanoutLimit) r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r,
Member FeaturesConfigSubsystem r
) =>
Local UserId ->
@@ -383,7 +364,7 @@ rmUser lusr conn = do
let nRange1000 = toRange (Proxy @1000) :: Range 1 1000 Int32
tids <- listTeams (tUnqualified lusr) Nothing maxBound
leaveTeams tids
- allConvIds <- Query.conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000)
+ allConvIds <- conversationIdsPageFrom lusr (GetPaginatedConversationIds Nothing nRange1000)
goConvPages nRange1000 allConvIds
deleteClients (tUnqualified lusr)
@@ -396,7 +377,7 @@ rmUser lusr conn = do
when (mtpHasMore page) $ do
let nextState = mtpPagingState page
nextQuery = GetPaginatedConversationIds (Just nextState) range
- newCids <- Query.conversationIdsPageFrom lusr nextQuery
+ newCids <- conversationIdsPageFrom lusr nextQuery
goConvPages range newCids
leaveTeams page = for_ (pageItems page) $ \tid -> do
@@ -405,7 +386,7 @@ rmUser lusr conn = do
getFeatureForTeam @_ @LimitedEventFanoutConfig tid
>>= ( \case
FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid
- FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid
+ FeatureStatusDisabled -> Right <$> TeamSubsystem.getTeamMembersForFanout tid
)
. (.status)
uncheckedDeleteTeamMember lusr conn tid (tUnqualified lusr) toNotify
@@ -522,7 +503,7 @@ safeForever funName action =
guardLegalholdPolicyConflictsH ::
( Member BrigAPIAccess r,
- Member (Input Opts) r,
+ Member (Input FeatureFlags) r,
Member P.TinyLog r,
Member (ErrorS 'MissingLegalholdConsent) r,
Member (ErrorS 'MissingLegalholdConsentOldClients) r,
diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
index c3e6abcfbe..9d45370cde 100644
--- a/services/galley/src/Galley/API/LegalHold.hs
+++ b/services/galley/src/Galley/API/LegalHold.hs
@@ -21,7 +21,6 @@ module Galley.API.LegalHold
removeSettingsInternalPaging,
removeSettings,
removeSettings',
- getUserStatus,
grantConsent,
requestDevice,
approveDevice,
@@ -40,10 +39,7 @@ import Data.Misc
import Data.Proxy (Proxy (Proxy))
import Data.Qualified
import Data.Range (toRange)
-import Galley.API.LegalHold.Get
import Galley.API.LegalHold.Team
-import Galley.API.Query (iterateConversations)
-import Galley.API.Update (removeMemberFromLocalConv)
import Galley.External.LegalHoldService qualified as LHService
import Galley.Types.Error
import Imports
@@ -54,12 +50,10 @@ import Polysemy.Input
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Log
import Wire.API.Conversation (ConvType (..), ConversationMetadata (..))
-import Wire.API.Conversation.Config (ConversationSubsystemConfig)
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
-import Wire.API.Federation.Error
import Wire.API.Provider.Service
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Public.Galley.LegalHold
@@ -72,21 +66,13 @@ import Wire.API.Team.LegalHold.Internal
import Wire.API.Team.Member
import Wire.API.User hiding (userId)
import Wire.API.User.Client.Prekey
-import Wire.BackendNotificationQueueAccess
import Wire.BrigAPIAccess
-import Wire.ConversationStore (ConversationStore)
import Wire.ConversationSubsystem
-import Wire.ConversationSubsystem.Util
-import Wire.ExternalAccess (ExternalAccess)
import Wire.FeaturesConfigSubsystem
import Wire.FireAndForget
import Wire.LegalHoldStore qualified as LegalHoldData
-import Wire.NotificationSubsystem
-import Wire.ProposalStore (ProposalStore)
-import Wire.Sem.Now (Now)
import Wire.Sem.Paging
import Wire.Sem.Paging.Cassandra
-import Wire.Sem.Random (Random)
import Wire.StoredConversation
import Wire.StoredConversation qualified as Data
import Wire.TeamMemberStore
@@ -97,11 +83,11 @@ import Wire.Util
createSettings ::
forall r.
- ( Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
- Member (ErrorS 'LegalHoldNotEnabled) r,
+ ( Member (ErrorS 'LegalHoldNotEnabled) r,
Member (ErrorS 'LegalHoldServiceInvalidKey) r,
Member (ErrorS 'LegalHoldServiceBadResponse) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member LegalHoldData.LegalHoldStore r,
Member P.TinyLog r,
Member (Input (FeatureDefaults LegalholdConfig)) r,
@@ -120,7 +106,7 @@ createSettings lzusr tid newService = do
-- Log.debug $
-- Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-- . Log.field "action" (Log.val "LegalHold.createSettings")
- void $ permissionCheck ChangeLegalHoldTeamSettings zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeLegalHoldTeamSettings zusrMembership
(key :: ServiceKey, fpr :: Fingerprint Rsa) <-
LegalHoldData.validateServiceKey newService.newLegalHoldServiceKey
>>= noteS @'LegalHoldServiceInvalidKey
@@ -153,37 +139,28 @@ getSettings lzusr tid = do
removeSettingsInternalPaging ::
forall r.
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error AuthenticationError) r,
- Member (Error FederationError) r,
+ ( Member BrigAPIAccess r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member (ErrorS 'LegalHoldDisableUnimplemented) r,
Member (ErrorS 'LegalHoldNotEnabled) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (Error AuthenticationError) r,
Member FireAndForget r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member (TeamMemberStore InternalPaging) r,
Member TeamStore r,
Member (Embed IO) r,
Member (Input (FeatureDefaults LegalholdConfig)) r,
Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r,
- Member FeaturesConfigSubsystem r
+ Member FeaturesConfigSubsystem r,
+ Member (Input (Local ())) r
) =>
Local UserId ->
TeamId ->
@@ -197,35 +174,26 @@ removeSettings ::
Bounded (PagingBounds p TeamMember),
Member (TeamMemberStore p) r,
Member TeamStore r,
- Member BackendNotificationQueueAccess r,
Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error AuthenticationError) r,
- Member (Error FederationError) r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member (ErrorS 'LegalHoldDisableUnimplemented) r,
Member (ErrorS 'LegalHoldNotEnabled) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (Error AuthenticationError) r,
Member FireAndForget r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
- Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member (Embed IO) r,
Member (Input (FeatureDefaults LegalholdConfig)) r,
Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r,
- Member FeaturesConfigSubsystem r
+ Member FeaturesConfigSubsystem r,
+ Member LegalHoldData.LegalHoldStore r,
+ Member (Input (Local ())) r
) =>
UserId ->
TeamId ->
@@ -239,7 +207,7 @@ removeSettings zusr tid (Public.RemoveLegalHoldSettingsRequest mPassword) = do
-- Log.debug $
-- Log.field "targets" (toByteString . show $ toByteString <$> zothers)
-- . Log.field "action" (Log.val "LegalHold.removeSettings")
- void $ permissionCheck ChangeLegalHoldTeamSettings zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeLegalHoldTeamSettings zusrMembership
ensureReAuthorised zusr mPassword Nothing Nothing
removeSettings' @p tid
where
@@ -257,30 +225,21 @@ removeSettings' ::
forall p r.
( Paging p,
Bounded (PagingBounds p TeamMember),
- Member BackendNotificationQueueAccess r,
Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
- Member ExternalAccess r,
Member FireAndForget r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member Now r,
- Member (Input (Local ())) r,
+ Member TeamSubsystem r,
Member LegalHoldData.LegalHoldStore r,
Member (TeamMemberStore p) r,
Member TeamStore r,
- Member ProposalStore r,
- Member Random r,
Member P.TinyLog r,
Member (Embed IO) r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
+ Member (Input (Local ())) r
) =>
TeamId ->
Sem r ()
@@ -308,26 +267,17 @@ removeSettings' tid =
-- @withdrawExplicitConsentH@ (lots of corner cases we'd have to implement for that to pan
-- out).
grantConsent ::
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
+ ( Member BrigAPIAccess r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member Now r,
Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member TeamStore r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
+ Member TeamSubsystem r
) =>
Local UserId ->
TeamId ->
@@ -346,10 +296,7 @@ grantConsent lusr tid = do
-- | Request to provision a device on the legal hold service for a user
requestDevice ::
forall r.
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
+ ( Member BrigAPIAccess r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
@@ -357,27 +304,21 @@ requestDevice ::
Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member (ErrorS 'MLSLegalholdIncompatible) r,
- Member (ErrorS 'NotATeamMember) r,
Member (ErrorS 'NoUserLegalHoldConsent) r,
- Member (ErrorS OperationDenied) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member TeamStore r,
Member (Embed IO) r,
Member (Input (FeatureDefaults LegalholdConfig)) r,
Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r,
- Member FeaturesConfigSubsystem r
+ Member FeaturesConfigSubsystem r,
+ Member (Input (Local ())) r
) =>
Local UserId ->
TeamId ->
@@ -391,7 +332,7 @@ requestDevice lzusr tid uid = do
Log.field "targets" (toByteString (tUnqualified luid))
. Log.field "action" (Log.val "LegalHold.requestDevice")
zusrMembership <- TeamSubsystem.internalGetTeamMember zusr tid
- void $ permissionCheck ChangeLegalHoldUserSettings zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeLegalHoldUserSettings zusrMembership
member <- noteS @'TeamMemberNotFound =<< TeamSubsystem.internalGetTeamMember uid tid
case member ^. legalHoldStatus of
UserLegalHoldEnabled -> throwS @'UserLegalHoldAlreadyEnabled
@@ -406,9 +347,10 @@ requestDevice lzusr tid uid = do
where
disallowIfMLSUser :: Local UserId -> Sem r ()
disallowIfMLSUser luid = do
- void $ iterateConversations luid (toRange (Proxy @500)) $ \convs -> do
- when (any (\c -> c.metadata.cnvmType /= SelfConv && c.protocol /= ProtocolProteus) convs) $ do
- throwS @'MLSLegalholdIncompatible
+ void $
+ iterateConversations luid (toRange (Proxy @500)) $ \convs -> do
+ when (any (\c -> c.metadata.cnvmType /= SelfConv && c.protocol /= ProtocolProteus) convs) $ do
+ throwS @'MLSLegalholdIncompatible
-- Wire's LH service that galley is usually calling here is idempotent in device creation,
-- ie. it returns the existing device on multiple calls to `/init`, like here:
@@ -440,11 +382,8 @@ requestDevice lzusr tid uid = do
-- since they are replaced if needed when registering new LH devices.
approveDevice ::
forall r.
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
+ ( Member BrigAPIAccess r,
Member (Error AuthenticationError) r,
- Member (Error FederationError) r,
Member (Error InternalError) r,
Member (ErrorS 'AccessDenied) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
@@ -452,25 +391,19 @@ approveDevice ::
Member (ErrorS 'LegalHoldNotEnabled) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member (ErrorS 'NoLegalHoldDeviceAllocated) r,
- Member (ErrorS 'NotATeamMember) r,
Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
Member (ErrorS 'UserLegalHoldNotPending) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
+ Member (ErrorS 'NotATeamMember) r,
Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member TeamStore r,
Member (Embed IO) r,
Member (Input (FeatureDefaults LegalholdConfig)) r,
Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r,
- Member FeaturesConfigSubsystem r
+ Member FeaturesConfigSubsystem r,
+ Member (Input (Local ())) r
) =>
Local UserId ->
ConnId ->
@@ -486,7 +419,7 @@ approveDevice lzusr connId tid uid (Public.ApproveLegalHoldForUserRequest mPassw
Log.field "targets" (toByteString (tUnqualified luid))
. Log.field "action" (Log.val "LegalHold.approveDevice")
unless (zusr == tUnqualified luid) $ throwS @'AccessDenied
- assertOnTeam (tUnqualified luid) tid
+ TeamSubsystem.assertOnTeam (tUnqualified luid) tid
ensureReAuthorised zusr mPassword Nothing Nothing
userLHStatus <-
maybe defUserLegalHoldStatus (view legalHoldStatus) <$> TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid
@@ -521,31 +454,22 @@ approveDevice lzusr connId tid uid (Public.ApproveLegalHoldForUserRequest mPassw
disableForUser ::
forall r.
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error AuthenticationError) r,
- Member (Error FederationError) r,
+ ( Member BrigAPIAccess r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (Error AuthenticationError) r,
Member ConversationSubsystem r,
- Member (Input (Local ())) r,
- Member Now r,
Member LegalHoldData.LegalHoldStore r,
- Member ProposalStore r,
Member P.TinyLog r,
- Member Random r,
Member TeamStore r,
Member (Embed IO) r,
Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
+ Member (Input (Local ())) r
) =>
Local UserId ->
TeamId ->
@@ -558,7 +482,7 @@ disableForUser lzusr tid uid (Public.DisableLegalHoldForUserRequest mPassword) =
Log.field "targets" (toByteString (tUnqualified luid))
. Log.field "action" (Log.val "LegalHold.disableForUser")
zusrMembership <- TeamSubsystem.internalGetTeamMember (tUnqualified lzusr) tid
- void $ permissionCheck ChangeLegalHoldUserSettings zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeLegalHoldUserSettings zusrMembership
userLHStatus <-
maybe defUserLegalHoldStatus (view legalHoldStatus) <$> TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid
@@ -589,25 +513,16 @@ disableForUser lzusr tid uid (Public.DisableLegalHoldForUserRequest mPassword) =
-- enabled, or disabled, make sure the affected connections are screened for policy conflict
-- (anybody with no-consent), and put those connections in the appropriate blocked state.
changeLegalholdStatusAndHandlePolicyConflicts ::
- ( Member BackendNotificationQueueAccess r,
- Member BrigAPIAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
+ ( Member BrigAPIAccess r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member Now r,
+ Member TeamSubsystem r,
Member LegalHoldData.LegalHoldStore r,
Member TeamStore r,
- Member ProposalStore r,
- Member Random r,
- Member P.TinyLog r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
+ Member P.TinyLog r
) =>
TeamId ->
Local UserId ->
@@ -676,7 +591,7 @@ blockNonConsentingConnections uid = do
-- FUTUREWORK: Handle remoteUsers here when federation is implemented
for (chunksOf 32 localUids) $ \others -> do
teamsOfUsers <- getUsersTeams others
- filterM (fmap (== ConsentNotGiven) . checkConsent teamsOfUsers) others
+ filterM (fmap (== TeamSubsystem.ConsentNotGiven) . TeamSubsystem.checkConsent teamsOfUsers) others
blockConflicts :: UserId -> [UserId] -> Sem r [String]
blockConflicts _ [] = pure []
@@ -708,21 +623,10 @@ unsetTeamLegalholdWhitelistedH tid = do
-- contains the hypothetical new LH status of `uid`'s so it can be consulted instead of the
-- one from the database.
handleGroupConvPolicyConflicts ::
- ( Member BackendNotificationQueueAccess r,
- Member ConversationStore r,
- Member (Error FederationError) r,
- Member (Error InternalError) r,
+ ( Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
- Member ExternalAccess r,
- Member NotificationSubsystem r,
Member ConversationSubsystem r,
- Member Now r,
- Member ProposalStore r,
- Member P.TinyLog r,
- Member Random r,
- Member TeamStore r,
- Member TeamSubsystem r,
- Member (Input ConversationSubsystemConfig) r
+ Member TeamSubsystem r
) =>
Local UserId ->
UserLegalHoldStatus ->
@@ -735,7 +639,7 @@ handleGroupConvPolicyConflicts luid hypotheticalLHStatus = do
membersAndLHStatus :: [(LocalMember, UserLegalHoldStatus)] <- do
let mems = conv.localMembers
- uidsLHStatus <- getLHStatusForUsers ((.id_) <$> mems)
+ uidsLHStatus <- TeamSubsystem.getLHStatusForUsers ((.id_) <$> mems)
pure $
zipWith
( \mem (mid, status) ->
@@ -756,10 +660,10 @@ handleGroupConvPolicyConflicts luid hypotheticalLHStatus = do
(InternalErrorWithDescription "conversation disappeared while iterating on a list of conversations")
. mapErrorS @('ActionDenied 'LeaveConversation) @('ActionDenied 'RemoveConversationMember)
$ if any
- ((== ConsentGiven) . consentGiven . snd)
+ ((== TeamSubsystem.ConsentGiven) . TeamSubsystem.consentGiven . snd)
(filter ((== roleNameWireAdmin) . (.convRoleName) . fst) membersAndLHStatus)
then do
- for_ (filter ((== ConsentNotGiven) . consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do
+ for_ (filter ((== TeamSubsystem.ConsentNotGiven) . TeamSubsystem.consentGiven . snd) membersAndLHStatus) $ \(memberNoConsent, _) -> do
let lusr = qualifyAs luid memberNoConsent.id_
removeMemberFromLocalConv lcnv lusr Nothing (tUntagged lusr)
else do
diff --git a/services/galley/src/Galley/API/LegalHold/Get.hs b/services/galley/src/Galley/API/LegalHold/Get.hs
deleted file mode 100644
index bc3c036beb..0000000000
--- a/services/galley/src/Galley/API/LegalHold/Get.hs
+++ /dev/null
@@ -1,78 +0,0 @@
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2022 Wire Swiss GmbH
---
--- This program is free software: you can redistribute it and/or modify it under
--- the terms of the GNU Affero General Public License as published by the Free
--- Software Foundation, either version 3 of the License, or (at your option) any
--- later version.
---
--- This program is distributed in the hope that it will be useful, but WITHOUT
--- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
--- details.
---
--- You should have received a copy of the GNU Affero General Public License along
--- with this program. If not, see .
-
-module Galley.API.LegalHold.Get (getUserStatus) where
-
-import Control.Lens (view)
-import Data.ByteString.Conversion (toByteString')
-import Data.Id
-import Data.LegalHold (UserLegalHoldStatus (..))
-import Data.Qualified
-import Galley.Types.Error
-import Imports
-import Polysemy
-import Polysemy.Error
-import Polysemy.TinyLog qualified as P
-import System.Logger.Class qualified as Log
-import Wire.API.Error
-import Wire.API.Error.Galley
-import Wire.API.Team.LegalHold
-import Wire.API.Team.LegalHold qualified as Public
-import Wire.API.Team.Member
-import Wire.API.User.Client.Prekey
-import Wire.LegalHoldStore qualified as LegalHoldData
-import Wire.TeamSubsystem (TeamSubsystem)
-import Wire.TeamSubsystem qualified as TeamSubsystem
-
--- | Learn whether a user has LH enabled and fetch pre-keys.
--- Note that this is accessible to ANY authenticated user, even ones outside the team
-getUserStatus ::
- forall r.
- ( Member (Error InternalError) r,
- Member (ErrorS 'TeamMemberNotFound) r,
- Member LegalHoldData.LegalHoldStore r,
- Member P.TinyLog r,
- Member TeamSubsystem r
- ) =>
- Local UserId ->
- TeamId ->
- UserId ->
- Sem r Public.UserLegalHoldStatusResponse
-getUserStatus _lzusr tid uid = do
- teamMember <- noteS @'TeamMemberNotFound =<< TeamSubsystem.internalGetTeamMember uid tid
- let status = view legalHoldStatus teamMember
- (mlk, lcid) <- case status of
- UserLegalHoldNoConsent -> pure (Nothing, Nothing)
- UserLegalHoldDisabled -> pure (Nothing, Nothing)
- UserLegalHoldPending -> makeResponseDetails
- UserLegalHoldEnabled -> makeResponseDetails
- pure $ UserLegalHoldStatusResponse status mlk lcid
- where
- makeResponseDetails :: Sem r (Maybe LastPrekey, Maybe ClientId)
- makeResponseDetails = do
- mLastKey <- fmap snd <$> LegalHoldData.selectPendingPrekeys uid
- lastKey <- case mLastKey of
- Nothing -> do
- P.err
- . Log.msg
- $ "expected to find a prekey for user: "
- <> toByteString' uid
- <> " but none was found"
- throw NoPrekeyForUser
- Just lstKey -> pure lstKey
- let clientId = clientIdFromPrekey . unpackLastPrekey $ lastKey
- pure (Just lastKey, Just clientId)
diff --git a/services/galley/src/Galley/API/LegalHold/Team.hs b/services/galley/src/Galley/API/LegalHold/Team.hs
index c7f511d449..632dff0658 100644
--- a/services/galley/src/Galley/API/LegalHold/Team.hs
+++ b/services/galley/src/Galley/API/LegalHold/Team.hs
@@ -21,19 +21,25 @@ module Galley.API.LegalHold.Team
assertLegalHoldEnabledForTeam,
ensureNotTooLargeToActivateLegalHold,
teamSizeBelowLimit,
+ ensureReAuthorised,
)
where
+import Data.Code qualified as Code
import Data.Id
+import Data.Misc (PlainTextPassword6)
import Data.Range
import Imports
import Polysemy
+import Polysemy.Error
import Polysemy.Input (Input, input)
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Team.Feature
import Wire.API.Team.FeatureFlags as Team (FanoutLimit, FeatureDefaults (..))
import Wire.API.Team.Size
+import Wire.API.User (VerificationAction)
+import Wire.API.User.Auth.ReAuth
import Wire.BrigAPIAccess
import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getDbFeatureRawInternal)
import Wire.LegalHold
@@ -94,3 +100,15 @@ teamSizeBelowLimit teamSize = do
FeatureLegalHoldWhitelistTeamsAndImplicitConsent ->
-- unlimited, see docs of 'ensureNotTooLargeForLegalHold'
pure True
+
+ensureReAuthorised ::
+ ( Member BrigAPIAccess r,
+ Member (Error AuthenticationError) r
+ ) =>
+ UserId ->
+ Maybe PlainTextPassword6 ->
+ Maybe Code.Value ->
+ Maybe VerificationAction ->
+ Sem r ()
+ensureReAuthorised u secret mbAction mbCode =
+ reauthUser u (ReAuthUser secret mbAction mbCode) >>= fromEither
diff --git a/services/galley/src/Galley/API/Mapping.hs b/services/galley/src/Galley/API/Mapping.hs
deleted file mode 100644
index 3837b9e623..0000000000
--- a/services/galley/src/Galley/API/Mapping.hs
+++ /dev/null
@@ -1,163 +0,0 @@
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2022 Wire Swiss GmbH
---
--- This program is free software: you can redistribute it and/or modify it under
--- the terms of the GNU Affero General Public License as published by the Free
--- Software Foundation, either version 3 of the License, or (at your option) any
--- later version.
---
--- This program is distributed in the hope that it will be useful, but WITHOUT
--- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
--- details.
---
--- You should have received a copy of the GNU Affero General Public License along
--- with this program. If not, see .
-
-module Galley.API.Mapping
- ( conversationViewV9,
- conversationView,
- conversationViewWithCachedOthers,
- remoteConversationView,
- conversationToRemote,
- )
-where
-
-import Data.Domain (Domain)
-import Data.Id (UserId, idToText)
-import Data.Qualified
-import Galley.Types.Error (InternalError (BadMemberState))
-import Imports
-import Polysemy
-import Polysemy.Error
-import Polysemy.TinyLog qualified as P
-import System.Logger.Message (msg, val, (+++))
-import Wire.API.Conversation hiding (Member)
-import Wire.API.Federation.API.Galley
-import Wire.ConversationSubsystem.Util (localMemberToPublic)
-import Wire.StoredConversation
-
--- | View for a given user of a stored conversation.
---
--- Throws @BadMemberState@ when the user is not part of the conversation.
-conversationViewV9 ::
- ( Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- Local UserId ->
- StoredConversation ->
- Sem r OwnConversation
-conversationViewV9 luid conv = do
- let remoteOthers = map remoteMemberToOther $ conv.remoteMembers
- localOthers = map (localMemberToOther (tDomain luid)) $ conv.localMembers
- conversationViewWithCachedOthers remoteOthers localOthers conv luid
-
-conversationView ::
- Local x ->
- Maybe (Local UserId) ->
- StoredConversation ->
- Conversation
-conversationView l luid conv =
- let remoteMembers = map remoteMemberToOther $ conv.remoteMembers
- localMembers = map (localMemberToOther (tDomain l)) $ conv.localMembers
- selfs = filter (\m -> fmap tUnqualified luid == Just m.id_) (conv.localMembers)
- mSelf = localMemberToPublic l <$> listToMaybe selfs
- others = filter (\oth -> (tUntagged <$> luid) /= Just (omQualifiedId oth)) localMembers <> remoteMembers
- in Conversation
- { members = ConvMembers mSelf others,
- qualifiedId = (tUntagged . qualifyAs l $ conv.id_),
- metadata = conv.metadata,
- protocol = conv.protocol
- }
-
--- | Like 'conversationView' but optimized for situations which could benefit
--- from pre-computing the list of @OtherMember@s in the conversation. For
--- instance, creating @ConversationView@ for more than 1 member of the same conversation.
-conversationViewWithCachedOthers ::
- ( Member (Error InternalError) r,
- Member P.TinyLog r
- ) =>
- [OtherMember] ->
- [OtherMember] ->
- StoredConversation ->
- Local UserId ->
- Sem r OwnConversation
-conversationViewWithCachedOthers remoteOthers localOthers conv luid = do
- let mbConv = conversationViewMaybe luid remoteOthers localOthers conv
- maybe memberNotFound pure mbConv
- where
- memberNotFound = do
- P.err . msg $
- val "User "
- +++ idToText (tUnqualified luid)
- +++ val " is not a member of conv "
- +++ idToText conv.id_
- throw BadMemberState
-
--- | View for a given user of a stored conversation.
---
--- Returns 'Nothing' if the user is not part of the conversation.
-conversationViewMaybe :: Local UserId -> [OtherMember] -> [OtherMember] -> StoredConversation -> Maybe OwnConversation
-conversationViewMaybe luid remoteOthers localOthers conv = do
- let selfs = filter (\m -> tUnqualified luid == m.id_) conv.localMembers
- self <- localMemberToPublic luid <$> listToMaybe selfs
- let others = filter (\oth -> tUntagged luid /= omQualifiedId oth) localOthers <> remoteOthers
- pure $
- OwnConversation
- (tUntagged . qualifyAs luid $ conv.id_)
- conv.metadata
- (OwnConvMembers self others)
- conv.protocol
-
--- | View for a local user of a remote conversation.
-remoteConversationView ::
- Local UserId ->
- MemberStatus ->
- Remote RemoteConversationV2 ->
- OwnConversation
-remoteConversationView uid status (tUntagged -> Qualified rconv rDomain) =
- let mems = rconv.members
- others = mems.others
- self =
- localMemberToPublic
- uid
- LocalMember
- { id_ = tUnqualified uid,
- service = Nothing,
- status = status,
- convRoleName = mems.selfRole
- }
- in OwnConversation
- (Qualified rconv.id rDomain)
- rconv.metadata
- (OwnConvMembers self others)
- rconv.protocol
-
--- | Convert a local conversation to a structure to be returned to a remote
--- backend.
---
--- This returns 'Nothing' if the given remote user is not part of the conversation.
-conversationToRemote ::
- Domain ->
- Remote UserId ->
- StoredConversation ->
- Maybe RemoteConversationV2
-conversationToRemote localDomain ruid conv = do
- let (selfs, rothers) = partition (\r -> r.id_ == ruid) (conv.remoteMembers)
- lothers = conv.localMembers
- selfRole' <- (.convRoleName) <$> listToMaybe selfs
- let others' =
- map (localMemberToOther localDomain) lothers
- <> map remoteMemberToOther rothers
- pure $
- RemoteConversationV2
- { id = conv.id_,
- metadata = conv.metadata,
- members =
- RemoteConvMembers
- { selfRole = selfRole',
- others = others'
- },
- protocol = conv.protocol
- }
diff --git a/services/galley/src/Galley/API/Public/Bot.hs b/services/galley/src/Galley/API/Public/Bot.hs
index ecb4f18eb3..ff47adc625 100644
--- a/services/galley/src/Galley/API/Public/Bot.hs
+++ b/services/galley/src/Galley/API/Public/Bot.hs
@@ -18,42 +18,28 @@
module Galley.API.Public.Bot where
import Data.Id
-import Data.Qualified
-import Galley.API.Query qualified as Query
-import Galley.API.Teams.Features qualified as Features
-import Galley.API.Update
import Galley.App
import Polysemy
-import Polysemy.Input
-import Wire.API.Error
-import Wire.API.Error.Galley
import Wire.API.Event.Team qualified as Public ()
import Wire.API.Provider.Bot
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Bot
-import Wire.ConversationStore (ConversationStore)
-import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem)
-import Wire.TeamStore (TeamStore)
-import Wire.TeamSubsystem (TeamSubsystem)
+import Wire.ConversationSubsystem
+import Wire.FeaturesConfigSubsystem
botAPI :: API BotAPI GalleyEffects
botAPI =
mkNamedAPI @"post-bot-message-unqualified" postBotMessageUnqualified
- <@> mkNamedAPI @"get-bot-conversation" getBotConversation
+ <@> mkNamedAPI @"get-bot-conversation" getBotConversationH
-getBotConversation ::
+getBotConversationH ::
forall r.
- ( Member ConversationStore r,
- Member (Input (Local ())) r,
- Member (ErrorS 'AccessDenied) r,
- Member (ErrorS 'ConvNotFound) r,
- Member TeamStore r,
- Member TeamSubsystem r,
+ ( Member ConversationSubsystem r,
Member FeaturesConfigSubsystem r
) =>
BotId ->
ConvId ->
Sem r BotConvView
-getBotConversation bid cnv = do
- Features.guardSecondFactorDisabled (botUserId bid) cnv
- Query.getBotConversation bid cnv
+getBotConversationH bid cnv = do
+ guardSecondFactorDisabled (botUserId bid) cnv
+ getBotConversation bid cnv
diff --git a/services/galley/src/Galley/API/Public/Conversation.hs b/services/galley/src/Galley/API/Public/Conversation.hs
index cbab0c5663..23598b787c 100644
--- a/services/galley/src/Galley/API/Public/Conversation.hs
+++ b/services/galley/src/Galley/API/Public/Conversation.hs
@@ -17,16 +17,14 @@
module Galley.API.Public.Conversation where
-import Galley.API.Create
-import Galley.API.MLS.GroupInfo
-import Galley.API.MLS.SubConversation
-import Galley.API.Query
-import Galley.API.Update
+import Data.Qualified
import Galley.App
import Imports
+import Wire.API.Conversation
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Conversation
import Wire.ConversationStore.MLS.Types
+import Wire.ConversationSubsystem
conversationAPI :: API ConversationAPI GalleyEffects
conversationAPI =
@@ -39,16 +37,16 @@ conversationAPI =
<@> mkNamedAPI @"get-conversation-roles" getConversationRoles
<@> mkNamedAPI @"get-group-info" getGroupInfo
<@> mkNamedAPI @"list-conversation-ids-unqualified" conversationIdsPageFromUnqualified
- <@> mkNamedAPI @"list-conversation-ids-v2" (conversationIdsPageFromV2 DoNotListGlobalSelf)
+ <@> mkNamedAPI @"list-conversation-ids-v2" (conversationIdsPaginated DoNotListGlobalSelf)
<@> mkNamedAPI @"list-conversation-ids" conversationIdsPageFrom
- <@> mkNamedAPI @"get-conversations" getConversations
+ <@> mkNamedAPI @"get-conversations" getPaginatedConversations
<@> mkNamedAPI @"list-conversations@v1" listConversations
<@> mkNamedAPI @"list-conversations@v2" listConversations
<@> mkNamedAPI @"list-conversations@v5" listConversations
<@> mkNamedAPI @"list-conversations" listConversations
<@> mkNamedAPI @"get-conversation-by-reusable-code" getConversationByReusableCode
- <@> mkNamedAPI @"create-group-conversation@v2" createGroupConversationUpToV3
- <@> mkNamedAPI @"create-group-conversation@v3" createGroupConversationUpToV3
+ <@> mkNamedAPI @"create-group-conversation@v2" createLegacyGroupConversation
+ <@> mkNamedAPI @"create-group-conversation@v3" createLegacyGroupConversation
<@> mkNamedAPI @"create-group-conversation@v5" createGroupOwnConversation
<@> mkNamedAPI @"create-group-conversation@v9" createGroupOwnConversation
<@> mkNamedAPI @"create-group-conversation" createGroupConversation
@@ -64,40 +62,40 @@ conversationAPI =
<@> mkNamedAPI @"create-one-to-one-conversation@v2" createOne2OneConversation
<@> mkNamedAPI @"create-one-to-one-conversation@v6" createOne2OneConversation
<@> mkNamedAPI @"create-one-to-one-conversation" createOne2OneConversation
- <@> mkNamedAPI @"get-one-to-one-mls-conversation@v5" getMLSOne2OneConversationV5
- <@> mkNamedAPI @"get-one-to-one-mls-conversation@v6" getMLSOne2OneConversationV6
+ <@> mkNamedAPI @"get-one-to-one-mls-conversation@v5" getMLSOne2OneOwnConversation
+ <@> mkNamedAPI @"get-one-to-one-mls-conversation@v6" getMLSOne2OneMLSConversation
<@> mkNamedAPI @"get-one-to-one-mls-conversation" getMLSOne2OneConversation
- <@> mkNamedAPI @"add-members-to-conversation-unqualified" addMembersUnqualified
- <@> mkNamedAPI @"add-members-to-conversation-unqualified2" addMembersUnqualifiedV2
+ <@> mkNamedAPI @"add-members-to-conversation-unqualified" (\lusr con cnv invite -> addMembers lusr con (tUntagged (qualifyAs lusr cnv)) (InviteQualified (fmap (tUntagged . qualifyAs lusr) (invUsers invite)) (invRoleName invite)))
+ <@> mkNamedAPI @"add-members-to-conversation-unqualified2" addQualifiedMembersUnqualified
<@> mkNamedAPI @"add-members-to-conversation" addMembers
<@> mkNamedAPI @"replace-members-in-conversation" replaceMembers
<@> mkNamedAPI @"join-conversation-by-id-unqualified" joinConversationById
<@> mkNamedAPI @"join-conversation-by-code-unqualified" joinConversationByReusableCode
<@> mkNamedAPI @"code-check" checkReusableCode
<@> mkNamedAPI @"create-conversation-code-unqualified@v3" (addCodeUnqualified Nothing)
- <@> mkNamedAPI @"create-conversation-code-unqualified" addCodeUnqualifiedWithReqBody
+ <@> mkNamedAPI @"create-conversation-code-unqualified" (\uid zhost conn conv req -> addCodeUnqualified (Just req) uid zhost conn conv)
<@> mkNamedAPI @"get-conversation-guest-links-status" getConversationGuestLinksStatus
<@> mkNamedAPI @"remove-code-unqualified" rmCodeUnqualified
<@> mkNamedAPI @"get-code" getCode
- <@> mkNamedAPI @"member-typing-unqualified" memberTypingUnqualified
+ <@> mkNamedAPI @"member-typing-unqualified" (\lusr con cnv status -> memberTyping lusr con (tUntagged (qualifyAs lusr cnv)) status)
<@> mkNamedAPI @"member-typing-qualified" memberTyping
- <@> mkNamedAPI @"remove-member-unqualified" removeMemberUnqualified
+ <@> mkNamedAPI @"remove-member-unqualified" (\lusr con cnv victim -> removeMemberQualified lusr con (tUntagged (qualifyAs lusr cnv)) (tUntagged (qualifyAs lusr victim)))
<@> mkNamedAPI @"remove-member" removeMemberQualified
- <@> mkNamedAPI @"update-other-member-unqualified" updateOtherMemberUnqualified
+ <@> mkNamedAPI @"update-other-member-unqualified" (\lusr con cnv victim update -> updateOtherMember lusr con (tUntagged (qualifyAs lusr cnv)) (tUntagged (qualifyAs lusr victim)) update)
<@> mkNamedAPI @"update-other-member" updateOtherMember
- <@> mkNamedAPI @"update-conversation-name-deprecated" updateUnqualifiedConversationName
- <@> mkNamedAPI @"update-conversation-name-unqualified" updateUnqualifiedConversationName
+ <@> mkNamedAPI @"update-conversation-name-deprecated" (\lusr con cnv rename -> updateConversationName lusr con (tUntagged (qualifyAs lusr cnv)) rename)
+ <@> mkNamedAPI @"update-conversation-name-unqualified" (\lusr con cnv rename -> updateConversationName lusr con (tUntagged (qualifyAs lusr cnv)) rename)
<@> mkNamedAPI @"update-conversation-name" updateConversationName
- <@> mkNamedAPI @"update-conversation-message-timer-unqualified" updateConversationMessageTimerUnqualified
+ <@> mkNamedAPI @"update-conversation-message-timer-unqualified" (\lusr con cnv update -> updateConversationMessageTimer lusr con (tUntagged (qualifyAs lusr cnv)) update)
<@> mkNamedAPI @"update-conversation-message-timer" updateConversationMessageTimer
- <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" updateConversationReceiptModeUnqualified
+ <@> mkNamedAPI @"update-conversation-receipt-mode-unqualified" (\lusr con cnv update -> updateConversationReceiptMode lusr con (tUntagged (qualifyAs lusr cnv)) update)
<@> mkNamedAPI @"update-conversation-receipt-mode" updateConversationReceiptMode
- <@> mkNamedAPI @"update-conversation-access-unqualified" updateConversationAccessUnqualified
+ <@> mkNamedAPI @"update-conversation-access-unqualified" (\lusr con cnv update -> updateConversationAccess lusr con (tUntagged (qualifyAs lusr cnv)) update)
<@> mkNamedAPI @"update-conversation-access@v2" updateConversationAccess
<@> mkNamedAPI @"update-conversation-access" updateConversationAccess
<@> mkNamedAPI @"update-conversation-history" updateConversationHistory
<@> mkNamedAPI @"get-conversation-self-unqualified" getLocalSelf
- <@> mkNamedAPI @"update-conversation-self-unqualified" updateUnqualifiedSelfMember
+ <@> mkNamedAPI @"update-conversation-self-unqualified" (\lusr con cnv update -> updateSelfMember lusr con (tUntagged (qualifyAs lusr cnv)) update)
<@> mkNamedAPI @"get-conversation-self" getSelfMember
<@> mkNamedAPI @"update-conversation-self" updateSelfMember
<@> mkNamedAPI @"update-conversation-protocol" updateConversationProtocolWithLocalUser
diff --git a/services/galley/src/Galley/API/Public/Feature.hs b/services/galley/src/Galley/API/Public/Feature.hs
index 0c55a19471..6fea67c590 100644
--- a/services/galley/src/Galley/API/Public/Feature.hs
+++ b/services/galley/src/Galley/API/Public/Feature.hs
@@ -20,16 +20,16 @@
module Galley.API.Public.Feature where
+import Data.Proxy (Proxy (..))
import Galley.API.Teams
import Galley.API.Teams.Features
-import Galley.API.Teams.Features.Get
import Galley.App
import Imports
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Feature
import Wire.API.Routes.Version
import Wire.API.Team.Feature
-import Wire.FeaturesConfigSubsystem (getAllTeamFeaturesForTeamMember)
+import Wire.FeaturesConfigSubsystem
featureAPIGetPut :: forall cfg r. (_) => API (FeatureAPIGetPut cfg) r
featureAPIGetPut =
@@ -42,7 +42,7 @@ featureAPI =
<@> featureAPIGetPut
<@> featureAPIGetPut
<@> mkNamedAPI @"get-search-visibility" getSearchVisibility
- <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam @SearchVisibilityAvailableConfig))
+ <@> mkNamedAPI @"set-search-visibility" (setSearchVisibility (featureEnabledForTeam (Proxy @SearchVisibilityAvailableConfig)))
<@> mkNamedAPI @'("get", RequireExternalEmailVerificationConfig) getFeature
<@> mkNamedAPI @'("get", DigitalSignaturesConfig) getFeature
<@> featureAPIGetPut
diff --git a/services/galley/src/Galley/API/Public/LegalHold.hs b/services/galley/src/Galley/API/Public/LegalHold.hs
index 04afca327f..33a5eeb8bb 100644
--- a/services/galley/src/Galley/API/Public/LegalHold.hs
+++ b/services/galley/src/Galley/API/Public/LegalHold.hs
@@ -21,6 +21,7 @@ import Galley.API.LegalHold
import Galley.App
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.LegalHold
+import Wire.TeamSubsystem (getUserStatus)
legalHoldAPI :: API LegalHoldAPI GalleyEffects
legalHoldAPI =
diff --git a/services/galley/src/Galley/API/Public/MLS.hs b/services/galley/src/Galley/API/Public/MLS.hs
index 687d9e4827..dafde053b8 100644
--- a/services/galley/src/Galley/API/Public/MLS.hs
+++ b/services/galley/src/Galley/API/Public/MLS.hs
@@ -17,12 +17,11 @@
module Galley.API.Public.MLS where
-import Galley.API.MLS
-import Galley.API.MLS.Reset
import Galley.App
import Imports
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.MLS
+import Wire.ConversationSubsystem
mlsAPI :: API MLSAPI GalleyEffects
mlsAPI =
diff --git a/services/galley/src/Galley/API/Public/Messaging.hs b/services/galley/src/Galley/API/Public/Messaging.hs
index 806484ae90..e96a78dd19 100644
--- a/services/galley/src/Galley/API/Public/Messaging.hs
+++ b/services/galley/src/Galley/API/Public/Messaging.hs
@@ -17,10 +17,10 @@
module Galley.API.Public.Messaging where
-import Galley.API.Update
import Galley.App
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Messaging
+import Wire.ConversationSubsystem
messagingAPI :: API MessagingAPI GalleyEffects
messagingAPI =
diff --git a/services/galley/src/Galley/API/Public/Team.hs b/services/galley/src/Galley/API/Public/Team.hs
index 7b8575c0e1..db27f6a176 100644
--- a/services/galley/src/Galley/API/Public/Team.hs
+++ b/services/galley/src/Galley/API/Public/Team.hs
@@ -17,11 +17,11 @@
module Galley.API.Public.Team where
-import Galley.API.Query
import Galley.API.Teams
import Galley.App
import Wire.API.Routes.API
import Wire.API.Routes.Public.Galley.Team
+import Wire.ConversationSubsystem
teamAPI :: API TeamAPI GalleyEffects
teamAPI =
diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
index fbf7ed1b74..726a465125 100644
--- a/services/galley/src/Galley/API/Teams.hs
+++ b/services/galley/src/Galley/API/Teams.hs
@@ -73,13 +73,9 @@ import Data.Proxy
import Data.Qualified
import Data.Range as Range
import Data.Set qualified as Set
-import Data.Singletons
import Data.Time.Clock (UTCTime)
-import Galley.API.Action
import Galley.API.LegalHold.Team
-import Galley.API.Teams.Features.Get
import Galley.API.Teams.Notifications qualified as APITeamQueue
-import Galley.API.Update qualified as API
import Galley.App
import Galley.Effects.Queue qualified as E
import Galley.Types.Error as Galley
@@ -91,13 +87,13 @@ import Polysemy.TinyLog qualified as P
import System.Logger qualified as Log
import Wire.API.Conversation (ConvType (..), ConversationRemoveMembers (..))
import Wire.API.Conversation qualified
+import Wire.API.Conversation.Action (SConversationActionTag (SConversationRemoveMembersTag))
import Wire.API.Conversation.Role (wireConvRoles)
import Wire.API.Conversation.Role qualified as Public
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Event.LeaveReason
import Wire.API.Event.Team
-import Wire.API.Federation.Error
import Wire.API.Push.V2 (RecipientClients (RecipientClientsAll))
import Wire.API.Routes.Internal.Galley.TeamsIntra
import Wire.API.Routes.MultiTablePaging (MultiTablePage (..), MultiTablePagingState (..))
@@ -122,18 +118,15 @@ import Wire.API.User qualified as U
import Wire.BrigAPIAccess
import Wire.BrigAPIAccess qualified as Brig
import Wire.BrigAPIAccess qualified as E
-import Wire.CodeStore
import Wire.ConversationStore (ConversationStore)
import Wire.ConversationStore qualified as E
import Wire.ConversationSubsystem
-import Wire.ConversationSubsystem.Util
import Wire.FeaturesConfigSubsystem
import Wire.LegalHoldStore (LegalHoldStore)
import Wire.ListItems
import Wire.ListItems qualified as E
import Wire.NotificationSubsystem
-import Wire.Options.Galley
-import Wire.ProposalStore (ProposalStore)
+import Wire.Options.Galley (Opts, maxTeamSize, settings)
import Wire.Sem.Now
import Wire.Sem.Now qualified as Now
import Wire.Sem.Paging.Cassandra
@@ -152,7 +145,11 @@ import Wire.Util
getTeamH ::
forall r.
- (Member (ErrorS 'TeamNotFound) r, Member (E.Queue DeleteItem) r, Member TeamStore r, Member TeamSubsystem r) =>
+ ( Member (ErrorS 'TeamNotFound) r,
+ Member (E.Queue DeleteItem) r,
+ Member TeamStore r,
+ Member TeamSubsystem r
+ ) =>
UserId ->
TeamId ->
Sem r Public.Team
@@ -262,11 +259,11 @@ createBindingTeam tid zusr body = do
updateTeamStatus ::
( Member E.BrigAPIAccess r,
- Member (ErrorS 'InvalidTeamStatusUpdate) r,
Member (ErrorS 'TeamNotFound) r,
Member Now r,
Member TeamStore r,
- Member TeamJournal r
+ Member TeamJournal r,
+ Member (ErrorS InvalidTeamStatusUpdate) r
) =>
TeamId ->
TeamStatusUpdate ->
@@ -301,12 +298,12 @@ updateTeamStatus tid (TeamStatusUpdate newStatus cur) = do
(_, _) -> throwS @'InvalidTeamStatusUpdate
updateTeamH ::
- ( Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS ('MissingPermission ('Just 'SetTeamData))) r,
- Member NotificationSubsystem r,
+ ( Member NotificationSubsystem r,
Member Now r,
Member TeamStore r,
- Member TeamSubsystem r
+ Member TeamSubsystem r,
+ Member (ErrorS (MissingPermission (Just SetTeamData))) r,
+ Member (ErrorS NotATeamMember) r
) =>
UserId ->
ConnId ->
@@ -315,7 +312,7 @@ updateTeamH ::
Sem r ()
updateTeamH zusr zcon tid updateData = do
zusrMembership <- TeamSubsystem.internalGetTeamMember zusr tid
- void $ permissionCheckS SSetTeamData zusrMembership
+ void $ TeamSubsystem.permissionCheckS SSetTeamData zusrMembership
E.setTeamData tid updateData
now <- Now.get
admins <- E.getTeamAdmins tid
@@ -333,15 +330,15 @@ updateTeamH zusr zcon tid updateData = do
deleteTeam ::
forall r.
- ( Member E.BrigAPIAccess r,
- Member (Error AuthenticationError) r,
- Member (ErrorS 'DeleteQueueFull) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
+ ( Member (ErrorS 'DeleteQueueFull) r,
Member (ErrorS 'TeamNotFound) r,
+ Member (ErrorS OperationDenied) r,
+ Member (Error AuthenticationError) r,
Member (E.Queue DeleteItem) r,
+ Member (ErrorS NotATeamMember) r,
Member TeamStore r,
- Member TeamSubsystem r
+ Member TeamSubsystem r,
+ Member E.BrigAPIAccess r
) =>
UserId ->
ConnId ->
@@ -359,7 +356,7 @@ deleteTeam zusr zcon tid body = do
queueTeamDeletion tid zusr (Just zcon)
where
checkPermissions team = do
- void $ permissionCheck DeleteTeam =<< TeamSubsystem.internalGetTeamMember zusr tid
+ void $ TeamSubsystem.permissionCheck DeleteTeam =<< TeamSubsystem.internalGetTeamMember zusr tid
when (tdTeam team ^. teamBinding == Binding) $ do
ensureReAuthorised zusr (body ^. tdAuthPassword) (body ^. tdVerificationCode) (Just U.DeleteTeam)
@@ -518,14 +515,14 @@ addTeamMember ::
Member NotificationSubsystem r,
Member (ErrorS 'InvalidPermissions) r,
Member (ErrorS 'NoAddToBinding) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS 'NotConnected) r,
- Member (ErrorS OperationDenied) r,
Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'TooManyTeamMembers) r,
Member (ErrorS 'TooManyTeamAdmins) r,
Member (ErrorS 'UserBindingExists) r,
Member (ErrorS 'TooManyTeamMembersOnTeamWithLegalhold) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
+ Member (ErrorS 'NotConnected) r,
Member (Input Opts) r,
Member Now r,
Member LegalHoldStore r,
@@ -551,12 +548,12 @@ addTeamMember lzusr zcon tid nmem = do
-- verify permissions
zusrMembership <-
TeamSubsystem.internalGetTeamMember zusr tid
- >>= permissionCheck AddTeamMember
+ >>= TeamSubsystem.permissionCheck AddTeamMember
let targetPermissions = nmem ^. nPermissions
targetPermissions `ensureNotElevated` zusrMembership
ensureNonBindingTeam tid
ensureUnboundUsers [uid]
- ensureConnectedToLocals zusr [uid]
+ E.ensureConnectedToLocals zusr [uid]
(TeamSize sizeBeforeJoin) <- E.getSize tid
ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
void $ addTeamMemberInternal tid (Just zusr) (Just zcon) nmem
@@ -655,8 +652,8 @@ updateTeamMember ::
Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'TooManyTeamAdmins) r,
- Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member NotificationSubsystem r,
Member Now r,
Member P.TinyLog r,
@@ -681,7 +678,7 @@ updateTeamMember lzusr zcon tid newMem = do
-- get the team and verify permissions
user <-
TeamSubsystem.internalGetTeamMember zusr tid
- >>= permissionCheck SetMemberPermissions
+ >>= TeamSubsystem.permissionCheck SetMemberPermissions
-- user may not elevate permissions
targetPermissions `ensureNotElevated` user
@@ -705,22 +702,21 @@ updateTeamMember lzusr zcon tid newMem = do
deleteTeamMember ::
( Member E.BrigAPIAccess r,
Member ConversationStore r,
- Member (Error AuthenticationError) r,
Member (Error InvalidInput) r,
Member (ErrorS 'AccessDenied) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
- Member Now r,
- Member NotificationSubsystem r,
+ Member (Error AuthenticationError) r,
Member ConversationSubsystem r,
+ Member TeamSubsystem r,
+ Member NotificationSubsystem r,
Member FeaturesConfigSubsystem r,
Member TeamStore r,
Member P.TinyLog r,
- Member (Input FanoutLimit) r,
Member TeamJournal r,
- Member TeamSubsystem r
+ Member Now r
) =>
Local UserId ->
ConnId ->
@@ -733,22 +729,21 @@ deleteTeamMember lusr zcon tid remove body = deleteTeamMember' lusr zcon tid rem
deleteNonBindingTeamMember ::
( Member E.BrigAPIAccess r,
Member ConversationStore r,
- Member (Error AuthenticationError) r,
Member (Error InvalidInput) r,
Member (ErrorS 'AccessDenied) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
- Member Now r,
- Member NotificationSubsystem r,
+ Member (Error AuthenticationError) r,
Member ConversationSubsystem r,
+ Member TeamSubsystem r,
+ Member NotificationSubsystem r,
Member FeaturesConfigSubsystem r,
Member TeamStore r,
Member P.TinyLog r,
- Member (Input FanoutLimit) r,
Member TeamJournal r,
- Member TeamSubsystem r
+ Member Now r
) =>
Local UserId ->
ConnId ->
@@ -761,22 +756,21 @@ deleteNonBindingTeamMember lusr zcon tid remove = deleteTeamMember' lusr zcon ti
deleteTeamMember' ::
( Member E.BrigAPIAccess r,
Member ConversationStore r,
- Member (Error AuthenticationError) r,
Member (Error InvalidInput) r,
Member (ErrorS 'AccessDenied) r,
Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
- Member Now r,
- Member NotificationSubsystem r,
+ Member (Error AuthenticationError) r,
Member ConversationSubsystem r,
+ Member NotificationSubsystem r,
Member FeaturesConfigSubsystem r,
Member TeamStore r,
Member P.TinyLog r,
- Member (Input FanoutLimit) r,
Member TeamJournal r,
- Member TeamSubsystem r
+ Member TeamSubsystem r,
+ Member Now r
) =>
Local UserId ->
ConnId ->
@@ -790,7 +784,7 @@ deleteTeamMember' lusr zcon tid remove mBody = do
. Log.field "action" (Log.val "Teams.deleteTeamMember")
zusrMember <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid
targetMember <- TeamSubsystem.internalGetTeamMember remove tid
- void $ permissionCheck RemoveTeamMember zusrMember
+ void $ TeamSubsystem.permissionCheck RemoveTeamMember zusrMember
do
dm <- noteS @'NotATeamMember zusrMember
tm <- noteS @'TeamMemberNotFound targetMember
@@ -820,7 +814,7 @@ deleteTeamMember' lusr zcon tid remove mBody = do
admins <- E.getTeamAdmins tid
uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Left admins)
FeatureStatusDisabled -> do
- mems <- getTeamMembersForFanout tid
+ mems <- TeamSubsystem.getTeamMembersForFanout tid
uncheckedDeleteTeamMember lusr (Just zcon) tid remove (Right mems)
pure TeamMemberDeleteCompleted
@@ -915,7 +909,7 @@ removeFromConvsAndPushConvLeaveEvent lusr zcon tid remove = do
(Set.fromList bots)
void $
sendConversationActionNotifications
- (sing @'ConversationRemoveMembersTag)
+ SConversationRemoveMembersTag
(tUntagged lusr)
True
zcon
@@ -965,17 +959,7 @@ getTeamConversation zusr tid cid = do
pure $ newTeamConversation teamConv
deleteTeamConversation ::
- ( Member CodeStore r,
- Member ConversationStore r,
- Member (Error FederationError) r,
- Member (ErrorS 'ConvNotFound) r,
- Member (ErrorS 'InvalidOperation) r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS ('ActionDenied 'Public.DeleteConversation)) r,
- Member ProposalStore r,
- Member ConversationSubsystem r,
- Member TeamSubsystem r
- ) =>
+ (Member ConversationSubsystem r) =>
Local UserId ->
ConnId ->
TeamId ->
@@ -983,12 +967,12 @@ deleteTeamConversation ::
Sem r ()
deleteTeamConversation lusr zcon _tid cid = do
let lconv = qualifyAs lusr cid
- void $ API.deleteLocalConversation lusr zcon lconv
+ void $ deleteLocalConversation lusr zcon lconv
getSearchVisibility ::
- ( Member (ErrorS 'NotATeamMember) r,
+ ( Member TeamStore r,
Member (ErrorS OperationDenied) r,
- Member TeamStore r,
+ Member (ErrorS 'NotATeamMember) r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -996,15 +980,15 @@ getSearchVisibility ::
Sem r TeamSearchVisibilityView
getSearchVisibility luid tid = do
zusrMembership <- TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid
- void $ permissionCheck ViewTeamSearchVisibility zusrMembership
+ void $ TeamSubsystem.permissionCheck ViewTeamSearchVisibility zusrMembership
getSearchVisibilityInternal tid
setSearchVisibility ::
forall r.
- ( Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
+ ( Member TeamStore r,
Member (ErrorS 'TeamSearchVisibilityNotEnabled) r,
- Member TeamStore r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member TeamSubsystem r
) =>
(TeamId -> Sem r Bool) ->
@@ -1014,7 +998,7 @@ setSearchVisibility ::
Sem r ()
setSearchVisibility availableForTeam luid tid req = do
zusrMembership <- TeamSubsystem.internalGetTeamMember (tUnqualified luid) tid
- void $ permissionCheck ChangeTeamSearchVisibility zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeTeamSearchVisibility zusrMembership
setSearchVisibilityInternal availableForTeam tid req
-- Internal -----------------------------------------------------------------
@@ -1176,14 +1160,13 @@ getBindingTeamMembers ::
( Member (ErrorS 'TeamNotFound) r,
Member (ErrorS 'NonBindingTeam) r,
Member TeamStore r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
UserId ->
Sem r TeamMemberList
getBindingTeamMembers zusr = do
tid <- E.lookupBindingTeam zusr
- getTeamMembersForFanout tid
+ TeamSubsystem.getTeamMembersForFanout tid
-- This could be extended for more checks, for now we test only legalhold
--
@@ -1242,8 +1225,8 @@ userIsTeamOwner ::
( Member (ErrorS 'TeamMemberNotFound) r,
Member (ErrorS 'AccessDenied) r,
Member (ErrorS 'NotATeamMember) r,
- Member (Input (Local ())) r,
- Member TeamSubsystem r
+ Member TeamSubsystem r,
+ Member (Input (Local ())) r
) =>
TeamId ->
UserId ->
@@ -1275,9 +1258,9 @@ checkAdminLimit adminCount =
updateTeamCollaborator ::
forall r.
( Member ConversationStore r,
- Member (ErrorS OperationDenied) r,
- Member (ErrorS NotATeamMember) r,
Member P.TinyLog r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member TeamCollaboratorsSubsystem r,
Member ConversationSubsystem r,
Member TeamSubsystem r
@@ -1292,7 +1275,7 @@ updateTeamCollaborator lusr tid rusr perms = do
Log.field "targets" (toByteString rusr)
. Log.field "action" (Log.val "Teams.updateTeamCollaborator")
zusrMember <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid
- void $ permissionCheck UpdateTeamCollaborator zusrMember
+ void $ TeamSubsystem.permissionCheck UpdateTeamCollaborator zusrMember
when (Set.null $ Set.intersection (Set.fromList [Collaborator.CreateTeamConversation, Collaborator.ImplicitConnection]) perms) $
removeFromConvsAndPushConvLeaveEvent lusr Nothing tid rusr
internalUpdateTeamCollaborator rusr tid perms
@@ -1301,16 +1284,15 @@ updateTeamCollaborator lusr tid rusr perms = do
removeTeamCollaborator ::
forall r.
( Member ConversationStore r,
- Member (ErrorS OperationDenied) r,
- Member (ErrorS NotATeamMember) r,
Member NotificationSubsystem r,
Member ConversationSubsystem r,
Member Now r,
Member P.TinyLog r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member FeaturesConfigSubsystem r,
Member TeamStore r,
Member TeamCollaboratorsSubsystem r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
Local UserId ->
@@ -1322,12 +1304,12 @@ removeTeamCollaborator lusr tid rusr = do
Log.field "targets" (toByteString rusr)
. Log.field "action" (Log.val "Teams.removeTeamCollaborator")
zusrMember <- TeamSubsystem.internalGetTeamMember (tUnqualified lusr) tid
- void $ permissionCheck RemoveTeamCollaborator zusrMember
+ void $ TeamSubsystem.permissionCheck RemoveTeamCollaborator zusrMember
toNotify <-
(getFeatureForTeam @_ @LimitedEventFanoutConfig tid)
>>= ( \case
FeatureStatusEnabled -> Left <$> E.getTeamAdmins tid
- FeatureStatusDisabled -> Right <$> getTeamMembersForFanout tid
+ FeatureStatusDisabled -> Right <$> TeamSubsystem.getTeamMembersForFanout tid
)
. (.status)
uncheckedDeleteTeamMember lusr Nothing tid rusr toNotify
diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs
index c113e394fa..46709503d4 100644
--- a/services/galley/src/Galley/API/Teams/Features.hs
+++ b/services/galley/src/Galley/API/Teams/Features.hs
@@ -22,13 +22,9 @@ module Galley.API.Teams.Features
( setFeature,
setFeatureInternal,
patchFeatureInternal,
- getAllTeamFeaturesForTeam,
- getAllTeamFeaturesForUser,
updateLockStatus,
GetFeatureConfig (..),
SetFeatureConfig (..),
- guardSecondFactorDisabled,
- featureEnabledForTeam,
guardMlsE2EIdConfig,
)
where
@@ -43,7 +39,6 @@ import Data.Kind
import Data.Qualified (Local)
import Galley.API.LegalHold qualified as LegalHold
import Galley.API.LegalHold.Team qualified as LegalHold
-import Galley.API.Teams.Features.Get
import Galley.App
import Galley.Types.Error (InternalError)
import Imports
@@ -59,6 +54,7 @@ import Wire.API.Error.Galley
import Wire.API.Event.FeatureConfig
import Wire.API.Federation.Client (FederatorClient)
import Wire.API.Federation.Error
+import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
import Wire.API.Team.Feature
import Wire.API.Team.FeatureFlags
import Wire.API.Team.Member
@@ -68,10 +64,9 @@ import Wire.BrigAPIAccess (BrigAPIAccess, getAppIdsForTeam, setAccountStatus, up
import Wire.CodeStore
import Wire.ConversationStore (ConversationStore, MLSCommitLockStore)
import Wire.ConversationSubsystem
-import Wire.ConversationSubsystem.Util (assertTeamExists, getTeamMembersForFanout, permissionCheck)
import Wire.ExternalAccess (ExternalAccess)
-import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getDbFeatureRawInternal)
-import Wire.FeaturesConfigSubsystem.Types (GetFeatureConfigEffects)
+import Wire.FeaturesConfigSubsystem (FeaturesConfigSubsystem, getDbFeatureRawInternal, getFeatureForTeam)
+import Wire.FeaturesConfigSubsystem.Types
import Wire.FeaturesConfigSubsystem.Utils (resolveServerFeature)
import Wire.FederationAPIAccess (FederationAPIAccess)
import Wire.FederationSubsystem (FederationSubsystem)
@@ -100,12 +95,9 @@ patchFeatureInternal ::
SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamStore r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r,
GetFeatureConfigEffects r
) =>
@@ -113,7 +105,7 @@ patchFeatureInternal ::
LockableFeaturePatch cfg ->
Sem r (LockableFeature cfg)
patchFeatureInternal tid patch = do
- assertTeamExists tid
+ TeamSubsystem.assertTeamExists tid
dbFeature <- getDbFeatureRawInternal tid
defFeature :: LockableFeature cfg <- resolveServerFeature
let dbFeatureWithDefaults = dbFeature.applyDbFeature defFeature
@@ -138,13 +130,12 @@ setFeature ::
SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS OperationDenied) r,
Member (Error TeamFeatureError) r,
+ Member (ErrorS OperationDenied) r,
+ Member (ErrorS 'NotATeamMember) r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
UserId ->
@@ -153,7 +144,7 @@ setFeature ::
Sem r (LockableFeature cfg)
setFeature uid tid feat = do
zusrMembership <- TeamSubsystem.internalGetTeamMember uid tid
- void $ permissionCheck ChangeTeamFeature zusrMembership
+ void $ TeamSubsystem.permissionCheck ChangeTeamFeature zusrMembership
setFeatureUnchecked tid feat
setFeatureInternal ::
@@ -162,20 +153,17 @@ setFeatureInternal ::
SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
- Member (ErrorS 'TeamNotFound) r,
Member (Error TeamFeatureError) r,
- Member TeamStore r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
TeamId ->
Feature cfg ->
Sem r (LockableFeature cfg)
setFeatureInternal tid feat = do
- assertTeamExists tid
+ TeamSubsystem.assertTeamExists tid
setFeatureUnchecked tid feat
setFeatureUnchecked ::
@@ -188,7 +176,6 @@ setFeatureUnchecked ::
Member TeamFeatureStore r,
Member (P.Logger (Log.Msg -> Log.Msg)) r,
Member NotificationSubsystem r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
TeamId ->
@@ -203,14 +190,13 @@ updateLockStatus ::
forall cfg r.
( IsFeatureConfig cfg,
Member TeamFeatureStore r,
- Member TeamStore r,
- Member (ErrorS 'TeamNotFound) r
+ Member TeamSubsystem r
) =>
TeamId ->
LockStatus ->
Sem r LockStatusResponse
updateLockStatus tid lockStatus = do
- assertTeamExists tid
+ TeamSubsystem.assertTeamExists tid
setFeatureLockStatus @cfg tid lockStatus
pure $ LockStatusResponse lockStatus
@@ -231,15 +217,14 @@ pushFeatureEvent ::
forall cfg r.
( IsFeatureConfig cfg,
Member NotificationSubsystem r,
- Member P.TinyLog r,
- Member (Input FanoutLimit) r,
- Member TeamSubsystem r
+ Member TeamSubsystem r,
+ Member P.TinyLog r
) =>
TeamId ->
Event ->
Sem r ()
pushFeatureEvent tid event = do
- memList <- getTeamMembersForFanout tid
+ memList <- TeamSubsystem.getTeamMembersForFanout tid
if ((memList ^. teamMemberListType) == ListTruncated)
then do
P.warn $
@@ -270,7 +255,6 @@ setFeatureForTeam ::
Member P.TinyLog r,
Member NotificationSubsystem r,
Member TeamFeatureStore r,
- Member (Input FanoutLimit) r,
Member TeamSubsystem r
) =>
TeamId ->
@@ -413,7 +397,7 @@ instance SetFeatureConfig SndFactorPasswordChallengeConfig
instance SetFeatureConfig SearchVisibilityInboundConfig where
type SetFeatureForTeamConstraints SearchVisibilityInboundConfig (r :: EffectRow) = (Member BrigAPIAccess r)
prepareFeature tid feat = do
- updateSearchVisibilityInbound $ toTeamStatus tid feat
+ updateSearchVisibilityInbound $ Multi.TeamStatus tid feat.status
instance SetFeatureConfig MLSConfig where
type
diff --git a/services/galley/src/Galley/API/Teams/Features/Get.hs b/services/galley/src/Galley/API/Teams/Features/Get.hs
deleted file mode 100644
index 231aa5d3c8..0000000000
--- a/services/galley/src/Galley/API/Teams/Features/Get.hs
+++ /dev/null
@@ -1,168 +0,0 @@
-{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
-
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2022 Wire Swiss GmbH
---
--- This program is free software: you can redistribute it and/or modify it under
--- the terms of the GNU Affero General Public License as published by the Free
--- Software Foundation, either version 3 of the License, or (at your option) any
--- later version.
---
--- This program is distributed in the hope that it will be useful, but WITHOUT
--- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
--- details.
---
--- You should have received a copy of the GNU Affero General Public License along
--- with this program. If not, see .
-
-module Galley.API.Teams.Features.Get
- ( getFeature,
- getFeatureInternal,
- getAllTeamFeaturesForServer,
- getAllTeamFeaturesForTeam,
- getAllTeamFeaturesForUser,
- getSingleFeatureForUser,
- GetFeatureConfig (..),
- getFeatureForTeam,
- guardSecondFactorDisabled,
- DoAuth (..),
- featureEnabledForTeam,
- toTeamStatus,
- )
-where
-
-import Control.Error (hush)
-import Data.Id
-import Data.SOP
-import Data.Tagged
-import Imports
-import Polysemy
-import Polysemy.Error
-import Wire.API.Conversation (cnvmTeam)
-import Wire.API.Error
-import Wire.API.Error.Galley
-import Wire.API.Routes.Internal.Galley.TeamFeatureNoConfigMulti qualified as Multi
-import Wire.API.Team.Feature
-import Wire.ConversationStore as ConversationStore
-import Wire.ConversationSubsystem.Util
-import Wire.FeaturesConfigSubsystem
-import Wire.FeaturesConfigSubsystem.Types
-import Wire.TeamStore qualified as TeamStore
-import Wire.TeamSubsystem (TeamSubsystem)
-import Wire.TeamSubsystem qualified as TeamSubsystem
-
--- FUTUREWORK: everything in this module should be moved to the FeatureConfigSubsystem
-data DoAuth = DoAuth UserId | DontDoAuth
-
-getFeatureInternal ::
- ( GetFeatureConfig cfg,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamStore.TeamStore r,
- Member FeaturesConfigSubsystem r
- ) =>
- TeamId ->
- Sem r (LockableFeature cfg)
-getFeatureInternal tid = do
- assertTeamExists tid
- getFeatureForTeam tid
-
-toTeamStatus :: TeamId -> LockableFeature cfg -> Multi.TeamStatus cfg
-toTeamStatus tid feat = Multi.TeamStatus tid feat.status
-
-getTeamAndCheckMembership ::
- ( Member TeamStore.TeamStore r,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamSubsystem r
- ) =>
- UserId ->
- Sem r (Maybe TeamId)
-getTeamAndCheckMembership uid = do
- mTid <- TeamStore.getOneUserTeam uid
- for_ mTid $ \tid -> do
- zusrMembership <- TeamSubsystem.internalGetTeamMember uid tid
- void $ maybe (throwS @'NotATeamMember) pure zusrMembership
- assertTeamExists tid
- pure mTid
-
-getAllTeamFeatures ::
- forall r.
- (Member FeaturesConfigSubsystem r) =>
- TeamId ->
- Sem r AllTeamFeatures
-getAllTeamFeatures tid = getAllTeamFeaturesForTeam tid
-
-getAllTeamFeaturesForUser ::
- forall r.
- ( Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamStore.TeamStore r,
- Member TeamSubsystem r,
- Member FeaturesConfigSubsystem r,
- GetFeatureConfigEffects r
- ) =>
- UserId ->
- Sem r AllTeamFeatures
-getAllTeamFeaturesForUser uid = do
- mTid <- getTeamAndCheckMembership uid
- case mTid of
- Nothing -> hsequence' $ hcpure (Proxy @(GetAllTeamFeaturesForUserConstraints r)) $ Comp $ getFeatureForUser uid
- Just tid -> getAllTeamFeatures tid
-
-getSingleFeatureForUser ::
- forall cfg r.
- ( GetFeatureConfig cfg,
- Member (ErrorS 'NotATeamMember) r,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamStore.TeamStore r,
- Member TeamSubsystem r,
- Member FeaturesConfigSubsystem r
- ) =>
- UserId ->
- Sem r (LockableFeature cfg)
-getSingleFeatureForUser uid = do
- mTid <- getTeamAndCheckMembership uid
- getFeatureForTeamUser @_ @cfg uid mTid
-
--- | If second factor auth is enabled, make sure that end-points that don't support it, but
--- should, are blocked completely. (This is a workaround until we have 2FA for those
--- end-points as well.)
---
--- This function exists to resolve a cyclic dependency.
-guardSecondFactorDisabled ::
- forall r.
- ( Member (ErrorS 'AccessDenied) r,
- Member TeamStore.TeamStore r,
- Member ConversationStore r,
- Member FeaturesConfigSubsystem r
- ) =>
- UserId ->
- ConvId ->
- Sem r ()
-guardSecondFactorDisabled uid cid = do
- mTid <- fmap hush . runError @() $ do
- convData <- ConversationStore.getConversationMetadata cid >>= note ()
- tid <- note () convData.cnvmTeam
- mapError (unTagged @'TeamNotFound @()) $ assertTeamExists tid
- pure tid
-
- tf <- getFeatureForTeamUser @_ @SndFactorPasswordChallengeConfig uid mTid
- case tf.status of
- FeatureStatusDisabled -> pure ()
- FeatureStatusEnabled -> throwS @'AccessDenied
-
-featureEnabledForTeam ::
- forall cfg r.
- ( GetFeatureConfig cfg,
- Member (ErrorS 'TeamNotFound) r,
- Member TeamStore.TeamStore r,
- Member FeaturesConfigSubsystem r
- ) =>
- TeamId ->
- Sem r Bool
-featureEnabledForTeam tid =
- (==) FeatureStatusEnabled
- . (.status)
- <$> getFeatureInternal @cfg tid
diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs
index 8ee5e1e092..e27c5e45ce 100644
--- a/services/galley/src/Galley/App.hs
+++ b/services/galley/src/Galley/App.hs
@@ -52,7 +52,6 @@ import Data.Misc
import Data.Qualified
import Data.Range
import Data.Text qualified as Text
-import Galley.API.MLS.GroupInfoCheck (GroupInfoCheckEnabled (GroupInfoCheckEnabled))
import Galley.Effects.Queue qualified as GE
import Galley.Env
import Galley.External.LegalHoldService.Internal qualified as LHInternal
@@ -106,8 +105,8 @@ import Wire.CodeStore.Postgres
import Wire.ConversationStore (ConversationStore, MLSCommitLockStore)
import Wire.ConversationStore.Cassandra
import Wire.ConversationStore.Postgres
-import Wire.ConversationSubsystem (ConversationSubsystem)
-import Wire.ConversationSubsystem.Interpreter (interpretConversationSubsystem)
+import Wire.ConversationSubsystem
+import Wire.ConversationSubsystem.Interpreter (ConversationSubsystemError, GroupInfoCheckEnabled (..), IntraListing (IntraListing), interpretConversationSubsystem)
import Wire.CustomBackendStore
import Wire.CustomBackendStore.Cassandra
import Wire.Error
@@ -233,6 +232,8 @@ type GalleyEffects =
Input FanoutLimit,
Input (FeatureDefaults LegalholdConfig),
Input (Local ()),
+ Input IntraListing,
+ Input (Maybe GuestLinkTTLSeconds),
Input (Maybe (MLSKeysByPurpose MLSPrivateKeys)),
Input (Maybe GroupInfoCheckEnabled),
Input Opts,
@@ -242,7 +243,10 @@ type GalleyEffects =
Error Meeting.MeetingError,
Error DynError,
Error RateLimitExceeded,
+ Error ConversationSubsystemError,
ErrorS OperationDenied,
+ ErrorS 'AccessDenied,
+ ErrorS 'TeamMemberNotFound,
ErrorS 'HistoryNotSupported,
ErrorS 'NotATeamMember,
ErrorS 'ConvAccessDenied,
@@ -292,7 +296,7 @@ type GalleyEffects =
validateOptions :: Opts -> IO (Either HttpsUrl (Map Text HttpsUrl))
validateOptions o = do
let settings' = view settings o
- optFanoutLimit = fromIntegral . fromRange $ currentFanoutLimit o
+ optFanoutLimit = fromIntegral . fromRange $ currentFanoutLimit settings'._maxTeamSize settings'._maxFanoutSize
when (settings'._maxConvSize > fromIntegral optFanoutLimit) $
error "setMaxConvSize cannot be > setTruncationLimit"
when (settings' ^. maxTeamSize < optFanoutLimit) $
@@ -308,12 +312,7 @@ validateOptions o = do
error "For starting MLS migration, MLS must be included in the supportedProtocol list"
unless (mlsDefaultProtocol mlsConfig `elem` mlsSupportedProtocols mlsConfig) $
error "The list 'settings.featureFlags.mls.supportedProtocols' must include the value in the field 'settings.featureFlags.mls.defaultProtocol'"
- let errMsg = "Either conversationCodeURI or multiIngress needs to be set."
- case (settings' ^. conversationCodeURI, settings' ^. multiIngress) of
- (Nothing, Nothing) -> error errMsg
- (Nothing, Just mi) -> pure (Right mi)
- (Just uri, Nothing) -> pure (Left uri)
- (Just _, Just _) -> error errMsg
+ conversationCodeURISettings o
createEnv :: Opts -> Logger -> IO Env
createEnv o l = do
@@ -501,7 +500,10 @@ evalGalley e =
. mapError toResponse -- ErrorS 'ConvAccessDenied
. mapError toResponse -- ErrorS 'NotATeamMember
. mapError toResponse -- ErrorS 'HistoryNotSupported
+ . mapError toResponse -- ErrorS 'TeamMemberNotFound
+ . mapError toResponse -- ErrorS 'AccessDenied
. mapError toResponse -- ErrorS OperationDenied
+ . mapError toResponse -- Error ConversationSubsystemError,
. mapError rateLimitExceededToHttpError
. mapError toResponse -- DynError
. mapError meetingError
@@ -511,9 +513,11 @@ evalGalley e =
. runInputConst (e ^. options)
. runInputConst (GroupInfoCheckEnabled <$> e._options._settings._checkGroupInfo)
. runInputConst e._mlsKeys
+ . runInputConst e._options._settings._guestLinkTTLSeconds
+ . runInputConst (IntraListing e._options._settings._intraListing)
. runInputConst localUnit
. interpretTeamFeatureSpecialContext e
- . runInputConst (currentFanoutLimit (e ^. options))
+ . runInputConst (currentFanoutLimitOpts (e ^. options))
. runInputSem (inputs @Opts $ view (O.settings . O.featureFlags))
. runInputSem (inputs @Opts $ ExposeInvitationURLsAllowlist . fromMaybe [] . view (O.settings . O.exposeInvitationURLsTeamAllowlist))
. interpretInternalTeamListToCassandra
diff --git a/services/galley/src/Galley/Env.hs b/services/galley/src/Galley/Env.hs
index 80de4fb949..009ac95254 100644
--- a/services/galley/src/Galley/Env.hs
+++ b/services/galley/src/Galley/Env.hs
@@ -18,13 +18,35 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Env where
+module Galley.Env
+ ( Env (..),
+ DeleteItem (..),
+ reqId,
+ options,
+ applog,
+ manager,
+ http2Manager,
+ Galley.Env.federator,
+ Galley.Env.brig,
+ cstate,
+ hasqlPool,
+ deleteQueue,
+ extEnv,
+ aEnv,
+ mlsKeys,
+ rabbitmqChannel,
+ convCodeURI,
+ passwordHashingRateLimitEnv,
+ reqIdMsg,
+ notificationSubsystemConfig,
+ currentFanoutLimitOpts,
+ )
+where
import Cassandra
import Control.Lens hiding ((.=))
import Data.Id
import Data.Misc (HttpsUrl)
-import Data.Range
import Data.Time.Clock.DiffTime (millisecondsToDiffTime)
import Galley.Queue qualified as Q
import HTTP2.Client.Manager (Http2Manager)
@@ -36,6 +58,7 @@ import System.Logger
import Util.Options
import Wire.API.MLS.Keys
import Wire.API.Team.FeatureFlags (FanoutLimit)
+import Wire.API.Team.FeatureFlags qualified as FeatureFlags
import Wire.AWS qualified as Aws
import Wire.ExternalAccess.External
import Wire.NotificationSubsystem.Interpreter
@@ -72,21 +95,19 @@ reqIdMsg :: RequestId -> Msg -> Msg
reqIdMsg = ("request" .=) . unRequestId
{-# INLINE reqIdMsg #-}
-currentFanoutLimit :: Opts -> FanoutLimit
-currentFanoutLimit o = do
- let optFanoutLimit = fromIntegral . fromRange $ fromMaybe defaultFanoutLimit (o ^. (O.settings . maxFanoutSize))
- let maxSize = fromIntegral (o ^. (O.settings . maxTeamSize))
- unsafeRange (min maxSize optFanoutLimit)
-
notificationSubsystemConfig :: Env -> NotificationSubsystemConfig
notificationSubsystemConfig env =
- NotificationSubsystemConfig
- { chunkSize = defaultChunkSize,
- fanoutLimit = currentFanoutLimit env._options,
- slowPushDelay =
- maybe
- defaultSlowPushDelay
- (millisecondsToDiffTime . toInteger)
- (env ^. options . O.settings . deleteConvThrottleMillis),
- requestId = env ^. reqId
- }
+ let settings' = env._options._settings
+ in NotificationSubsystemConfig
+ { chunkSize = defaultChunkSize,
+ fanoutLimit = FeatureFlags.currentFanoutLimit settings'._maxTeamSize settings'._maxFanoutSize,
+ slowPushDelay =
+ maybe
+ defaultSlowPushDelay
+ (millisecondsToDiffTime . toInteger)
+ (env ^. options . O.settings . deleteConvThrottleMillis),
+ requestId = env ^. reqId
+ }
+
+currentFanoutLimitOpts :: Opts -> FanoutLimit
+currentFanoutLimitOpts opts = FeatureFlags.currentFanoutLimit opts._settings._maxTeamSize opts._settings._maxFanoutSize
diff --git a/services/galley/test/integration/API.hs b/services/galley/test/integration/API.hs
index 7ada333264..5f9475e034 100644
--- a/services/galley/test/integration/API.hs
+++ b/services/galley/test/integration/API.hs
@@ -66,7 +66,6 @@ import Data.Text.Ascii qualified as Ascii
import Data.Time.Clock (getCurrentTime)
import Federator.Discovery (DiscoveryFailure (..))
import Federator.MockServer hiding (status)
-import Galley.API.Mapping
import Imports hiding (id)
import Imports qualified as I
import Network.HTTP.Types.Status qualified as HTTP
@@ -2375,8 +2374,8 @@ testBulkGetQualifiedConvs = do
let mock = do
d <- frTargetDomain <$> getRequest
asum
- [ guard (d == remoteDomainA) *> mockReply (GetConversationsResponseV2 [mockConversationA]),
- guard (d == remoteDomainB) *> mockReply (GetConversationsResponseV2 [mockConversationB]),
+ [ guard (d == remoteDomainA) *> mockReply (GetRemoteConversationViewsResponse [mockConversationA]),
+ guard (d == remoteDomainB) *> mockReply (GetRemoteConversationViewsResponse [mockConversationB]),
guard (d == remoteDomainC) *> liftIO (throw (DiscoveryFailureSrvNotAvailable "domainC")),
do
r <- getRequest
@@ -3056,7 +3055,7 @@ putRemoteConvMemberOk update = do
(qUnqualified qbob)
roleNameWireMember
[localMemberToOther remoteDomain bobAsLocal]
- remoteConversationResponse = GetConversationsResponseV2 [mockConversation]
+ remoteConversationResponse = GetRemoteConversationViewsResponse [mockConversation]
(rs, _) <-
withTempMockFederator'
(mockReply remoteConversationResponse)
@@ -3381,7 +3380,7 @@ testOne2OneConversationRequest shouldBeLocal actor desired = do
pure . map omQualifiedId . cmOthers . cnvMembers $ conv
RemoteActor -> do
fedGalleyClient <- view tsFedGalleyClient
- GetConversationsResponseV2 convs <-
+ GetRemoteConversationViewsResponse convs <-
runFedClient @"get-conversations" fedGalleyClient (tDomain bob) $
GetConversationsRequest
{ userId = tUnqualified bob,
@@ -3400,7 +3399,7 @@ testOne2OneConversationRequest shouldBeLocal actor desired = do
found <- do
let rconv = mkProteusConv (qUnqualified convId) (tUnqualified bob) roleNameWireAdmin []
(resp, _) <-
- withTempMockFederator' (mockReply (GetConversationsResponseV2 [rconv])) $
+ withTempMockFederator' (mockReply (GetRemoteConversationViewsResponse [rconv])) $
getConvQualified (tUnqualified alice) convId
pure $ statusCode resp == 200
liftIO $ found @?= ((actor, desired) == (LocalActor, Included))
diff --git a/services/galley/test/integration/API/Federation.hs b/services/galley/test/integration/API/Federation.hs
index 01c5b35d9e..3d4c74398a 100644
--- a/services/galley/test/integration/API/Federation.hs
+++ b/services/galley/test/integration/API/Federation.hs
@@ -153,7 +153,7 @@ getConversationsAllFound = do
fedGalleyClient <- view tsFedGalleyClient
- GetConversationsResponseV2 convs <-
+ GetRemoteConversationViewsResponse convs <-
runFedClient @"get-conversations" fedGalleyClient (qDomain aliceQ) $
GetConversationsRequest
(qUnqualified aliceQ)
@@ -198,7 +198,7 @@ getConversationsNotPartOf = do
fedGalleyClient <- view tsFedGalleyClient
rando <- Id <$> liftIO nextRandom
- GetConversationsResponseV2 convs <-
+ GetRemoteConversationViewsResponse convs <-
runFedClient @"get-conversations" fedGalleyClient localDomain $
GetConversationsRequest rando [qUnqualified . cnvQualifiedId $ cnv1]
liftIO $ assertEqual "conversation list not empty" [] convs
diff --git a/services/galley/test/integration/API/Teams.hs b/services/galley/test/integration/API/Teams.hs
index 04263221b2..472092c674 100644
--- a/services/galley/test/integration/API/Teams.hs
+++ b/services/galley/test/integration/API/Teams.hs
@@ -1280,7 +1280,7 @@ testBillingInLargeTeam = do
refreshIndex
opts <- view tsGConf
galley <- viewGalley
- let fanoutLimit = fromRange $ Galley.currentFanoutLimit opts
+ let fanoutLimit = fromRange $ Galley.currentFanoutLimitOpts opts
allOwnersBeforeFanoutLimit <-
foldM
( \billingMembers n -> do
diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs
index f24abb8ada..db9e3db7d0 100644
--- a/services/galley/test/integration/API/Teams/LegalHold.hs
+++ b/services/galley/test/integration/API/Teams/LegalHold.hs
@@ -173,7 +173,7 @@ testRemoveLegalHoldFromTeam = do
testAddTeamUserTooLargeWithLegalholdWhitelisted :: (HasCallStack) => TestM ()
testAddTeamUserTooLargeWithLegalholdWhitelisted = withTeam $ \owner tid -> do
o <- view tsGConf
- let fanoutLimit = fromIntegral @_ @Integer . fromRange $ Galley.currentFanoutLimit o
+ let fanoutLimit = fromIntegral @_ @Integer . fromRange $ Galley.currentFanoutLimitOpts o
forM_ [2 .. (fanoutLimit + 5)] $ \_n -> do
addUserToTeam' owner tid !!! do
const 201 === statusCode
diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
index 222c2af34b..734af584d7 100644
--- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
+++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
@@ -200,7 +200,7 @@ testRemoveLegalHoldFromTeam = do
testEnablePerTeamTooLarge :: TestM ()
testEnablePerTeamTooLarge = do
o <- view tsGConf
- let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimit o
+ let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimitOpts o
-- TODO: it is impossible in this test to create teams bigger than the fanout limit.
-- Change the +1 to anything else and look at the logs
(tid, _owner, _others) <- createBindingTeamWithMembers (fanoutLimit + 5)
@@ -215,7 +215,7 @@ testEnablePerTeamTooLarge = do
testAddTeamUserTooLargeWithLegalhold :: TestM ()
testAddTeamUserTooLargeWithLegalhold = do
o <- view tsGConf
- let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimit o
+ let fanoutLimit = fromIntegral . fromRange $ Galley.currentFanoutLimitOpts o
(tid, owner, _others) <- createBindingTeamWithMembers fanoutLimit
feat :: Public.Feature Public.LegalholdConfig <- responseJsonUnsafe <$> (getEnabled tid
RoleName ->
[OtherMember] ->
- RemoteConversationV2
+ RemoteConversationView
mkProteusConv cnvId creator selfRole otherMembers =
- RemoteConversationV2
+ RemoteConversationView
cnvId
( ConversationMetadata
RegularConv
diff --git a/services/galley/test/unit/Run.hs b/services/galley/test/unit/Run.hs
deleted file mode 100644
index 486fea4a91..0000000000
--- a/services/galley/test/unit/Run.hs
+++ /dev/null
@@ -1,37 +0,0 @@
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2022 Wire Swiss GmbH
---
--- This program is free software: you can redistribute it and/or modify it under
--- the terms of the GNU Affero General Public License as published by the Free
--- Software Foundation, either version 3 of the License, or (at your option) any
--- later version.
---
--- This program is distributed in the hope that it will be useful, but WITHOUT
--- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
--- FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
--- details.
---
--- You should have received a copy of the GNU Affero General Public License along
--- with this program. If not, see .
-
-module Run
- ( main,
- )
-where
-
-import Imports
-import Test.Galley.API.Message qualified
-import Test.Galley.API.One2One qualified
-import Test.Galley.Mapping qualified
-import Test.Tasty
-
-main :: IO ()
-main =
- defaultMain $
- testGroup
- "Tests"
- [ Test.Galley.API.Message.tests,
- Test.Galley.API.One2One.tests,
- Test.Galley.Mapping.tests
- ]