module Galley.API.LegalHold.Team
( isLegalHoldEnabledForTeam,
computeLegalHoldFeatureStatus,
assertLegalHoldEnabledForTeam,
ensureNotTooLargeToActivateLegalHold,
teamSizeBelowLimit,
)
where
import Data.Default
import Data.Id
import Data.Range
import Galley.Effects
import Galley.Effects.BrigAccess
import Galley.Effects.LegalHoldStore qualified as LegalHoldData
import Galley.Effects.TeamFeatureStore
import Galley.Effects.TeamStore
import Galley.Types.Teams as Team
import Imports
import Polysemy
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Team.Feature
import Wire.API.Team.Size
assertLegalHoldEnabledForTeam ::
forall r.
( Member LegalHoldStore r,
Member TeamStore r,
Member TeamFeatureStore r,
Member (ErrorS 'LegalHoldNotEnabled) r
) =>
TeamId ->
Sem r ()
assertLegalHoldEnabledForTeam :: forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
Member TeamFeatureStore r,
Member (ErrorS 'LegalHoldNotEnabled) r) =>
TeamId -> Sem r ()
assertLegalHoldEnabledForTeam TeamId
tid =
Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (TeamId -> Sem r Bool
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
Member TeamFeatureStore r) =>
TeamId -> Sem r Bool
isLegalHoldEnabledForTeam TeamId
tid) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'LegalHoldNotEnabled
computeLegalHoldFeatureStatus ::
( Member TeamStore r,
Member LegalHoldStore r
) =>
TeamId ->
DbFeature LegalholdConfig ->
Sem r FeatureStatus
computeLegalHoldFeatureStatus :: forall (r :: EffectRow).
(Member TeamStore r, Member LegalHoldStore r) =>
TeamId -> DbFeature LegalholdConfig -> Sem r FeatureStatus
computeLegalHoldFeatureStatus TeamId
tid DbFeature LegalholdConfig
dbFeature =
Sem r (FeatureDefaults LegalholdConfig)
forall (r :: EffectRow).
Member TeamStore r =>
Sem r (FeatureDefaults LegalholdConfig)
getLegalHoldFlag Sem r (FeatureDefaults LegalholdConfig)
-> (FeatureDefaults LegalholdConfig -> Sem r FeatureStatus)
-> Sem r FeatureStatus
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledPermanently -> FeatureStatus -> Sem r FeatureStatus
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FeatureStatus
FeatureStatusDisabled
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledByDefault ->
FeatureStatus -> Sem r FeatureStatus
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbFeature LegalholdConfig
-> LockableFeature LegalholdConfig
-> LockableFeature LegalholdConfig
forall cfg.
DbFeature cfg -> LockableFeature cfg -> LockableFeature cfg
applyDbFeature DbFeature LegalholdConfig
dbFeature LockableFeature LegalholdConfig
forall a. Default a => a
def).status
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldWhitelistTeamsAndImplicitConsent -> do
Bool
wl <- TeamId -> Sem r Bool
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r Bool
LegalHoldData.isTeamLegalholdWhitelisted TeamId
tid
FeatureStatus -> Sem r FeatureStatus
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FeatureStatus -> Sem r FeatureStatus)
-> FeatureStatus -> Sem r FeatureStatus
forall a b. (a -> b) -> a -> b
$ if Bool
wl then FeatureStatus
FeatureStatusEnabled else FeatureStatus
FeatureStatusDisabled
isLegalHoldEnabledForTeam ::
forall r.
( Member LegalHoldStore r,
Member TeamStore r,
Member TeamFeatureStore r
) =>
TeamId ->
Sem r Bool
isLegalHoldEnabledForTeam :: forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
Member TeamFeatureStore r) =>
TeamId -> Sem r Bool
isLegalHoldEnabledForTeam TeamId
tid = do
DbFeature LegalholdConfig
dbFeature <- TeamId -> Sem r (DbFeature LegalholdConfig)
forall (r :: EffectRow) cfg.
(Member TeamFeatureStore r, IsFeatureConfig cfg) =>
TeamId -> Sem r (DbFeature cfg)
getDbFeature TeamId
tid
FeatureStatus
status <- TeamId -> DbFeature LegalholdConfig -> Sem r FeatureStatus
forall (r :: EffectRow).
(Member TeamStore r, Member LegalHoldStore r) =>
TeamId -> DbFeature LegalholdConfig -> Sem r FeatureStatus
computeLegalHoldFeatureStatus TeamId
tid DbFeature LegalholdConfig
dbFeature
Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ FeatureStatus
status FeatureStatus -> FeatureStatus -> Bool
forall a. Eq a => a -> a -> Bool
== FeatureStatus
FeatureStatusEnabled
ensureNotTooLargeToActivateLegalHold ::
( Member BrigAccess r,
Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r,
Member TeamStore r
) =>
TeamId ->
Sem r ()
ensureNotTooLargeToActivateLegalHold :: forall (r :: EffectRow).
(Member BrigAccess r,
Member (ErrorS 'CannotEnableLegalHoldServiceLargeTeam) r,
Member TeamStore r) =>
TeamId -> Sem r ()
ensureNotTooLargeToActivateLegalHold TeamId
tid = do
(TeamSize Natural
teamSize) <- TeamId -> Sem r TeamSize
forall (r :: EffectRow).
Member BrigAccess r =>
TeamId -> Sem r TeamSize
getSize TeamId
tid
Sem r Bool -> Sem r () -> Sem r ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Int -> Sem r Bool
forall (r :: EffectRow). Member TeamStore r => Int -> Sem r Bool
teamSizeBelowLimit (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
teamSize)) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$
forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Sem r a
throwS @'CannotEnableLegalHoldServiceLargeTeam
teamSizeBelowLimit :: (Member TeamStore r) => Int -> Sem r Bool
teamSizeBelowLimit :: forall (r :: EffectRow). Member TeamStore r => Int -> Sem r Bool
teamSizeBelowLimit Int
teamSize = do
Int
limit <- Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Int)
-> (Range 1 HardTruncationLimit Int32 -> Int32)
-> Range 1 HardTruncationLimit Int32
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range 1 HardTruncationLimit Int32 -> Int32
forall (n :: Natural) (m :: Natural) a. Range n m a -> a
fromRange (Range 1 HardTruncationLimit Int32 -> Int)
-> Sem r (Range 1 HardTruncationLimit Int32) -> Sem r Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sem r (Range 1 HardTruncationLimit Int32)
forall (r :: EffectRow).
Member TeamStore r =>
Sem r (Range 1 HardTruncationLimit Int32)
fanoutLimit
let withinLimit :: Bool
withinLimit = Int
teamSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
limit
Sem r (FeatureDefaults LegalholdConfig)
forall (r :: EffectRow).
Member TeamStore r =>
Sem r (FeatureDefaults LegalholdConfig)
getLegalHoldFlag Sem r (FeatureDefaults LegalholdConfig)
-> (FeatureDefaults LegalholdConfig -> Sem r Bool) -> Sem r Bool
forall a b. Sem r a -> (a -> Sem r b) -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledPermanently -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
withinLimit
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledByDefault -> Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
withinLimit
FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldWhitelistTeamsAndImplicitConsent ->
Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True