-- 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.Cassandra.LegalHold
  ( interpretLegalHoldStoreToCassandra,
    isTeamLegalholdWhitelisted,

    -- * Used by tests
    selectPendingPrekeys,
    validateServiceKey,
  )
where

import Brig.Types.Instances ()
import Brig.Types.Team.LegalHold
import Cassandra
import Control.Exception.Enclosed (handleAny)
import Control.Lens (unsnoc)
import Data.ByteString.Conversion.To
import Data.ByteString.Lazy.Char8 qualified as LC8
import Data.Id
import Data.LegalHold
import Data.Misc
import Galley.Cassandra.Instances ()
import Galley.Cassandra.Queries qualified as Q
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.LegalHoldStore (LegalHoldStore (..))
import Galley.Env
import Galley.External.LegalHoldService.Internal
import Galley.Monad
import Galley.Types.Teams
import Imports
import OpenSSL.EVP.Digest qualified as SSL
import OpenSSL.EVP.PKey qualified as SSL
import OpenSSL.PEM qualified as SSL
import OpenSSL.RSA qualified as SSL
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Ssl.Util qualified as SSL
import Wire.API.Provider.Service
import Wire.API.Team.Feature
import Wire.API.User.Client.Prekey

interpretLegalHoldStoreToCassandra ::
  ( Member (Embed IO) r,
    Member (Input ClientState) r,
    Member (Input Env) r,
    Member TinyLog r
  ) =>
  FeatureDefaults LegalholdConfig ->
  Sem (LegalHoldStore ': r) a ->
  Sem r a
interpretLegalHoldStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
 Member (Input Env) r, Member TinyLog r) =>
FeatureDefaults LegalholdConfig
-> Sem (LegalHoldStore : r) a -> Sem r a
interpretLegalHoldStoreToCassandra FeatureDefaults LegalholdConfig
lh = (forall (rInitial :: EffectRow) x.
 LegalHoldStore (Sem rInitial) x -> Sem r x)
-> Sem (LegalHoldStore : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  LegalHoldStore (Sem rInitial) x -> Sem r x)
 -> Sem (LegalHoldStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    LegalHoldStore (Sem rInitial) x -> Sem r x)
-> Sem (LegalHoldStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  CreateSettings LegalHoldService
s -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.CreateSettings"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ LegalHoldService -> Client ()
forall (m :: * -> *). MonadClient m => LegalHoldService -> m ()
createSettings LegalHoldService
s
  GetSettings TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.GetSettings"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ TeamId -> Client (Maybe LegalHoldService)
forall (m :: * -> *).
MonadClient m =>
TeamId -> m (Maybe LegalHoldService)
getSettings TeamId
tid
  RemoveSettings TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.RemoveSettings"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ TeamId -> Client ()
forall (m :: * -> *). MonadClient m => TeamId -> m ()
removeSettings TeamId
tid
  InsertPendingPrekeys UserId
uid [Prekey]
pkeys -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.InsertPendingPrekeys"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ UserId -> [Prekey] -> Client ()
forall (m :: * -> *). MonadClient m => UserId -> [Prekey] -> m ()
insertPendingPrekeys UserId
uid [Prekey]
pkeys
  SelectPendingPrekeys UserId
uid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.SelectPendingPrekeys"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ UserId -> Client (Maybe ([Prekey], LastPrekey))
forall (m :: * -> *).
MonadClient m =>
UserId -> m (Maybe ([Prekey], LastPrekey))
selectPendingPrekeys UserId
uid
  DropPendingPrekeys UserId
uid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.DropPendingPrekeys"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ UserId -> Client ()
forall (m :: * -> *). MonadClient m => UserId -> m ()
dropPendingPrekeys UserId
uid
  SetUserLegalHoldStatus TeamId
tid UserId
uid UserLegalHoldStatus
st -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.SetUserLegalHoldStatus"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ TeamId -> UserId -> UserLegalHoldStatus -> Client ()
forall (m :: * -> *).
MonadClient m =>
TeamId -> UserId -> UserLegalHoldStatus -> m ()
setUserLegalHoldStatus TeamId
tid UserId
uid UserLegalHoldStatus
st
  SetTeamLegalholdWhitelisted TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.SetTeamLegalholdWhitelisted"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ TeamId -> Client ()
forall (m :: * -> *). MonadClient m => TeamId -> m ()
setTeamLegalholdWhitelisted TeamId
tid
  UnsetTeamLegalholdWhitelisted TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.UnsetTeamLegalholdWhitelisted"
    Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$ TeamId -> Client ()
forall (m :: * -> *). MonadClient m => TeamId -> m ()
unsetTeamLegalholdWhitelisted TeamId
tid
  IsTeamLegalholdWhitelisted TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.IsTeamLegalholdWhitelisted"
    Client Bool -> Sem r Bool
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client Bool -> Sem r Bool) -> Client Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ FeatureDefaults LegalholdConfig -> TeamId -> Client Bool
isTeamLegalholdWhitelisted FeatureDefaults LegalholdConfig
lh TeamId
tid
  -- FUTUREWORK: should this action be part of a separate effect?
  MakeVerifiedRequestFreshManager Fingerprint Rsa
