-- 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
  ( createSettings,
    getSettings,
    removeSettingsInternalPaging,
    removeSettings,
    removeSettings',
    getUserStatus,
    grantConsent,
    requestDevice,
    approveDevice,
    disableForUser,
    unsetTeamLegalholdWhitelistedH,
  )
where

import Brig.Types.Connection (UpdateConnectionsInternal (..))
import Brig.Types.Team.LegalHold (legalHoldService, viewLegalHoldService)
import Control.Exception (assert)
import Control.Lens (view, (^.))
import Data.ByteString.Conversion (toByteString)
import Data.Id
import Data.LegalHold (UserLegalHoldStatus (..), defUserLegalHoldStatus)
import Data.List.Split (chunksOf)
import Data.Misc
import Data.Proxy (Proxy (Proxy))
import Data.Qualified
import Data.Range (toRange)
import Data.Time.Clock
import Galley.API.Error
import Galley.API.LegalHold.Get
import Galley.API.LegalHold.Team
import Galley.API.Query (iterateConversations)
import Galley.API.Update (removeMemberFromLocalConv)
import Galley.API.Util
import Galley.App
import Galley.Data.Conversation qualified as Data
import Galley.Effects
import Galley.Effects.BrigAccess
import Galley.Effects.FireAndForget
import Galley.Effects.LegalHoldStore qualified as LegalHoldData
import Galley.Effects.TeamMemberStore
import Galley.Effects.TeamStore
import Galley.External.LegalHoldService qualified as LHService
import Galley.Types.Conversations.Members
import Galley.Types.Teams as Team
import Imports
import Network.HTTP.Types.Status (status200)
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 (ConvType (..))
import Wire.API.Conversation.Protocol
import Wire.API.Conversation.Role
import Wire.API.Error
import Wire.API.Error.Galley
import Wire.API.Federation.Error
import Wire.API.Provider.Service
import Wire.API.Routes.Internal.Brig.Connection
import Wire.API.Routes.Public.Galley.LegalHold
import Wire.API.Team.LegalHold
import Wire.API.Team.LegalHold qualified as Public
import Wire.API.Team.LegalHold.External hiding (userId)
import Wire.API.Team.Member
import Wire.API.User.Client.Prekey
import Wire.NotificationSubsystem
import Wire.Sem.Paging
import Wire.Sem.Paging.Cassandra

createSettings ::
  forall r.
  ( Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'LegalHoldNotEnabled) r,
    Member (ErrorS 'LegalHoldServiceInvalidKey) r,
    Member (ErrorS 'LegalHoldServiceBadResponse) r,
    Member LegalHoldStore r,
    Member TeamFeatureStore r,
    Member TeamStore r,
    Member P.TinyLog r
  ) =>
  Local UserId ->
  TeamId ->
  Public.NewLegalHoldService ->
  Sem r Public.ViewLegalHoldService
createSettings :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceInvalidKey) r,
 Member (ErrorS 'LegalHoldServiceBadResponse) r,
 Member LegalHoldStore r, Member TeamFeatureStore r,
 Member TeamStore r, Member TinyLog r) =>
Local UserId
-> TeamId -> NewLegalHoldService -> Sem r ViewLegalHoldService
createSettings Local UserId
lzusr TeamId
tid NewLegalHoldService
newService = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  TeamId -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'LegalHoldNotEnabled) r) =>
TeamId -> Sem r ()
assertLegalHoldEnabledForTeam TeamId
tid
  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
zusr
  -- let zothers = map (view userId) membs
  -- Log.debug $
  --   Log.field "targets" (toByteString . show $ toByteString <$> zothers)
  --     . Log.field "action" (Log.val "LegalHold.createSettings")
  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
ChangeLegalHoldTeamSettings Maybe TeamMember
zusrMembership
  (ServiceKey
key :: ServiceKey, Fingerprint Rsa
fpr :: Fingerprint Rsa) <-
    ServiceKeyPEM -> Sem r (Maybe (ServiceKey, Fingerprint Rsa))
forall (r :: EffectRow).
Member LegalHoldStore r =>
ServiceKeyPEM -> Sem r (Maybe (ServiceKey, Fingerprint Rsa))
LegalHoldData.validateServiceKey (NewLegalHoldService -> ServiceKeyPEM
newLegalHoldServiceKey NewLegalHoldService
newService)
      Sem r (Maybe (ServiceKey, Fingerprint Rsa))
-> (Maybe (ServiceKey, Fingerprint Rsa)
    -> Sem r (ServiceKey, Fingerprint Rsa))
-> Sem r (ServiceKey, Fingerprint Rsa)
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
>>= forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'LegalHoldServiceInvalidKey
  Fingerprint Rsa -> HttpsUrl -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
 Member LegalHoldStore r, Member TinyLog r) =>
Fingerprint Rsa -> HttpsUrl -> Sem r ()
LHService.checkLegalHoldServiceStatus Fingerprint Rsa
fpr (NewLegalHoldService -> HttpsUrl
newLegalHoldServiceUrl NewLegalHoldService
newService)
  let service :: LegalHoldService
service = TeamId
-> Fingerprint Rsa
-> NewLegalHoldService
-> ServiceKey
-> LegalHoldService
legalHoldService TeamId
tid Fingerprint Rsa
fpr NewLegalHoldService
newService ServiceKey
key
  LegalHoldService -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
LegalHoldService -> Sem r ()
LegalHoldData.createSettings LegalHoldService
service
  ViewLegalHoldService -> Sem r ViewLegalHoldService
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewLegalHoldService -> Sem r ViewLegalHoldService)
-> (LegalHoldService -> ViewLegalHoldService)
-> LegalHoldService
-> Sem r ViewLegalHoldService
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LegalHoldService -> ViewLegalHoldService
viewLegalHoldService (LegalHoldService -> Sem r ViewLegalHoldService)
-> LegalHoldService -> Sem r ViewLegalHoldService
forall a b. (a -> b) -> a -> b
$ LegalHoldService
service

getSettings ::
  forall r.
  ( Member (ErrorS 'NotATeamMember) r,
    Member LegalHoldStore r,
    Member TeamFeatureStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r Public.ViewLegalHoldService
getSettings :: forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r, Member LegalHoldStore r,
 Member TeamFeatureStore r, Member TeamStore r) =>
Local UserId -> TeamId -> Sem r ViewLegalHoldService
getSettings Local UserId
lzusr TeamId
tid = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  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
zusr
  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
$ Sem r TeamMember
-> (TeamMember -> Sem r TeamMember)
-> Maybe TeamMember
-> Sem r TeamMember
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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 @'NotATeamMember) TeamMember -> Sem r TeamMember
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TeamMember
zusrMembership
  Bool
isenabled <- TeamId -> Sem r Bool
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r) =>
TeamId -> Sem r Bool
isLegalHoldEnabledForTeam TeamId
tid
  Maybe LegalHoldService
mresult <- TeamId -> Sem r (Maybe LegalHoldService)
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r (Maybe LegalHoldService)
LegalHoldData.getSettings TeamId
tid
  ViewLegalHoldService -> Sem r ViewLegalHoldService
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ViewLegalHoldService -> Sem r ViewLegalHoldService)
-> ViewLegalHoldService -> Sem r ViewLegalHoldService
forall a b. (a -> b) -> a -> b
$ case (Bool
isenabled, Maybe LegalHoldService
mresult) of
    (Bool
False, Maybe LegalHoldService
_) -> ViewLegalHoldService
Public.ViewLegalHoldServiceDisabled
    (Bool
True, Maybe LegalHoldService
Nothing) -> ViewLegalHoldService
Public.ViewLegalHoldServiceNotConfigured
    (Bool
True, Just LegalHoldService
result) -> LegalHoldService -> ViewLegalHoldService
viewLegalHoldService LegalHoldService
result

