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
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
newService.newLegalHoldServiceKey
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
newService.newLegalHoldServiceUrl
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,
Member (Embed IO) 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,
Member (Embed IO) 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, Member (Embed IO) 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,
Member (Embed IO) 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, Member (Embed IO) 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
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, Member (Embed IO) 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
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,
Member (Embed IO) 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, Member (Embed IO) 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 -> Local UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member TinyLog r, Member LegalHoldStore r, Member (Embed IO) r) =>
TeamId -> Local UserId -> Sem r ()
LHService.removeLegalHold TeamId
tid 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
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
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,
Member (Embed IO) 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,
Member (Embed IO) 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 ->
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
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
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 -> Local UserId -> Sem r NewLegalHoldClient
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceBadResponse) r,
Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member LegalHoldStore r, Member TinyLog r, Member (Embed IO) r) =>
TeamId -> Local UserId -> Sem r NewLegalHoldClient
LHService.requestNewDevice TeamId
tid 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)
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,
Member (Embed IO) 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,
Member (Embed IO) 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'
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 -> Local UserId -> OpaqueAuthToken -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member TinyLog r, Member LegalHoldStore r, Member (Embed IO) r) =>
ClientId -> TeamId -> Local UserId -> OpaqueAuthToken -> Sem r ()
LHService.confirmLegalHold ClientId
clientId TeamId
tid Local UserId
luid OpaqueAuthToken
legalHoldAuthToken
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,
Member (Embed IO) 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,
Member (Embed IO) 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
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 ->
DisableLegalHoldForUserResponse
-> Sem r DisableLegalHoldForUserResponse
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DisableLegalHoldForUserResponse
DisableLegalHoldWasNotEnabled
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 -> Local UserId -> Sem r ()
forall (r :: EffectRow).
(Member (ErrorS 'LegalHoldServiceNotRegistered) r,
Member TinyLog r, Member LegalHoldStore r, Member (Embed IO) r) =>
TeamId -> Local UserId -> Sem r ()
LHService.removeLegalHold TeamId
tid 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 UserLegalHoldStatus
userLHStatus UserLegalHoldStatus
UserLegalHoldDisabled
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 -> Sem r ()
removeBlocks
UserLegalHoldStatus
UserLegalHoldNoConsent -> 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
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)
[[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
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)
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)