fpr HttpsUrl
url Request -> Request
r -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.MakeVerifiedRequestFreshManager"
    App (Response ByteString) -> Sem r (Response ByteString)
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App (Response ByteString) -> Sem r (Response ByteString))
-> App (Response ByteString) -> Sem r (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> App (Response ByteString)
makeVerifiedRequestFreshManager Fingerprint Rsa
fpr HttpsUrl
url Request -> Request
r
  MakeVerifiedRequest Fingerprint Rsa
fpr HttpsUrl
url Request -> Request
r -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.MakeVerifiedRequest"
    App (Response ByteString) -> Sem r (Response ByteString)
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input Env) r) =>
App a -> Sem r a
embedApp (App (Response ByteString) -> Sem r (Response ByteString))
-> App (Response ByteString) -> Sem r (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Fingerprint Rsa
-> HttpsUrl -> (Request -> Request) -> App (Response ByteString)
makeVerifiedRequest Fingerprint Rsa
fpr HttpsUrl
url Request -> Request
r
  ValidateServiceKey ServiceKeyPEM
sk -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"LegalHoldStore.ValidateServiceKey"
    forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed @IO (IO x -> Sem r x) -> IO x -> Sem r x
forall a b. (a -> b) -> a -> b
$ ServiceKeyPEM -> IO (Maybe (ServiceKey, Fingerprint Rsa))
forall (m :: * -> *).
MonadIO m =>
ServiceKeyPEM -> m (Maybe (ServiceKey, Fingerprint Rsa))
validateServiceKey ServiceKeyPEM
sk

-- | Returns 'False' if legal hold is not enabled for this team
-- The Caller is responsible for checking whether legal hold is enabled for this team
createSettings :: (MonadClient m) => LegalHoldService -> m ()
createSettings :: forall (m :: * -> *). MonadClient m => LegalHoldService -> m ()
createSettings (LegalHoldService TeamId
tid HttpsUrl
url Fingerprint Rsa
fpr ServiceToken
tok ServiceKey
key) = do
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery
  W (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId) ()
-> QueryParams
     (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId)
-> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery
  W (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId) ()
Q.insertLegalHoldSettings (Consistency
-> (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId)
-> QueryParams
     (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey, TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (HttpsUrl
url, Fingerprint Rsa
fpr, ServiceToken
tok, ServiceKey
key, TeamId
tid))

-- | Returns 'Nothing' if no settings are saved
-- The Caller is responsible for checking whether legal hold is enabled for this team
getSettings :: (MonadClient m) => TeamId -> m (Maybe LegalHoldService)
getSettings :: forall (m :: * -> *).
MonadClient m =>
TeamId -> m (Maybe LegalHoldService)
getSettings TeamId
tid =
  ((HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
 -> LegalHoldService)
-> Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
-> Maybe LegalHoldService
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
-> LegalHoldService
toLegalHoldService (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
 -> Maybe LegalHoldService)
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
-> m (Maybe LegalHoldService)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    RetrySettings
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
 -> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)))
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
forall a b. (a -> b) -> a -> b
$ PrepQuery
  R
  (Identity TeamId)
  (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
-> QueryParams (Identity TeamId)
-> m (Maybe (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery
  R
  (Identity TeamId)
  (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
Q.selectLegalHoldSettings (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid))
  where
    toLegalHoldService :: (HttpsUrl, Fingerprint Rsa, ServiceToken, ServiceKey)
-> LegalHoldService
toLegalHoldService (HttpsUrl
httpsUrl, Fingerprint Rsa
fingerprint, ServiceToken
tok, ServiceKey
key) = TeamId
-> HttpsUrl
-> Fingerprint Rsa
-> ServiceToken
-> ServiceKey
-> LegalHoldService
LegalHoldService TeamId
tid HttpsUrl
httpsUrl Fingerprint Rsa
fingerprint ServiceToken
tok ServiceKey
key

removeSettings :: (MonadClient m) => TeamId -> m ()
removeSettings :: forall (m :: * -> *). MonadClient m => TeamId -> m ()
removeSettings TeamId
tid = RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity TeamId) ()
-> QueryParams (Identity TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity TeamId) ()
Q.removeLegalHoldSettings (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid)))