removeSettingsInternalPaging ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'LegalHoldDisableUnimplemented) r,
    Member (ErrorS 'LegalHoldNotEnabled) r,
    Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member FireAndForget r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamFeatureStore r,
    Member (TeamMemberStore InternalPaging) r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  Public.RemoveLegalHoldSettingsRequest ->
  Sem r ()
removeSettingsInternalPaging :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldDisableUnimplemented) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member FireAndForget r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input (Local ())) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member ProposalStore r, Member TinyLog r, Member Random r,
 Member SubConversationStore r, Member TeamFeatureStore r,
 Member (TeamMemberStore InternalPaging) r, Member TeamStore r) =>
Local UserId
-> TeamId -> RemoveLegalHoldSettingsRequest -> Sem r ()
removeSettingsInternalPaging Local UserId
lzusr = forall p (r :: EffectRow).
(Paging p, Bounded (PagingBounds p TeamMember),
 Member TeamFeatureStore r, Member (TeamMemberStore p) r,
 Member TeamStore r, Member BackendNotificationQueueAccess r,
 Member BrigAccess r, Member ConversationStore r,
 Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldDisableUnimplemented) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member FireAndForget r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input (Local ())) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member ProposalStore r, Member TinyLog r, Member Random r,
 Member SubConversationStore r) =>
UserId -> TeamId -> RemoveLegalHoldSettingsRequest -> Sem r ()
removeSettings @InternalPaging (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr)

removeSettings ::
  forall p r.
  ( Paging p,
    Bounded (PagingBounds p TeamMember),
    Member TeamFeatureStore r,
    Member (TeamMemberStore p) r,
    Member TeamStore r,
    Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'LegalHoldDisableUnimplemented) r,
    Member (ErrorS 'LegalHoldNotEnabled) r,
    Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member FireAndForget r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member P.TinyLog r,
    Member Random r,
    Member SubConversationStore r
  ) =>
  UserId ->
  TeamId ->
  Public.RemoveLegalHoldSettingsRequest ->
  Sem r ()
removeSettings :: forall p (r :: EffectRow).
(Paging p, Bounded (PagingBounds p TeamMember),
 Member TeamFeatureStore r, Member (TeamMemberStore p) r,
 Member TeamStore r, Member BackendNotificationQueueAccess r,
 Member BrigAccess r, Member ConversationStore r,
 Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldDisableUnimplemented) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member FireAndForget r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input (Local ())) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member ProposalStore r, Member TinyLog r, Member Random r,
 Member SubConversationStore r) =>
UserId -> TeamId -> RemoveLegalHoldSettingsRequest -> Sem r ()
removeSettings UserId
zusr TeamId
tid (Public.RemoveLegalHoldSettingsRequest Maybe PlainTextPassword6
mPassword) = do
  Sem r ()
assertNotWhitelisting
  TeamId -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'LegalHoldNotEnabled) r) =>
TeamId -> Sem r ()
assertLegalHoldEnabledForTeam TeamId
tid
  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
zusr
  -- let zothers = map (view userId) membs
  -- Log.debug $
  --   Log.field "targets" (toByteString . show $ toByteString <$> zothers)
  --     . Log.field "action" (Log.val "LegalHold.removeSettings")
  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
ChangeLegalHoldTeamSettings Maybe TeamMember
zusrMembership
  UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
ensureReAuthorised UserId
zusr Maybe PlainTextPassword6
mPassword Maybe Value
forall a. Maybe a
Nothing Maybe VerificationAction
forall a. Maybe a
Nothing
  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 ()
removeSettings' @p TeamId
tid
  where
    assertNotWhitelisting :: Sem r ()
    assertNotWhitelisting :: Sem r ()
assertNotWhitelisting = do
      Sem r (FeatureDefaults LegalholdConfig)
forall (r :: EffectRow).
Member TeamStore r =>
Sem r (FeatureDefaults LegalholdConfig)
getLegalHoldFlag Sem r (FeatureDefaults LegalholdConfig)
-> (FeatureDefaults LegalholdConfig -> Sem r ()) -> Sem r ()
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 -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledByDefault -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldWhitelistTeamsAndImplicitConsent ->
          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 @'LegalHoldDisableUnimplemented

-- | Remove legal hold settings from team; also disabling for all users and removing LH devices
removeSettings' ::
  forall p r.
  ( 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 P.TinyLog r,
    Member SubConversationStore r
  ) =>
  TeamId ->
  Sem r ()
removeSettings' :: 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 ()
removeSettings' TeamId
tid =
  (Maybe (PagingState p TeamMember) -> Sem r (Page p TeamMember))
-> ([TeamMember] -> Sem r ()) -> Sem r ()
forall p (m :: * -> *) i.
(Paging p, Monad m) =>
(Maybe (PagingState p i) -> m (Page p i)) -> ([i] -> m ()) -> m ()
withChunks
    (\Maybe (PagingState p TeamMember)
mps -> forall p (r :: EffectRow).
Member (TeamMemberStore p) r =>
TeamId
-> Maybe (PagingState p TeamMember)
-> PagingBounds p TeamMember
-> Sem r (Page p TeamMember)
listTeamMembers @p TeamId
tid Maybe (PagingState p TeamMember)
mps PagingBounds p TeamMember
forall a. Bounded a => a
maxBound)
    [TeamMember] -> Sem r ()
action
  where
    action :: [TeamMember] -> Sem r ()
    action :: [TeamMember] -> Sem r ()
action [TeamMember]
membs = do
      let zothers :: [UserId]
zothers = (TeamMember -> UserId) -> [TeamMember] -> [UserId]
forall a b. (a -> b) -> [a] -> [b]
map (Getting UserId TeamMember UserId -> TeamMember -> UserId
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId) [TeamMember]
membs
      let lhMembers :: [TeamMember]
lhMembers = (TeamMember -> Bool) -> [TeamMember] -> [TeamMember]
forall a. (a -> Bool) -> [a] -> [a]
filter ((UserLegalHoldStatus -> UserLegalHoldStatus -> Bool
forall a. Eq a => a -> a -> Bool
== UserLegalHoldStatus
UserLegalHoldEnabled) (UserLegalHoldStatus -> Bool)
-> (TeamMember -> UserLegalHoldStatus) -> TeamMember -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> TeamMember -> UserLegalHoldStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) [TeamMember]
membs
      (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
        ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (String -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (String -> ByteString)
-> ([ByteString] -> String) -> [ByteString] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> String
forall a. Show a => a -> String
show ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (UserId -> ByteString) -> [UserId] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [UserId]
zothers)
          (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
"action" (ByteString -> Builder
Log.val ByteString
"LegalHold.removeSettings'")
      [Sem r ()] -> Sem r ()
forall (r :: EffectRow).
Member FireAndForget r =>
[Sem r ()] -> Sem r ()
spawnMany ((TeamMember -> Sem r ()) -> [TeamMember] -> [Sem r ()]
forall a b. (a -> b) -> [a] -> [b]
map TeamMember -> Sem r ()
removeLHForUser [TeamMember]
lhMembers)
    removeLHForUser :: TeamMember -> Sem r ()
    removeLHForUser :: TeamMember -> Sem r ()
removeLHForUser TeamMember
member = do
      Local UserId
luid <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal (TeamMember
member TeamMember -> Getting UserId TeamMember UserId -> UserId
forall s a. s -> Getting a s a -> a
^. Getting UserId TeamMember UserId
Lens' TeamMember UserId
userId)
      UserId -> Sem r ()
forall (r :: EffectRow). Member BrigAccess r => UserId -> Sem r ()
removeLegalHoldClientFromUser (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
      TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member LegalHoldStore r) =>
TeamId -> UserId -> Sem r ()
LHService.removeLegalHold TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
      TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
luid (TeamMember
member TeamMember
-> Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> UserLegalHoldStatus
forall s a. s -> Getting a s a -> a
^. Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) UserLegalHoldStatus
UserLegalHoldDisabled -- (support for withdrawing consent is not planned yet.)

-- | Change 'UserLegalHoldStatus' from no consent to disabled.  FUTUREWORK:
-- @withdrawExplicitConsentH@ (lots of corner cases we'd have to implement for that to pan
-- out).
grantConsent ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  Sem r GrantConsentResult
grantConsent :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member ProposalStore r, Member TinyLog r, Member Random r,
 Member SubConversationStore r, Member TeamStore r) =>
Local UserId -> TeamId -> Sem r GrantConsentResult
grantConsent Local UserId
lusr TeamId
tid = do
  UserLegalHoldStatus
userLHStatus <-
    forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound
      (Maybe UserLegalHoldStatus -> Sem r UserLegalHoldStatus)
-> Sem r (Maybe UserLegalHoldStatus) -> Sem r UserLegalHoldStatus
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (TeamMember -> UserLegalHoldStatus)
-> Maybe TeamMember -> Maybe UserLegalHoldStatus
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> TeamMember -> UserLegalHoldStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) (Maybe TeamMember -> Maybe UserLegalHoldStatus)
-> Sem r (Maybe TeamMember) -> Sem r (Maybe UserLegalHoldStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lusr)
  case UserLegalHoldStatus
