{-# LANGUAGE TemplateHaskell #-}

-- 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.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|])