insertPendingPrekeys :: (MonadClient m) => UserId -> [Prekey] -> m ()
insertPendingPrekeys :: forall (m :: * -> *). MonadClient m => UserId -> [Prekey] -> m ()
insertPendingPrekeys UserId
uid [Prekey]
keys = RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> (BatchM () -> m ()) -> BatchM () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchM () -> m ()
forall (m :: * -> *). MonadClient m => BatchM () -> m ()
batch (BatchM () -> m ()) -> BatchM () -> m ()
forall a b. (a -> b) -> a -> b
$
  [Prekey] -> (Prekey -> BatchM ()) -> BatchM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Prekey]
keys ((Prekey -> BatchM ()) -> BatchM ())
-> (Prekey -> BatchM ()) -> BatchM ()
forall a b. (a -> b) -> a -> b
$
    \Prekey
key ->
      PrepQuery W (UserId, PrekeyId, Text) ()
-> (UserId, PrekeyId, Text) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (UserId, PrekeyId, Text) ()
Q.insertPendingPrekeys (Prekey -> (UserId, PrekeyId, Text)
toTuple Prekey
key)
  where
    toTuple :: Prekey -> (UserId, PrekeyId, Text)
toTuple (Prekey PrekeyId
keyId Text
key) = (UserId
uid, PrekeyId
keyId, Text
key)

selectPendingPrekeys :: (MonadClient m) => UserId -> m (Maybe ([Prekey], LastPrekey))
selectPendingPrekeys :: forall (m :: * -> *).
MonadClient m =>
UserId -> m (Maybe ([Prekey], LastPrekey))
selectPendingPrekeys UserId
uid =
  [Prekey] -> Maybe ([Prekey], LastPrekey)
forall {a}. Snoc a a Prekey Prekey => a -> Maybe (a, LastPrekey)
pickLastKey ([Prekey] -> Maybe ([Prekey], LastPrekey))
-> ([(PrekeyId, Text)] -> [Prekey])
-> [(PrekeyId, Text)]
-> Maybe ([Prekey], LastPrekey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PrekeyId, Text) -> Prekey) -> [(PrekeyId, Text)] -> [Prekey]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrekeyId, Text) -> Prekey
fromTuple
    ([(PrekeyId, Text)] -> Maybe ([Prekey], LastPrekey))
-> m [(PrekeyId, Text)] -> m (Maybe ([Prekey], LastPrekey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings -> m [(PrekeyId, Text)] -> m [(PrekeyId, Text)]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Identity UserId) (PrekeyId, Text)
-> QueryParams (Identity UserId) -> m [(PrekeyId, Text)]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (Identity UserId) (PrekeyId, Text)
Q.selectPendingPrekeys (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))
  where
    fromTuple :: (PrekeyId, Text) -> Prekey
fromTuple (PrekeyId
keyId, Text
key) = PrekeyId -> Text -> Prekey
Prekey PrekeyId
keyId Text
key
    pickLastKey :: a -> Maybe (a, LastPrekey)
pickLastKey a
allPrekeys =
      case a -> Maybe (a, Prekey)
forall s a. Snoc s s a a => s -> Maybe (s, a)
unsnoc a
allPrekeys of
        Maybe (a, Prekey)
Nothing -> Maybe (a, LastPrekey)
forall a. Maybe a
Nothing
        Just (a
keys, Prekey
lst) -> (a, LastPrekey) -> Maybe (a, LastPrekey)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
keys, Text -> LastPrekey
lastPrekey (Text -> LastPrekey) -> (Prekey -> Text) -> Prekey -> LastPrekey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prekey -> Text
prekeyKey (Prekey -> LastPrekey) -> Prekey -> LastPrekey
forall a b. (a -> b) -> a -> b
$ Prekey
lst)