userLHStatus of
    lhs :: UserLegalHoldStatus
lhs@UserLegalHoldStatus
UserLegalHoldNoConsent ->
      TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
lusr UserLegalHoldStatus
lhs UserLegalHoldStatus
UserLegalHoldDisabled Sem r () -> GrantConsentResult -> Sem r GrantConsentResult
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> GrantConsentResult
GrantConsentSuccess
    UserLegalHoldStatus
UserLegalHoldEnabled -> GrantConsentResult -> Sem r GrantConsentResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrantConsentResult
GrantConsentAlreadyGranted
    UserLegalHoldStatus
UserLegalHoldPending -> GrantConsentResult -> Sem r GrantConsentResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrantConsentResult
GrantConsentAlreadyGranted
    UserLegalHoldStatus
UserLegalHoldDisabled -> GrantConsentResult -> Sem r GrantConsentResult
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GrantConsentResult
GrantConsentAlreadyGranted

-- | Request to provision a device on the legal hold service for a user
requestDevice ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'LegalHoldNotEnabled) r,
    Member (ErrorS 'LegalHoldServiceBadResponse) r,
    Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member (ErrorS 'MLSLegalholdIncompatible) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'NoUserLegalHoldConsent) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'TeamMemberNotFound) r,
    Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess 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 P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamFeatureStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  Sem r RequestDeviceResult
requestDevice :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceBadResponse) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'MLSLegalholdIncompatible) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'NoUserLegalHoldConsent) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'TeamMemberNotFound) r,
 Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess 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 TinyLog r,
 Member Random r, Member SubConversationStore r,
 Member TeamFeatureStore r, Member TeamStore r) =>
Local UserId -> TeamId -> UserId -> Sem r RequestDeviceResult
requestDevice Local UserId
lzusr TeamId
tid UserId
uid = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  Local UserId
luid <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal UserId
uid
  TeamId -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'LegalHoldNotEnabled) r) =>
TeamId -> Sem r ()
assertLegalHoldEnabledForTeam TeamId
tid
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid))
      (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
"action" (ByteString -> Builder
Log.val ByteString
"LegalHold.requestDevice")
  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
zusr
  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
ChangeLegalHoldUserSettings Maybe TeamMember
zusrMembership
  TeamMember
member <- forall {k} (e :: k) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
forall (e :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e) r =>
Maybe a -> Sem r a
noteS @'TeamMemberNotFound (Maybe TeamMember -> Sem r TeamMember)
-> Sem r (Maybe TeamMember) -> Sem r TeamMember
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid UserId
uid
  case TeamMember
member TeamMember
-> Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> UserLegalHoldStatus
forall s a. s -> Getting a s a -> a
^. Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus of
    UserLegalHoldStatus
UserLegalHoldEnabled -> 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 @'UserLegalHoldAlreadyEnabled
    lhs :: UserLegalHoldStatus
lhs@UserLegalHoldStatus
UserLegalHoldPending ->
      -- FUTUREWORK: we create a new device if a pending one is found.  this helps with
      -- recovering from lost credentials (but where would that happen?).  on the other
      -- hand. do we properly gc the old pending device?  maybe we should just throw an error
      -- here?
      RequestDeviceResult
RequestDeviceAlreadyPending RequestDeviceResult -> Sem r () -> Sem r RequestDeviceResult
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
provisionLHDevice UserId
zusr Local UserId
luid UserLegalHoldStatus
lhs
    lhs :: UserLegalHoldStatus
lhs@UserLegalHoldStatus
UserLegalHoldDisabled -> RequestDeviceResult
RequestDeviceSuccess RequestDeviceResult -> Sem r () -> Sem r RequestDeviceResult
forall a b. a -> Sem r b -> Sem r a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
provisionLHDevice UserId
zusr Local UserId
luid UserLegalHoldStatus
lhs
    UserLegalHoldStatus
UserLegalHoldNoConsent -> 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 @'NoUserLegalHoldConsent
  where
    disallowIfMLSUser :: Local UserId -> Sem r ()
    disallowIfMLSUser :: Local UserId -> Sem r ()
disallowIfMLSUser Local UserId
luid = do
      Sem r [()] -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r [()] -> Sem r ()) -> Sem r [()] -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Local UserId
-> Range 1 500 Int32 -> ([Conversation] -> Sem r ()) -> Sem r [()]
forall (r :: EffectRow) a.
(Member (ListItems LegacyPaging ConvId) r,
 Member ConversationStore r) =>
Local UserId
-> Range 1 500 Int32 -> ([Conversation] -> Sem r a) -> Sem r [a]
iterateConversations Local UserId
luid (Proxy 500 -> Range 1 500 Int32
forall (n :: Nat) (x :: Nat) (m :: Nat) a.
(n <= x, x <= m, KnownNat x, Num a) =>
Proxy x -> Range n m a
toRange (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @500)) (([Conversation] -> Sem r ()) -> Sem r [()])
-> ([Conversation] -> Sem r ()) -> Sem r [()]
forall a b. (a -> b) -> a -> b
$ \[Conversation]
convs -> do
        Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((Conversation -> Bool) -> [Conversation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Conversation
c -> Conversation
c.convProtocol Protocol -> Protocol -> Bool
forall a. Eq a => a -> a -> Bool
/= Protocol
ProtocolProteus) [Conversation]
convs) (Sem r () -> Sem r ()) -> Sem r () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ do
          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 @'MLSLegalholdIncompatible

    -- Wire's LH service that galley is usually calling here is idempotent in device creation,
    -- ie. it returns the existing device on multiple calls to `/init`, like here:
    -- https://github.com/wireapp/legalhold/blob/e0a241162b9dbc841f12fbc57c8a1e1093c7e83a/src/main/java/com/wire/bots/hold/resource/InitiateResource.java#L42
    --
    -- This will still work if the LH service creates two new device on two consecutive calls
    -- to `/init`, but there may be race conditions, eg. when updating and enabling a pending
    -- device at (almost) the same time.
    provisionLHDevice :: UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
    provisionLHDevice :: UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
provisionLHDevice UserId
zusr Local UserId
luid UserLegalHoldStatus
userLHStatus = do
      Local UserId -> Sem r ()
disallowIfMLSUser Local UserId
luid
      (LastPrekey
lastPrekey', [Prekey]
prekeys) <- Local UserId -> Sem r (LastPrekey, [Prekey])
requestDeviceFromService Local UserId
luid
      -- We don't distinguish the last key here; brig will do so when the device is added
      UserId -> [Prekey] -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
UserId -> [Prekey] -> Sem r ()
LegalHoldData.insertPendingPrekeys (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) (LastPrekey -> Prekey
unpackLastPrekey LastPrekey
lastPrekey' Prekey -> [Prekey] -> [Prekey]
forall a. a -> [a] -> [a]
: [Prekey]
prekeys)
      TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
luid UserLegalHoldStatus
userLHStatus UserLegalHoldStatus
UserLegalHoldPending
      UserId -> UserId -> LastPrekey -> Sem r ()
