-- 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.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 ->
      -- unlimited, see docs of 'ensureNotTooLargeForLegalHold'
      Bool -> Sem r Bool
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True