diff --git a/changelog.d/5-internal/polysemy-store b/changelog.d/5-internal/polysemy-store
index 98d604a47a..92950ac7ef 100644
--- a/changelog.d/5-internal/polysemy-store
+++ b/changelog.d/5-internal/polysemy-store
@@ -1 +1 @@
-Add polysemy store effects and split off Cassandra specific functionality from the Galley.Data module hierarchy.
+Add polysemy store effects and split off Cassandra specific functionality from the Galley.Data module hierarchy (#1890, #1906).
diff --git a/services/galley/galley.cabal b/services/galley/galley.cabal
index fe434196d1..2a18dcb467 100644
--- a/services/galley/galley.cabal
+++ b/services/galley/galley.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: f4fae64cc086ec4a37984b47611854d490e7d34ba17147a2e53d2b11c3ca3218
+-- hash: 07288a51b3ae662362fae1279cdd4c22977ae3c8dfb4dffe1228d0da1beba2b4
name: galley
version: 0.83.0
@@ -46,26 +46,27 @@ library
Galley.App
Galley.Aws
Galley.Cassandra
+ Galley.Cassandra.Access
Galley.Cassandra.Client
Galley.Cassandra.Code
Galley.Cassandra.Conversation
Galley.Cassandra.Conversation.Members
Galley.Cassandra.ConversationList
+ Galley.Cassandra.CustomBackend
Galley.Cassandra.LegalHold
Galley.Cassandra.Paging
+ Galley.Cassandra.Queries
+ Galley.Cassandra.ResultSet
+ Galley.Cassandra.SearchVisibility
Galley.Cassandra.Services
Galley.Cassandra.Store
Galley.Cassandra.Team
- Galley.Data.Access
+ Galley.Cassandra.TeamFeatures
+ Galley.Cassandra.TeamNotifications
Galley.Data.Conversation
Galley.Data.Conversation.Types
- Galley.Data.CustomBackend
- Galley.Data.Instances
- Galley.Data.LegalHold
- Galley.Data.Queries
- Galley.Data.ResultSet
+ Galley.Cassandra.Instances
Galley.Data.Scope
- Galley.Data.SearchVisibility
Galley.Data.Services
Galley.Data.TeamFeatures
Galley.Data.TeamNotifications
@@ -76,17 +77,22 @@ library
Galley.Effects.ClientStore
Galley.Effects.CodeStore
Galley.Effects.ConversationStore
+ Galley.Effects.CustomBackendStore
Galley.Effects.ExternalAccess
Galley.Effects.FederatorAccess
Galley.Effects.FireAndForget
Galley.Effects.GundeckAccess
+ Galley.Effects.LegalHoldStore
Galley.Effects.ListItems
Galley.Effects.MemberStore
Galley.Effects.Paging
Galley.Effects.RemoteConversationListStore
+ Galley.Effects.SearchVisibilityStore
Galley.Effects.ServiceStore
Galley.Effects.SparAccess
+ Galley.Effects.TeamFeatureStore
Galley.Effects.TeamMemberStore
+ Galley.Effects.TeamNotificationStore
Galley.Effects.TeamStore
Galley.Env
Galley.External
diff --git a/services/galley/src/Galley/API/Create.hs b/services/galley/src/Galley/API/Create.hs
index 39f75a9733..ee86e14933 100644
--- a/services/galley/src/Galley/API/Create.hs
+++ b/services/galley/src/Galley/API/Create.hs
@@ -39,7 +39,6 @@ import Galley.API.Mapping
import Galley.API.One2One
import Galley.API.Util
import Galley.App
-import Galley.Data.Access
import qualified Galley.Data.Conversation as Data
import Galley.Data.Conversation.Types
import Galley.Effects
@@ -73,7 +72,15 @@ import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotIm
--
-- See Note [managed conversations].
createGroupConversation ::
- Members '[ConversationStore, BrigAccess, FederatorAccess, GundeckAccess, TeamStore] r =>
+ Members
+ '[ ConversationStore,
+ BrigAccess,
+ FederatorAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ TeamStore
+ ]
+ r =>
UserId ->
ConnId ->
Public.NewConvUnmanaged ->
@@ -86,7 +93,15 @@ createGroupConversation user conn wrapped@(Public.NewConvUnmanaged body) =
-- | An internal endpoint for creating managed group conversations. Will
-- throw an error for everything else.
internalCreateManagedConversationH ::
- Members '[ConversationStore, BrigAccess, FederatorAccess, GundeckAccess, TeamStore] r =>
+ Members
+ '[ ConversationStore,
+ BrigAccess,
+ FederatorAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ TeamStore
+ ]
+ r =>
UserId ::: ConnId ::: JsonRequest NewConvManaged ->
Galley r Response
internalCreateManagedConversationH (zusr ::: zcon ::: req) = do
@@ -94,7 +109,15 @@ internalCreateManagedConversationH (zusr ::: zcon ::: req) = do
handleConversationResponse <$> internalCreateManagedConversation zusr zcon newConv
internalCreateManagedConversation ::
- Members '[ConversationStore, BrigAccess, FederatorAccess, GundeckAccess, TeamStore] r =>
+ Members
+ '[ ConversationStore,
+ BrigAccess,
+ FederatorAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ TeamStore
+ ]
+ r =>
UserId ->
ConnId ->
NewConvManaged ->
@@ -105,7 +128,7 @@ internalCreateManagedConversation zusr zcon (NewConvManaged body) = do
Just tinfo -> createTeamGroupConv zusr zcon tinfo body
ensureNoLegalholdConflicts ::
- Member TeamStore r =>
+ Members '[LegalHoldStore, TeamStore] r =>
[Remote UserId] ->
[UserId] ->
Galley r ()
@@ -117,7 +140,15 @@ ensureNoLegalholdConflicts remotes locals = do
-- | A helper for creating a regular (non-team) group conversation.
createRegularGroupConv ::
- Members '[ConversationStore, BrigAccess, FederatorAccess, GundeckAccess, TeamStore] r =>
+ Members
+ '[ ConversationStore,
+ BrigAccess,
+ FederatorAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ TeamStore
+ ]
+ r =>
UserId ->
ConnId ->
NewConvUnmanaged ->
@@ -155,6 +186,7 @@ createTeamGroupConv ::
BrigAccess,
FederatorAccess,
GundeckAccess,
+ LegalHoldStore,
TeamStore
]
r =>
@@ -497,11 +529,11 @@ toUUIDs a b = do
return (a', b')
accessRole :: NewConv -> AccessRole
-accessRole b = fromMaybe defRole (newConvAccessRole b)
+accessRole b = fromMaybe Data.defRole (newConvAccessRole b)
access :: NewConv -> [Access]
access a = case Set.toList (newConvAccess a) of
- [] -> defRegularConvAccess
+ [] -> Data.defRegularConvAccess
(x : xs) -> x : xs
newConvMembers :: Local x -> NewConv -> UserList UserId
diff --git a/services/galley/src/Galley/API/CustomBackend.hs b/services/galley/src/Galley/API/CustomBackend.hs
index fa98803c79..9630ca6b4c 100644
--- a/services/galley/src/Galley/API/CustomBackend.hs
+++ b/services/galley/src/Galley/API/CustomBackend.hs
@@ -27,37 +27,41 @@ import Data.Domain (Domain)
import Galley.API.Error
import Galley.API.Util
import Galley.App
-import qualified Galley.Data.CustomBackend as Data
+import Galley.Effects.CustomBackendStore
import Galley.Types
import Imports hiding ((\\))
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Predicate hiding (setStatus)
import Network.Wai.Utilities
+import Polysemy
import qualified Wire.API.CustomBackend as Public
-- PUBLIC ---------------------------------------------------------------------
-getCustomBackendByDomainH :: Domain ::: JSON -> Galley r Response
+getCustomBackendByDomainH :: Member CustomBackendStore r => Domain ::: JSON -> Galley r Response
getCustomBackendByDomainH (domain ::: _) =
json <$> getCustomBackendByDomain domain
-getCustomBackendByDomain :: Domain -> Galley r Public.CustomBackend
+getCustomBackendByDomain :: Member CustomBackendStore r => Domain -> Galley r Public.CustomBackend
getCustomBackendByDomain domain =
- Data.getCustomBackend domain >>= \case
+ liftSem (getCustomBackend domain) >>= \case
Nothing -> throwM (customBackendNotFound domain)
Just customBackend -> pure customBackend
-- INTERNAL -------------------------------------------------------------------
-internalPutCustomBackendByDomainH :: Domain ::: JsonRequest CustomBackend -> Galley r Response
+internalPutCustomBackendByDomainH ::
+ Member CustomBackendStore r =>
+ Domain ::: JsonRequest CustomBackend ->
+ Galley r Response
internalPutCustomBackendByDomainH (domain ::: req) = do
customBackend <- fromJsonBody req
-- simple enough to not need a separate function
- Data.setCustomBackend domain customBackend
+ liftSem $ setCustomBackend domain customBackend
pure (empty & setStatus status201)
-internalDeleteCustomBackendByDomainH :: Domain ::: JSON -> Galley r Response
+internalDeleteCustomBackendByDomainH :: Member CustomBackendStore r => Domain ::: JSON -> Galley r Response
internalDeleteCustomBackendByDomainH (domain ::: _) = do
- Data.deleteCustomBackend domain
+ liftSem $ deleteCustomBackend domain
pure (empty & setStatus status200)
diff --git a/services/galley/src/Galley/API/Federation.hs b/services/galley/src/Galley/API/Federation.hs
index fcadd8f171..a6ba85d575 100644
--- a/services/galley/src/Galley/API/Federation.hs
+++ b/services/galley/src/Galley/API/Federation.hs
@@ -246,6 +246,7 @@ leaveConversation ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
MemberStore,
TeamStore
]
diff --git a/services/galley/src/Galley/API/LegalHold.hs b/services/galley/src/Galley/API/LegalHold.hs
index 2f6d2a63c7..0a6015259e 100644
--- a/services/galley/src/Galley/API/LegalHold.hs
+++ b/services/galley/src/Galley/API/LegalHold.hs
@@ -54,12 +54,11 @@ import Galley.API.Util
import Galley.App
import Galley.Cassandra.Paging
import qualified Galley.Data.Conversation as Data
-import Galley.Data.LegalHold (isTeamLegalholdWhitelisted)
-import qualified Galley.Data.LegalHold as LegalHoldData
-import qualified Galley.Data.TeamFeatures as TeamFeatures
import Galley.Effects
import Galley.Effects.BrigAccess
+import qualified Galley.Effects.LegalHoldStore as LegalHoldData
import Galley.Effects.Paging
+import qualified Galley.Effects.TeamFeatureStore as TeamFeatures
import Galley.Effects.TeamMemberStore
import Galley.Effects.TeamStore
import qualified Galley.External.LegalHoldService as LHService
@@ -80,25 +79,27 @@ import qualified Wire.API.Team.Feature as Public
import Wire.API.Team.LegalHold (LegalholdProtectee (LegalholdPlusFederationNotImplemented))
import qualified Wire.API.Team.LegalHold as Public
-assertLegalHoldEnabledForTeam :: TeamId -> Galley r ()
+assertLegalHoldEnabledForTeam :: Members '[LegalHoldStore, TeamFeatureStore] r => TeamId -> Galley r ()
assertLegalHoldEnabledForTeam tid = unlessM (isLegalHoldEnabledForTeam tid) $ throwM legalHoldNotEnabled
-isLegalHoldEnabledForTeam :: TeamId -> Galley r Bool
+isLegalHoldEnabledForTeam :: Members '[LegalHoldStore, TeamFeatureStore] r => TeamId -> Galley r Bool
isLegalHoldEnabledForTeam tid = do
view (options . Opts.optSettings . Opts.setFeatureFlags . flagLegalHold) >>= \case
FeatureLegalHoldDisabledPermanently -> do
pure False
FeatureLegalHoldDisabledByDefault -> do
- statusValue <- Public.tfwoStatus <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid
+ statusValue <-
+ liftSem $
+ Public.tfwoStatus <$$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid
return $ case statusValue of
Just Public.TeamFeatureEnabled -> True
Just Public.TeamFeatureDisabled -> False
Nothing -> False
FeatureLegalHoldWhitelistTeamsAndImplicitConsent ->
- isTeamLegalholdWhitelisted tid
+ liftSem $ LegalHoldData.isTeamLegalholdWhitelisted tid
createSettingsH ::
- Member TeamStore r =>
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
UserId ::: TeamId ::: JsonRequest Public.NewLegalHoldService ::: JSON ->
Galley r Response
createSettingsH (zusr ::: tid ::: req ::: _) = do
@@ -106,7 +107,7 @@ createSettingsH (zusr ::: tid ::: req ::: _) = do
setStatus status201 . json <$> createSettings zusr tid newService
createSettings ::
- Member TeamStore r =>
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
UserId ->
TeamId ->
Public.NewLegalHoldService ->
@@ -124,18 +125,18 @@ createSettings zusr tid newService = do
>>= maybe (throwM legalHoldServiceInvalidKey) pure
LHService.checkLegalHoldServiceStatus fpr (newLegalHoldServiceUrl newService)
let service = legalHoldService tid fpr newService key
- LegalHoldData.createSettings service
+ liftSem $ LegalHoldData.createSettings service
pure . viewLegalHoldService $ service
getSettingsH ::
- Member TeamStore r =>
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
UserId ::: TeamId ::: JSON ->
Galley r Response
getSettingsH (zusr ::: tid ::: _) = do
json <$> getSettings zusr tid
getSettings ::
- Member TeamStore r =>
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
UserId ->
TeamId ->
Galley r Public.ViewLegalHoldService
@@ -143,7 +144,7 @@ getSettings zusr tid = do
zusrMembership <- liftSem $ getTeamMember tid zusr
void $ permissionCheck (ViewTeamFeature Public.TeamFeatureLegalHold) zusrMembership
isenabled <- isLegalHoldEnabledForTeam tid
- mresult <- LegalHoldData.getSettings tid
+ mresult <- liftSem $ LegalHoldData.getSettings tid
pure $ case (isenabled, mresult) of
(False, _) -> Public.ViewLegalHoldServiceDisabled
(True, Nothing) -> Public.ViewLegalHoldServiceNotConfigured
@@ -159,9 +160,11 @@ removeSettingsH ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore,
+ TeamFeatureStore,
TeamMemberStore InternalPaging
]
r =>
@@ -184,8 +187,10 @@ removeSettings ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore,
TeamMemberStore p
]
@@ -229,6 +234,7 @@ removeSettings' ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore,
@@ -260,11 +266,19 @@ removeSettings' tid =
-- | 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
-getUserStatusH :: Member TeamStore r => UserId ::: TeamId ::: UserId ::: JSON -> Galley r Response
+getUserStatusH ::
+ Members '[LegalHoldStore, TeamStore] r =>
+ UserId ::: TeamId ::: UserId ::: JSON ->
+ Galley r Response
getUserStatusH (_zusr ::: tid ::: uid ::: _) = do
json <$> getUserStatus tid uid
-getUserStatus :: Member TeamStore r => TeamId -> UserId -> Galley r Public.UserLegalHoldStatusResponse
+getUserStatus ::
+ forall r.
+ Members '[LegalHoldStore, TeamStore] r =>
+ TeamId ->
+ UserId ->
+ Galley r Public.UserLegalHoldStatusResponse
getUserStatus tid uid = do
mTeamMember <- liftSem $ getTeamMember tid uid
teamMember <- maybe (throwM teamMemberNotFound) pure mTeamMember
@@ -278,7 +292,7 @@ getUserStatus tid uid = do
where
makeResponseDetails :: Galley r (Maybe LastPrekey, Maybe ClientId)
makeResponseDetails = do
- mLastKey <- fmap snd <$> LegalHoldData.selectPendingPrekeys uid
+ mLastKey <- liftSem $ fmap snd <$> LegalHoldData.selectPendingPrekeys uid
lastKey <- case mLastKey of
Nothing -> do
Log.err . Log.msg $
@@ -303,6 +317,7 @@ grantConsentH ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
@@ -329,6 +344,7 @@ grantConsent ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
@@ -361,8 +377,10 @@ requestDeviceH ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore
]
r =>
@@ -388,8 +406,10 @@ requestDevice ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore
]
r =>
@@ -422,13 +442,13 @@ requestDevice zusr tid uid = do
provisionLHDevice userLHStatus = do
(lastPrekey', prekeys) <- requestDeviceFromService
-- We don't distinguish the last key here; brig will do so when the device is added
- LegalHoldData.insertPendingPrekeys uid (unpackLastPrekey lastPrekey' : prekeys)
+ liftSem $ LegalHoldData.insertPendingPrekeys uid (unpackLastPrekey lastPrekey' : prekeys)
changeLegalholdStatus tid uid userLHStatus UserLegalHoldPending
liftSem $ notifyClientsAboutLegalHoldRequest zusr uid lastPrekey'
requestDeviceFromService :: Galley r (LastPrekey, [Prekey])
requestDeviceFromService = do
- LegalHoldData.dropPendingPrekeys uid
+ liftSem $ LegalHoldData.dropPendingPrekeys uid
lhDevice <- LHService.requestNewDevice tid uid
let NewLegalHoldClient prekeys lastKey = lhDevice
return (lastKey, prekeys)
@@ -448,8 +468,10 @@ approveDeviceH ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore
]
r =>
@@ -470,8 +492,10 @@ approveDevice ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore
]
r =>
@@ -493,7 +517,7 @@ approveDevice zusr tid uid connId (Public.ApproveLegalHoldForUserRequest mPasswo
liftSem $
maybe defUserLegalHoldStatus (view legalHoldStatus) <$> getTeamMember tid uid
assertUserLHPending userLHStatus
- mPreKeys <- LegalHoldData.selectPendingPrekeys uid
+ mPreKeys <- liftSem $ LegalHoldData.selectPendingPrekeys uid
(prekeys, lastPrekey') <- case mPreKeys of
Nothing -> do
Log.info $ Log.msg @Text "No prekeys found"
@@ -529,6 +553,7 @@ disableForUserH ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
@@ -557,6 +582,7 @@ disableForUser ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
@@ -604,6 +630,7 @@ changeLegalholdStatus ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
@@ -619,25 +646,25 @@ changeLegalholdStatus tid uid old new = do
UserLegalHoldEnabled -> case new of
UserLegalHoldEnabled -> noop
UserLegalHoldPending -> illegal
- UserLegalHoldDisabled -> update >> removeblocks
+ UserLegalHoldDisabled -> liftSem update >> removeblocks
UserLegalHoldNoConsent -> illegal
--
UserLegalHoldPending -> case new of
- UserLegalHoldEnabled -> update
+ UserLegalHoldEnabled -> liftSem update
UserLegalHoldPending -> noop
- UserLegalHoldDisabled -> update >> removeblocks
+ UserLegalHoldDisabled -> liftSem update >> removeblocks
UserLegalHoldNoConsent -> illegal
--
UserLegalHoldDisabled -> case new of
UserLegalHoldEnabled -> illegal
- UserLegalHoldPending -> addblocks >> update
+ UserLegalHoldPending -> addblocks >> liftSem update
UserLegalHoldDisabled -> {- in case the last attempt crashed -} removeblocks
UserLegalHoldNoConsent -> {- withdrawing consent is not (yet?) implemented -} illegal
--
UserLegalHoldNoConsent -> case new of
UserLegalHoldEnabled -> illegal
UserLegalHoldPending -> illegal
- UserLegalHoldDisabled -> update
+ UserLegalHoldDisabled -> liftSem update
UserLegalHoldNoConsent -> noop
where
update = LegalHoldData.setUserLegalHoldStatus tid uid new
@@ -651,7 +678,7 @@ changeLegalholdStatus tid uid old new = do
-- FUTUREWORK: make this async?
blockNonConsentingConnections ::
forall r.
- Members '[BrigAccess, TeamStore] r =>
+ Members '[BrigAccess, LegalHoldStore, TeamStore] r =>
UserId ->
Galley r ()
blockNonConsentingConnections uid = do
@@ -679,19 +706,21 @@ blockNonConsentingConnections uid = do
status <- liftSem $ putConnectionInternal (BlockForMissingLHConsent userLegalhold othersToBlock)
pure $ ["blocking users failed: " <> show (status, othersToBlock) | status /= status200]
-setTeamLegalholdWhitelisted :: TeamId -> Galley r ()
-setTeamLegalholdWhitelisted tid = do
- LegalHoldData.setTeamLegalholdWhitelisted tid
+setTeamLegalholdWhitelisted :: Member LegalHoldStore r => TeamId -> Galley r ()
+setTeamLegalholdWhitelisted tid =
+ liftSem $
+ LegalHoldData.setTeamLegalholdWhitelisted tid
-setTeamLegalholdWhitelistedH :: TeamId -> Galley r Response
+setTeamLegalholdWhitelistedH :: Member LegalHoldStore r => TeamId -> Galley r Response
setTeamLegalholdWhitelistedH tid = do
empty <$ setTeamLegalholdWhitelisted tid
-unsetTeamLegalholdWhitelisted :: TeamId -> Galley r ()
-unsetTeamLegalholdWhitelisted tid = do
- LegalHoldData.unsetTeamLegalholdWhitelisted tid
+unsetTeamLegalholdWhitelisted :: Member LegalHoldStore r => TeamId -> Galley r ()
+unsetTeamLegalholdWhitelisted tid =
+ liftSem $
+ LegalHoldData.unsetTeamLegalholdWhitelisted tid
-unsetTeamLegalholdWhitelistedH :: TeamId -> Galley r Response
+unsetTeamLegalholdWhitelistedH :: Member LegalHoldStore r => TeamId -> Galley r Response
unsetTeamLegalholdWhitelistedH tid = do
() <-
error
@@ -700,9 +729,9 @@ unsetTeamLegalholdWhitelistedH tid = do
\before you enable the end-point."
setStatus status204 empty <$ unsetTeamLegalholdWhitelisted tid
-getTeamLegalholdWhitelistedH :: TeamId -> Galley r Response
-getTeamLegalholdWhitelistedH tid = do
- lhEnabled <- isTeamLegalholdWhitelisted tid
+getTeamLegalholdWhitelistedH :: Member LegalHoldStore r => TeamId -> Galley r Response
+getTeamLegalholdWhitelistedH tid = liftSem $ do
+ lhEnabled <- LegalHoldData.isTeamLegalholdWhitelisted tid
pure $
if lhEnabled
then setStatus status200 empty
@@ -732,6 +761,7 @@ handleGroupConvPolicyConflicts ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
TeamStore
diff --git a/services/galley/src/Galley/API/Query.hs b/services/galley/src/Galley/API/Query.hs
index 6b07b1d18f..d395b1e424 100644
--- a/services/galley/src/Galley/API/Query.hs
+++ b/services/galley/src/Galley/API/Query.hs
@@ -52,7 +52,6 @@ import qualified Galley.API.Mapping as Mapping
import Galley.API.Util
import Galley.App
import Galley.Cassandra.Paging
-import Galley.Data.ResultSet
import qualified Galley.Data.Types as Data
import Galley.Effects
import qualified Galley.Effects.ConversationStore as E
diff --git a/services/galley/src/Galley/API/Teams.hs b/services/galley/src/Galley/API/Teams.hs
index 8c32af600c..0b58052ecc 100644
--- a/services/galley/src/Galley/API/Teams.hs
+++ b/services/galley/src/Galley/API/Teams.hs
@@ -88,20 +88,19 @@ import Galley.API.Util
import Galley.App
import Galley.Cassandra.Paging
import qualified Galley.Data.Conversation as Data
-import qualified Galley.Data.LegalHold as Data
-import qualified Galley.Data.ResultSet as Data
-import qualified Galley.Data.SearchVisibility as SearchVisibilityData
import Galley.Data.Services (BotMember)
-import qualified Galley.Data.TeamFeatures as TeamFeatures
import Galley.Effects
import qualified Galley.Effects.BrigAccess as E
import qualified Galley.Effects.ConversationStore as E
import qualified Galley.Effects.ExternalAccess as E
import qualified Galley.Effects.GundeckAccess as E
+import qualified Galley.Effects.LegalHoldStore as Data
import qualified Galley.Effects.ListItems as E
import qualified Galley.Effects.MemberStore as E
import qualified Galley.Effects.Paging as E
+import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData
import qualified Galley.Effects.SparAccess as Spar
+import qualified Galley.Effects.TeamFeatureStore as TeamFeatures
import qualified Galley.Effects.TeamMemberStore as E
import qualified Galley.Effects.TeamStore as E
import qualified Galley.Intra.Journal as Journal
@@ -367,6 +366,7 @@ uncheckedDeleteTeam ::
'[ BrigAccess,
ExternalAccess,
GundeckAccess,
+ LegalHoldStore,
MemberStore,
SparAccess,
TeamStore
@@ -400,7 +400,7 @@ uncheckedDeleteTeam zusr zcon tid = do
when ((view teamBinding . tdTeam <$> team) == Just Binding) $ do
liftSem $ mapM_ (E.deleteUser . view userId) membs
Journal.teamDelete tid
- Data.unsetTeamLegalholdWhitelisted tid
+ liftSem $ Data.unsetTeamLegalholdWhitelisted tid
liftSem $ E.deleteTeam tid
where
pushDeleteEvents :: [TeamMember] -> Event -> [Push] -> Galley r ()
@@ -687,7 +687,16 @@ uncheckedGetTeamMembers ::
uncheckedGetTeamMembers tid maxResults = liftSem $ E.getTeamMembersWithLimit tid maxResults
addTeamMemberH ::
- Members '[BrigAccess, GundeckAccess, MemberStore, TeamStore] r =>
+ Members
+ '[ BrigAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ MemberStore,
+ TeamFeatureStore,
+ TeamNotificationStore,
+ TeamStore
+ ]
+ r =>
UserId ::: ConnId ::: TeamId ::: JsonRequest Public.NewTeamMember ::: JSON ->
Galley r Response
addTeamMemberH (zusr ::: zcon ::: tid ::: req ::: _) = do
@@ -696,7 +705,16 @@ addTeamMemberH (zusr ::: zcon ::: tid ::: req ::: _) = do
pure empty
addTeamMember ::
- Members '[BrigAccess, GundeckAccess, MemberStore, TeamStore] r =>
+ Members
+ '[ BrigAccess,
+ GundeckAccess,
+ LegalHoldStore,
+ MemberStore,
+ TeamFeatureStore,
+ TeamNotificationStore,
+ TeamStore
+ ]
+ r =>
UserId ->
ConnId ->
TeamId ->
@@ -723,7 +741,16 @@ addTeamMember zusr zcon tid nmem = do
-- This function is "unchecked" because there is no need to check for user binding (invite only).
uncheckedAddTeamMemberH ::
- Members '[BrigAccess, GundeckAccess, MemberStore, TeamStore] r =>
+ Members
+ '[ BrigAccess,
+ GundeckAccess,
+ MemberStore,
+ LegalHoldStore,
+ TeamFeatureStore,
+ TeamStore,
+ TeamNotificationStore
+ ]
+ r =>
TeamId ::: JsonRequest NewTeamMember ::: JSON ->
Galley r Response
uncheckedAddTeamMemberH (tid ::: req ::: _) = do
@@ -732,7 +759,16 @@ uncheckedAddTeamMemberH (tid ::: req ::: _) = do
return empty
uncheckedAddTeamMember ::
- Members '[BrigAccess, GundeckAccess, MemberStore, TeamStore] r =>
+ Members
+ '[ BrigAccess,
+ GundeckAccess,
+ MemberStore,
+ LegalHoldStore,
+ TeamFeatureStore,
+ TeamStore,
+ TeamNotificationStore
+ ]
+ r =>
TeamId ->
NewTeamMember ->
Galley r ()
@@ -994,6 +1030,7 @@ deleteTeamConversation ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
MemberStore,
TeamStore
]
@@ -1009,7 +1046,7 @@ deleteTeamConversation zusr zcon _tid cid = do
void $ API.deleteLocalConversation lusr zcon lconv
getSearchVisibilityH ::
- Member TeamStore r =>
+ Members '[SearchVisibilityStore, TeamStore] r =>
UserId ::: TeamId ::: JSON ->
Galley r Response
getSearchVisibilityH (uid ::: tid ::: _) = do
@@ -1018,7 +1055,7 @@ getSearchVisibilityH (uid ::: tid ::: _) = do
json <$> getSearchVisibilityInternal tid
setSearchVisibilityH ::
- Member TeamStore r =>
+ Members '[SearchVisibilityStore, TeamStore, TeamFeatureStore] r =>
UserId ::: TeamId ::: JsonRequest Public.TeamSearchVisibilityView ::: JSON ->
Galley r Response
setSearchVisibilityH (uid ::: tid ::: req ::: _) = do
@@ -1051,10 +1088,10 @@ withTeamIds ::
withTeamIds usr range size k = case range of
Nothing -> do
r <- liftSem $ E.listItems usr Nothing (rcast size)
- k (Data.resultSetType r == Data.ResultSetTruncated) (Data.resultSetResult r)
+ k (resultSetType r == ResultSetTruncated) (resultSetResult r)
Just (Right c) -> do
r <- liftSem $ E.listItems usr (Just c) (rcast size)
- k (Data.resultSetType r == Data.ResultSetTruncated) (Data.resultSetResult r)
+ k (resultSetType r == ResultSetTruncated) (resultSetResult r)
Just (Left (fromRange -> cc)) -> do
ids <- liftSem $ E.selectTeams usr (Data.ByteString.Conversion.fromList cc)
k False ids
@@ -1102,7 +1139,11 @@ ensureNotTooLarge tid = do
-- size unlimited, because we make the assumption that these teams won't turn
-- LegalHold off after activation.
-- FUTUREWORK: Find a way around the fanout limit.
-ensureNotTooLargeForLegalHold :: Member BrigAccess r => TeamId -> Int -> Galley r ()
+ensureNotTooLargeForLegalHold ::
+ Members '[BrigAccess, LegalHoldStore, TeamFeatureStore] r =>
+ TeamId ->
+ Int ->
+ Galley r ()
ensureNotTooLargeForLegalHold tid teamSize = do
whenM (isLegalHoldEnabledForTeam tid) $ do
unlessM (teamSizeBelowLimit teamSize) $ do
@@ -1126,7 +1167,7 @@ teamSizeBelowLimit teamSize = do
pure True
addTeamMemberInternal ::
- Members '[BrigAccess, GundeckAccess, MemberStore, TeamStore] r =>
+ Members '[BrigAccess, GundeckAccess, MemberStore, TeamNotificationStore, TeamStore] r =>
TeamId ->
Maybe UserId ->
Maybe ConnId ->
@@ -1164,7 +1205,7 @@ addTeamMemberInternal tid origin originConn (view ntmNewTeamMember -> new) memLi
-- less warped. This is a work-around because we cannot send events to all of a large team.
-- See haddocks of module "Galley.API.TeamNotifications" for details.
getTeamNotificationsH ::
- Member BrigAccess r =>
+ Members '[BrigAccess, TeamNotificationStore] r =>
UserId
::: Maybe ByteString {- NotificationId -}
::: Range 1 10000 Int32
@@ -1226,18 +1267,24 @@ getBindingTeamMembers :: Member TeamStore r => UserId -> Galley r TeamMemberList
getBindingTeamMembers zusr = withBindingTeam zusr $ \tid ->
getTeamMembersForFanout tid
-canUserJoinTeamH :: Member BrigAccess r => TeamId -> Galley r Response
+canUserJoinTeamH ::
+ Members '[BrigAccess, LegalHoldStore, TeamFeatureStore] r =>
+ TeamId ->
+ Galley r Response
canUserJoinTeamH tid = canUserJoinTeam tid >> pure empty
-- This could be extended for more checks, for now we test only legalhold
-canUserJoinTeam :: Member BrigAccess r => TeamId -> Galley r ()
+canUserJoinTeam :: Members '[BrigAccess, LegalHoldStore, TeamFeatureStore] r => TeamId -> Galley r ()
canUserJoinTeam tid = do
lhEnabled <- isLegalHoldEnabledForTeam tid
when lhEnabled $ do
(TeamSize sizeBeforeJoin) <- liftSem $ E.getSize tid
ensureNotTooLargeForLegalHold tid (fromIntegral sizeBeforeJoin + 1)
-getTeamSearchVisibilityAvailableInternal :: TeamId -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
+getTeamSearchVisibilityAvailableInternal ::
+ Member TeamFeatureStore r =>
+ TeamId ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
getTeamSearchVisibilityAvailableInternal tid = do
-- TODO: This is just redundant given there is a decent default
defConfig <- do
@@ -1246,28 +1293,44 @@ getTeamSearchVisibilityAvailableInternal tid = do
FeatureTeamSearchVisibilityEnabledByDefault -> Public.TeamFeatureEnabled
FeatureTeamSearchVisibilityDisabledByDefault -> Public.TeamFeatureDisabled
- fromMaybe defConfig
- <$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility tid
+ liftSem $
+ fromMaybe defConfig
+ <$> TeamFeatures.getFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility tid
-- | Modify and get visibility type for a team (internal, no user permission checks)
-getSearchVisibilityInternalH :: TeamId ::: JSON -> Galley r Response
+getSearchVisibilityInternalH ::
+ Member SearchVisibilityStore r =>
+ TeamId ::: JSON ->
+ Galley r Response
getSearchVisibilityInternalH (tid ::: _) =
json <$> getSearchVisibilityInternal tid
-getSearchVisibilityInternal :: TeamId -> Galley r TeamSearchVisibilityView
-getSearchVisibilityInternal = fmap TeamSearchVisibilityView . SearchVisibilityData.getSearchVisibility
-
-setSearchVisibilityInternalH :: TeamId ::: JsonRequest TeamSearchVisibilityView ::: JSON -> Galley r Response
+getSearchVisibilityInternal ::
+ Member SearchVisibilityStore r =>
+ TeamId ->
+ Galley r TeamSearchVisibilityView
+getSearchVisibilityInternal =
+ fmap TeamSearchVisibilityView . liftSem
+ . SearchVisibilityData.getSearchVisibility
+
+setSearchVisibilityInternalH ::
+ Members '[SearchVisibilityStore, TeamFeatureStore] r =>
+ TeamId ::: JsonRequest TeamSearchVisibilityView ::: JSON ->
+ Galley r Response
setSearchVisibilityInternalH (tid ::: req ::: _) = do
setSearchVisibilityInternal tid =<< fromJsonBody req
pure noContent
-setSearchVisibilityInternal :: TeamId -> TeamSearchVisibilityView -> Galley r ()
+setSearchVisibilityInternal ::
+ Members '[SearchVisibilityStore, TeamFeatureStore] r =>
+ TeamId ->
+ TeamSearchVisibilityView ->
+ Galley r ()
setSearchVisibilityInternal tid (TeamSearchVisibilityView searchVisibility) = do
status <- getTeamSearchVisibilityAvailableInternal tid
unless (Public.tfwoStatus status == Public.TeamFeatureEnabled) $
throwM teamSearchVisibilityNotEnabled
- SearchVisibilityData.setSearchVisibility tid searchVisibility
+ liftSem $ SearchVisibilityData.setSearchVisibility tid searchVisibility
userIsTeamOwnerH :: Member TeamStore r => TeamId ::: UserId ::: JSON -> Galley r Response
userIsTeamOwnerH (tid ::: uid ::: _) = do
diff --git a/services/galley/src/Galley/API/Teams/Features.hs b/services/galley/src/Galley/API/Teams/Features.hs
index f3dcd40448..4204906747 100644
--- a/services/galley/src/Galley/API/Teams/Features.hs
+++ b/services/galley/src/Galley/API/Teams/Features.hs
@@ -60,11 +60,12 @@ import Galley.API.Teams (ensureNotTooLargeToActivateLegalHold)
import Galley.API.Util
import Galley.App
import Galley.Cassandra.Paging
-import qualified Galley.Data.SearchVisibility as SearchVisibilityData
-import qualified Galley.Data.TeamFeatures as TeamFeatures
+import Galley.Data.TeamFeatures
import Galley.Effects
import Galley.Effects.GundeckAccess
import Galley.Effects.Paging
+import qualified Galley.Effects.SearchVisibilityStore as SearchVisibilityData
+import qualified Galley.Effects.TeamFeatureStore as TeamFeatures
import Galley.Effects.TeamStore
import Galley.Intra.Push (PushEvent (FeatureConfigEvent), newPush)
import Galley.Options
@@ -139,7 +140,10 @@ getFeatureConfig getter zusr = do
assertTeamExists tid
getter (Right tid)
-getAllFeatureConfigs :: Member TeamStore r => UserId -> Galley r AllFeatureConfigs
+getAllFeatureConfigs ::
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
+ UserId ->
+ Galley r AllFeatureConfigs
getAllFeatureConfigs zusr = do
mbTeam <- liftSem $ getOneUserTeam zusr
zusrMembership <- maybe (pure Nothing) (liftSem . (flip getTeamMember zusr)) mbTeam
@@ -172,11 +176,19 @@ getAllFeatureConfigs zusr = do
getStatus @'Public.TeamFeatureSelfDeletingMessages getSelfDeletingMessagesInternal
]
-getAllFeaturesH :: Member TeamStore r => UserId ::: TeamId ::: JSON -> Galley r Response
+getAllFeaturesH ::
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
+ UserId ::: TeamId ::: JSON ->
+ Galley r Response
getAllFeaturesH (uid ::: tid ::: _) =
json <$> getAllFeatures uid tid
-getAllFeatures :: forall r. Member TeamStore r => UserId -> TeamId -> Galley r Aeson.Value
+getAllFeatures ::
+ forall r.
+ Members '[LegalHoldStore, TeamFeatureStore, TeamStore] r =>
+ UserId ->
+ TeamId ->
+ Galley r Aeson.Value
getAllFeatures uid tid = do
Aeson.object
<$> sequence
@@ -206,20 +218,24 @@ getAllFeatures uid tid = do
getFeatureStatusNoConfig ::
forall (a :: Public.TeamFeatureName) r.
- (Public.KnownTeamFeatureName a, Public.FeatureHasNoConfig a, TeamFeatures.HasStatusCol a) =>
+ ( Public.KnownTeamFeatureName a,
+ Public.FeatureHasNoConfig a,
+ HasStatusCol a,
+ Member TeamFeatureStore r
+ ) =>
Galley r Public.TeamFeatureStatusValue ->
TeamId ->
Galley r (Public.TeamFeatureStatus a)
getFeatureStatusNoConfig getDefault tid = do
defaultStatus <- Public.TeamFeatureStatusNoConfig <$> getDefault
- fromMaybe defaultStatus <$> TeamFeatures.getFeatureStatusNoConfig @a tid
+ liftSem $ fromMaybe defaultStatus <$> TeamFeatures.getFeatureStatusNoConfig @a tid
setFeatureStatusNoConfig ::
forall (a :: Public.TeamFeatureName) r.
( Public.KnownTeamFeatureName a,
Public.FeatureHasNoConfig a,
- TeamFeatures.HasStatusCol a,
- Members '[GundeckAccess, TeamStore] r
+ HasStatusCol a,
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r
) =>
(Public.TeamFeatureStatusValue -> TeamId -> Galley r ()) ->
TeamId ->
@@ -227,7 +243,7 @@ setFeatureStatusNoConfig ::
Galley r (Public.TeamFeatureStatus a)
setFeatureStatusNoConfig applyState tid status = do
applyState (Public.tfwoStatus status) tid
- newStatus <- TeamFeatures.setFeatureStatusNoConfig @a tid status
+ newStatus <- liftSem $ TeamFeatures.setFeatureStatusNoConfig @a tid status
pushFeatureConfigEvent tid $
Event.Event Event.Update (Public.knownTeamFeatureName @a) (EdFeatureWithoutConfigChanged newStatus)
pure newStatus
@@ -236,7 +252,10 @@ setFeatureStatusNoConfig applyState tid status = do
-- the feature flag, so that we get more type safety.
type GetFeatureInternalParam = Either (Maybe UserId) TeamId
-getSSOStatusInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSSO)
+getSSOStatusInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSSO)
getSSOStatusInternal =
either
(const $ Public.TeamFeatureStatusNoConfig <$> getDef)
@@ -249,7 +268,7 @@ getSSOStatusInternal =
FeatureSSODisabledByDefault -> Public.TeamFeatureDisabled
setSSOStatusInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r =>
TeamId ->
(Public.TeamFeatureStatus 'Public.TeamFeatureSSO) ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSSO)
@@ -257,7 +276,10 @@ setSSOStatusInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSSO $ \case
Public.TeamFeatureDisabled -> const (throwM disableSsoNotImplemented)
Public.TeamFeatureEnabled -> const (pure ())
-getTeamSearchVisibilityAvailableInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
+getTeamSearchVisibilityAvailableInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
getTeamSearchVisibilityAvailableInternal =
either
(const $ Public.TeamFeatureStatusNoConfig <$> getDef)
@@ -269,15 +291,18 @@ getTeamSearchVisibilityAvailableInternal =
FeatureTeamSearchVisibilityDisabledByDefault -> Public.TeamFeatureDisabled
setTeamSearchVisibilityAvailableInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, SearchVisibilityStore, TeamFeatureStore, TeamStore] r =>
TeamId ->
(Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility) ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSearchVisibility)
setTeamSearchVisibilityAvailableInternal = setFeatureStatusNoConfig @'Public.TeamFeatureSearchVisibility $ \case
- Public.TeamFeatureDisabled -> SearchVisibilityData.resetSearchVisibility
+ Public.TeamFeatureDisabled -> liftSem . SearchVisibilityData.resetSearchVisibility
Public.TeamFeatureEnabled -> const (pure ())
-getValidateSAMLEmailsInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails)
+getValidateSAMLEmailsInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails)
getValidateSAMLEmailsInternal =
either
(const $ Public.TeamFeatureStatusNoConfig <$> getDef)
@@ -289,13 +314,16 @@ getValidateSAMLEmailsInternal =
getDef = pure Public.TeamFeatureDisabled
setValidateSAMLEmailsInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r =>
TeamId ->
(Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails) ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureValidateSAMLEmails)
setValidateSAMLEmailsInternal = setFeatureStatusNoConfig @'Public.TeamFeatureValidateSAMLEmails $ \_ _ -> pure ()
-getDigitalSignaturesInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures)
+getDigitalSignaturesInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures)
getDigitalSignaturesInternal =
either
(const $ Public.TeamFeatureStatusNoConfig <$> getDef)
@@ -307,13 +335,16 @@ getDigitalSignaturesInternal =
getDef = pure Public.TeamFeatureDisabled
setDigitalSignaturesInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r =>
TeamId ->
Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureDigitalSignatures)
setDigitalSignaturesInternal = setFeatureStatusNoConfig @'Public.TeamFeatureDigitalSignatures $ \_ _ -> pure ()
-getLegalholdStatusInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold)
+getLegalholdStatusInternal ::
+ Members '[LegalHoldStore, TeamFeatureStore] r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureLegalHold)
getLegalholdStatusInternal (Left _) =
pure $ Public.TeamFeatureStatusNoConfig Public.TeamFeatureDisabled
getLegalholdStatusInternal (Right tid) = do
@@ -333,8 +364,10 @@ setLegalholdStatusInternal ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
ListItems LegacyPaging ConvId,
MemberStore,
+ TeamFeatureStore,
TeamStore,
TeamMemberStore p
]
@@ -362,15 +395,18 @@ setLegalholdStatusInternal tid status@(Public.tfwoStatus -> statusValue) = do
Public.TeamFeatureDisabled -> removeSettings' tid
Public.TeamFeatureEnabled -> do
ensureNotTooLargeToActivateLegalHold tid
- TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status
+ liftSem $ TeamFeatures.setFeatureStatusNoConfig @'Public.TeamFeatureLegalHold tid status
-getFileSharingInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing)
+getFileSharingInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing)
getFileSharingInternal =
getFeatureStatusWithDefaultConfig @'Public.TeamFeatureFileSharing flagFileSharing . either (const Nothing) Just
getFeatureStatusWithDefaultConfig ::
forall (a :: TeamFeatureName) r.
- (KnownTeamFeatureName a, TeamFeatures.HasStatusCol a, FeatureHasNoConfig a) =>
+ (KnownTeamFeatureName a, HasStatusCol a, FeatureHasNoConfig a, Member TeamFeatureStore r) =>
Lens' FeatureFlags (Defaults (Public.TeamFeatureStatus a)) ->
Maybe TeamId ->
Galley r (Public.TeamFeatureStatus a)
@@ -385,23 +421,32 @@ getFeatureStatusWithDefaultConfig lens' =
<&> Public.tfwoStatus . view unDefaults
setFileSharingInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r =>
TeamId ->
Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureFileSharing)
setFileSharingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureFileSharing $ \_status _tid -> pure ()
-getAppLockInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock)
+getAppLockInternal ::
+ Member TeamFeatureStore r =>
+ GetFeatureInternalParam ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock)
getAppLockInternal mbtid = do
Defaults defaultStatus <- view (options . optSettings . setFeatureFlags . flagAppLockDefaults)
- status <- join <$> (TeamFeatures.getApplockFeatureStatus `mapM` either (const Nothing) Just mbtid)
+ status <-
+ liftSem $
+ join <$> (TeamFeatures.getApplockFeatureStatus `mapM` either (const Nothing) Just mbtid)
pure $ fromMaybe defaultStatus status
-setAppLockInternal :: TeamId -> Public.TeamFeatureStatus 'Public.TeamFeatureAppLock -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock)
+setAppLockInternal ::
+ Member TeamFeatureStore r =>
+ TeamId ->
+ Public.TeamFeatureStatus 'Public.TeamFeatureAppLock ->
+ Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureAppLock)
setAppLockInternal tid status = do
when (Public.applockInactivityTimeoutSecs (Public.tfwcConfig status) < 30) $
throwM inactivityTimeoutTooLow
- TeamFeatures.setApplockFeatureStatus tid status
+ liftSem $ TeamFeatures.setApplockFeatureStatus tid status
getClassifiedDomainsInternal :: GetFeatureInternalParam -> Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureClassifiedDomains)
getClassifiedDomainsInternal _mbtid = do
@@ -413,6 +458,7 @@ getClassifiedDomainsInternal _mbtid = do
Public.TeamFeatureEnabled -> config
getConferenceCallingInternal ::
+ Member TeamFeatureStore r =>
GetFeatureInternalParam ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling)
getConferenceCallingInternal (Left (Just uid)) = do
@@ -423,26 +469,32 @@ getConferenceCallingInternal (Right tid) = do
getFeatureStatusWithDefaultConfig @'Public.TeamFeatureConferenceCalling flagConferenceCalling (Just tid)
setConferenceCallingInternal ::
- Members '[GundeckAccess, TeamStore] r =>
+ Members '[GundeckAccess, TeamFeatureStore, TeamStore] r =>
TeamId ->
Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureConferenceCalling)
-setConferenceCallingInternal = setFeatureStatusNoConfig @'Public.TeamFeatureConferenceCalling $ \_status _tid -> pure ()
+setConferenceCallingInternal =
+ setFeatureStatusNoConfig @'Public.TeamFeatureConferenceCalling $ \_status _tid -> pure ()
getSelfDeletingMessagesInternal ::
+ Member TeamFeatureStore r =>
GetFeatureInternalParam ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages)
getSelfDeletingMessagesInternal = \case
Left _ -> pure Public.defaultSelfDeletingMessagesStatus
Right tid ->
- TeamFeatures.getSelfDeletingMessagesStatus tid
- <&> maybe Public.defaultSelfDeletingMessagesStatus id
+ liftSem $
+ TeamFeatures.getSelfDeletingMessagesStatus tid
+ <&> maybe Public.defaultSelfDeletingMessagesStatus id
setSelfDeletingMessagesInternal ::
+ Member TeamFeatureStore r =>
TeamId ->
Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages ->
Galley r (Public.TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages)
-setSelfDeletingMessagesInternal = TeamFeatures.setSelfDeletingMessagesStatus
+setSelfDeletingMessagesInternal tid value =
+ liftSem $
+ TeamFeatures.setSelfDeletingMessagesStatus tid value
pushFeatureConfigEvent ::
Members '[GundeckAccess, TeamStore] r =>
diff --git a/services/galley/src/Galley/API/Teams/Notifications.hs b/services/galley/src/Galley/API/Teams/Notifications.hs
index d37e42a64b..8b4b0117a1 100644
--- a/services/galley/src/Galley/API/Teams/Notifications.hs
+++ b/services/galley/src/Galley/API/Teams/Notifications.hs
@@ -53,6 +53,7 @@ import Galley.App
import qualified Galley.Data.TeamNotifications as DataTeamQueue
import Galley.Effects
import Galley.Effects.BrigAccess as Intra
+import qualified Galley.Effects.TeamNotificationStore as E
import Galley.Types.Teams hiding (newTeam)
import Gundeck.Types.Notification
import Imports
@@ -60,7 +61,7 @@ import Network.HTTP.Types
import Network.Wai.Utilities
getTeamNotifications ::
- Member BrigAccess r =>
+ Members '[BrigAccess, TeamNotificationStore] r =>
UserId ->
Maybe NotificationId ->
Range 1 10000 Int32 ->
@@ -70,17 +71,17 @@ getTeamNotifications zusr since size = do
mtid <- liftSem $ (userTeam . accountUser =<<) <$> Intra.getUser zusr
let err = throwM teamNotFound
maybe err pure mtid
- page <- DataTeamQueue.fetch tid since size
+ page <- liftSem $ E.getTeamNotifications tid since size
pure $
queuedNotificationList
(toList (DataTeamQueue.resultSeq page))
(DataTeamQueue.resultHasMore page)
Nothing
-pushTeamEvent :: TeamId -> Event -> Galley r ()
+pushTeamEvent :: Member TeamNotificationStore r => TeamId -> Event -> Galley r ()
pushTeamEvent tid evt = do
nid <- mkNotificationId
- DataTeamQueue.add tid nid (List1.singleton $ toJSONObject evt)
+ liftSem $ E.createTeamNotification tid nid (List1.singleton $ toJSONObject evt)
-- | 'Data.UUID.V1.nextUUID' is sometimes unsuccessful, so we try a few times.
mkNotificationId :: (MonadIO m, MonadThrow m) => m NotificationId
diff --git a/services/galley/src/Galley/API/Update.hs b/services/galley/src/Galley/API/Update.hs
index 43190d9d83..7708afa49e 100644
--- a/services/galley/src/Galley/API/Update.hs
+++ b/services/galley/src/Galley/API/Update.hs
@@ -92,8 +92,6 @@ import Galley.API.Mapping
import Galley.API.Message
import Galley.API.Util
import Galley.App
-import Galley.Cassandra.Services
-import qualified Galley.Data.Access as Data
import qualified Galley.Data.Conversation as Data
import Galley.Data.Services as Data
import Galley.Data.Types hiding (Conversation)
@@ -107,6 +105,7 @@ import qualified Galley.Effects.ExternalAccess as E
import qualified Galley.Effects.FederatorAccess as E
import qualified Galley.Effects.GundeckAccess as E
import qualified Galley.Effects.MemberStore as E
+import qualified Galley.Effects.ServiceStore as E
import qualified Galley.Effects.TeamStore as E
import Galley.Intra.Push
import Galley.Options
@@ -282,6 +281,7 @@ performAccessUpdateAction ::
FederatorAccess,
FireAndForget,
GundeckAccess,
+ LegalHoldStore,
MemberStore,
TeamStore
]
@@ -457,6 +457,7 @@ type UpdateConversationActions =
GundeckAccess,
CodeStore,
ConversationStore,
+ LegalHoldStore,
MemberStore,
TeamStore
]
@@ -1432,14 +1433,14 @@ isTyping zusr zcon cnv typingData = do
& pushRoute .~ RouteDirect
& pushTransient .~ True
-addServiceH :: JsonRequest Service -> Galley r Response
+addServiceH :: Member ServiceStore r => JsonRequest Service -> Galley r Response
addServiceH req = do
- insertService =<< fromJsonBody req
+ liftSem . E.createService =<< fromJsonBody req
return empty
-rmServiceH :: JsonRequest ServiceRef -> Galley r Response
+rmServiceH :: Member ServiceStore r => JsonRequest ServiceRef -> Galley r Response
rmServiceH req = do
- deleteService =<< fromJsonBody req
+ liftSem . E.deleteService =<< fromJsonBody req
return empty
addBotH ::
diff --git a/services/galley/src/Galley/API/Util.hs b/services/galley/src/Galley/API/Util.hs
index 17c8a47415..5f434712e3 100644
--- a/services/galley/src/Galley/API/Util.hs
+++ b/services/galley/src/Galley/API/Util.hs
@@ -42,7 +42,6 @@ import Data.Time
import Galley.API.Error
import Galley.App
import qualified Galley.Data.Conversation as Data
-import Galley.Data.LegalHold (isTeamLegalholdWhitelisted)
import Galley.Data.Services (BotMember, newBotMember)
import qualified Galley.Data.Types as DataTypes
import Galley.Effects
@@ -52,6 +51,7 @@ import Galley.Effects.ConversationStore
import Galley.Effects.ExternalAccess
import Galley.Effects.FederatorAccess
import Galley.Effects.GundeckAccess
+import Galley.Effects.LegalHoldStore
import Galley.Effects.MemberStore
import Galley.Effects.TeamStore
import Galley.Intra.Push
@@ -797,7 +797,10 @@ anyLegalholdActivated uids = do
teamsOfUsers <- liftSem $ getUsersTeams uidsPage
anyM (\uid -> userLHEnabled <$> getLHStatus (Map.lookup uid teamsOfUsers) uid) uidsPage
-allLegalholdConsentGiven :: Member TeamStore r => [UserId] -> Galley r Bool
+allLegalholdConsentGiven ::
+ Members '[LegalHoldStore, TeamStore] r =>
+ [UserId] ->
+ Galley r Bool
allLegalholdConsentGiven uids = do
view (options . optSettings . setFeatureFlags . flagLegalHold) >>= \case
FeatureLegalHoldDisabledPermanently -> pure False
@@ -811,7 +814,7 @@ allLegalholdConsentGiven uids = do
-- conversation with user under legalhold.
flip allM (chunksOf 32 uids) $ \uidsPage -> do
teamsPage <- liftSem $ nub . Map.elems <$> getUsersTeams uidsPage
- allM isTeamLegalholdWhitelisted teamsPage
+ allM (liftSem . isTeamLegalholdWhitelisted) teamsPage
-- | Add to every uid the legalhold status
getLHStatusForUsers ::
diff --git a/services/galley/src/Galley/App.hs b/services/galley/src/Galley/App.hs
index cc0dfcd04b..bdb74e4992 100644
--- a/services/galley/src/Galley/App.hs
+++ b/services/galley/src/Galley/App.hs
@@ -91,8 +91,13 @@ import Galley.Cassandra.Code
import Galley.Cassandra.Conversation
import Galley.Cassandra.Conversation.Members
import Galley.Cassandra.ConversationList
+import Galley.Cassandra.CustomBackend
+import Galley.Cassandra.LegalHold
+import Galley.Cassandra.SearchVisibility
import Galley.Cassandra.Services
import Galley.Cassandra.Team
+import Galley.Cassandra.TeamFeatures
+import Galley.Cassandra.TeamNotifications
import Galley.Effects
import Galley.Effects.FireAndForget (interpretFireAndForget)
import qualified Galley.Effects.FireAndForget as E
@@ -158,12 +163,6 @@ instance MonadReader Env (Galley r) where
ask = Galley $ P.ask @Env
local f m = Galley $ P.local f (unGalley m)
-instance MonadClient (Galley r) where
- liftClient m = Galley $ do
- cs <- P.ask @ClientState
- embed @IO $ runClient cs m
- localState f m = Galley $ P.local f (unGalley m)
-
instance HasFederatorConfig (Galley r) where
federatorEndpoint = view federator
federationDomain = view (options . optSettings . setFederationDomain)
@@ -333,8 +332,13 @@ interpretGalleyToGalley0 =
. interpretConversationListToCassandra
. withLH interpretTeamMemberStoreToCassandra
. withLH interpretTeamStoreToCassandra
+ . interpretTeamNotificationStoreToCassandra
+ . interpretTeamFeatureStoreToCassandra
. interpretServiceStoreToCassandra
+ . interpretSearchVisibilityStoreToCassandra
. interpretMemberStoreToCassandra
+ . withLH interpretLegalHoldStoreToCassandra
+ . interpretCustomBackendStoreToCassandra
. interpretConversationStoreToCassandra
. interpretCodeStoreToCassandra
. interpretClientStoreToCassandra
diff --git a/services/galley/src/Galley/Data/Access.hs b/services/galley/src/Galley/Cassandra/Access.hs
similarity index 67%
rename from services/galley/src/Galley/Data/Access.hs
rename to services/galley/src/Galley/Cassandra/Access.hs
index e2dfb0b7f5..a2c4fb176b 100644
--- a/services/galley/src/Galley/Data/Access.hs
+++ b/services/galley/src/Galley/Cassandra/Access.hs
@@ -15,11 +15,10 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Data.Access where
+module Galley.Cassandra.Access where
import Cassandra
-import qualified Data.Set as Set
-import Galley.Data.Conversation.Types
+import Galley.Data.Conversation
import Imports hiding (Set)
import Wire.API.Conversation hiding (Conversation)
@@ -34,27 +33,5 @@ defAccess One2OneConv (Just (Set [])) = [PrivateAccess]
defAccess RegularConv (Just (Set [])) = defRegularConvAccess
defAccess _ (Just (Set (x : xs))) = x : xs
-defRegularConvAccess :: [Access]
-defRegularConvAccess = [InviteAccess]
-
-maybeRole :: ConvType -> Maybe AccessRole -> AccessRole
-maybeRole SelfConv _ = privateRole
-maybeRole ConnectConv _ = privateRole
-maybeRole One2OneConv _ = privateRole
-maybeRole RegularConv Nothing = defRole
-maybeRole RegularConv (Just r) = r
-
-defRole :: AccessRole
-defRole = ActivatedAccessRole
-
-privateRole :: AccessRole
-privateRole = PrivateAccessRole
-
privateOnly :: Set Access
privateOnly = Set [PrivateAccess]
-
-convAccessData :: Conversation -> ConversationAccessData
-convAccessData conv =
- ConversationAccessData
- (Set.fromList (convAccess conv))
- (convAccessRole conv)
diff --git a/services/galley/src/Galley/Cassandra/Client.hs b/services/galley/src/Galley/Cassandra/Client.hs
index ecf66e2f0f..ee0f4e3bda 100644
--- a/services/galley/src/Galley/Cassandra/Client.hs
+++ b/services/galley/src/Galley/Cassandra/Client.hs
@@ -25,8 +25,8 @@ import Cassandra
import Control.Arrow
import Data.Id
import Data.List.Split (chunksOf)
+import qualified Galley.Cassandra.Queries as Cql
import Galley.Cassandra.Store
-import qualified Galley.Data.Queries as Cql
import Galley.Effects.ClientStore (ClientStore (..))
import Galley.Types.Clients (Clients)
import qualified Galley.Types.Clients as Clients
diff --git a/services/galley/src/Galley/Cassandra/Code.hs b/services/galley/src/Galley/Cassandra/Code.hs
index c41e3c09b4..ac9d03525a 100644
--- a/services/galley/src/Galley/Cassandra/Code.hs
+++ b/services/galley/src/Galley/Cassandra/Code.hs
@@ -22,8 +22,8 @@ where
import Brig.Types.Code
import Cassandra
+import qualified Galley.Cassandra.Queries as Cql
import Galley.Cassandra.Store
-import qualified Galley.Data.Queries as Cql
import Galley.Data.Types
import Galley.Effects.CodeStore (CodeStore (..))
import Imports
diff --git a/services/galley/src/Galley/Cassandra/Conversation.hs b/services/galley/src/Galley/Cassandra/Conversation.hs
index 2522fd3ef6..04822d1850 100644
--- a/services/galley/src/Galley/Cassandra/Conversation.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation.hs
@@ -22,7 +22,8 @@ module Galley.Cassandra.Conversation
)
where
-import Cassandra
+import Cassandra hiding (Set)
+import qualified Cassandra as Cql
import Data.ByteString.Conversion
import Data.Id
import qualified Data.Map as Map
@@ -31,12 +32,12 @@ import Data.Qualified
import Data.Range
import qualified Data.UUID.Tagged as U
import Data.UUID.V4 (nextRandom)
+import Galley.Cassandra.Access
import Galley.Cassandra.Conversation.Members
+import qualified Galley.Cassandra.Queries as Cql
import Galley.Cassandra.Store
-import Galley.Data.Access
import Galley.Data.Conversation
import Galley.Data.Conversation.Types
-import qualified Galley.Data.Queries as Cql
import Galley.Effects.ConversationStore (ConversationStore (..))
import Galley.Types.Conversations.Members
import Galley.Types.UserList
@@ -55,11 +56,11 @@ createConversation (NewConversation ty usr acc arole name mtid mtimer recpt user
conv <- Id <$> liftIO nextRandom
retry x5 $ case mtid of
Nothing ->
- write Cql.insertConv (params LocalQuorum (conv, ty, usr, Set (toList acc), arole, fmap fromRange name, Nothing, mtimer, recpt))
+ write Cql.insertConv (params LocalQuorum (conv, ty, usr, Cql.Set (toList acc), arole, fmap fromRange name, Nothing, mtimer, recpt))
Just tid -> batch $ do
setType BatchLogged
setConsistency LocalQuorum
- addPrepQuery Cql.insertConv (conv, ty, usr, Set (toList acc), arole, fmap fromRange name, Just tid, mtimer, recpt)
+ addPrepQuery Cql.insertConv (conv, ty, usr, Cql.Set (toList acc), arole, fmap fromRange name, Just tid, mtimer, recpt)
addPrepQuery Cql.insertTeamConv (tid, conv, False)
let newUsers = fmap (,role) (fromConvSize users)
(lmems, rmems) <- addMembers conv (ulAddLocal (usr, roleNameWireAdmin) newUsers)
@@ -249,7 +250,7 @@ updateConvName cid name = retry x5 $ write Cql.updateConvName (params LocalQuoru
updateConvAccess :: ConvId -> ConversationAccessData -> Client ()
updateConvAccess cid (ConversationAccessData acc role) =
retry x5 $
- write Cql.updateConvAccess (params LocalQuorum (Set (toList acc), role, cid))
+ write Cql.updateConvAccess (params LocalQuorum (Cql.Set (toList acc), role, cid))
updateConvReceiptMode :: ConvId -> ReceiptMode -> Client ()
updateConvReceiptMode cid receiptMode = retry x5 $ write Cql.updateConvReceiptMode (params LocalQuorum (receiptMode, cid))
@@ -332,6 +333,17 @@ remoteConversationStatusOnDomain uid rconvs =
toMemberStatus (omus, omur, oar, oarr, hid, hidr)
)
+toConv ::
+ ConvId ->
+ [LocalMember] ->
+ [RemoteMember] ->
+ Maybe (ConvType, UserId, Maybe (Cql.Set Access), Maybe AccessRole, Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode) ->
+ Maybe Conversation
+toConv cid mms remoteMems conv =
+ f mms <$> conv
+ where
+ f ms (cty, uid, acc, role, nme, ti, del, timer, rm) = Conversation cid cty uid nme (defAccess cty acc) (maybeRole cty role) ms remoteMems ti del timer rm
+
interpretConversationStoreToCassandra ::
Members '[Embed IO, P.Reader ClientState, TinyLog] r =>
Sem (ConversationStore ': r) a ->
diff --git a/services/galley/src/Galley/Cassandra/Conversation/Members.hs b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
index 3a69e61899..039fc64342 100644
--- a/services/galley/src/Galley/Cassandra/Conversation/Members.hs
+++ b/services/galley/src/Galley/Cassandra/Conversation/Members.hs
@@ -34,10 +34,10 @@ import qualified Data.List.Extra as List
import qualified Data.Map as Map
import Data.Monoid
import Data.Qualified
+import Galley.Cassandra.Instances ()
+import qualified Galley.Cassandra.Queries as Cql
import Galley.Cassandra.Services
import Galley.Cassandra.Store
-import Galley.Data.Instances ()
-import qualified Galley.Data.Queries as Cql
import Galley.Effects.MemberStore
import Galley.Types.Conversations.Members
import Galley.Types.ToUserRole
diff --git a/services/galley/src/Galley/Cassandra/ConversationList.hs b/services/galley/src/Galley/Cassandra/ConversationList.hs
index 76d8139dab..324b7fad34 100644
--- a/services/galley/src/Galley/Cassandra/ConversationList.hs
+++ b/services/galley/src/Galley/Cassandra/ConversationList.hs
@@ -26,11 +26,11 @@ import Cassandra
import Data.Id
import Data.Qualified
import Data.Range
+import Galley.Cassandra.Instances ()
import Galley.Cassandra.Paging
+import qualified Galley.Cassandra.Queries as Cql
+import Galley.Cassandra.ResultSet
import Galley.Cassandra.Store
-import Galley.Data.Instances ()
-import qualified Galley.Data.Queries as Cql
-import Galley.Data.ResultSet
import Galley.Effects.ListItems
import Imports hiding (max)
import Polysemy
diff --git a/services/galley/src/Galley/Data/CustomBackend.hs b/services/galley/src/Galley/Cassandra/CustomBackend.hs
similarity index 69%
rename from services/galley/src/Galley/Data/CustomBackend.hs
rename to services/galley/src/Galley/Cassandra/CustomBackend.hs
index ec6955e16b..fe757271b8 100644
--- a/services/galley/src/Galley/Data/CustomBackend.hs
+++ b/services/galley/src/Galley/Cassandra/CustomBackend.hs
@@ -17,19 +17,27 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Data.CustomBackend
- ( getCustomBackend,
- setCustomBackend,
- deleteCustomBackend,
- )
-where
+module Galley.Cassandra.CustomBackend (interpretCustomBackendStoreToCassandra) where
import Cassandra
import Data.Domain (Domain)
-import Galley.Data.Instances ()
-import qualified Galley.Data.Queries as Cql
+import Galley.Cassandra.Instances ()
+import qualified Galley.Cassandra.Queries as Cql
+import Galley.Cassandra.Store
+import Galley.Effects.CustomBackendStore (CustomBackendStore (..))
import Galley.Types
import Imports
+import Polysemy
+import qualified Polysemy.Reader as P
+
+interpretCustomBackendStoreToCassandra ::
+ Members '[Embed IO, P.Reader ClientState] r =>
+ Sem (CustomBackendStore ': r) a ->
+ Sem r a
+interpretCustomBackendStoreToCassandra = interpret $ \case
+ GetCustomBackend dom -> embedClient $ getCustomBackend dom
+ SetCustomBackend dom b -> embedClient $ setCustomBackend dom b
+ DeleteCustomBackend dom -> embedClient $ deleteCustomBackend dom
getCustomBackend :: MonadClient m => Domain -> m (Maybe CustomBackend)
getCustomBackend domain =
diff --git a/services/galley/src/Galley/Data/Instances.hs b/services/galley/src/Galley/Cassandra/Instances.hs
similarity index 99%
rename from services/galley/src/Galley/Data/Instances.hs
rename to services/galley/src/Galley/Cassandra/Instances.hs
index b1d259548e..198aa2675c 100644
--- a/services/galley/src/Galley/Data/Instances.hs
+++ b/services/galley/src/Galley/Cassandra/Instances.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.Data.Instances
+module Galley.Cassandra.Instances
(
)
where
diff --git a/services/galley/src/Galley/Cassandra/LegalHold.hs b/services/galley/src/Galley/Cassandra/LegalHold.hs
index 12f687abd8..87345d5c79 100644
--- a/services/galley/src/Galley/Cassandra/LegalHold.hs
+++ b/services/galley/src/Galley/Cassandra/LegalHold.hs
@@ -15,13 +15,99 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Cassandra.LegalHold (isTeamLegalholdWhitelisted) where
+module Galley.Cassandra.LegalHold
+ ( interpretLegalHoldStoreToCassandra,
+ isTeamLegalholdWhitelisted,
+ -- * Used by tests
+ selectPendingPrekeys,
+ )
+where
+
+import Brig.Types.Client.Prekey
+import Brig.Types.Instances ()
+import Brig.Types.Team.LegalHold
import Cassandra
+import Control.Lens (unsnoc)
import Data.Id
-import Galley.Data.Queries as Q
+import Data.LegalHold
+import Galley.Cassandra.Instances ()
+import qualified Galley.Cassandra.Queries as Q
+import Galley.Cassandra.Store
+import Galley.Effects.LegalHoldStore (LegalHoldStore (..))
import Galley.Types.Teams
import Imports
+import Polysemy
+import qualified Polysemy.Reader as P
+
+interpretLegalHoldStoreToCassandra ::
+ Members '[Embed IO, P.Reader ClientState] r =>
+ FeatureLegalHold ->
+ Sem (LegalHoldStore ': r) a ->
+ Sem r a
+interpretLegalHoldStoreToCassandra lh = interpret $ \case
+ CreateSettings s -> embedClient $ createSettings s
+ GetSettings tid -> embedClient $ getSettings tid
+ RemoveSettings tid -> embedClient $ removeSettings tid
+ InsertPendingPrekeys uid pkeys -> embedClient $ insertPendingPrekeys uid pkeys
+ SelectPendingPrekeys uid -> embedClient $ selectPendingPrekeys uid
+ DropPendingPrekeys uid -> embedClient $ dropPendingPrekeys uid
+ SetUserLegalHoldStatus tid uid st -> embedClient $ setUserLegalHoldStatus tid uid st
+ SetTeamLegalholdWhitelisted tid -> embedClient $ setTeamLegalholdWhitelisted tid
+ UnsetTeamLegalholdWhitelisted tid -> embedClient $ unsetTeamLegalholdWhitelisted tid
+ IsTeamLegalholdWhitelisted tid -> embedClient $ isTeamLegalholdWhitelisted lh tid
+
+-- | Returns 'False' if legal hold is not enabled for this team
+-- The Caller is responsible for checking whether legal hold is enabled for this team
+createSettings :: MonadClient m => LegalHoldService -> m ()
+createSettings (LegalHoldService tid url fpr tok key) = do
+ retry x1 $ write Q.insertLegalHoldSettings (params LocalQuorum (url, fpr, tok, key, tid))
+
+-- | Returns 'Nothing' if no settings are saved
+-- The Caller is responsible for checking whether legal hold is enabled for this team
+getSettings :: MonadClient m => TeamId -> m (Maybe LegalHoldService)
+getSettings tid =
+ fmap toLegalHoldService <$> do
+ retry x1 $ query1 Q.selectLegalHoldSettings (params LocalQuorum (Identity tid))
+ where
+ toLegalHoldService (httpsUrl, fingerprint, tok, key) = LegalHoldService tid httpsUrl fingerprint tok key
+
+removeSettings :: MonadClient m => TeamId -> m ()
+removeSettings tid = retry x5 (write Q.removeLegalHoldSettings (params LocalQuorum (Identity tid)))
+
+insertPendingPrekeys :: MonadClient m => UserId -> [Prekey] -> m ()
+insertPendingPrekeys uid keys = retry x5 . batch $
+ forM_ keys $
+ \key ->
+ addPrepQuery Q.insertPendingPrekeys (toTuple key)
+ where
+ toTuple (Prekey keyId key) = (uid, keyId, key)
+
+selectPendingPrekeys :: MonadClient m => UserId -> m (Maybe ([Prekey], LastPrekey))
+selectPendingPrekeys uid =
+ pickLastKey . fmap fromTuple
+ <$> retry x1 (query Q.selectPendingPrekeys (params LocalQuorum (Identity uid)))
+ where
+ fromTuple (keyId, key) = Prekey keyId key
+ pickLastKey allPrekeys =
+ case unsnoc allPrekeys of
+ Nothing -> Nothing
+ Just (keys, lst) -> pure (keys, lastPrekey . prekeyKey $ lst)
+
+dropPendingPrekeys :: MonadClient m => UserId -> m ()
+dropPendingPrekeys uid = retry x5 (write Q.dropPendingPrekeys (params LocalQuorum (Identity uid)))
+
+setUserLegalHoldStatus :: MonadClient m => TeamId -> UserId -> UserLegalHoldStatus -> m ()
+setUserLegalHoldStatus tid uid status =
+ retry x5 (write Q.updateUserLegalHoldStatus (params LocalQuorum (status, tid, uid)))
+
+setTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m ()
+setTeamLegalholdWhitelisted tid =
+ retry x5 (write Q.insertLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid)))
+
+unsetTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m ()
+unsetTeamLegalholdWhitelisted tid =
+ retry x5 (write Q.removeLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid)))
isTeamLegalholdWhitelisted :: FeatureLegalHold -> TeamId -> Client Bool
isTeamLegalholdWhitelisted FeatureLegalHoldDisabledPermanently _ = pure False
diff --git a/services/galley/src/Galley/Cassandra/Paging.hs b/services/galley/src/Galley/Cassandra/Paging.hs
index d2ea8e4cd2..f4dd6a07c7 100644
--- a/services/galley/src/Galley/Cassandra/Paging.hs
+++ b/services/galley/src/Galley/Cassandra/Paging.hs
@@ -23,6 +23,12 @@ module Galley.Cassandra.Paging
InternalPagingState (..),
mkInternalPage,
ipNext,
+
+ -- * Re-exports
+ ResultSet,
+ resultSetResult,
+ resultSetType,
+ ResultSetType (..),
)
where
@@ -30,7 +36,7 @@ import Cassandra
import Data.Id
import Data.Qualified
import Data.Range
-import Galley.Data.ResultSet
+import Galley.Cassandra.ResultSet
import qualified Galley.Effects.Paging as E
import Imports
import Wire.API.Team.Member (HardTruncationLimit, TeamMember)
diff --git a/services/galley/src/Galley/Data/Queries.hs b/services/galley/src/Galley/Cassandra/Queries.hs
similarity index 99%
rename from services/galley/src/Galley/Data/Queries.hs
rename to services/galley/src/Galley/Cassandra/Queries.hs
index fc919ac312..641fdcbe57 100644
--- a/services/galley/src/Galley/Data/Queries.hs
+++ b/services/galley/src/Galley/Cassandra/Queries.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.Data.Queries where
+module Galley.Cassandra.Queries where
import Brig.Types.Client.Prekey
import Brig.Types.Code
diff --git a/services/galley/src/Galley/Data/ResultSet.hs b/services/galley/src/Galley/Cassandra/ResultSet.hs
similarity index 98%
rename from services/galley/src/Galley/Data/ResultSet.hs
rename to services/galley/src/Galley/Cassandra/ResultSet.hs
index 78db286a0e..441a5baa40 100644
--- a/services/galley/src/Galley/Data/ResultSet.hs
+++ b/services/galley/src/Galley/Cassandra/ResultSet.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.Data.ResultSet where
+module Galley.Cassandra.ResultSet where
import Cassandra
import Imports
diff --git a/services/galley/src/Galley/Data/SearchVisibility.hs b/services/galley/src/Galley/Cassandra/SearchVisibility.hs
similarity index 71%
rename from services/galley/src/Galley/Data/SearchVisibility.hs
rename to services/galley/src/Galley/Cassandra/SearchVisibility.hs
index f291fae8d1..cd3905ad4c 100644
--- a/services/galley/src/Galley/Data/SearchVisibility.hs
+++ b/services/galley/src/Galley/Cassandra/SearchVisibility.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ViewPatterns #-}
-
-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 Wire Swiss GmbH
@@ -17,19 +15,27 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Data.SearchVisibility
- ( setSearchVisibility,
- getSearchVisibility,
- resetSearchVisibility,
- )
-where
+module Galley.Cassandra.SearchVisibility (interpretSearchVisibilityStoreToCassandra) where
import Cassandra
import Data.Id
-import Galley.Data.Instances ()
-import Galley.Data.Queries
+import Galley.Cassandra.Instances ()
+import Galley.Cassandra.Queries
+import Galley.Cassandra.Store
+import Galley.Effects.SearchVisibilityStore (SearchVisibilityStore (..))
import Galley.Types.Teams.SearchVisibility
import Imports
+import Polysemy
+import qualified Polysemy.Reader as P
+
+interpretSearchVisibilityStoreToCassandra ::
+ Members '[Embed IO, P.Reader ClientState] r =>
+ Sem (SearchVisibilityStore ': r) a ->
+ Sem r a
+interpretSearchVisibilityStoreToCassandra = interpret $ \case
+ GetSearchVisibility tid -> embedClient $ getSearchVisibility tid
+ SetSearchVisibility tid value -> embedClient $ setSearchVisibility tid value
+ ResetSearchVisibility tid -> embedClient $ resetSearchVisibility tid
-- | Return whether a given team is allowed to enable/disable sso
getSearchVisibility :: MonadClient m => TeamId -> m TeamSearchVisibility
diff --git a/services/galley/src/Galley/Cassandra/Services.hs b/services/galley/src/Galley/Cassandra/Services.hs
index b6e7f7403f..724c5dab5f 100644
--- a/services/galley/src/Galley/Cassandra/Services.hs
+++ b/services/galley/src/Galley/Cassandra/Services.hs
@@ -20,8 +20,8 @@ module Galley.Cassandra.Services where
import Cassandra
import Control.Lens
import Data.Id
+import Galley.Cassandra.Queries
import Galley.Cassandra.Store
-import Galley.Data.Queries
import Galley.Data.Services
import Galley.Effects.ServiceStore (ServiceStore (..))
import Galley.Types hiding (Conversation)
diff --git a/services/galley/src/Galley/Cassandra/Team.hs b/services/galley/src/Galley/Cassandra/Team.hs
index 709b236d1a..9e5ece8d00 100644
--- a/services/galley/src/Galley/Cassandra/Team.hs
+++ b/services/galley/src/Galley/Cassandra/Team.hs
@@ -39,10 +39,9 @@ import Data.UUID.V4 (nextRandom)
import qualified Galley.Cassandra.Conversation as C
import Galley.Cassandra.LegalHold (isTeamLegalholdWhitelisted)
import Galley.Cassandra.Paging
+import qualified Galley.Cassandra.Queries as Cql
+import Galley.Cassandra.ResultSet
import Galley.Cassandra.Store
-import Galley.Data.Instances ()
-import qualified Galley.Data.Queries as Cql
-import Galley.Data.ResultSet
import Galley.Effects.ListItems
import Galley.Effects.TeamMemberStore
import Galley.Effects.TeamStore (TeamStore (..))
diff --git a/services/galley/src/Galley/Cassandra/TeamFeatures.hs b/services/galley/src/Galley/Cassandra/TeamFeatures.hs
new file mode 100644
index 0000000000..7ef181c87a
--- /dev/null
+++ b/services/galley/src/Galley/Cassandra/TeamFeatures.hs
@@ -0,0 +1,153 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 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.Cassandra.TeamFeatures (interpretTeamFeatureStoreToCassandra) where
+
+import Cassandra
+import Data.Id
+import Data.Proxy
+import Galley.Cassandra.Instances ()
+import Galley.Cassandra.Store
+import Galley.Data.TeamFeatures
+import Galley.Effects.TeamFeatureStore (TeamFeatureStore (..))
+import Imports
+import Polysemy
+import qualified Polysemy.Reader as P
+import Wire.API.Team.Feature
+
+getFeatureStatusNoConfig ::
+ forall (a :: TeamFeatureName) m.
+ ( MonadClient m,
+ FeatureHasNoConfig a,
+ HasStatusCol a
+ ) =>
+ Proxy a ->
+ TeamId ->
+ m (Maybe (TeamFeatureStatus a))
+getFeatureStatusNoConfig _ tid = do
+ let q = query1 select (params LocalQuorum (Identity tid))
+ mStatusValue <- (>>= runIdentity) <$> retry x1 q
+ pure $ TeamFeatureStatusNoConfig <$> mStatusValue
+ where
+ select :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatusValue))
+ select = fromString $ "select " <> statusCol @a <> " from team_features where team_id = ?"
+
+setFeatureStatusNoConfig ::
+ forall (a :: TeamFeatureName) m.
+ ( MonadClient m,
+ FeatureHasNoConfig a,
+ HasStatusCol a
+ ) =>
+ Proxy a ->
+ TeamId ->
+ TeamFeatureStatus a ->
+ m (TeamFeatureStatus a)
+setFeatureStatusNoConfig _ tid status = do
+ let flag = tfwoStatus status
+ retry x5 $ write insert (params LocalQuorum (tid, flag))
+ pure status
+ where
+ insert :: PrepQuery W (TeamId, TeamFeatureStatusValue) ()
+ insert = fromString $ "insert into team_features (team_id, " <> statusCol @a <> ") values (?, ?)"
+
+getApplockFeatureStatus ::
+ forall m.
+ (MonadClient m) =>
+ TeamId ->
+ m (Maybe (TeamFeatureStatus 'TeamFeatureAppLock))
+getApplockFeatureStatus tid = do
+ let q = query1 select (params LocalQuorum (Identity tid))
+ mTuple <- retry x1 q
+ pure $
+ mTuple >>= \(mbStatusValue, mbEnforce, mbTimeout) ->
+ TeamFeatureStatusWithConfig <$> mbStatusValue <*> (TeamFeatureAppLockConfig <$> mbEnforce <*> mbTimeout)
+ where
+ select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe EnforceAppLock, Maybe Int32)
+ select =
+ fromString $
+ "select " <> statusCol @'TeamFeatureAppLock <> ", app_lock_enforce, app_lock_inactivity_timeout_secs "
+ <> "from team_features where team_id = ?"
+
+setApplockFeatureStatus ::
+ (MonadClient m) =>
+ TeamId ->
+ TeamFeatureStatus 'TeamFeatureAppLock ->
+ m (TeamFeatureStatus 'TeamFeatureAppLock)
+setApplockFeatureStatus tid status = do
+ let statusValue = tfwcStatus status
+ enforce = applockEnforceAppLock . tfwcConfig $ status
+ timeout = applockInactivityTimeoutSecs . tfwcConfig $ status
+ retry x5 $ write insert (params LocalQuorum (tid, statusValue, enforce, timeout))
+ pure status
+ where
+ insert :: PrepQuery W (TeamId, TeamFeatureStatusValue, EnforceAppLock, Int32) ()
+ insert =
+ fromString $
+ "insert into team_features (team_id, "
+ <> statusCol @'TeamFeatureAppLock
+ <> ", app_lock_enforce, app_lock_inactivity_timeout_secs) values (?, ?, ?, ?)"
+
+getSelfDeletingMessagesStatus ::
+ forall m.
+ (MonadClient m) =>
+ TeamId ->
+ m (Maybe (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages))
+getSelfDeletingMessagesStatus tid = do
+ let q = query1 select (params LocalQuorum (Identity tid))
+ mTuple <- retry x1 q
+ pure $
+ mTuple >>= \(mbStatusValue, mbTimeout) ->
+ TeamFeatureStatusWithConfig <$> mbStatusValue <*> (TeamFeatureSelfDeletingMessagesConfig <$> mbTimeout)
+ where
+ select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Int32)
+ select =
+ fromString $
+ "select "
+ <> statusCol @'TeamFeatureSelfDeletingMessages
+ <> ", self_deleting_messages_ttl "
+ <> "from team_features where team_id = ?"
+
+setSelfDeletingMessagesStatus ::
+ (MonadClient m) =>
+ TeamId ->
+ TeamFeatureStatus 'TeamFeatureSelfDeletingMessages ->
+ m (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages)
+setSelfDeletingMessagesStatus tid status = do
+ let statusValue = tfwcStatus status
+ timeout = sdmEnforcedTimeoutSeconds . tfwcConfig $ status
+ retry x5 $ write insert (params LocalQuorum (tid, statusValue, timeout))
+ pure status
+ where
+ insert :: PrepQuery W (TeamId, TeamFeatureStatusValue, Int32) ()
+ insert =
+ fromString $
+ "insert into team_features (team_id, "
+ <> statusCol @'TeamFeatureSelfDeletingMessages
+ <> ", self_deleting_messages_ttl) "
+ <> "values (?, ?, ?)"
+
+interpretTeamFeatureStoreToCassandra ::
+ Members '[Embed IO, P.Reader ClientState] r =>
+ Sem (TeamFeatureStore ': r) a ->
+ Sem r a
+interpretTeamFeatureStoreToCassandra = interpret $ \case
+ GetFeatureStatusNoConfig' p tid -> embedClient $ getFeatureStatusNoConfig p tid
+ SetFeatureStatusNoConfig' p tid value -> embedClient $ setFeatureStatusNoConfig p tid value
+ GetApplockFeatureStatus tid -> embedClient $ getApplockFeatureStatus tid
+ SetApplockFeatureStatus tid value -> embedClient $ setApplockFeatureStatus tid value
+ GetSelfDeletingMessagesStatus tid -> embedClient $ getSelfDeletingMessagesStatus tid
+ SetSelfDeletingMessagesStatus tid value -> embedClient $ setSelfDeletingMessagesStatus tid value
diff --git a/services/galley/src/Galley/Cassandra/TeamNotifications.hs b/services/galley/src/Galley/Cassandra/TeamNotifications.hs
new file mode 100644
index 0000000000..2a12e34737
--- /dev/null
+++ b/services/galley/src/Galley/Cassandra/TeamNotifications.hs
@@ -0,0 +1,139 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2020 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 .
+
+-- | See also: "Galley.API.TeamNotifications".
+--
+-- This module is a clone of "Gundeck.Notification.Data".
+--
+-- FUTUREWORK: this is a work-around because it only solves *some* problems with team events.
+-- We should really use a scalable message queue instead.
+module Galley.Cassandra.TeamNotifications
+ ( interpretTeamNotificationStoreToCassandra,
+ )
+where
+
+import Cassandra
+import qualified Data.Aeson as JSON
+import Data.Id
+import Data.List1 (List1)
+import Data.Range (Range, fromRange)
+import Data.Sequence (Seq, ViewL (..), ViewR (..), (<|), (><))
+import qualified Data.Sequence as Seq
+import Galley.Cassandra.Store
+import Galley.Data.TeamNotifications
+import Galley.Effects.TeamNotificationStore
+import Gundeck.Types.Notification
+import Imports
+import Polysemy
+import qualified Polysemy.Reader as P
+
+interpretTeamNotificationStoreToCassandra ::
+ Members '[Embed IO, P.Reader ClientState] r =>
+ Sem (TeamNotificationStore ': r) a ->
+ Sem r a
+interpretTeamNotificationStoreToCassandra = interpret $ \case
+ CreateTeamNotification tid nid objs -> embedClient $ add tid nid objs
+ GetTeamNotifications tid mnid lim -> embedClient $ fetch tid mnid lim
+
+-- FUTUREWORK: the magic 32 should be made configurable, so it can be tuned
+add ::
+ TeamId ->
+ NotificationId ->
+ List1 JSON.Object ->
+ Client ()
+add tid nid (Blob . JSON.encode -> payload) =
+ write cqlInsert (params LocalQuorum (tid, nid, payload, notificationTTLSeconds)) & retry x5
+ where
+ cqlInsert :: PrepQuery W (TeamId, NotificationId, Blob, Int32) ()
+ cqlInsert =
+ "INSERT INTO team_notifications \
+ \(team, id, payload) VALUES \
+ \(?, ?, ?) \
+ \USING TTL ?"
+
+notificationTTLSeconds :: Int32
+notificationTTLSeconds = 24192200
+
+fetch :: TeamId -> Maybe NotificationId -> Range 1 10000 Int32 -> Client ResultPage
+fetch tid since (fromRange -> size) = do
+ -- We always need to look for one more than requested in order to correctly
+ -- report whether there are more results.
+ let size' = bool (+ 1) (+ 2) (isJust since) size
+ page1 <- case TimeUuid . toUUID <$> since of
+ Nothing -> paginate cqlStart (paramsP LocalQuorum (Identity tid) size') & retry x1
+ Just s -> paginate cqlSince (paramsP LocalQuorum (tid, s) size') & retry x1
+ -- Collect results, requesting more pages until we run out of data
+ -- or have found size + 1 notifications (not including the 'since').
+ let isize = fromIntegral size' :: Int
+ (ns, more) <- collect Seq.empty isize page1
+ -- Drop the extra element from the end as well. Keep the inclusive start
+ -- value in the response (if a 'since' was given and found).
+ -- This can probably simplified a lot further, but we need to understand
+ -- 'Seq' in order to do that. If you find a bug, this may be a good
+ -- place to start looking.
+ return $! case Seq.viewl (trim (isize - 1) ns) of
+ EmptyL -> ResultPage Seq.empty False
+ (x :< xs) -> ResultPage (x <| xs) more
+ where
+ collect ::
+ Seq QueuedNotification ->
+ Int ->
+ Page (TimeUuid, Blob) ->
+ Client (Seq QueuedNotification, Bool)
+ collect acc num page =
+ let ns = splitAt num $ foldr toNotif [] (result page)
+ nseq = Seq.fromList (fst ns)
+ more = hasMore page
+ num' = num - Seq.length nseq
+ acc' = acc >< nseq
+ in if not more || num' == 0
+ then return (acc', more || not (null (snd ns)))
+ else liftClient (nextPage page) >>= collect acc' num'
+ trim :: Int -> Seq a -> Seq a
+ trim l ns
+ | Seq.length ns <= l = ns
+ | otherwise = case Seq.viewr ns of
+ EmptyR -> ns
+ xs :> _ -> xs
+ cqlStart :: PrepQuery R (Identity TeamId) (TimeUuid, Blob)
+ cqlStart =
+ "SELECT id, payload \
+ \FROM team_notifications \
+ \WHERE team = ? \
+ \ORDER BY id ASC"
+ cqlSince :: PrepQuery R (TeamId, TimeUuid) (TimeUuid, Blob)
+ cqlSince =
+ "SELECT id, payload \
+ \FROM team_notifications \
+ \WHERE team = ? AND id >= ? \
+ \ORDER BY id ASC"
+
+-------------------------------------------------------------------------------
+-- Conversions
+
+toNotif :: (TimeUuid, Blob) -> [QueuedNotification] -> [QueuedNotification]
+toNotif (i, b) ns =
+ maybe
+ ns
+ (\p1 -> queuedNotification notifId p1 : ns)
+ ( JSON.decode' (fromBlob b)
+ -- FUTUREWORK: this is from the database, so it's slightly more ok to ignore parse
+ -- errors than if it's data provided by a client. it would still be better to have an
+ -- error entry in the log file and crash, rather than ignore the error and continue.
+ )
+ where
+ notifId = Id (fromTimeUuid i)
diff --git a/services/galley/src/Galley/Data/Conversation.hs b/services/galley/src/Galley/Data/Conversation.hs
index 725161d7f0..b1e149b651 100644
--- a/services/galley/src/Galley/Data/Conversation.hs
+++ b/services/galley/src/Galley/Data/Conversation.hs
@@ -26,20 +26,21 @@ module Galley.Data.Conversation
isTeamConv,
isConvDeleted,
selfConv,
- toConv,
localOne2OneConvId,
convMetadata,
+ convAccessData,
+ defRole,
+ maybeRole,
+ privateRole,
+ defRegularConvAccess,
)
where
-import Cassandra
import Data.Id
-import Data.Misc
+import qualified Data.Set as Set
import qualified Data.UUID.Tagged as U
-import Galley.Data.Access
+import Galley.Cassandra.Instances ()
import Galley.Data.Conversation.Types
-import Galley.Data.Instances ()
-import Galley.Types.Conversations.Members
import Imports hiding (Set)
import Wire.API.Conversation hiding (Conversation)
@@ -58,17 +59,6 @@ isConvDeleted = fromMaybe False . convDeleted
selfConv :: UserId -> ConvId
selfConv uid = Id (toUUID uid)
-toConv ::
- ConvId ->
- [LocalMember] ->
- [RemoteMember] ->
- Maybe (ConvType, UserId, Maybe (Set Access), Maybe AccessRole, Maybe Text, Maybe TeamId, Maybe Bool, Maybe Milliseconds, Maybe ReceiptMode) ->
- Maybe Conversation
-toConv cid mms remoteMems conv =
- f mms <$> conv
- where
- f ms (cty, uid, acc, role, nme, ti, del, timer, rm) = Conversation cid cty uid nme (defAccess cty acc) (maybeRole cty role) ms remoteMems ti del timer rm
-
-- | We deduce the conversation ID by adding the 4 components of the V4 UUID
-- together pairwise, and then setting the version bits (v4) and variant bits
-- (variant 2). This means that we always know what the UUID is for a
@@ -87,3 +77,25 @@ convMetadata c =
(convTeam c)
(convMessageTimer c)
(convReceiptMode c)
+
+convAccessData :: Conversation -> ConversationAccessData
+convAccessData conv =
+ ConversationAccessData
+ (Set.fromList (convAccess conv))
+ (convAccessRole conv)
+
+defRole :: AccessRole
+defRole = ActivatedAccessRole
+
+maybeRole :: ConvType -> Maybe AccessRole -> AccessRole
+maybeRole SelfConv _ = privateRole
+maybeRole ConnectConv _ = privateRole
+maybeRole One2OneConv _ = privateRole
+maybeRole RegularConv Nothing = defRole
+maybeRole RegularConv (Just r) = r
+
+privateRole :: AccessRole
+privateRole = PrivateAccessRole
+
+defRegularConvAccess :: [Access]
+defRegularConvAccess = [InviteAccess]
diff --git a/services/galley/src/Galley/Data/LegalHold.hs b/services/galley/src/Galley/Data/LegalHold.hs
deleted file mode 100644
index 716e0917df..0000000000
--- a/services/galley/src/Galley/Data/LegalHold.hs
+++ /dev/null
@@ -1,102 +0,0 @@
--- This file is part of the Wire Server implementation.
---
--- Copyright (C) 2020 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.Data.LegalHold
- ( createSettings,
- getSettings,
- removeSettings,
- Galley.Data.LegalHold.insertPendingPrekeys,
- Galley.Data.LegalHold.selectPendingPrekeys,
- Galley.Data.LegalHold.dropPendingPrekeys,
- setUserLegalHoldStatus,
- setTeamLegalholdWhitelisted,
- isTeamLegalholdWhitelisted,
- unsetTeamLegalholdWhitelisted,
- )
-where
-
-import Brig.Types.Client.Prekey
-import Brig.Types.Instances ()
-import Brig.Types.Team.LegalHold
-import Cassandra
-import Control.Lens (unsnoc, view)
-import Data.Id
-import Data.LegalHold
-import qualified Galley.Cassandra.LegalHold as C
-import Galley.Data.Instances ()
-import Galley.Data.Queries as Q
-import Galley.Env
-import qualified Galley.Options as Opts
-import Galley.Types.Teams (flagLegalHold)
-import Imports
-
--- | Returns 'False' if legal hold is not enabled for this team
--- The Caller is responsible for checking whether legal hold is enabled for this team
-createSettings :: MonadClient m => LegalHoldService -> m ()
-createSettings (LegalHoldService tid url fpr tok key) = do
- retry x1 $ write insertLegalHoldSettings (params LocalQuorum (url, fpr, tok, key, tid))
-
--- | Returns 'Nothing' if no settings are saved
--- The Caller is responsible for checking whether legal hold is enabled for this team
-getSettings :: MonadClient m => TeamId -> m (Maybe LegalHoldService)
-getSettings tid =
- fmap toLegalHoldService <$> do
- retry x1 $ query1 selectLegalHoldSettings (params LocalQuorum (Identity tid))
- where
- toLegalHoldService (httpsUrl, fingerprint, tok, key) = LegalHoldService tid httpsUrl fingerprint tok key
-
-removeSettings :: MonadClient m => TeamId -> m ()
-removeSettings tid = retry x5 (write removeLegalHoldSettings (params LocalQuorum (Identity tid)))
-
-insertPendingPrekeys :: MonadClient m => UserId -> [Prekey] -> m ()
-insertPendingPrekeys uid keys = retry x5 . batch $
- forM_ keys $
- \key ->
- addPrepQuery Q.insertPendingPrekeys (toTuple key)
- where
- toTuple (Prekey keyId key) = (uid, keyId, key)
-
-selectPendingPrekeys :: MonadClient m => UserId -> m (Maybe ([Prekey], LastPrekey))
-selectPendingPrekeys uid =
- pickLastKey . fmap fromTuple
- <$> retry x1 (query Q.selectPendingPrekeys (params LocalQuorum (Identity uid)))
- where
- fromTuple (keyId, key) = Prekey keyId key
- pickLastKey allPrekeys =
- case unsnoc allPrekeys of
- Nothing -> Nothing
- Just (keys, lst) -> pure (keys, lastPrekey . prekeyKey $ lst)
-
-dropPendingPrekeys :: MonadClient m => UserId -> m ()
-dropPendingPrekeys uid = retry x5 (write Q.dropPendingPrekeys (params LocalQuorum (Identity uid)))
-
-setUserLegalHoldStatus :: MonadClient m => TeamId -> UserId -> UserLegalHoldStatus -> m ()
-setUserLegalHoldStatus tid uid status =
- retry x5 (write Q.updateUserLegalHoldStatus (params LocalQuorum (status, tid, uid)))
-
-setTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m ()
-setTeamLegalholdWhitelisted tid =
- retry x5 (write Q.insertLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid)))
-
-unsetTeamLegalholdWhitelisted :: MonadClient m => TeamId -> m ()
-unsetTeamLegalholdWhitelisted tid =
- retry x5 (write Q.removeLegalHoldWhitelistedTeam (params LocalQuorum (Identity tid)))
-
-isTeamLegalholdWhitelisted :: (MonadReader Env m, MonadClient m) => TeamId -> m Bool
-isTeamLegalholdWhitelisted tid = do
- lhFlag <- view (options . Opts.optSettings . Opts.setFeatureFlags . flagLegalHold)
- liftClient $ C.isTeamLegalholdWhitelisted lhFlag tid
diff --git a/services/galley/src/Galley/Data/TeamFeatures.hs b/services/galley/src/Galley/Data/TeamFeatures.hs
index a9437a3470..e7ab337d0f 100644
--- a/services/galley/src/Galley/Data/TeamFeatures.hs
+++ b/services/galley/src/Galley/Data/TeamFeatures.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE ViewPatterns #-}
-
-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2020 Wire Swiss GmbH
@@ -17,29 +15,10 @@
-- You should have received a copy of the GNU Affero General Public License along
-- with this program. If not, see .
-module Galley.Data.TeamFeatures
- ( getFeatureStatusNoConfig,
- setFeatureStatusNoConfig,
- getApplockFeatureStatus,
- setApplockFeatureStatus,
- getSelfDeletingMessagesStatus,
- setSelfDeletingMessagesStatus,
- HasStatusCol (..),
- )
-where
+module Galley.Data.TeamFeatures (HasStatusCol (..)) where
-import Cassandra
-import Data.Id
-import Galley.Data.Instances ()
import Imports
import Wire.API.Team.Feature
- ( TeamFeatureName (..),
- TeamFeatureStatus,
- TeamFeatureStatusNoConfig (..),
- TeamFeatureStatusValue (..),
- TeamFeatureStatusWithConfig (..),
- )
-import qualified Wire.API.Team.Feature as Public
-- | Because not all so called team features are actually team-level features,
-- not all of them have a corresponding column in the database. Therefore,
@@ -69,112 +48,3 @@ instance HasStatusCol 'TeamFeatureFileSharing where statusCol = "file_sharing"
instance HasStatusCol 'TeamFeatureConferenceCalling where statusCol = "conference_calling"
instance HasStatusCol 'TeamFeatureSelfDeletingMessages where statusCol = "self_deleting_messages_status"
-
-getFeatureStatusNoConfig ::
- forall (a :: Public.TeamFeatureName) m.
- ( MonadClient m,
- Public.FeatureHasNoConfig a,
- HasStatusCol a
- ) =>
- TeamId ->
- m (Maybe (TeamFeatureStatus a))
-getFeatureStatusNoConfig tid = do
- let q = query1 select (params LocalQuorum (Identity tid))
- mStatusValue <- (>>= runIdentity) <$> retry x1 q
- pure $ TeamFeatureStatusNoConfig <$> mStatusValue
- where
- select :: PrepQuery R (Identity TeamId) (Identity (Maybe TeamFeatureStatusValue))
- select = fromString $ "select " <> statusCol @a <> " from team_features where team_id = ?"
-
-setFeatureStatusNoConfig ::
- forall (a :: Public.TeamFeatureName) m.
- ( MonadClient m,
- Public.FeatureHasNoConfig a,
- HasStatusCol a
- ) =>
- TeamId ->
- TeamFeatureStatus a ->
- m (TeamFeatureStatus a)
-setFeatureStatusNoConfig tid status = do
- let flag = Public.tfwoStatus status
- retry x5 $ write insert (params LocalQuorum (tid, flag))
- pure status
- where
- insert :: PrepQuery W (TeamId, TeamFeatureStatusValue) ()
- insert = fromString $ "insert into team_features (team_id, " <> statusCol @a <> ") values (?, ?)"
-
-getApplockFeatureStatus ::
- forall m.
- (MonadClient m) =>
- TeamId ->
- m (Maybe (TeamFeatureStatus 'Public.TeamFeatureAppLock))
-getApplockFeatureStatus tid = do
- let q = query1 select (params LocalQuorum (Identity tid))
- mTuple <- retry x1 q
- pure $
- mTuple >>= \(mbStatusValue, mbEnforce, mbTimeout) ->
- TeamFeatureStatusWithConfig <$> mbStatusValue <*> (Public.TeamFeatureAppLockConfig <$> mbEnforce <*> mbTimeout)
- where
- select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Public.EnforceAppLock, Maybe Int32)
- select =
- fromString $
- "select " <> statusCol @'Public.TeamFeatureAppLock <> ", app_lock_enforce, app_lock_inactivity_timeout_secs "
- <> "from team_features where team_id = ?"
-
-setApplockFeatureStatus ::
- (MonadClient m) =>
- TeamId ->
- TeamFeatureStatus 'Public.TeamFeatureAppLock ->
- m (TeamFeatureStatus 'Public.TeamFeatureAppLock)
-setApplockFeatureStatus tid status = do
- let statusValue = Public.tfwcStatus status
- enforce = Public.applockEnforceAppLock . Public.tfwcConfig $ status
- timeout = Public.applockInactivityTimeoutSecs . Public.tfwcConfig $ status
- retry x5 $ write insert (params LocalQuorum (tid, statusValue, enforce, timeout))
- pure status
- where
- insert :: PrepQuery W (TeamId, TeamFeatureStatusValue, Public.EnforceAppLock, Int32) ()
- insert =
- fromString $
- "insert into team_features (team_id, "
- <> statusCol @'Public.TeamFeatureAppLock
- <> ", app_lock_enforce, app_lock_inactivity_timeout_secs) values (?, ?, ?, ?)"
-
-getSelfDeletingMessagesStatus ::
- forall m.
- (MonadClient m) =>
- TeamId ->
- m (Maybe (TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages))
-getSelfDeletingMessagesStatus tid = do
- let q = query1 select (params LocalQuorum (Identity tid))
- mTuple <- retry x1 q
- pure $
- mTuple >>= \(mbStatusValue, mbTimeout) ->
- TeamFeatureStatusWithConfig <$> mbStatusValue <*> (Public.TeamFeatureSelfDeletingMessagesConfig <$> mbTimeout)
- where
- select :: PrepQuery R (Identity TeamId) (Maybe TeamFeatureStatusValue, Maybe Int32)
- select =
- fromString $
- "select "
- <> statusCol @'Public.TeamFeatureSelfDeletingMessages
- <> ", self_deleting_messages_ttl "
- <> "from team_features where team_id = ?"
-
-setSelfDeletingMessagesStatus ::
- (MonadClient m) =>
- TeamId ->
- TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages ->
- m (TeamFeatureStatus 'Public.TeamFeatureSelfDeletingMessages)
-setSelfDeletingMessagesStatus tid status = do
- let statusValue = Public.tfwcStatus status
- timeout = Public.sdmEnforcedTimeoutSeconds . Public.tfwcConfig $ status
- retry x5 $ write insert (params LocalQuorum (tid, statusValue, timeout))
- pure status
- where
- insert :: PrepQuery W (TeamId, TeamFeatureStatusValue, Int32) ()
- insert =
- fromString $
- "insert into team_features (team_id, "
- <> statusCol @'Public.TeamFeatureSelfDeletingMessages
- <> ", self_deleting_messages_ttl) "
- <> "values (?, ?, ?)"
diff --git a/services/galley/src/Galley/Data/TeamNotifications.hs b/services/galley/src/Galley/Data/TeamNotifications.hs
index d7b3a9003d..faeff5edd9 100644
--- a/services/galley/src/Galley/Data/TeamNotifications.hs
+++ b/services/galley/src/Galley/Data/TeamNotifications.hs
@@ -23,21 +23,9 @@
--
-- FUTUREWORK: this is a work-around because it only solves *some* problems with team events.
-- We should really use a scalable message queue instead.
-module Galley.Data.TeamNotifications
- ( ResultPage (..),
- add,
- fetch,
- )
-where
+module Galley.Data.TeamNotifications (ResultPage (..)) where
-import Cassandra as C
-import qualified Data.Aeson as JSON
-import Data.Id
-import Data.List1 (List1)
-import Data.Range (Range, fromRange)
-import Data.Sequence (Seq, ViewL (..), ViewR (..), (<|), (><))
-import qualified Data.Sequence as Seq
-import Galley.App
+import Data.Sequence (Seq)
import Gundeck.Types.Notification
import Imports
@@ -49,92 +37,3 @@ data ResultPage = ResultPage
-- last notification in 'resultSeq'.
resultHasMore :: !Bool
}
-
--- FUTUREWORK: the magic 32 should be made configurable, so it can be tuned
-add ::
- TeamId ->
- NotificationId ->
- List1 JSON.Object ->
- Galley r ()
-add tid nid (Blob . JSON.encode -> payload) =
- write cqlInsert (params LocalQuorum (tid, nid, payload, notificationTTLSeconds)) & retry x5
- where
- cqlInsert :: PrepQuery W (TeamId, NotificationId, Blob, Int32) ()
- cqlInsert =
- "INSERT INTO team_notifications \
- \(team, id, payload) VALUES \
- \(?, ?, ?) \
- \USING TTL ?"
-
-notificationTTLSeconds :: Int32
-notificationTTLSeconds = 24192200
-
-fetch :: TeamId -> Maybe NotificationId -> Range 1 10000 Int32 -> Galley r ResultPage
-fetch tid since (fromRange -> size) = do
- -- We always need to look for one more than requested in order to correctly
- -- report whether there are more results.
- let size' = bool (+ 1) (+ 2) (isJust since) size
- page1 <- case TimeUuid . toUUID <$> since of
- Nothing -> paginate cqlStart (paramsP LocalQuorum (Identity tid) size') & retry x1
- Just s -> paginate cqlSince (paramsP LocalQuorum (tid, s) size') & retry x1
- -- Collect results, requesting more pages until we run out of data
- -- or have found size + 1 notifications (not including the 'since').
- let isize = fromIntegral size' :: Int
- (ns, more) <- collect Seq.empty isize page1
- -- Drop the extra element from the end as well. Keep the inclusive start
- -- value in the response (if a 'since' was given and found).
- -- This can probably simplified a lot further, but we need to understand
- -- 'Seq' in order to do that. If you find a bug, this may be a good
- -- place to start looking.
- return $! case Seq.viewl (trim (isize - 1) ns) of
- EmptyL -> ResultPage Seq.empty False
- (x :< xs) -> ResultPage (x <| xs) more
- where
- collect ::
- Seq QueuedNotification ->
- Int ->
- Page (TimeUuid, Blob) ->
- Galley r (Seq QueuedNotification, Bool)
- collect acc num page =
- let ns = splitAt num $ foldr toNotif [] (result page)
- nseq = Seq.fromList (fst ns)
- more = hasMore page
- num' = num - Seq.length nseq
- acc' = acc >< nseq
- in if not more || num' == 0
- then return (acc', more || not (null (snd ns)))
- else liftClient (nextPage page) >>= collect acc' num'
- trim :: Int -> Seq a -> Seq a
- trim l ns
- | Seq.length ns <= l = ns
- | otherwise = case Seq.viewr ns of
- EmptyR -> ns
- xs :> _ -> xs
- cqlStart :: PrepQuery R (Identity TeamId) (TimeUuid, Blob)
- cqlStart =
- "SELECT id, payload \
- \FROM team_notifications \
- \WHERE team = ? \
- \ORDER BY id ASC"
- cqlSince :: PrepQuery R (TeamId, TimeUuid) (TimeUuid, Blob)
- cqlSince =
- "SELECT id, payload \
- \FROM team_notifications \
- \WHERE team = ? AND id >= ? \
- \ORDER BY id ASC"
-
--------------------------------------------------------------------------------
--- Conversions
-
-toNotif :: (TimeUuid, Blob) -> [QueuedNotification] -> [QueuedNotification]
-toNotif (i, b) ns =
- maybe
- ns
- (\p1 -> queuedNotification notifId p1 : ns)
- ( JSON.decode' (fromBlob b)
- -- FUTUREWORK: this is from the database, so it's slightly more ok to ignore parse
- -- errors than if it's data provided by a client. it would still be better to have an
- -- error entry in the log file and crash, rather than ignore the error and continue.
- )
- where
- notifId = Id (fromTimeUuid i)
diff --git a/services/galley/src/Galley/Effects.hs b/services/galley/src/Galley/Effects.hs
index 4058b1ea44..e2f26dea92 100644
--- a/services/galley/src/Galley/Effects.hs
+++ b/services/galley/src/Galley/Effects.hs
@@ -36,10 +36,15 @@ module Galley.Effects
ClientStore,
CodeStore,
ConversationStore,
+ CustomBackendStore,
+ LegalHoldStore,
MemberStore,
+ SearchVisibilityStore,
ServiceStore,
- TeamStore,
+ TeamFeatureStore,
TeamMemberStore,
+ TeamNotificationStore,
+ TeamStore,
-- * Paging effects
ListItems,
@@ -58,15 +63,20 @@ import Galley.Effects.BrigAccess
import Galley.Effects.ClientStore
import Galley.Effects.CodeStore
import Galley.Effects.ConversationStore
+import Galley.Effects.CustomBackendStore
import Galley.Effects.ExternalAccess
import Galley.Effects.FederatorAccess
import Galley.Effects.FireAndForget
import Galley.Effects.GundeckAccess
+import Galley.Effects.LegalHoldStore
import Galley.Effects.ListItems
import Galley.Effects.MemberStore
+import Galley.Effects.SearchVisibilityStore
import Galley.Effects.ServiceStore
import Galley.Effects.SparAccess
+import Galley.Effects.TeamFeatureStore
import Galley.Effects.TeamMemberStore
+import Galley.Effects.TeamNotificationStore
import Galley.Effects.TeamStore
import Polysemy
@@ -82,8 +92,13 @@ type GalleyEffects1 =
ClientStore,
CodeStore,
ConversationStore,
+ CustomBackendStore,
+ LegalHoldStore,
MemberStore,
+ SearchVisibilityStore,
ServiceStore,
+ TeamFeatureStore,
+ TeamNotificationStore,
TeamStore,
TeamMemberStore InternalPaging,
ListItems CassandraPaging ConvId,
diff --git a/services/galley/src/Galley/Effects/CustomBackendStore.hs b/services/galley/src/Galley/Effects/CustomBackendStore.hs
new file mode 100644
index 0000000000..cd3fc72300
--- /dev/null
+++ b/services/galley/src/Galley/Effects/CustomBackendStore.hs
@@ -0,0 +1,36 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 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.Effects.CustomBackendStore
+ ( CustomBackendStore (..),
+ getCustomBackend,
+ setCustomBackend,
+ deleteCustomBackend,
+ )
+where
+
+import Data.Domain (Domain)
+import Galley.Types
+import Imports
+import Polysemy
+
+data CustomBackendStore m a where
+ GetCustomBackend :: Domain -> CustomBackendStore m (Maybe CustomBackend)
+ SetCustomBackend :: Domain -> CustomBackend -> CustomBackendStore m ()
+ DeleteCustomBackend :: Domain -> CustomBackendStore m ()
+
+makeSem ''CustomBackendStore
diff --git a/services/galley/src/Galley/Effects/LegalHoldStore.hs b/services/galley/src/Galley/Effects/LegalHoldStore.hs
new file mode 100644
index 0000000000..28b70fcf1f
--- /dev/null
+++ b/services/galley/src/Galley/Effects/LegalHoldStore.hs
@@ -0,0 +1,52 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 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.Effects.LegalHoldStore
+ ( LegalHoldStore (..),
+ createSettings,
+ getSettings,
+ removeSettings,
+ insertPendingPrekeys,
+ selectPendingPrekeys,
+ dropPendingPrekeys,
+ setUserLegalHoldStatus,
+ setTeamLegalholdWhitelisted,
+ unsetTeamLegalholdWhitelisted,
+ isTeamLegalholdWhitelisted,
+ )
+where
+
+import Data.Id
+import Data.LegalHold
+import Galley.External.LegalHoldService.Types
+import Imports
+import Polysemy
+import Wire.API.User.Client.Prekey
+
+data LegalHoldStore m a where
+ CreateSettings :: LegalHoldService -> LegalHoldStore m ()
+ GetSettings :: TeamId -> LegalHoldStore m (Maybe LegalHoldService)
+ RemoveSettings :: TeamId -> LegalHoldStore m ()
+ InsertPendingPrekeys :: UserId -> [Prekey] -> LegalHoldStore m ()
+ SelectPendingPrekeys :: UserId -> LegalHoldStore m (Maybe ([Prekey], LastPrekey))
+ DropPendingPrekeys :: UserId -> LegalHoldStore m ()
+ SetUserLegalHoldStatus :: TeamId -> UserId -> UserLegalHoldStatus -> LegalHoldStore m ()
+ SetTeamLegalholdWhitelisted :: TeamId -> LegalHoldStore m ()
+ UnsetTeamLegalholdWhitelisted :: TeamId -> LegalHoldStore m ()
+ IsTeamLegalholdWhitelisted :: TeamId -> LegalHoldStore m Bool
+
+makeSem ''LegalHoldStore
diff --git a/services/galley/src/Galley/Effects/SearchVisibilityStore.hs b/services/galley/src/Galley/Effects/SearchVisibilityStore.hs
new file mode 100644
index 0000000000..28a9b394c3
--- /dev/null
+++ b/services/galley/src/Galley/Effects/SearchVisibilityStore.hs
@@ -0,0 +1,35 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 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.Effects.SearchVisibilityStore
+ ( SearchVisibilityStore (..),
+ getSearchVisibility,
+ setSearchVisibility,
+ resetSearchVisibility,
+ )
+where
+
+import Data.Id
+import Galley.Types.Teams.SearchVisibility
+import Polysemy
+
+data SearchVisibilityStore m a where
+ GetSearchVisibility :: TeamId -> SearchVisibilityStore m TeamSearchVisibility
+ SetSearchVisibility :: TeamId -> TeamSearchVisibility -> SearchVisibilityStore m ()
+ ResetSearchVisibility :: TeamId -> SearchVisibilityStore m ()
+
+makeSem ''SearchVisibilityStore
diff --git a/services/galley/src/Galley/Effects/TeamFeatureStore.hs b/services/galley/src/Galley/Effects/TeamFeatureStore.hs
new file mode 100644
index 0000000000..d2910980f2
--- /dev/null
+++ b/services/galley/src/Galley/Effects/TeamFeatureStore.hs
@@ -0,0 +1,86 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 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.Effects.TeamFeatureStore
+ ( TeamFeatureStore (..),
+ getFeatureStatusNoConfig,
+ setFeatureStatusNoConfig,
+ getApplockFeatureStatus,
+ setApplockFeatureStatus,
+ getSelfDeletingMessagesStatus,
+ setSelfDeletingMessagesStatus,
+ )
+where
+
+import Data.Id
+import Data.Proxy
+import Galley.Data.TeamFeatures
+import Imports
+import Polysemy
+import Wire.API.Team.Feature
+
+data TeamFeatureStore m a where
+ -- the proxy argument makes sure that makeSem below generates type-inference-friendly code
+ GetFeatureStatusNoConfig' ::
+ forall (a :: TeamFeatureName) m.
+ ( FeatureHasNoConfig a,
+ HasStatusCol a
+ ) =>
+ Proxy a ->
+ TeamId ->
+ TeamFeatureStore m (Maybe (TeamFeatureStatus a))
+ -- the proxy argument makes sure that makeSem below generates type-inference-friendly code
+ SetFeatureStatusNoConfig' ::
+ forall (a :: TeamFeatureName) m.
+ ( FeatureHasNoConfig a,
+ HasStatusCol a
+ ) =>
+ Proxy a ->
+ TeamId ->
+ TeamFeatureStatus a ->
+ TeamFeatureStore m (TeamFeatureStatus a)
+ GetApplockFeatureStatus ::
+ TeamId ->
+ TeamFeatureStore m (Maybe (TeamFeatureStatus 'TeamFeatureAppLock))
+ SetApplockFeatureStatus ::
+ TeamId ->
+ TeamFeatureStatus 'TeamFeatureAppLock ->
+ TeamFeatureStore m (TeamFeatureStatus 'TeamFeatureAppLock)
+ GetSelfDeletingMessagesStatus ::
+ TeamId ->
+ TeamFeatureStore m (Maybe (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages))
+ SetSelfDeletingMessagesStatus ::
+ TeamId ->
+ TeamFeatureStatus 'TeamFeatureSelfDeletingMessages ->
+ TeamFeatureStore m (TeamFeatureStatus 'TeamFeatureSelfDeletingMessages)
+
+makeSem ''TeamFeatureStore
+
+getFeatureStatusNoConfig ::
+ forall (a :: TeamFeatureName) r.
+ (Member TeamFeatureStore r, FeatureHasNoConfig a, HasStatusCol a) =>
+ TeamId ->
+ Sem r (Maybe (TeamFeatureStatus a))
+getFeatureStatusNoConfig = getFeatureStatusNoConfig' (Proxy @a)
+
+setFeatureStatusNoConfig ::
+ forall (a :: TeamFeatureName) r.
+ (Member TeamFeatureStore r, FeatureHasNoConfig a, HasStatusCol a) =>
+ TeamId ->
+ TeamFeatureStatus a ->
+ Sem r (TeamFeatureStatus a)
+setFeatureStatusNoConfig = setFeatureStatusNoConfig' (Proxy @a)
diff --git a/services/galley/src/Galley/Effects/TeamNotificationStore.hs b/services/galley/src/Galley/Effects/TeamNotificationStore.hs
new file mode 100644
index 0000000000..5e553315d4
--- /dev/null
+++ b/services/galley/src/Galley/Effects/TeamNotificationStore.hs
@@ -0,0 +1,41 @@
+-- This file is part of the Wire Server implementation.
+--
+-- Copyright (C) 2021 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.Effects.TeamNotificationStore where
+
+import qualified Data.Aeson as JSON
+import Data.Id
+import Data.List1 (List1)
+import Data.Range
+import Galley.Data.TeamNotifications
+import Gundeck.Types.Notification
+import Imports
+import Polysemy
+
+data TeamNotificationStore m a where
+ CreateTeamNotification ::
+ TeamId ->
+ NotificationId ->
+ List1 JSON.Object ->
+ TeamNotificationStore m ()
+ GetTeamNotifications ::
+ TeamId ->
+ Maybe NotificationId ->
+ Range 1 10000 Int32 ->
+ TeamNotificationStore m ResultPage
+
+makeSem ''TeamNotificationStore
diff --git a/services/galley/src/Galley/External/LegalHoldService.hs b/services/galley/src/Galley/External/LegalHoldService.hs
index ac503fc67c..1c4a3038ec 100644
--- a/services/galley/src/Galley/External/LegalHoldService.hs
+++ b/services/galley/src/Galley/External/LegalHoldService.hs
@@ -44,7 +44,7 @@ import Data.Id
import Data.Misc
import Galley.API.Error
import Galley.App
-import qualified Galley.Data.LegalHold as LegalHoldData
+import Galley.Effects.LegalHoldStore as LegalHoldData
import Galley.Env
import Galley.External.LegalHoldService.Types
import Imports
@@ -55,6 +55,7 @@ import qualified OpenSSL.EVP.PKey as SSL
import qualified OpenSSL.PEM as SSL
import qualified OpenSSL.RSA as SSL
import qualified OpenSSL.Session as SSL
+import Polysemy
import Ssl.Util
import qualified Ssl.Util as SSL
import qualified System.Logger.Class as Log
@@ -80,7 +81,11 @@ checkLegalHoldServiceStatus fpr url = do
. Bilge.expect2xx
-- | @POST /initiate@.
-requestNewDevice :: TeamId -> UserId -> Galley r NewLegalHoldClient
+requestNewDevice ::
+ Member LegalHoldStore r =>
+ TeamId ->
+ UserId ->
+ Galley r NewLegalHoldClient
requestNewDevice tid uid = do
resp <- makeLegalHoldServiceRequest tid reqParams
case eitherDecode (responseBody resp) of
@@ -99,6 +104,7 @@ requestNewDevice tid uid = do
-- | @POST /confirm@
-- Confirm that a device has been linked to a user and provide an authorization token
confirmLegalHold ::
+ Member LegalHoldStore r =>
ClientId ->
TeamId ->
UserId ->
@@ -118,6 +124,7 @@ confirmLegalHold clientId tid uid legalHoldAuthToken = do
-- | @POST /remove@
-- Inform the LegalHold Service that a user's legalhold has been disabled.
removeLegalHold ::
+ Member LegalHoldStore r =>
TeamId ->
UserId ->
Galley r ()
@@ -137,9 +144,13 @@ removeLegalHold tid uid = do
-- | Lookup legal hold service settings for a team and make a request to the service. Pins
-- the TSL fingerprint via 'makeVerifiedRequest' and passes the token so the service can
-- authenticate the request.
-makeLegalHoldServiceRequest :: TeamId -> (Http.Request -> Http.Request) -> Galley r (Http.Response LC8.ByteString)
+makeLegalHoldServiceRequest ::
+ Member LegalHoldStore r =>
+ TeamId ->
+ (Http.Request -> Http.Request) ->
+ Galley r (Http.Response LC8.ByteString)
makeLegalHoldServiceRequest tid reqBuilder = do
- maybeLHSettings <- LegalHoldData.getSettings tid
+ maybeLHSettings <- liftSem $ LegalHoldData.getSettings tid
lhSettings <- case maybeLHSettings of
Nothing -> throwM legalHoldServiceNotRegistered
Just lhSettings -> pure lhSettings
diff --git a/services/galley/src/Galley/External/LegalHoldService/Types.hs b/services/galley/src/Galley/External/LegalHoldService/Types.hs
index cecf37ad87..8a3f671bcf 100644
--- a/services/galley/src/Galley/External/LegalHoldService/Types.hs
+++ b/services/galley/src/Galley/External/LegalHoldService/Types.hs
@@ -19,9 +19,13 @@
module Galley.External.LegalHoldService.Types
( OpaqueAuthToken (..),
+
+ -- * Re-exports
+ LegalHoldService,
)
where
+import Brig.Types.Team.LegalHold
import Data.Aeson
import Data.ByteString.Conversion.To
import Imports
diff --git a/services/galley/test/integration/API/Teams/LegalHold.hs b/services/galley/test/integration/API/Teams/LegalHold.hs
index 2f16338b5a..b5d4cd24de 100644
--- a/services/galley/test/integration/API/Teams/LegalHold.hs
+++ b/services/galley/test/integration/API/Teams/LegalHold.hs
@@ -66,7 +66,7 @@ import Data.Text.Encoding (encodeUtf8)
import qualified Data.Time.Clock as Time
import qualified Galley.App as Galley
import Galley.Cassandra.Client
-import qualified Galley.Data.LegalHold as LegalHoldData
+import qualified Galley.Cassandra.LegalHold as LegalHoldData
import Galley.External.LegalHoldService (validateServiceKey)
import Galley.Options (optSettings, setFeatureFlags)
import qualified Galley.Types.Clients as Clients
diff --git a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
index c9ee4e914a..f7ce810822 100644
--- a/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
+++ b/services/galley/test/integration/API/Teams/LegalHold/DisabledByDefault.hs
@@ -60,7 +60,7 @@ import Data.String.Conversions (LBS, cs)
import Data.Text.Encoding (encodeUtf8)
import qualified Galley.App as Galley
import Galley.Cassandra.Client
-import qualified Galley.Data.LegalHold as LegalHoldData
+import qualified Galley.Cassandra.LegalHold as LegalHoldData
import Galley.External.LegalHoldService (validateServiceKey)
import Galley.Options (optSettings, setFeatureFlags)
import qualified Galley.Types.Clients as Clients
diff --git a/tools/db/migrate-sso-feature-flag/src/Work.hs b/tools/db/migrate-sso-feature-flag/src/Work.hs
index c2dc980ab7..582f2fdf3b 100644
--- a/tools/db/migrate-sso-feature-flag/src/Work.hs
+++ b/tools/db/migrate-sso-feature-flag/src/Work.hs
@@ -31,7 +31,7 @@ import Data.Conduit.Internal (zipSources)
import qualified Data.Conduit.List as C
import Data.Id
import Data.Misc
-import Galley.Data.Instances ()
+import Galley.Cassandra.Instances ()
import Imports
import System.Logger (Logger)
import qualified System.Logger as Log
diff --git a/tools/db/move-team/src/ParseSchema.hs b/tools/db/move-team/src/ParseSchema.hs
index cae5abef31..7d4299a8b2 100644
--- a/tools/db/move-team/src/ParseSchema.hs
+++ b/tools/db/move-team/src/ParseSchema.hs
@@ -205,7 +205,7 @@ import Data.Conduit
import Data.Id
import Data.Time
import Data.UUID
-import Galley.Data.Instances ()
+import Galley.Cassandra.Instances ()
import Imports
import Types
import Wire.API.Team.Permission
diff --git a/tools/db/move-team/src/Schema.hs b/tools/db/move-team/src/Schema.hs
index 56ce0a9a8d..1958fb705b 100644
--- a/tools/db/move-team/src/Schema.hs
+++ b/tools/db/move-team/src/Schema.hs
@@ -27,7 +27,7 @@ import Data.IP (IP)
import Data.Id
import Data.Time
import Data.UUID
-import Galley.Data.Instances ()
+import Galley.Cassandra.Instances ()
import Imports
import System.FilePath.Posix (())
import Types
diff --git a/tools/db/move-team/src/Types.hs b/tools/db/move-team/src/Types.hs
index 8d079316b0..e103908cb7 100644
--- a/tools/db/move-team/src/Types.hs
+++ b/tools/db/move-team/src/Types.hs
@@ -36,7 +36,7 @@ import Data.Id
import qualified Data.Text as T
import Data.Text.Ascii (AsciiText, Base64, decodeBase64, encodeBase64)
import qualified Data.Vector as V
-import Galley.Data.Instances ()
+import Galley.Cassandra.Instances ()
import Imports
import System.Logger (Logger)
import Wire.API.User.Password (PasswordResetKey (..))
diff --git a/tools/db/move-team/src/Work.hs b/tools/db/move-team/src/Work.hs
index 7d9e8207ae..cab4883b38 100644
--- a/tools/db/move-team/src/Work.hs
+++ b/tools/db/move-team/src/Work.hs
@@ -38,7 +38,7 @@ import qualified Data.Conduit.List as CL
import Data.Id
import qualified Data.Set as Set
import Data.UUID
-import Galley.Data.Instances ()
+import Galley.Cassandra.Instances ()
import Imports
import Schema
import System.Exit (ExitCode (ExitFailure, ExitSuccess), exitWith)