dropPendingPrekeys :: (MonadClient m) => UserId -> m ()
dropPendingPrekeys :: forall (m :: * -> *). MonadClient m => UserId -> m ()
dropPendingPrekeys UserId
uid = RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity UserId) ()
-> QueryParams (Identity UserId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity UserId) ()
Q.dropPendingPrekeys (Consistency -> Identity UserId -> QueryParams (Identity UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserId -> Identity UserId
forall a. a -> Identity a
Identity UserId
uid)))

setUserLegalHoldStatus :: (MonadClient m) => TeamId -> UserId -> UserLegalHoldStatus -> m ()
setUserLegalHoldStatus :: forall (m :: * -> *).
MonadClient m =>
TeamId -> UserId -> UserLegalHoldStatus -> m ()
setUserLegalHoldStatus TeamId
tid UserId
uid UserLegalHoldStatus
status =
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (UserLegalHoldStatus, TeamId, UserId) ()
-> QueryParams (UserLegalHoldStatus, TeamId, UserId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (UserLegalHoldStatus, TeamId, UserId) ()
Q.updateUserLegalHoldStatus (Consistency
-> (UserLegalHoldStatus, TeamId, UserId)
-> QueryParams (UserLegalHoldStatus, TeamId, UserId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (UserLegalHoldStatus
status, TeamId
tid, UserId
uid)))

setTeamLegalholdWhitelisted :: (MonadClient m) => TeamId -> m ()
setTeamLegalholdWhitelisted :: forall (m :: * -> *). MonadClient m => TeamId -> m ()
setTeamLegalholdWhitelisted TeamId
tid =
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity TeamId) ()
-> QueryParams (Identity TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity TeamId) ()
Q.insertLegalHoldWhitelistedTeam (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid)))

unsetTeamLegalholdWhitelisted :: (MonadClient m) => TeamId -> m ()
unsetTeamLegalholdWhitelisted :: forall (m :: * -> *). MonadClient m => TeamId -> m ()
unsetTeamLegalholdWhitelisted TeamId
tid =
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity TeamId) ()
-> QueryParams (Identity TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity TeamId) ()
Q.removeLegalHoldWhitelistedTeam (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid)))

isTeamLegalholdWhitelisted :: FeatureDefaults LegalholdConfig -> TeamId -> Client Bool
isTeamLegalholdWhitelisted :: FeatureDefaults LegalholdConfig -> TeamId -> Client Bool
isTeamLegalholdWhitelisted FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledPermanently TeamId
_ = Bool -> Client Bool
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isTeamLegalholdWhitelisted FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldDisabledByDefault TeamId
_ = Bool -> Client Bool
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
isTeamLegalholdWhitelisted FeatureDefaults LegalholdConfig
R:FeatureDefaultsLegalholdConfig
FeatureLegalHoldWhitelistTeamsAndImplicitConsent TeamId
tid =
  Maybe TeamId -> Bool
forall a. Maybe a -> Bool
isJust (Maybe TeamId -> Bool) -> Client (Maybe TeamId) -> Client Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Identity TeamId -> TeamId
forall a. Identity a -> a
runIdentity (Identity TeamId -> TeamId)
-> Client (Maybe (Identity TeamId)) -> Client (Maybe TeamId)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings
-> Client (Maybe (Identity TeamId))
-> Client (Maybe (Identity TeamId))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery R (Identity TeamId) (Identity TeamId)
-> QueryParams (Identity TeamId)
-> Client (Maybe (Identity TeamId))
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m (Maybe b)
query1 PrepQuery R (Identity TeamId) (Identity TeamId)
Q.selectLegalHoldWhitelistedTeam (Consistency -> Identity TeamId -> QueryParams (Identity TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamId -> Identity TeamId
forall a. a -> Identity a
Identity TeamId
tid))))

-- | Copied unchanged from "Brig.Provider.API".  Interpret a service certificate and extract
-- key and fingerprint.  (This only has to be in 'MonadIO' because the FFI in OpenSSL works
-- like that.)
--
-- FUTUREWORK: It would be nice to move (part of) this to ssl-util, but it has types from
-- brig-types and types-common.
validateServiceKey :: (MonadIO m) => ServiceKeyPEM -> m (Maybe (ServiceKey, Fingerprint Rsa))
validateServiceKey :: forall (m :: * -> *).
MonadIO m =>
ServiceKeyPEM -> m (Maybe (ServiceKey, Fingerprint Rsa))
validateServiceKey ServiceKeyPEM
pem =
  IO (Maybe (ServiceKey, Fingerprint Rsa))