forall (r :: EffectRow).
Member BrigAccess r =>
UserId -> UserId -> LastPrekey -> Sem r ()
notifyClientsAboutLegalHoldRequest UserId
zusr (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) LastPrekey
lastPrekey'

    requestDeviceFromService :: Local UserId -> Sem r (LastPrekey, [Prekey])
    requestDeviceFromService :: Local UserId -> Sem r (LastPrekey, [Prekey])
requestDeviceFromService Local UserId
luid = do
      UserId -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
UserId -> Sem r ()
LegalHoldData.dropPendingPrekeys (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
      NewLegalHoldClient
lhDevice <- TeamId -> UserId -> Sem r NewLegalHoldClient
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member LegalHoldStore r, Member TinyLog r) =>
TeamId -> UserId -> Sem r NewLegalHoldClient
LHService.requestNewDevice TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
      let NewLegalHoldClient [Prekey]
prekeys LastPrekey
lastKey = NewLegalHoldClient
lhDevice
      (LastPrekey, [Prekey]) -> Sem r (LastPrekey, [Prekey])
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LastPrekey
lastKey, [Prekey]
prekeys)

-- | Approve the adding of a Legal Hold device to the user.
--
-- We don't delete pending prekeys during this flow just in case
-- it gets interupted. There's really no reason to delete them anyways
-- since they are replaced if needed when registering new LH devices.
approveDevice ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS 'AccessDenied) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'LegalHoldNotEnabled) r,
    Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member (ErrorS 'NoLegalHoldDeviceAllocated) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member (ErrorS 'UserLegalHoldNotPending) r,
    Member ExternalAccess r,
    Member FederatorAccess 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 P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamFeatureStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  ConnId ->
  TeamId ->
  UserId ->
  Public.ApproveLegalHoldForUserRequest ->
  Sem r ()
approveDevice :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS 'AccessDenied) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldNotEnabled) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'NoLegalHoldDeviceAllocated) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS 'UserLegalHoldAlreadyEnabled) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member (ErrorS 'UserLegalHoldNotPending) r,
 Member ExternalAccess r, Member FederatorAccess 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 TinyLog r,
 Member Random r, Member SubConversationStore r,
 Member TeamFeatureStore r, Member TeamStore r) =>
Local UserId
-> ConnId
-> TeamId
-> UserId
-> ApproveLegalHoldForUserRequest
-> Sem r ()
approveDevice Local UserId
lzusr ConnId
connId TeamId
tid UserId
uid (Public.ApproveLegalHoldForUserRequest Maybe PlainTextPassword6
mPassword) = do
  let zusr :: UserId
zusr = Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr
  Local UserId
luid <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal UserId
uid
  TeamId -> Sem r ()
forall (r :: EffectRow).
(Member LegalHoldStore r, Member TeamStore r,
 Member TeamFeatureStore r,
 Member (ErrorS 'LegalHoldNotEnabled) r) =>
TeamId -> Sem r ()
assertLegalHoldEnabledForTeam TeamId
tid
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid))
      (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
"action" (ByteString -> Builder
Log.val ByteString
"LegalHold.approveDevice")
  Bool -> Sem r () -> Sem r ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UserId
zusr UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) (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 @'AccessDenied
  UserId -> TeamId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'NotATeamMember) r, Member TeamStore r) =>
UserId -> TeamId -> Sem r ()
assertOnTeam (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) TeamId
tid
  UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
ensureReAuthorised UserId
zusr Maybe PlainTextPassword6
mPassword Maybe Value
forall a. Maybe a
Nothing Maybe VerificationAction
forall a. Maybe a
Nothing
  UserLegalHoldStatus
userLHStatus <-
    UserLegalHoldStatus
-> (TeamMember -> UserLegalHoldStatus)
-> Maybe TeamMember
-> UserLegalHoldStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UserLegalHoldStatus
defUserLegalHoldStatus (Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> TeamMember -> UserLegalHoldStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) (Maybe TeamMember -> UserLegalHoldStatus)
-> Sem r (Maybe TeamMember) -> Sem r UserLegalHoldStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
  UserLegalHoldStatus -> Sem r ()
assertUserLHPending UserLegalHoldStatus
userLHStatus
  Maybe ([Prekey], LastPrekey)
mPreKeys <- UserId -> Sem r (Maybe ([Prekey], LastPrekey))
forall (r :: EffectRow).
Member LegalHoldStore r =>
UserId -> Sem r (Maybe ([Prekey], LastPrekey))
LegalHoldData.selectPendingPrekeys (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
  ([Prekey]
prekeys, LastPrekey
lastPrekey') <- case Maybe ([Prekey], LastPrekey)
mPreKeys of
    Maybe ([Prekey], LastPrekey)
Nothing -> do
      (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.info ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ forall a. ToBytes a => a -> Msg -> Msg
Log.msg @Text Text
"No prekeys found"
      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 @'NoLegalHoldDeviceAllocated
    Just ([Prekey], LastPrekey)
keys -> ([Prekey], LastPrekey) -> Sem r ([Prekey], LastPrekey)
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Prekey], LastPrekey)
keys
  ClientId
clientId <- UserId -> ConnId -> [Prekey] -> LastPrekey -> Sem r ClientId
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId -> ConnId -> [Prekey] -> LastPrekey -> Sem r ClientId
addLegalHoldClientToUser (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) ConnId
connId [Prekey]
prekeys LastPrekey
lastPrekey'
  -- Note: teamId could be passed in the getLegalHoldAuthToken request instead of lookup up again
  -- Note: both 'getLegalHoldToken' and 'ensureReAuthorized' check the password
  -- Note: both 'getLegalHoldToken' and this function in 'assertOnTeam' above
  --       checks that the user is part of a binding team
  -- FUTUREWORK: reduce double checks
  OpaqueAuthToken
legalHoldAuthToken <- UserId -> Maybe PlainTextPassword6 -> Sem r OpaqueAuthToken
forall (r :: EffectRow).
Member BrigAccess r =>
UserId -> Maybe PlainTextPassword6 -> Sem r OpaqueAuthToken
getLegalHoldAuthToken (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) Maybe PlainTextPassword6
mPassword
  ClientId -> TeamId -> UserId -> OpaqueAuthToken -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member LegalHoldStore r) =>
ClientId -> TeamId -> UserId -> OpaqueAuthToken -> Sem r ()
LHService.confirmLegalHold ClientId
clientId TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) OpaqueAuthToken
legalHoldAuthToken
  -- TODO: send event at this point (see also:
  -- https://github.com/wireapp/wire-server/pull/802#pullrequestreview-262280386)
  TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
luid UserLegalHoldStatus
userLHStatus UserLegalHoldStatus
UserLegalHoldEnabled
  where
    assertUserLHPending ::
      UserLegalHoldStatus ->
      Sem r ()
    assertUserLHPending :: UserLegalHoldStatus -> Sem r ()
assertUserLHPending UserLegalHoldStatus
userLHStatus = do
      case UserLegalHoldStatus
userLHStatus of
        UserLegalHoldStatus
UserLegalHoldEnabled -> 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 @'UserLegalHoldAlreadyEnabled
        UserLegalHoldStatus
UserLegalHoldPending -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        UserLegalHoldStatus
UserLegalHoldDisabled -> 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 @'UserLegalHoldNotPending
        UserLegalHoldStatus
UserLegalHoldNoConsent -> 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 @'UserLegalHoldNotPending

disableForUser ::
  forall r.
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error AuthenticationError) r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'LegalHoldServiceNotRegistered) r,
    Member (ErrorS 'NotATeamMember) r,
    Member (ErrorS OperationDenied) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input (Local ())) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  TeamId ->
  UserId ->
  Public.DisableLegalHoldForUserRequest ->
  Sem r DisableLegalHoldForUserResponse
