{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
module Galley.API.Teams.Features
( getFeatureMulti,
setFeature,
setFeatureInternal,
patchFeatureInternal,
getAllTeamFeaturesForTeam,
getAllTeamFeaturesForUser,
updateLockStatus,
GetFeatureConfig (..),
SetFeatureConfig (..),
guardSecondFactorDisabled,
featureEnabledForTeam,
guardMlsE2EIdConfig,
initialiseTeamFeatures,
)
where
import Control.Lens
import Data.ByteString.Conversion (toByteString')
import Data.ByteString.UTF8 qualified as UTF8
import Data.Id
import Data.Json.Util
import Data.Kind
import Data.Qualified (Local)
import Data.Time (UTCTime)
import Galley.API.Error (InternalError)
import Galley.API.LegalHold qualified as LegalHold
import Galley.API.LegalHold.Team qualified as LegalHold
import Galley.API.Teams.Features.Get
import Galley.API.Util (assertTeamExists, getTeamMembersForFanout, membersToRecipients, permissionCheck)
import Galley.App
import Galley.Effects
import Galley.Effects.BrigAccess (updateSearchVisibilityInbound)
import Galley.Effects.SearchVisibilityStore qualified as SearchVisibilityData
import Galley.Effects.TeamFeatureStore
import Galley.Effects.TeamStore (getLegalHoldFlag, getTeamMember)
import Galley.Options
import Galley.Types.Teams
import Imports
import Polysemy
import Polysemy.Error
import Polysemy.Input
import Polysemy.TinyLog qualified as P
import System.Logger.Class qualified as Log
import Wire.API.Conversation.Role (Action (RemoveConversationMember))
import Wire.API.Error (ErrorS)
import Wire.API.Error.Galley
import Wire.API.Event.FeatureConfig
import Wire.API.Federation.Error
import Wire.API.Team.Feature
import Wire.API.Team.Member
import Wire.NotificationSubsystem
import Wire.Sem.Paging
import Wire.Sem.Paging.Cassandra
patchFeatureInternal ::
forall cfg r.
( SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'TeamNotFound) r,
Member (Input Opts) r,
Member TeamStore r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r
) =>
TeamId ->
LockableFeaturePatch cfg ->
Sem r (LockableFeature cfg)
patchFeatureInternal :: forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'TeamNotFound) r, Member (Input Opts) r,
Member TeamStore r, Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
TeamId -> LockableFeaturePatch cfg -> Sem r (LockableFeature cfg)
patchFeatureInternal TeamId
tid LockableFeaturePatch cfg
patch = do
TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member TeamStore r) =>
TeamId -> Sem r ()
assertTeamExists TeamId
tid
LockableFeature cfg
currentFeatureStatus <- forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @cfg TeamId
tid
let newFeatureStatus :: LockableFeature cfg
newFeatureStatus = LockableFeature cfg -> LockableFeature cfg
applyPatch LockableFeature cfg
currentFeatureStatus
forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r,
ComputeFeatureConstraints cfg r, Member (Input Opts) r,
Member TinyLog r, Member NotificationSubsystem r,
Member TeamFeatureStore r, Member TeamStore r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
setFeatureForTeam @cfg TeamId
tid LockableFeature cfg
newFeatureStatus
where
applyPatch :: LockableFeature cfg -> LockableFeature cfg
applyPatch :: LockableFeature cfg -> LockableFeature cfg
applyPatch LockableFeature cfg
current =
LockableFeature cfg
current
{ status = fromMaybe current.status patch.status,
lockStatus = fromMaybe current.lockStatus patch.lockStatus,
config = fromMaybe current.config patch.config
}
setFeature ::
forall cfg r.
( SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
Member (Error TeamFeatureError) r,
Member (Input Opts) r,
Member TeamStore r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r
) =>
UserId ->
TeamId ->
Feature cfg ->
Sem r (LockableFeature cfg)
setFeature :: forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'NotATeamMember) r,
Member (ErrorS OperationDenied) r,
Member (Error TeamFeatureError) r, Member (Input Opts) r,
Member TeamStore r, Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
UserId -> TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
setFeature UserId
uid TeamId
tid Feature cfg
feat = do
Maybe TeamMember
zusrMembership <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid UserId
uid
Sem r TeamMember -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r TeamMember -> Sem r ()) -> Sem r TeamMember -> Sem r ()
forall a b. (a -> b) -> a -> b
$ HiddenPerm -> Maybe TeamMember -> Sem r TeamMember
forall perm (r :: EffectRow).
(IsPerm perm,
(Member (ErrorS OperationDenied) r,
Member (ErrorS 'NotATeamMember) r)) =>
perm -> Maybe TeamMember -> Sem r TeamMember
permissionCheck HiddenPerm
ChangeTeamFeature Maybe TeamMember
zusrMembership
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (Error TeamFeatureError) r, Member (Input Opts) r,
Member TeamStore r, Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
setFeatureUnchecked TeamId
tid Feature cfg
feat
setFeatureInternal ::
forall cfg r.
( SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'TeamNotFound) r,
Member (Error TeamFeatureError) r,
Member (Input Opts) r,
Member TeamStore r,
Member TeamFeatureStore r,
Member P.TinyLog r,
Member NotificationSubsystem r
) =>
TeamId ->
Feature cfg ->
Sem r (LockableFeature cfg)
setFeatureInternal :: forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (ErrorS 'TeamNotFound) r, Member (Error TeamFeatureError) r,
Member (Input Opts) r, Member TeamStore r,
Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
setFeatureInternal TeamId
tid Feature cfg
feat = do
TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member TeamStore r) =>
TeamId -> Sem r ()
assertTeamExists TeamId
tid
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (Error TeamFeatureError) r, Member (Input Opts) r,
Member TeamStore r, Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
setFeatureUnchecked TeamId
tid Feature cfg
feat
setFeatureUnchecked ::
forall cfg r.
( SetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (Error TeamFeatureError) r,
Member (Input Opts) r,
Member TeamStore r,
Member TeamFeatureStore r,
Member (P.Logger (Log.Msg -> Log.Msg)) r,
Member NotificationSubsystem r
) =>
TeamId ->
Feature cfg ->
Sem r (LockableFeature cfg)
setFeatureUnchecked :: forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
SetFeatureForTeamConstraints cfg r,
Member (Error TeamFeatureError) r, Member (Input Opts) r,
Member TeamStore r, Member TeamFeatureStore r, Member TinyLog r,
Member NotificationSubsystem r) =>
TeamId -> Feature cfg -> Sem r (LockableFeature cfg)
setFeatureUnchecked TeamId
tid Feature cfg
feat = do
LockableFeature cfg
feat0 <- forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @cfg TeamId
tid
LockStatus -> Sem r ()
forall (r :: EffectRow).
Member (Error TeamFeatureError) r =>
LockStatus -> Sem r ()
guardLockStatus LockableFeature cfg
feat0.lockStatus
forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r,
ComputeFeatureConstraints cfg r, Member (Input Opts) r,
Member TinyLog r, Member NotificationSubsystem r,
Member TeamFeatureStore r, Member TeamStore r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
setFeatureForTeam @cfg TeamId
tid (LockStatus -> Feature cfg -> LockableFeature cfg
forall a. LockStatus -> Feature a -> LockableFeature a
withLockStatus LockableFeature cfg
feat0.lockStatus Feature cfg
feat)
updateLockStatus ::
forall cfg r.
( IsFeatureConfig cfg,
Member TeamFeatureStore r,
Member TeamStore r,
Member (ErrorS 'TeamNotFound) r
) =>
TeamId ->
LockStatus ->
Sem r LockStatusResponse
updateLockStatus :: forall cfg (r :: EffectRow).
(IsFeatureConfig cfg, Member TeamFeatureStore r,
Member TeamStore r, Member (ErrorS 'TeamNotFound) r) =>
TeamId -> LockStatus -> Sem r LockStatusResponse
updateLockStatus TeamId
tid LockStatus
lockStatus = do
TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'TeamNotFound) r, Member TeamStore r) =>
TeamId -> Sem r ()
assertTeamExists TeamId
tid
forall cfg (r :: EffectRow).
(Member TeamFeatureStore r, IsFeatureConfig cfg) =>
TeamId -> LockStatus -> Sem r ()
setFeatureLockStatus @cfg TeamId
tid LockStatus
lockStatus
LockStatusResponse -> Sem r LockStatusResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LockStatusResponse -> Sem r LockStatusResponse)
-> LockStatusResponse -> Sem r LockStatusResponse
forall a b. (a -> b) -> a -> b
$ LockStatus -> LockStatusResponse
LockStatusResponse LockStatus
lockStatus
persistFeature ::
forall cfg r.
( GetFeatureConfig cfg,
ComputeFeatureConstraints cfg r,
Member (Input Opts) r,
Member TeamFeatureStore r
) =>
TeamId ->
LockableFeature cfg ->
Sem r (LockableFeature cfg)
persistFeature :: forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
persistFeature TeamId
tid LockableFeature cfg
feat = do
TeamId -> LockableFeature cfg -> Sem r ()
forall (r :: EffectRow) cfg.
(Member TeamFeatureStore r, IsFeatureConfig cfg) =>
TeamId -> LockableFeature cfg -> Sem r ()
setDbFeature TeamId
tid LockableFeature cfg
feat
forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @cfg TeamId
tid
pushFeatureEvent ::
( Member NotificationSubsystem r,
Member TeamStore r,
Member P.TinyLog r
) =>
TeamId ->
Event ->
Sem r ()
pushFeatureEvent :: forall (r :: EffectRow).
(Member NotificationSubsystem r, Member TeamStore r,
Member TinyLog r) =>
TeamId -> Event -> Sem r ()
pushFeatureEvent TeamId
tid Event
event = do
TeamMemberList
memList <- TeamId -> Sem r TeamMemberList
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> Sem r TeamMemberList
getTeamMembersForFanout TeamId
tid
if ((TeamMemberList
memList TeamMemberList
-> Getting ListType TeamMemberList ListType -> ListType
forall s a. s -> Getting a s a -> a
^. Getting ListType TeamMemberList ListType
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(ListType -> f ListType)
-> TeamMemberList' tag -> f (TeamMemberList' tag)
teamMemberListType) ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
== ListType
ListTruncated)
then do
(Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.warn ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"action" (ByteString -> Builder
Log.val ByteString
"Features.pushFeatureConfigEvent")
(Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"feature" (ByteString -> Builder
Log.val (Text -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString' (Text -> ByteString) -> (Event -> Text) -> Event -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Text
_eventFeatureName (Event -> ByteString) -> Event -> ByteString
forall a b. (a -> b) -> a -> b
$ Event
event))
(Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"team" (ByteString -> Builder
Log.val (String -> ByteString
UTF8.fromString (String -> ByteString)
-> (TeamId -> String) -> TeamId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TeamId -> String
forall a. Show a => a -> String
show (TeamId -> ByteString) -> TeamId -> ByteString
forall a b. (a -> b) -> a -> b
$ TeamId
tid))
(Msg -> Msg) -> (Msg -> Msg) -> Msg -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToBytes a => a -> Msg -> Msg
Log.msg @Text Text
"Fanout limit exceeded. Events will not be sent."
else do
let recipients :: [Recipient]
recipients = Maybe UserId -> [TeamMember] -> [Recipient]
membersToRecipients Maybe UserId
forall a. Maybe a
Nothing (TeamMemberList
memList TeamMemberList
-> Getting [TeamMember] TeamMemberList [TeamMember] -> [TeamMember]
forall s a. s -> Getting a s a -> a
^. Getting [TeamMember] TeamMemberList [TeamMember]
forall (tag1 :: PermissionTag) (tag2 :: PermissionTag)
(f :: * -> *).
Functor f =>
([TeamMember' tag1] -> f [TeamMember' tag2])
-> TeamMemberList' tag1 -> f (TeamMemberList' tag2)
teamMembers)
[Push] -> Sem r ()
forall (r :: EffectRow).
Member NotificationSubsystem r =>
[Push] -> Sem r ()
pushNotifications ([Push] -> Sem r ()) -> [Push] -> Sem r ()
forall a b. (a -> b) -> a -> b
$
Maybe Push -> [Push]
forall a. Maybe a -> [a]
maybeToList (Maybe Push -> [Push]) -> Maybe Push -> [Push]
forall a b. (a -> b) -> a -> b
$
(Maybe UserId -> Object -> [Recipient] -> Maybe Push
newPush Maybe UserId
forall a. Maybe a
Nothing (Event -> Object
forall a. ToJSONObject a => a -> Object
toJSONObject Event
event) [Recipient]
recipients)
guardLockStatus ::
forall r.
(Member (Error TeamFeatureError) r) =>
LockStatus ->
Sem r ()
guardLockStatus :: forall (r :: EffectRow).
Member (Error TeamFeatureError) r =>
LockStatus -> Sem r ()
guardLockStatus = \case
LockStatus
LockStatusUnlocked -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
LockStatus
LockStatusLocked -> TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
FeatureLocked
setFeatureForTeam ::
( SetFeatureConfig cfg,
SetFeatureForTeamConstraints cfg r,
ComputeFeatureConstraints cfg r,
Member (Input Opts) r,
Member P.TinyLog r,
Member NotificationSubsystem r,
Member TeamFeatureStore r,
Member TeamStore r
) =>
TeamId ->
LockableFeature cfg ->
Sem r (LockableFeature cfg)
setFeatureForTeam :: forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r,
ComputeFeatureConstraints cfg r, Member (Input Opts) r,
Member TinyLog r, Member NotificationSubsystem r,
Member TeamFeatureStore r, Member TeamStore r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
setFeatureForTeam TeamId
tid LockableFeature cfg
feat = do
LockableFeature cfg
preparedFeat <- TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
forall (r :: EffectRow).
SetFeatureForTeamConstraints cfg r =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
forall cfg (r :: EffectRow).
(SetFeatureConfig cfg, SetFeatureForTeamConstraints cfg r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
prepareFeature TeamId
tid LockableFeature cfg
feat
LockableFeature cfg
newFeat <- TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
persistFeature TeamId
tid LockableFeature cfg
preparedFeat
TeamId -> Event -> Sem r ()
forall (r :: EffectRow).
(Member NotificationSubsystem r, Member TeamStore r,
Member TinyLog r) =>
TeamId -> Event -> Sem r ()
pushFeatureEvent TeamId
tid (LockableFeature cfg -> Event
forall cfg. IsFeatureConfig cfg => LockableFeature cfg -> Event
mkUpdateEvent LockableFeature cfg
newFeat)
LockableFeature cfg -> Sem r (LockableFeature cfg)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature cfg
newFeat
initialiseTeamFeatures ::
( Member (Input Opts) r,
Member TeamFeatureStore r
) =>
TeamId ->
Sem r ()
initialiseTeamFeatures :: forall (r :: EffectRow).
(Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r ()
initialiseTeamFeatures TeamId
tid = do
FeatureFlags
flags :: FeatureFlags <- (Opts -> FeatureFlags) -> Sem r FeatureFlags
forall i j (r :: EffectRow).
Member (Input i) r =>
(i -> j) -> Sem r j
inputs ((Opts -> FeatureFlags) -> Sem r FeatureFlags)
-> (Opts -> FeatureFlags) -> Sem r FeatureFlags
forall a b. (a -> b) -> a -> b
$ Getting FeatureFlags Opts FeatureFlags -> Opts -> FeatureFlags
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Settings -> Const FeatureFlags Settings)
-> Opts -> Const FeatureFlags Opts
Lens' Opts Settings
settings ((Settings -> Const FeatureFlags Settings)
-> Opts -> Const FeatureFlags Opts)
-> ((FeatureFlags -> Const FeatureFlags FeatureFlags)
-> Settings -> Const FeatureFlags Settings)
-> Getting FeatureFlags Opts FeatureFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FeatureFlags -> Const FeatureFlags FeatureFlags)
-> Settings -> Const FeatureFlags Settings
Lens' Settings FeatureFlags
featureFlags)
let MLSDefaults DefaultsInitial MLSConfig
fdef = FeatureFlags -> FeatureDefaults MLSConfig
forall {k} (x :: k) (f :: k -> *) (xs :: [k]).
NpProject x xs =>
NP f xs -> f x
npProject FeatureFlags
flags
let feat :: LockableFeature MLSConfig
feat = DefaultsInitial MLSConfig -> LockableFeature MLSConfig
forall cfg. DefaultsInitial cfg -> LockableFeature cfg
initialFeature DefaultsInitial MLSConfig
fdef
TeamId -> LockableFeature MLSConfig -> Sem r ()
forall (r :: EffectRow) cfg.
(Member TeamFeatureStore r, IsFeatureConfig cfg) =>
TeamId -> LockableFeature cfg -> Sem r ()
setDbFeature TeamId
tid LockableFeature MLSConfig
feat
() -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
class (GetFeatureConfig cfg) => SetFeatureConfig cfg where
type SetFeatureForTeamConstraints cfg (r :: EffectRow) :: Constraint
type SetFeatureForTeamConstraints cfg (r :: EffectRow) = ()
prepareFeature ::
(SetFeatureForTeamConstraints cfg r) =>
TeamId ->
LockableFeature cfg ->
Sem r (LockableFeature cfg)
default prepareFeature :: TeamId -> LockableFeature cfg -> Sem r (LockableFeature cfg)
prepareFeature TeamId
_tid LockableFeature cfg
feat = LockableFeature cfg -> Sem r (LockableFeature cfg)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature cfg
feat
instance SetFeatureConfig SSOConfig where
type
SetFeatureForTeamConstraints SSOConfig (r :: EffectRow) =
( Member (Input Opts) r,
Member (Error TeamFeatureError) r
)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints SSOConfig r =>
TeamId
-> LockableFeature SSOConfig -> Sem r (LockableFeature SSOConfig)
prepareFeature TeamId
_tid LockableFeature SSOConfig
feat = do
case LockableFeature SSOConfig
feat.status of
FeatureStatus
FeatureStatusEnabled -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FeatureStatus
FeatureStatusDisabled -> TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
DisableSsoNotImplemented
LockableFeature SSOConfig -> Sem r (LockableFeature SSOConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature SSOConfig
feat
instance SetFeatureConfig SearchVisibilityAvailableConfig where
type
SetFeatureForTeamConstraints SearchVisibilityAvailableConfig (r :: EffectRow) =
( Member SearchVisibilityStore r,
Member (Input Opts) r
)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints SearchVisibilityAvailableConfig r =>
TeamId
-> LockableFeature SearchVisibilityAvailableConfig
-> Sem r (LockableFeature SearchVisibilityAvailableConfig)
prepareFeature TeamId
tid LockableFeature SearchVisibilityAvailableConfig
feat = do
case LockableFeature SearchVisibilityAvailableConfig
feat.status of
FeatureStatus
FeatureStatusEnabled -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FeatureStatus
FeatureStatusDisabled -> TeamId -> Sem r ()
forall (r :: EffectRow).
Member SearchVisibilityStore r =>
TeamId -> Sem r ()
SearchVisibilityData.resetSearchVisibility TeamId
tid
LockableFeature SearchVisibilityAvailableConfig
-> Sem r (LockableFeature SearchVisibilityAvailableConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature SearchVisibilityAvailableConfig
feat
instance SetFeatureConfig ValidateSAMLEmailsConfig
instance SetFeatureConfig DigitalSignaturesConfig
instance SetFeatureConfig LegalholdConfig where
type
SetFeatureForTeamConstraints LegalholdConfig (r :: EffectRow) =
( Bounded (PagingBounds InternalPaging TeamMember),
Member BackendNotificationQueueAccess r,
Member BotAccess r,
Member BrigAccess r,
Member CodeStore r,
Member ConversationStore r,
Member (Error FederationError) r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r,
Member (ErrorS 'NotATeamMember) r,
Member (Error TeamFeatureError) r,
Member (ErrorS 'LegalHoldNotEnabled) r,
Member (ErrorS 'LegalHoldDisableUnimplemented) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member ExternalAccess r,
Member FederatorAccess r,
Member FireAndForget r,
Member NotificationSubsystem r,
Member (Input (Local ())) r,
Member (Input Env) r,
Member (Input UTCTime) r,
Member LegalHoldStore r,
Member (ListItems LegacyPaging ConvId) r,
Member MemberStore r,
Member ProposalStore r,
Member SubConversationStore r,
Member TeamFeatureStore r,
Member TeamStore r,
Member (TeamMemberStore InternalPaging) r,
Member P.TinyLog r,
Member Random r,
Member (Embed IO) r
)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints LegalholdConfig r =>
TeamId
-> LockableFeature LegalholdConfig
-> Sem r (LockableFeature LegalholdConfig)
prepareFeature TeamId
tid LockableFeature LegalholdConfig
feat = do
FeatureDefaults LegalholdConfig
featureLegalHold <- Sem r (FeatureDefaults LegalholdConfig)
forall (r :: EffectRow).
Member TeamStore r =>
Sem r (FeatureDefaults LegalholdConfig)
getLegalHoldFlag
case FeatureDefaults LegalholdConfig
featureLegalHold of
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledByDefault -> do
() -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledPermanently -> do
TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
LegalHoldFeatureFlagNotEnabled
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do
TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
LegalHoldWhitelistedOnly
case LockableFeature LegalholdConfig
feat.status of
FeatureStatus
FeatureStatusDisabled -> forall p (r :: EffectRow).
(Paging p, Bounded (PagingBounds p TeamMember),
Member BackendNotificationQueueAccess r, Member BrigAccess r,
Member ConversationStore r, Member (Error FederationError) r,
Member (Error InternalError) r,
Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member (ErrorS 'UserLegalHoldIllegalOperation) r,
Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
Member ExternalAccess r, Member FederatorAccess r,
Member FireAndForget r, Member NotificationSubsystem r,
Member (Input UTCTime) r, Member (Input (Local ())) r,
Member (Input Env) r, Member LegalHoldStore r,
Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
Member (TeamMemberStore p) r, Member TeamStore r,
Member ProposalStore r, Member Random r, Member TinyLog r,
Member SubConversationStore r, Member (Embed IO) r) =>
TeamId -> Sem r ()
LegalHold.removeSettings' @InternalPaging TeamId
tid
FeatureStatus
FeatureStatusEnabled -> TeamId -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r,
Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r,
Member TeamStore r) =>
TeamId -> Sem r ()
LegalHold.ensureNotTooLargeToActivateLegalHold TeamId
tid
LockableFeature LegalholdConfig
-> Sem r (LockableFeature LegalholdConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature LegalholdConfig
feat
instance SetFeatureConfig FileSharingConfig
instance SetFeatureConfig AppLockConfig where
type SetFeatureForTeamConstraints AppLockConfig r = Member (Error TeamFeatureError) r
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints AppLockConfig r =>
TeamId
-> LockableFeature AppLockConfig
-> Sem r (LockableFeature AppLockConfig)
prepareFeature TeamId
_tid LockableFeature AppLockConfig
feat = do
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((AppLockConfig -> Int32
applockInactivityTimeoutSecs LockableFeature AppLockConfig
feat.config) Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
30) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
AppLockInactivityTimeoutTooLow
LockableFeature AppLockConfig
-> Sem r (LockableFeature AppLockConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature AppLockConfig
feat
instance SetFeatureConfig ConferenceCallingConfig
instance SetFeatureConfig SelfDeletingMessagesConfig
instance SetFeatureConfig GuestLinksConfig
instance SetFeatureConfig SndFactorPasswordChallengeConfig
instance SetFeatureConfig SearchVisibilityInboundConfig where
type SetFeatureForTeamConstraints SearchVisibilityInboundConfig (r :: EffectRow) = (Member BrigAccess r)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints SearchVisibilityInboundConfig r =>
TeamId
-> LockableFeature SearchVisibilityInboundConfig
-> Sem r (LockableFeature SearchVisibilityInboundConfig)
prepareFeature TeamId
tid LockableFeature SearchVisibilityInboundConfig
feat = do
TeamStatus SearchVisibilityInboundConfig -> Sem r ()
forall (r :: EffectRow).
Member BrigAccess r =>
TeamStatus SearchVisibilityInboundConfig -> Sem r ()
updateSearchVisibilityInbound (TeamStatus SearchVisibilityInboundConfig -> Sem r ())
-> TeamStatus SearchVisibilityInboundConfig -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamId
-> LockableFeature SearchVisibilityInboundConfig
-> TeamStatus SearchVisibilityInboundConfig
forall cfg. TeamId -> LockableFeature cfg -> TeamStatus cfg
toTeamStatus TeamId
tid LockableFeature SearchVisibilityInboundConfig
feat
LockableFeature SearchVisibilityInboundConfig
-> Sem r (LockableFeature SearchVisibilityInboundConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature SearchVisibilityInboundConfig
feat
instance SetFeatureConfig MLSConfig where
type
SetFeatureForTeamConstraints MLSConfig (r :: EffectRow) =
( Member (Input Opts) r,
Member TeamFeatureStore r,
Member (Error TeamFeatureError) r
)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints MLSConfig r =>
TeamId
-> LockableFeature MLSConfig -> Sem r (LockableFeature MLSConfig)
prepareFeature TeamId
tid LockableFeature MLSConfig
feat = do
LockableFeature MlsMigrationConfig
mlsMigrationConfig <- forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @MlsMigrationConfig TeamId
tid
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(
LockableFeature MLSConfig
feat.config.mlsDefaultProtocol ProtocolTag -> [ProtocolTag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` LockableFeature MLSConfig
feat.config.mlsSupportedProtocols
Bool -> Bool -> Bool
&& (LockableFeature MlsMigrationConfig
mlsMigrationConfig.status FeatureStatus -> FeatureStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureStatus
FeatureStatusDisabled Bool -> Bool -> Bool
|| LockableFeature MLSConfig
feat.status FeatureStatus -> FeatureStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureStatus
FeatureStatusEnabled)
)
(Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
MLSProtocolMismatch
LockableFeature MLSConfig -> Sem r (LockableFeature MLSConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature MLSConfig
feat
instance SetFeatureConfig ExposeInvitationURLsToTeamAdminConfig
instance SetFeatureConfig OutlookCalIntegrationConfig
instance SetFeatureConfig MlsE2EIdConfig
guardMlsE2EIdConfig ::
forall r a.
(Member (Error TeamFeatureError) r) =>
(UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a) ->
UserId ->
TeamId ->
Feature MlsE2EIdConfig ->
Sem r a
guardMlsE2EIdConfig :: forall (r :: EffectRow) a.
Member (Error TeamFeatureError) r =>
(UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a)
-> UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a
guardMlsE2EIdConfig UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a
handler UserId
uid TeamId
tid Feature MlsE2EIdConfig
feat = do
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe HttpsUrl -> Bool
forall a. Maybe a -> Bool
isNothing Feature MlsE2EIdConfig
feat.config.crlProxy) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
MLSE2EIDMissingCrlProxy
UserId -> TeamId -> Feature MlsE2EIdConfig -> Sem r a
handler UserId
uid TeamId
tid Feature MlsE2EIdConfig
feat
instance SetFeatureConfig MlsMigrationConfig where
type
SetFeatureForTeamConstraints MlsMigrationConfig (r :: EffectRow) =
( Member (Input Opts) r,
Member (Error TeamFeatureError) r,
Member TeamFeatureStore r
)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints MlsMigrationConfig r =>
TeamId
-> LockableFeature MlsMigrationConfig
-> Sem r (LockableFeature MlsMigrationConfig)
prepareFeature TeamId
tid LockableFeature MlsMigrationConfig
feat = do
LockableFeature MLSConfig
mlsConfig <- forall cfg (r :: EffectRow).
(GetFeatureConfig cfg, ComputeFeatureConstraints cfg r,
Member (Input Opts) r, Member TeamFeatureStore r) =>
TeamId -> Sem r (LockableFeature cfg)
getFeatureForTeam @MLSConfig TeamId
tid
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
(
LockableFeature MlsMigrationConfig
feat.status FeatureStatus -> FeatureStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureStatus
FeatureStatusDisabled Bool -> Bool -> Bool
|| LockableFeature MLSConfig
mlsConfig.status FeatureStatus -> FeatureStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureStatus
FeatureStatusEnabled
)
(Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
MLSProtocolMismatch
LockableFeature MlsMigrationConfig
-> Sem r (LockableFeature MlsMigrationConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature MlsMigrationConfig
feat
instance SetFeatureConfig EnforceFileDownloadLocationConfig where
type
SetFeatureForTeamConstraints EnforceFileDownloadLocationConfig r =
(Member (Error TeamFeatureError) r)
prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints EnforceFileDownloadLocationConfig r =>
TeamId
-> LockableFeature EnforceFileDownloadLocationConfig
-> Sem r (LockableFeature EnforceFileDownloadLocationConfig)
prepareFeature TeamId
_ LockableFeature EnforceFileDownloadLocationConfig
feat = do
Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LockableFeature EnforceFileDownloadLocationConfig
feat.config.enforcedDownloadLocation Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"") (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
TeamFeatureError -> Sem r ()
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw TeamFeatureError
EmptyDownloadLocation
LockableFeature EnforceFileDownloadLocationConfig
-> Sem r (LockableFeature EnforceFileDownloadLocationConfig)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LockableFeature EnforceFileDownloadLocationConfig
feat
instance SetFeatureConfig LimitedEventFanoutConfig