{-# OPTIONS_GHC -Wno-ambiguous-fields #-}

-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2022 Wire Swiss GmbH <opensource@wire.com>
--
-- 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 <https://www.gnu.org/licenses/>.

module Galley.API.Teams.Features
  ( getFeatureMulti,
    setFeature,
    setFeatureInternal,
    patchFeatureInternal,
    getAllTeamFeaturesForTeam,
    getAllTeamFeaturesForUser,
    updateLockStatus,
    GetFeatureConfig (..),
    SetFeatureConfig (..),
    guardSecondFactorDisabled,
    featureEnabledForTeam,
    guardMlsE2EIdConfig,
  )
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.Teams (ensureNotTooLargeToActivateLegalHold)
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

-------------------------------------------------------------------------------
-- SetFeatureConfig instances

-- | Don't export methods of this typeclass
class (GetFeatureConfig cfg) => SetFeatureConfig cfg where
  type SetFeatureForTeamConstraints cfg (r :: EffectRow) :: Constraint
  type SetFeatureForTeamConstraints cfg (r :: EffectRow) = ()

  -- | This method takes a feature about to be set, performs the required
  -- checks, makes any related updates via the internal API, then finally
  -- returns the feature to be persisted and pushed to clients.
  --
  -- The default simply returns the original feature unchanged, which should be
  -- enough for most features.
  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
      )

  prepareFeature :: forall (r :: EffectRow).
SetFeatureForTeamConstraints LegalholdConfig r =>
TeamId
-> LockableFeature LegalholdConfig
-> Sem r (LockableFeature LegalholdConfig)
prepareFeature TeamId
tid LockableFeature LegalholdConfig
feat = do
    -- this extra do is to encapsulate the assertions running before the actual operation.
    -- enabling LH for teams is only allowed in normal operation; disabled-permanently and
    -- whitelist-teams have no or their own way to do that, resp.
    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) =>
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 ()
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
      ( -- default protocol needs to be included in supported protocols
        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
          -- when MLS migration is enabled, MLS needs to be enabled as well
          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
      ( -- when MLS migration is enabled, MLS needs to be enabled as well
        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

instance SetFeatureConfig LimitedEventFanoutConfig