disableForUser :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error AuthenticationError) r,
 Member (Error FederationError) r, Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member (ErrorS 'NotATeamMember) r,
 Member (ErrorS OperationDenied) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input (Local ())) r, Member (Input UTCTime) r,
 Member LegalHoldStore r, Member (ListItems LegacyPaging ConvId) r,
 Member MemberStore r, Member ProposalStore r, Member TinyLog r,
 Member Random r, Member SubConversationStore r,
 Member TeamStore r) =>
Local UserId
-> TeamId
-> UserId
-> DisableLegalHoldForUserRequest
-> Sem r DisableLegalHoldForUserResponse
disableForUser Local UserId
lzusr TeamId
tid UserId
uid (Public.DisableLegalHoldForUserRequest Maybe PlainTextPassword6
mPassword) = do
  Local UserId
luid <- UserId -> Sem r (Local UserId)
forall (r :: EffectRow) a.
Member (Input (Local ())) r =>
a -> Sem r (Local a)
qualifyLocal UserId
uid
  (Msg -> Msg) -> Sem r ()
forall msg (r :: EffectRow).
Member (Logger msg) r =>
msg -> Sem r ()
P.debug ((Msg -> Msg) -> Sem r ()) -> (Msg -> Msg) -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> ByteString -> Msg -> Msg
forall a. ToBytes a => ByteString -> a -> Msg -> Msg
Log.field ByteString
"targets" (UserId -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid))
      (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
"action" (ByteString -> Builder
Log.val ByteString
"LegalHold.disableForUser")
  Maybe TeamMember
zusrMembership <- TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr)
  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
ChangeLegalHoldUserSettings Maybe TeamMember
zusrMembership

  UserLegalHoldStatus
userLHStatus <-
    UserLegalHoldStatus
-> (TeamMember -> UserLegalHoldStatus)
-> Maybe TeamMember
-> UserLegalHoldStatus
forall b a. b -> (a -> b) -> Maybe a -> b
maybe UserLegalHoldStatus
defUserLegalHoldStatus (Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
-> TeamMember -> UserLegalHoldStatus
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UserLegalHoldStatus TeamMember UserLegalHoldStatus
forall (tag :: PermissionTag) (f :: * -> *).
Functor f =>
(UserLegalHoldStatus -> f UserLegalHoldStatus)
-> TeamMember' tag -> f (TeamMember' tag)
legalHoldStatus) (Maybe TeamMember -> UserLegalHoldStatus)
-> Sem r (Maybe TeamMember) -> Sem r UserLegalHoldStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TeamId -> UserId -> Sem r (Maybe TeamMember)
forall (r :: EffectRow).
Member TeamStore r =>
TeamId -> UserId -> Sem r (Maybe TeamMember)
getTeamMember TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)

  let doDisable :: Sem r DisableLegalHoldForUserResponse
doDisable = UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
disableLH (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
lzusr) Local UserId
luid UserLegalHoldStatus
userLHStatus Sem r ()
-> DisableLegalHoldForUserResponse
-> Sem r DisableLegalHoldForUserResponse
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DisableLegalHoldForUserResponse
DisableLegalHoldSuccess
  case UserLegalHoldStatus
userLHStatus of
    -- no state change necessary
    UserLegalHoldStatus
UserLegalHoldDisabled -> DisableLegalHoldForUserResponse
-> Sem r DisableLegalHoldForUserResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DisableLegalHoldForUserResponse
DisableLegalHoldWasNotEnabled
    UserLegalHoldStatus
UserLegalHoldNoConsent ->
      -- no state change allowed
      -- we cannot go to disabled because that would subsume consent
      DisableLegalHoldForUserResponse
-> Sem r DisableLegalHoldForUserResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DisableLegalHoldForUserResponse
DisableLegalHoldWasNotEnabled
    -- LH is enabled or pending, we can disable (change state) without issue
    UserLegalHoldStatus
UserLegalHoldEnabled -> Sem r DisableLegalHoldForUserResponse
doDisable
    UserLegalHoldStatus
UserLegalHoldPending -> Sem r DisableLegalHoldForUserResponse
doDisable
  where
    disableLH :: UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
    disableLH :: UserId -> Local UserId -> UserLegalHoldStatus -> Sem r ()
disableLH UserId
zusr Local UserId
luid UserLegalHoldStatus
userLHStatus = do
      UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member (Error AuthenticationError) r) =>
UserId
-> Maybe PlainTextPassword6
-> Maybe Value
-> Maybe VerificationAction
-> Sem r ()
ensureReAuthorised UserId
zusr Maybe PlainTextPassword6
mPassword Maybe Value
forall a. Maybe a
Nothing Maybe VerificationAction
forall a. Maybe a
Nothing
      UserId -> Sem r ()
forall (r :: EffectRow). Member BrigAccess r => UserId -> Sem r ()
removeLegalHoldClientFromUser UserId
uid
      TeamId -> UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
 Member LegalHoldStore r) =>
TeamId -> UserId -> Sem r ()
LHService.removeLegalHold TeamId
tid UserId
uid
      -- TODO: send event at this point (see also: related TODO in this module in
      -- 'approveDevice' and
      -- https://github.com/wireapp/wire-server/pull/802#pullrequestreview-262280386)
      TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
luid UserLegalHoldStatus
userLHStatus UserLegalHoldStatus
UserLegalHoldDisabled

-- | Allow no-consent or requested => consent without further changes.  If LH device is
-- enabled, or disabled, make sure the affected connections are screened for policy conflict
-- (anybody with no-consent), and put those connections in the appropriate blocked state.
changeLegalholdStatusAndHandlePolicyConflicts ::
  ( Member BackendNotificationQueueAccess r,
    Member BrigAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
    Member (ErrorS 'UserLegalHoldIllegalOperation) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member LegalHoldStore r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member TeamStore r,
    Member ProposalStore r,
    Member Random r,
    Member P.TinyLog r,
    Member SubConversationStore r
  ) =>
  TeamId ->
  Local UserId ->
  UserLegalHoldStatus ->
  UserLegalHoldStatus ->
  Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r, Member BrigAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r,
 Member (ErrorS 'UserLegalHoldIllegalOperation) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member LegalHoldStore r,
 Member (ListItems LegacyPaging ConvId) r, Member MemberStore r,
 Member TeamStore r, Member ProposalStore r, Member Random r,
 Member TinyLog r, Member SubConversationStore r) =>
TeamId
-> Local UserId
-> UserLegalHoldStatus
-> UserLegalHoldStatus
-> Sem r ()
changeLegalholdStatusAndHandlePolicyConflicts TeamId
tid Local UserId
luid UserLegalHoldStatus
old UserLegalHoldStatus
new = do
  case UserLegalHoldStatus
old of
    UserLegalHoldStatus
UserLegalHoldEnabled -> case UserLegalHoldStatus
new of
      UserLegalHoldStatus
UserLegalHoldEnabled -> Sem r ()
noop
      UserLegalHoldStatus
UserLegalHoldPending -> Sem r ()
forall {a}. Sem r a
illegal
      UserLegalHoldStatus
UserLegalHoldDisabled -> Sem r ()
update Sem r () -> Sem r () -> Sem r ()
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sem r ()
removeBlocks
      UserLegalHoldStatus
UserLegalHoldNoConsent -> Sem r ()
forall {a}. Sem r a
illegal
    --
    UserLegalHoldStatus
UserLegalHoldPending -> case UserLegalHoldStatus
new of
      UserLegalHoldStatus
UserLegalHoldEnabled -> Sem r ()
addBlocks Sem r () -> Sem r () -> Sem r ()
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sem r ()
update
      UserLegalHoldStatus
UserLegalHoldPending -> Sem r ()
noop
      UserLegalHoldStatus
UserLegalHoldDisabled -> Sem r ()
update Sem r () -> Sem r () -> Sem r ()
forall a b. Sem r a -> Sem r b -> Sem r b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Sem r ()
removeBlocks
      UserLegalHoldStatus
UserLegalHoldNoConsent -> Sem r ()
forall {a}. Sem r a
illegal
    --
    UserLegalHoldStatus
UserLegalHoldDisabled -> case UserLegalHoldStatus
new of
      UserLegalHoldStatus
UserLegalHoldEnabled -> Sem r ()
forall {a}. Sem r a
illegal
      UserLegalHoldStatus
UserLegalHoldPending -> Sem r ()
update
      UserLegalHoldStatus
UserLegalHoldDisabled -> {- in case the last attempt crashed -} Sem r ()
removeBlocks
      UserLegalHoldStatus
UserLegalHoldNoConsent -> {- withdrawing consent is not (yet?) implemented -} Sem r ()
forall {a}. Sem r a
illegal
    --
    UserLegalHoldStatus
UserLegalHoldNoConsent -> case UserLegalHoldStatus
new of
      UserLegalHoldStatus
UserLegalHoldEnabled -> Sem r ()
forall {a}. Sem r a
illegal
      UserLegalHoldStatus
UserLegalHoldPending -> Sem r ()
forall {a}. Sem r a
illegal
      UserLegalHoldStatus
UserLegalHoldDisabled -> Sem r ()
update
      UserLegalHoldStatus
UserLegalHoldNoConsent -> Sem r ()
noop
  where
    update :: Sem r ()
update = TeamId -> UserId -> UserLegalHoldStatus -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> UserId -> UserLegalHoldStatus -> Sem r ()
LegalHoldData.setUserLegalHoldStatus TeamId
tid (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid) UserLegalHoldStatus
new
    removeBlocks :: Sem r ()
removeBlocks = Sem r Status -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r Status -> Sem r ()) -> Sem r Status -> Sem r ()
forall a b. (a -> b) -> a -> b
$ UpdateConnectionsInternal -> Sem r Status
forall (r :: EffectRow).
Member BrigAccess r =>
UpdateConnectionsInternal -> Sem r Status
putConnectionInternal (UserId -> UpdateConnectionsInternal
RemoveLHBlocksInvolving (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid))
    addBlocks :: Sem r ()
addBlocks = do
      UserId -> Sem r ()
forall (r :: EffectRow).
(Member BrigAccess r, Member TeamStore r, Member TinyLog r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r) =>
UserId -> Sem r ()
blockNonConsentingConnections (Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid)
      Local UserId -> UserLegalHoldStatus -> Sem r ()
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member (ListItems LegacyPaging ConvId) r,
 Member MemberStore r, Member ProposalStore r, Member TinyLog r,
 Member Random r, Member SubConversationStore r,
 Member TeamStore r) =>
