{-# LANGUAGE TemplateHaskell #-}
module Galley.Cassandra.TeamFeatures
( interpretTeamFeatureStoreToCassandra,
getDbFeatureMulti,
getAllTeamFeaturesForServer,
)
where
import Cassandra
import Data.Id
import Galley.API.Teams.Features.Get
import Galley.Cassandra.FeatureTH
import Galley.Cassandra.GetAllTeamFeatures
import Galley.Cassandra.Instances ()
import Galley.Cassandra.MakeFeature
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.TeamFeatureStore qualified as TFS
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import UnliftIO.Async (pooledMapConcurrentlyN)
import Wire.API.Team.Feature
interpretTeamFeatureStoreToCassandra ::
( Member (Embed IO) r,
Member (Input ClientState) r,
Member TinyLog r
) =>
Sem (TFS.TeamFeatureStore ': r) a ->
Sem r a
interpretTeamFeatureStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
Member TinyLog r) =>
Sem (TeamFeatureStore : r) a -> Sem r a
interpretTeamFeatureStoreToCassandra = (forall (rInitial :: EffectRow) x.
TeamFeatureStore (Sem rInitial) x -> Sem r x)
-> Sem (TeamFeatureStore : 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.
TeamFeatureStore (Sem rInitial) x -> Sem r x)
-> Sem (TeamFeatureStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
TeamFeatureStore (Sem rInitial) x -> Sem r x)
-> Sem (TeamFeatureStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
TFS.GetDbFeature FeatureSingleton cfg
sing TeamId
tid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"TeamFeatureStore.GetFeatureConfig"
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
$ FeatureSingleton cfg -> TeamId -> Client (DbFeature cfg)
forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> m (DbFeature cfg)
getDbFeature FeatureSingleton cfg
sing TeamId
tid
TFS.GetDbFeatureMulti FeatureSingleton cfg
sing [TeamId]
tids -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"TeamFeatureStore.GetFeatureConfigMulti"
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
$ FeatureSingleton cfg
-> [TeamId] -> Client [(TeamId, DbFeature cfg)]
forall cfg (m :: * -> *).
(MonadClient m, MonadUnliftIO m) =>
FeatureSingleton cfg -> [TeamId] -> m [(TeamId, DbFeature cfg)]
getDbFeatureMulti FeatureSingleton cfg
sing [TeamId]
tids
TFS.SetDbFeature FeatureSingleton cfg
sing TeamId
tid LockableFeature cfg
feat -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"TeamFeatureStore.SetFeatureConfig"
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
$ FeatureSingleton cfg -> TeamId -> LockableFeature cfg -> Client ()
forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> LockableFeature cfg -> m ()
setDbFeature FeatureSingleton cfg
sing TeamId
tid LockableFeature cfg
feat
TFS.SetFeatureLockStatus FeatureSingleton cfg
sing TeamId
tid LockStatus
lock -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"TeamFeatureStore.SetFeatureLockStatus"
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
$ FeatureSingleton cfg
-> TeamId -> Tagged cfg LockStatus -> Client ()
forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> Tagged cfg LockStatus -> m ()
setFeatureLockStatus FeatureSingleton cfg
sing TeamId
tid (LockStatus -> Tagged cfg LockStatus
forall a b. b -> Tagged a b
Tagged LockStatus
lock)
TFS.GetAllDbFeatures TeamId
tid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"TeamFeatureStore.GetAllTeamFeatures"
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 (NP DbFeature Features)
forall (row :: [*]) (mrow :: [*]) (m :: * -> *).
(MonadClient m, row ~ AllFeatureRow, Tuple (TupleP mrow),
IsProductType (TupleP mrow) mrow, AllZip (IsF Maybe) row mrow) =>
TeamId -> m (NP DbFeature Features)
getAllDbFeatures TeamId
tid
getDbFeatureMulti ::
forall cfg m.
(MonadClient m, MonadUnliftIO m) =>
FeatureSingleton cfg ->
[TeamId] ->
m [(TeamId, DbFeature cfg)]
getDbFeatureMulti :: forall cfg (m :: * -> *).
(MonadClient m, MonadUnliftIO m) =>
FeatureSingleton cfg -> [TeamId] -> m [(TeamId, DbFeature cfg)]
getDbFeatureMulti FeatureSingleton cfg
proxy =
Int
-> (TeamId -> m (TeamId, DbFeature cfg))
-> [TeamId]
-> m [(TeamId, DbFeature cfg)]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> (a -> m b) -> t a -> m (t b)
pooledMapConcurrentlyN Int
8 (\TeamId
tid -> FeatureSingleton cfg -> TeamId -> m (DbFeature cfg)
forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> m (DbFeature cfg)
getDbFeature FeatureSingleton cfg
proxy TeamId
tid m (DbFeature cfg)
-> (DbFeature cfg -> (TeamId, DbFeature cfg))
-> m (TeamId, DbFeature cfg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (TeamId
tid,))
getDbFeature :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> m (DbFeature cfg)
getDbFeature :: forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> m (DbFeature cfg)
getDbFeature = $(featureCases [|fetchFeature|])
setDbFeature :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> LockableFeature cfg -> m ()
setDbFeature :: forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> LockableFeature cfg -> m ()
setDbFeature = $(featureCases [|storeFeature|])
setFeatureLockStatus :: (MonadClient m) => FeatureSingleton cfg -> TeamId -> Tagged cfg LockStatus -> m ()
setFeatureLockStatus :: forall (m :: * -> *) cfg.
MonadClient m =>
FeatureSingleton cfg -> TeamId -> Tagged cfg LockStatus -> m ()
setFeatureLockStatus = $(featureCases [|storeFeatureLockStatus|])