content: {-# LANGUAGE RecordWildCards #-}
  
  -- 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,
      getAllTeamFeaturesForServer,
    )
  where
  
  import Cassandra
  import Data.Aeson.Types qualified as A
  import Data.Constraint
  import Data.Id
  import Data.Map qualified as M
  import Data.Text.Lazy qualified as LT
  import Galley.API.Error
  import Galley.API.Teams.Features.Get
  import Galley.Cassandra.Store
  import Galley.Cassandra.Util
  import Galley.Effects.TeamFeatureStore qualified as TFS
  import Imports
  import Polysemy
  import Polysemy.Error
  import Polysemy.Input
  import Polysemy.TinyLog
  import Wire.API.Team.Feature
  import Wire.API.Team.Feature.TH
  import Wire.ConversationStore.Cassandra.Instances ()
  
  interpretTeamFeatureStoreToCassandra ::
    ( Member (Embed IO) r,
      Member (Input ClientState) r,
      Member (Error InternalError) r,
      Member TinyLog r
    ) =>
    Sem (TFS.TeamFeatureStore ': r) a ->
    Sem r a
  interpretTeamFeatureStoreToCassandra = interpret $ \case
    TFS.GetDbFeature sing tid -> do
      logEffect "TeamFeatureStore.GetFeatureConfig"
      getDbFeatureDyn sing tid
    TFS.SetDbFeature sing tid feat -> do
      logEffect "TeamFeatureStore.SetFeatureConfig"
      setDbFeatureDyn sing tid feat
    TFS.SetFeatureLockStatus sing tid lock -> do
      logEffect "TeamFeatureStore.SetFeatureLockStatus"
      setFeatureLockStatusDyn sing tid (Tagged lock)
    TFS.GetAllDbFeatures tid -> do
      logEffect "TeamFeatureStore.GetAllTeamFeatures"
      getAllDbFeaturesDyn tid
    TFS.PatchDbFeature sing tid feat -> do
      logEffect "TeamFeatureStore.PatchDbFeature"
      patchDbFeatureDyn sing tid feat
  
  getDbFeatureDyn ::
    forall cfg r.
    ( Member (Input ClientState) r,
      Member (Embed IO) r,
      Member (Error InternalError) r
    ) =>
    FeatureSingleton cfg ->
    TeamId ->
    Sem r (DbFeature cfg)
  getDbFeatureDyn sing tid = case featureSingIsFeature sing of
    Dict -> do
      let q :: PrepQuery R (TeamId, Text) (Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig)
          q = "select status, lock_status, config from team_features_dyn where team = ? and feature = ?"
      embedClient (retry x1 $ query1 q (params LocalQuorum (tid, featureName @cfg))) >>= \case
        Nothing -> pure mempty
        Just (status, lockStatus, config) ->
          runFeatureParser . parseDbFeature $
            LockableFeaturePatch {..}
  
  setDbFeatureDyn ::
    forall cfg r.
    ( Member (Input ClientState) r,
      Member (Embed IO) r
    ) =>
    FeatureSingleton cfg ->
    TeamId ->
    LockableFeature cfg ->
    Sem r ()
  setDbFeatureDyn sing tid feat =
    patchDbFeatureDyn
      sing
      tid
      ( LockableFeaturePatch
          { status = Just feat.status,
            lockStatus = Just feat.lockStatus,
            config = Just feat.config
          }
      )
  
  patchDbFeatureDyn ::
    forall cfg r.
    ( Member (Input ClientState) r,
      Member (Embed IO) r
    ) =>
    FeatureSingleton cfg ->
    TeamId ->
    LockableFeaturePatch cfg ->
    Sem r ()
  patchDbFeatureDyn sing tid patch = case featureSingIsFeature sing of
    Dict -> embedClient $ do
      retry x5 . batch $ do
        setType BatchLogged
        setConsistency LocalQuorum
        for_ patch.status $ \featureStatus -> addPrepQuery writeStatus (featureStatus, tid, featureName @cfg)
        for_ patch.lockStatus $ \lockStatus -> addPrepQuery writeLockStatus (lockStatus, tid, featureName @cfg)
        for_ patch.config $ \config -> addPrepQuery writeConfig (serialiseDbConfig config, tid, featureName @cfg)
    where
      writeStatus :: PrepQuery W (FeatureStatus, TeamId, Text) ()
      writeStatus = "update team_features_dyn set status = ? where team = ? and feature = ?"
  
      writeLockStatus :: PrepQuery W (LockStatus, TeamId, Text) ()
      writeLockStatus = "update team_features_dyn set lock_status = ? where team = ? and feature = ?"
  
      writeConfig :: PrepQuery W (DbConfig, TeamId, Text) ()
      writeConfig = "update team_features_dyn set config = ? where team = ? and feature = ?"
  
  setFeatureLockStatusDyn ::
    forall cfg r.
    ( Member (Input ClientState) r,
      Member (Embed IO) r
    ) =>
    FeatureSingleton cfg ->
    TeamId ->
    Tagged cfg LockStatus ->
    Sem r ()
  setFeatureLockStatusDyn sing tid (Tagged lockStatus) = case featureSingIsFeature sing of
    Dict -> do
      let q :: PrepQuery W (LockStatus, TeamId, Text) ()
          q = "update team_features_dyn set  lock_status = ? where team = ? and feature = ?"
      embedClient $
        retry x5 $
          write q (params LocalQuorum (lockStatus, tid, featureName @cfg))
  
  getAllDbFeaturesDyn ::
    ( Member (Embed IO) r,
      Member (Error InternalError) r,
      Member (Input ClientState) r
    ) =>
    TeamId ->
    Sem r (AllFeatures DbFeature)
  getAllDbFeaturesDyn tid = do
    let q :: PrepQuery R (Identity TeamId) (Text, Maybe FeatureStatus, Maybe LockStatus, Maybe DbConfig)
        q = "select feature, status, lock_status, config from team_features_dyn where team = ?"
    rows <- embedClient $ retry x1 $ query q (params LocalQuorum (Identity tid))
    let m = M.fromList $ do
          (name, status, lockStatus, config) <- rows
          pure (name, LockableFeaturePatch {..})
    runFeatureParser $ mkAllFeatures m
  
  runFeatureParser ::
    forall r a.
    (Member (Error InternalError) r) =>
    A.Parser a ->
    Sem r a
  runFeatureParser p =
    mapError (InternalErrorWithDescription . LT.pack)
      . fromEither
      $ A.parseEither (const p) ()
  