Local UserId -> UserLegalHoldStatus -> Sem r ()
handleGroupConvPolicyConflicts Local UserId
luid UserLegalHoldStatus
new
    noop :: Sem r ()
noop = () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    illegal :: Sem r a
illegal = 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 @'UserLegalHoldIllegalOperation

-- FUTUREWORK: make this async?
blockNonConsentingConnections ::
  forall r.
  ( Member BrigAccess r,
    Member TeamStore r,
    Member P.TinyLog r,
    Member (ErrorS 'LegalHoldCouldNotBlockConnections) r
  ) =>
  UserId ->
  Sem r ()
blockNonConsentingConnections :: forall (r :: EffectRow).
(Member BrigAccess r, Member TeamStore r, Member TinyLog r,
 Member (ErrorS 'LegalHoldCouldNotBlockConnections) r) =>
UserId -> Sem r ()
blockNonConsentingConnections UserId
uid = do
  [ConnectionStatus]
conns <- [UserId]
-> Maybe [UserId] -> Maybe Relation -> Sem r [ConnectionStatus]
forall (r :: EffectRow).
Member BrigAccess r =>
[UserId]
-> Maybe [UserId] -> Maybe Relation -> Sem r [ConnectionStatus]
getConnectionsUnqualified [UserId
uid] Maybe [UserId]
forall a. Maybe a
Nothing Maybe Relation
forall a. Maybe a
Nothing
  [String]
errmsgs <- do
    [UserId]
conflicts <- [[UserId]] -> [UserId]
forall a. Monoid a => [a] -> a
mconcat ([[UserId]] -> [UserId]) -> Sem r [[UserId]] -> Sem r [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConnectionStatus] -> Sem r [[UserId]]
findConflicts [ConnectionStatus]
conns
    UserId -> [UserId] -> Sem r [String]
blockConflicts UserId
uid [UserId]
conflicts
  case [String] -> String
forall a. Monoid a => [a] -> a
mconcat [String]
errmsgs of
    [] -> () -> Sem r ()
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    msgs :: String
msgs@(Char
_ : String
_) -> 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
$ forall a. ToBytes a => a -> Msg -> Msg
Log.msg @String String
msgs
      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 @'LegalHoldCouldNotBlockConnections
  where
    findConflicts :: [ConnectionStatus] -> Sem r [[UserId]]
    findConflicts :: [ConnectionStatus] -> Sem r [[UserId]]
findConflicts [ConnectionStatus]
conns = do
      let (forall {k} (label :: k) payload.
payload -> FutureWork label payload
forall (label :: LegalholdProtectee) payload.
payload -> FutureWork label payload
FutureWork @'Public.LegalholdPlusFederationNotImplemented -> FutureWork 'LegalholdPlusFederationNotImplemented Any
_remoteUids, [UserId]
localUids) = (Any
forall a. HasCallStack => a
undefined, ConnectionStatus -> UserId
csTo (ConnectionStatus -> UserId) -> [ConnectionStatus] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ConnectionStatus]
conns)
      -- FUTUREWORK: Handle remoteUsers here when federation is implemented
      [[UserId]] -> ([UserId] -> Sem r [UserId]) -> Sem r [[UserId]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (Int -> [UserId] -> [[UserId]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
32 [UserId]
localUids) (([UserId] -> Sem r [UserId]) -> Sem r [[UserId]])
-> ([UserId] -> Sem r [UserId]) -> Sem r [[UserId]]
forall a b. (a -> b) -> a -> b
$ \[UserId]
others -> do
        Map UserId TeamId
teamsOfUsers <- [UserId] -> Sem r (Map UserId TeamId)
forall (r :: EffectRow).
Member TeamStore r =>
[UserId] -> Sem r (Map UserId TeamId)
getUsersTeams [UserId]
others
        (UserId -> Sem r Bool) -> [UserId] -> Sem r [UserId]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((ConsentGiven -> Bool) -> Sem r ConsentGiven -> Sem r Bool
forall a b. (a -> b) -> Sem r a -> Sem r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ConsentGiven -> ConsentGiven -> Bool
forall a. Eq a => a -> a -> Bool
== ConsentGiven
ConsentNotGiven) (Sem r ConsentGiven -> Sem r Bool)
-> (UserId -> Sem r ConsentGiven) -> UserId -> Sem r Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UserId TeamId -> UserId -> Sem r ConsentGiven
forall (r :: EffectRow).
Member TeamStore r =>
Map UserId TeamId -> UserId -> Sem r ConsentGiven
checkConsent Map UserId TeamId
teamsOfUsers) [UserId]
others

    blockConflicts :: UserId -> [UserId] -> Sem r [String]
    blockConflicts :: UserId -> [UserId] -> Sem r [String]
blockConflicts UserId
_ [] = [String] -> Sem r [String]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    blockConflicts UserId
userLegalhold othersToBlock :: [UserId]
othersToBlock@(UserId
_ : [UserId]
_) = do
      Status
status <- UpdateConnectionsInternal -> Sem r Status
forall (r :: EffectRow).
Member BrigAccess r =>
UpdateConnectionsInternal -> Sem r Status
putConnectionInternal (UserId -> [UserId] -> UpdateConnectionsInternal
BlockForMissingLHConsent UserId
userLegalhold [UserId]
othersToBlock)
      [String] -> Sem r [String]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Sem r [String]) -> [String] -> Sem r [String]
forall a b. (a -> b) -> a -> b
$ [String
"blocking users failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Status, [UserId]) -> String
forall a. Show a => a -> String
show (Status
status, [UserId]
othersToBlock) | Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
status200]

unsetTeamLegalholdWhitelistedH :: (Member LegalHoldStore r) => TeamId -> Sem r ()
unsetTeamLegalholdWhitelistedH :: forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r ()
unsetTeamLegalholdWhitelistedH TeamId
tid = do
  () <-
    String -> Sem r ()
forall a. HasCallStack => String -> a
error
      String
"FUTUREWORK: if we remove entries from the list, that means removing an unknown \
      \number of LH devices as well, and possibly other things.  think this through \
      \before you enable the end-point."
  TeamId -> Sem r ()
forall (r :: EffectRow).
Member LegalHoldStore r =>
TeamId -> Sem r ()
LegalHoldData.unsetTeamLegalholdWhitelisted TeamId
tid

-- | Make sure that enough people are removed from all conversations that contain user `uid`
-- that no policy conflict arises.
--
-- It is guaranteed that no group will ever end up without a group admin because of a policy
-- conflict: If at least one group admin has 'ConsentGiven', non-consenting users are removed.
-- Otherwise, we assume that the group is dominated by people not interested in giving
-- consent, and users carrying LH devices are removed instead.
--
-- The first argument to this function needs explaining: in order to guarantee that this
-- function terminates before we set the LH of user `uid` on pending, we need to call it
-- first.  This means that user `uid` has outdated LH status while this function is running,
-- which may cause wrong behavior.  In order to guarantee correct behavior, the first argument
-- contains the hypothetical new LH status of `uid`'s so it can be consulted instead of the
-- one from the database.
handleGroupConvPolicyConflicts ::
  ( Member BackendNotificationQueueAccess r,
    Member ConversationStore r,
    Member (Error FederationError) r,
    Member (Error InternalError) r,
    Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
    Member ExternalAccess r,
    Member FederatorAccess r,
    Member NotificationSubsystem r,
    Member (Input Env) r,
    Member (Input UTCTime) r,
    Member (ListItems LegacyPaging ConvId) r,
    Member MemberStore r,
    Member ProposalStore r,
    Member P.TinyLog r,
    Member Random r,
    Member SubConversationStore r,
    Member TeamStore r
  ) =>
  Local UserId ->
  UserLegalHoldStatus ->
  Sem r ()
handleGroupConvPolicyConflicts :: forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member ExternalAccess r, Member FederatorAccess r,
 Member NotificationSubsystem r, Member (Input Env) r,
 Member (Input UTCTime) r, Member (ListItems LegacyPaging ConvId) r,
 Member MemberStore r, Member ProposalStore r, Member TinyLog r,
 Member Random r, Member SubConversationStore r,
 Member TeamStore r) =>
Local UserId -> UserLegalHoldStatus -> Sem r ()
handleGroupConvPolicyConflicts Local UserId
luid UserLegalHoldStatus
hypotheticalLHStatus = do
  Sem r [()] -> Sem r ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sem r [()] -> Sem r ()) -> Sem r [()] -> Sem r ()
