-- 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.SearchVisibility (interpretSearchVisibilityStoreToCassandra) where

import Cassandra
import Data.Id
import Galley.Cassandra.Instances ()
import Galley.Cassandra.Queries
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.SearchVisibilityStore (SearchVisibilityStore (..))
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.Team.SearchVisibility

interpretSearchVisibilityStoreToCassandra ::
  ( Member (Embed IO) r,
    Member (Input ClientState) r,
    Member TinyLog r
  ) =>
  Sem (SearchVisibilityStore ': r) a ->
  Sem r a
interpretSearchVisibilityStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
 Member TinyLog r) =>
Sem (SearchVisibilityStore : r) a -> Sem r a
interpretSearchVisibilityStoreToCassandra = (forall (rInitial :: EffectRow) x.
 SearchVisibilityStore (Sem rInitial) x -> Sem r x)
-> Sem (SearchVisibilityStore : 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.
  SearchVisibilityStore (Sem rInitial) x -> Sem r x)
 -> Sem (SearchVisibilityStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    SearchVisibilityStore (Sem rInitial) x -> Sem r x)
-> Sem (SearchVisibilityStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  GetSearchVisibility TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"SearchVisibilityStore.GetSearchVisibility"
    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 TeamSearchVisibility
forall (m :: * -> *).
MonadClient m =>
TeamId -> m TeamSearchVisibility
getSearchVisibility TeamId
tid
  SetSearchVisibility TeamId
tid TeamSearchVisibility
value -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"SearchVisibilityStore.SetSearchVisibility"
    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 -> TeamSearchVisibility -> Client ()
forall (m :: * -> *).
MonadClient m =>
TeamId -> TeamSearchVisibility -> m ()
setSearchVisibility TeamId
tid TeamSearchVisibility
value
  ResetSearchVisibility TeamId
tid -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"SearchVisibilityStore.ResetSearchVisibility"
    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 ()
resetSearchVisibility TeamId
tid

-- | Return whether a given team is allowed to enable/disable sso
getSearchVisibility :: (MonadClient m) => TeamId -> m TeamSearchVisibility
getSearchVisibility :: forall (m :: * -> *).
MonadClient m =>
TeamId -> m TeamSearchVisibility
getSearchVisibility TeamId
tid =
  Maybe (Identity (Maybe TeamSearchVisibility))
-> TeamSearchVisibility
toSearchVisibility (Maybe (Identity (Maybe TeamSearchVisibility))
 -> TeamSearchVisibility)
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
-> m TeamSearchVisibility
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    RetrySettings
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m (Maybe (Identity (Maybe TeamSearchVisibility)))
 -> m (Maybe (Identity (Maybe TeamSearchVisibility))))
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
forall a b. (a -> b) -> a -> b
$ PrepQuery
  R (Identity TeamId) (Identity (Maybe TeamSearchVisibility))
-> QueryParams (Identity TeamId)
-> m (Maybe (Identity (Maybe TeamSearchVisibility)))
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 (Maybe TeamSearchVisibility))
selectSearchVisibility (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
    -- The value is either set or we return the default
    toSearchVisibility :: Maybe (Identity (Maybe TeamSearchVisibility)) -> TeamSearchVisibility
    toSearchVisibility :: Maybe (Identity (Maybe TeamSearchVisibility))
-> TeamSearchVisibility
toSearchVisibility (Just (Identity (Just TeamSearchVisibility
status))) = TeamSearchVisibility
status
    toSearchVisibility Maybe (Identity (Maybe TeamSearchVisibility))
_ = TeamSearchVisibility
SearchVisibilityStandard

-- | Determines whether a given team is allowed to enable/disable sso
setSearchVisibility :: (MonadClient m) => TeamId -> TeamSearchVisibility -> m ()
setSearchVisibility :: forall (m :: * -> *).
MonadClient m =>
TeamId -> TeamSearchVisibility -> m ()
setSearchVisibility TeamId
tid TeamSearchVisibility
visibilityType = do
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (TeamSearchVisibility, TeamId) ()
-> QueryParams (TeamSearchVisibility, TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (TeamSearchVisibility, TeamId) ()
updateSearchVisibility (Consistency
-> (TeamSearchVisibility, TeamId)
-> QueryParams (TeamSearchVisibility, TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamSearchVisibility
visibilityType, TeamId
tid))

resetSearchVisibility :: (MonadClient m) => TeamId -> m ()
resetSearchVisibility :: forall (m :: * -> *). MonadClient m => TeamId -> m ()
resetSearchVisibility TeamId
tid = do
  RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (TeamSearchVisibility, TeamId) ()
-> QueryParams (TeamSearchVisibility, TeamId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (TeamSearchVisibility, TeamId) ()
updateSearchVisibility (Consistency
-> (TeamSearchVisibility, TeamId)
-> QueryParams (TeamSearchVisibility, TeamId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (TeamSearchVisibility
SearchVisibilityStandard, TeamId
tid))