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