forall a b. (a -> b) -> a -> b
$
    Local UserId
-> Range 1 500 Int32 -> ([Conversation] -> Sem r ()) -> Sem r [()]
forall (r :: EffectRow) a.
(Member (ListItems LegacyPaging ConvId) r,
 Member ConversationStore r) =>
Local UserId
-> Range 1 500 Int32 -> ([Conversation] -> Sem r a) -> Sem r [a]
iterateConversations Local UserId
luid (Proxy 500 -> Range 1 500 Int32
forall (n :: Nat) (x :: Nat) (m :: Nat) a.
(n <= x, x <= m, KnownNat x, Num a) =>
Proxy x -> Range n m a
toRange (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @500)) (([Conversation] -> Sem r ()) -> Sem r [()])
-> ([Conversation] -> Sem r ()) -> Sem r [()]
forall a b. (a -> b) -> a -> b
$ \[Conversation]
convs -> do
      [Conversation] -> (Conversation -> Sem r ()) -> Sem r ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ((Conversation -> Bool) -> [Conversation] -> [Conversation]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ConvType -> ConvType -> Bool
forall a. Eq a => a -> a -> Bool
== ConvType
RegularConv) (ConvType -> Bool)
-> (Conversation -> ConvType) -> Conversation -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conversation -> ConvType
Data.convType) [Conversation]
convs) ((Conversation -> Sem r ()) -> Sem r ())
-> (Conversation -> Sem r ()) -> Sem r ()
forall a b. (a -> b) -> a -> b
$ \Conversation
conv -> do
        let FutureWork Conversation -> [RemoteMember]
_convRemoteMembers' = forall {k} (label :: k) payload.
payload -> FutureWork label payload
forall (label :: LegalholdProtectee) payload.
payload -> FutureWork label payload
FutureWork @'LegalholdPlusFederationNotImplemented Conversation -> [RemoteMember]
Data.convRemoteMembers

        [(LocalMember, UserLegalHoldStatus)]
membersAndLHStatus :: [(LocalMember, UserLegalHoldStatus)] <- do
          let mems :: [LocalMember]
mems = Conversation -> [LocalMember]
Data.convLocalMembers Conversation
conv
          [(UserId, UserLegalHoldStatus)]
uidsLHStatus <- [UserId] -> Sem r [(UserId, UserLegalHoldStatus)]
forall (r :: EffectRow).
Member TeamStore r =>
[UserId] -> Sem r [(UserId, UserLegalHoldStatus)]
getLHStatusForUsers (LocalMember -> UserId
lmId (LocalMember -> UserId) -> [LocalMember] -> [UserId]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [LocalMember]
mems)
          [(LocalMember, UserLegalHoldStatus)]
-> Sem r [(LocalMember, UserLegalHoldStatus)]
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(LocalMember, UserLegalHoldStatus)]
 -> Sem r [(LocalMember, UserLegalHoldStatus)])
-> [(LocalMember, UserLegalHoldStatus)]
-> Sem r [(LocalMember, UserLegalHoldStatus)]
forall a b. (a -> b) -> a -> b
$
            (LocalMember
 -> (UserId, UserLegalHoldStatus)
 -> (LocalMember, UserLegalHoldStatus))