-> m (Maybe (ServiceKey, Fingerprint Rsa))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (ServiceKey, Fingerprint Rsa))
 -> m (Maybe (ServiceKey, Fingerprint Rsa)))
-> IO (Maybe (ServiceKey, Fingerprint Rsa))
-> m (Maybe (ServiceKey, Fingerprint Rsa))
forall a b. (a -> b) -> a -> b
$
    IO (Maybe SomePublicKey)
readPublicKey IO (Maybe SomePublicKey)
-> (Maybe SomePublicKey
    -> IO (Maybe (ServiceKey, Fingerprint Rsa)))
-> IO (Maybe (ServiceKey, Fingerprint Rsa))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe SomePublicKey
pk ->
      case SomePublicKey -> Maybe RSAPubKey
forall k. PublicKey k => SomePublicKey -> Maybe k
SSL.toPublicKey (SomePublicKey -> Maybe RSAPubKey)
-> Maybe SomePublicKey -> Maybe RSAPubKey
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SomePublicKey
pk of
        Maybe RSAPubKey
Nothing -> Maybe (ServiceKey, Fingerprint Rsa)
-> IO (Maybe (ServiceKey, Fingerprint Rsa))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ServiceKey, Fingerprint Rsa)
forall a. Maybe a
Nothing
        Just RSAPubKey
pk' -> do
          Just Digest
sha <- String -> IO (Maybe Digest)
SSL.getDigestByName String
"SHA256"
          let size :: Int
size = RSAPubKey -> Int
forall k. RSAKey k => k -> Int
SSL.rsaSize (RSAPubKey
pk' :: SSL.RSAPubKey)
          if Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minRsaKeySize
            then Maybe (ServiceKey, Fingerprint Rsa)
-> IO (Maybe (ServiceKey, Fingerprint Rsa))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ServiceKey, Fingerprint Rsa)
forall a. Maybe a
Nothing
            else do
              Fingerprint Rsa
fpr <- ByteString -> Fingerprint Rsa
forall {k} (a :: k). ByteString -> Fingerprint a
Fingerprint (ByteString -> Fingerprint Rsa)
-> IO ByteString -> IO (Fingerprint Rsa)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Digest -> RSAPubKey -> IO ByteString
forall k. RSAKey k => Digest -> k -> IO ByteString
SSL.rsaFingerprint Digest
sha RSAPubKey
pk'
              let bits :: Int32
bits = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
8
              let key :: ServiceKey
key = ServiceKeyType -> Int32 -> ServiceKeyPEM -> ServiceKey
ServiceKey ServiceKeyType
RsaServiceKey Int32
bits ServiceKeyPEM
pem
              Maybe (ServiceKey, Fingerprint Rsa)
-> IO (Maybe (ServiceKey, Fingerprint Rsa))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ServiceKey, Fingerprint Rsa)
-> Maybe (ServiceKey, Fingerprint Rsa)
forall a. a -> Maybe a
Just (ServiceKey
key, Fingerprint Rsa
fpr))
  where
    readPublicKey :: IO (Maybe SomePublicKey)
readPublicKey =
      (SomeException -> IO (Maybe SomePublicKey))
-> IO (Maybe SomePublicKey) -> IO (Maybe SomePublicKey)
forall (m :: * -> *) a.
MonadBaseControl IO m =>
(SomeException -> m a) -> m a -> m a
handleAny
        (IO (Maybe SomePublicKey)
-> SomeException -> IO (Maybe SomePublicKey)
forall a b. a -> b -> a
const (IO (Maybe SomePublicKey)
 -> SomeException -> IO (Maybe SomePublicKey))
-> IO (Maybe SomePublicKey)
-> SomeException
-> IO (Maybe SomePublicKey)
forall a b. (a -> b) -> a -> b
$ Maybe SomePublicKey -> IO (Maybe SomePublicKey)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SomePublicKey
forall a. Maybe a
Nothing)
        (String -> IO SomePublicKey
SSL.readPublicKey (ByteString -> String
LC8.unpack (ServiceKeyPEM -> ByteString
forall a. ToByteString a => a -> ByteString
toByteString ServiceKeyPEM
pem)) IO SomePublicKey
-> (SomePublicKey -> Maybe SomePublicKey)
-> IO (Maybe SomePublicKey)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SomePublicKey -> Maybe SomePublicKey
forall a. a -> Maybe a
Just)
    minRsaKeySize :: Int
    minRsaKeySize :: Int
minRsaKeySize = Int
256 -- Bytes (= 2048 bits)