-> [LocalMember]
-> [(UserId, UserLegalHoldStatus)]
-> [(LocalMember, UserLegalHoldStatus)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
              ( \LocalMember
mem (UserId
mid, UserLegalHoldStatus
status) ->
                  Bool
-> (LocalMember, UserLegalHoldStatus)
-> (LocalMember, UserLegalHoldStatus)
forall a. HasCallStack => Bool -> a -> a
assert (LocalMember -> UserId
lmId LocalMember
mem UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== UserId
mid) ((LocalMember, UserLegalHoldStatus)
 -> (LocalMember, UserLegalHoldStatus))
-> (LocalMember, UserLegalHoldStatus)
-> (LocalMember, UserLegalHoldStatus)
forall a b. (a -> b) -> a -> b
$
                    if LocalMember -> UserId
lmId LocalMember
mem UserId -> UserId -> Bool
forall a. Eq a => a -> a -> Bool
== Local UserId -> UserId
forall (t :: QTag) a. QualifiedWithTag t a -> a
tUnqualified Local UserId
luid
                      then (LocalMember
mem, UserLegalHoldStatus
hypotheticalLHStatus)
                      else (LocalMember
mem, UserLegalHoldStatus
status)
              )
              [LocalMember]
mems
              [(UserId, UserLegalHoldStatus)]
uidsLHStatus

        let lcnv :: QualifiedWithTag 'QLocal ConvId
lcnv = Local UserId -> ConvId -> QualifiedWithTag 'QLocal ConvId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
luid (Conversation -> ConvId
Data.convId Conversation
conv)
        -- we know that this is a group conversation, so invalid operation
        -- and conversation not found errors cannot actually be thrown
        forall {k} (e :: k) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
forall (e :: GalleyError) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
mapToRuntimeError @'InvalidOperation
          (LText -> InternalError
InternalErrorWithDescription LText
"expected group conversation while handling policy conflicts")
          (Sem (ErrorS 'InvalidOperation : r) () -> Sem r ())
-> (Sem
      (ErrorS ('ActionDenied 'LeaveConversation)
         : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
      ()
    -> Sem (ErrorS 'InvalidOperation : r) ())
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
-> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (e :: k) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
forall (e :: GalleyError) e' (r :: EffectRow) a.
Member (Error e') r =>
e' -> Sem (ErrorS e : r) a -> Sem r a
mapToRuntimeError @'ConvNotFound
            (LText -> InternalError
InternalErrorWithDescription LText
"conversation disappeared while iterating on a list of conversations")
          (Sem (ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r) ()
 -> Sem (ErrorS 'InvalidOperation : r) ())
-> (Sem
      (ErrorS ('ActionDenied 'LeaveConversation)
         : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
      ()
    -> Sem (ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r) ())
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
-> Sem (ErrorS 'InvalidOperation : r) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (e :: k1) (e' :: k2) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
forall (e :: GalleyError) (e' :: GalleyError) (r :: EffectRow) a.
Member (ErrorS e') r =>
Sem (ErrorS e : r) a -> Sem r a
mapErrorS @('ActionDenied 'LeaveConversation) @('ActionDenied 'RemoveConversationMember)
          (Sem
   (ErrorS ('ActionDenied 'LeaveConversation)
      : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
   ()
 -> Sem r ())
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
-> Sem r ()
forall a b. (a -> b) -> a -> b
$ if ((LocalMember, UserLegalHoldStatus) -> Bool)
-> [(LocalMember, UserLegalHoldStatus)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any
            ((ConsentGiven -> ConsentGiven -> Bool
forall a. Eq a => a -> a -> Bool
== ConsentGiven
ConsentGiven) (ConsentGiven -> Bool)
-> ((LocalMember, UserLegalHoldStatus) -> ConsentGiven)
-> (LocalMember, UserLegalHoldStatus)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserLegalHoldStatus -> ConsentGiven
consentGiven (UserLegalHoldStatus -> ConsentGiven)
-> ((LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus)
-> (LocalMember, UserLegalHoldStatus)
-> ConsentGiven
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus
forall a b. (a, b) -> b
snd)
            (((LocalMember, UserLegalHoldStatus) -> Bool)
-> [(LocalMember, UserLegalHoldStatus)]
-> [(LocalMember, UserLegalHoldStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
roleNameWireAdmin) (RoleName -> Bool)
-> ((LocalMember, UserLegalHoldStatus) -> RoleName)
-> (LocalMember, UserLegalHoldStatus)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalMember -> RoleName
lmConvRoleName (LocalMember -> RoleName)
-> ((LocalMember, UserLegalHoldStatus) -> LocalMember)
-> (LocalMember, UserLegalHoldStatus)
-> RoleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalMember, UserLegalHoldStatus) -> LocalMember
forall a b. (a, b) -> a
fst) [(LocalMember, UserLegalHoldStatus)]
membersAndLHStatus)
            then do
              [(LocalMember, UserLegalHoldStatus)]
-> ((LocalMember, UserLegalHoldStatus)
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation)
            : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
         (Maybe Event))
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (((LocalMember, UserLegalHoldStatus) -> Bool)
-> [(LocalMember, UserLegalHoldStatus)]
-> [(LocalMember, UserLegalHoldStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ConsentGiven -> ConsentGiven -> Bool
forall a. Eq a => a -> a -> Bool
== ConsentGiven
ConsentNotGiven) (ConsentGiven -> Bool)
-> ((LocalMember, UserLegalHoldStatus) -> ConsentGiven)
-> (LocalMember, UserLegalHoldStatus)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserLegalHoldStatus -> ConsentGiven
consentGiven (UserLegalHoldStatus -> ConsentGiven)
-> ((LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus)
-> (LocalMember, UserLegalHoldStatus)
-> ConsentGiven
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus
forall a b. (a, b) -> b
snd) [(LocalMember, UserLegalHoldStatus)]
membersAndLHStatus) (((LocalMember, UserLegalHoldStatus)
  -> Sem
       (ErrorS ('ActionDenied 'LeaveConversation)
          : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
       (Maybe Event))
 -> Sem
      (ErrorS ('ActionDenied 'LeaveConversation)
         : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
      ())
-> ((LocalMember, UserLegalHoldStatus)
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation)
            : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
         (Maybe Event))
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
forall a b. (a -> b) -> a -> b
$ \(LocalMember
memberNoConsent, UserLegalHoldStatus
_) -> do
                let lusr :: Local UserId
lusr = Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
luid (LocalMember -> UserId
lmId LocalMember
memberNoConsent)
                QualifiedWithTag 'QLocal ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     (Maybe Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
QualifiedWithTag 'QLocal ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberFromLocalConv QualifiedWithTag 'QLocal ConvId
lcnv Local UserId
lusr Maybe ConnId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)
            else do
              [(LocalMember, UserLegalHoldStatus)]
-> ((LocalMember, UserLegalHoldStatus)
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation)
            : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
         (Maybe Event))
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (((LocalMember, UserLegalHoldStatus) -> Bool)
-> [(LocalMember, UserLegalHoldStatus)]
-> [(LocalMember, UserLegalHoldStatus)]
forall a. (a -> Bool) -> [a] -> [a]
filter (UserLegalHoldStatus -> Bool
userLHEnabled (UserLegalHoldStatus -> Bool)
-> ((LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus)
-> (LocalMember, UserLegalHoldStatus)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalMember, UserLegalHoldStatus) -> UserLegalHoldStatus
forall a b. (a, b) -> b
snd) [(LocalMember, UserLegalHoldStatus)]
membersAndLHStatus) (((LocalMember, UserLegalHoldStatus)
  -> Sem
       (ErrorS ('ActionDenied 'LeaveConversation)
          : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
       (Maybe Event))
 -> Sem
      (ErrorS ('ActionDenied 'LeaveConversation)
         : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
      ())
-> ((LocalMember, UserLegalHoldStatus)
    -> Sem
         (ErrorS ('ActionDenied 'LeaveConversation)
            : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
         (Maybe Event))
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     ()
forall a b. (a -> b) -> a -> b
$ \(LocalMember
legalholder, UserLegalHoldStatus
_) -> do
                let lusr :: Local UserId
lusr = Local UserId -> UserId -> Local UserId
forall (t :: QTag) x a.
QualifiedWithTag t x -> a -> QualifiedWithTag t a
qualifyAs Local UserId
luid (LocalMember -> UserId
lmId LocalMember
legalholder)
                QualifiedWithTag 'QLocal ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem
     (ErrorS ('ActionDenied 'LeaveConversation)
        : ErrorS 'ConvNotFound : ErrorS 'InvalidOperation : r)
     (Maybe Event)
forall (r :: EffectRow).
(Member BackendNotificationQueueAccess r,
 Member ConversationStore r, Member (Error FederationError) r,
 Member (Error InternalError) r,
 Member (ErrorS ('ActionDenied 'LeaveConversation)) r,
 Member (ErrorS ('ActionDenied 'RemoveConversationMember)) r,
 Member (ErrorS 'ConvNotFound) r,
 Member (ErrorS 'InvalidOperation) r, Member ExternalAccess r,
 Member FederatorAccess r, Member NotificationSubsystem r,
 Member (Input Env) r, Member (Input UTCTime) r,
 Member MemberStore r, Member ProposalStore r, Member Random r,
 Member SubConversationStore r, Member TinyLog r) =>
QualifiedWithTag 'QLocal ConvId
-> Local UserId
-> Maybe ConnId
-> Qualified UserId
-> Sem r (Maybe Event)
removeMemberFromLocalConv QualifiedWithTag 'QLocal ConvId
lcnv Local UserId
lusr Maybe ConnId
forall a. Maybe a
Nothing (Local UserId -> Qualified UserId
forall (t :: QTag) a. QualifiedWithTag t a -> Qualified a
tUntagged Local UserId
lusr)