{-# 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.CustomBackend (interpretCustomBackendStoreToCassandra) where

import Cassandra
import Data.Domain (Domain)
import Galley.Cassandra.Instances ()
import Galley.Cassandra.Queries qualified as Cql
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.CustomBackendStore (CustomBackendStore (..))
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.CustomBackend

interpretCustomBackendStoreToCassandra ::
  ( Member (Embed IO) r,
    Member (Input ClientState) r,
    Member TinyLog r
  ) =>
  Sem (CustomBackendStore ': r) a ->
  Sem r a
interpretCustomBackendStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
 Member TinyLog r) =>
Sem (CustomBackendStore : r) a -> Sem r a
interpretCustomBackendStoreToCassandra = (forall (rInitial :: EffectRow) x.
 CustomBackendStore (Sem rInitial) x -> Sem r x)
-> Sem (CustomBackendStore : 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.
  CustomBackendStore (Sem rInitial) x -> Sem r x)
 -> Sem (CustomBackendStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    CustomBackendStore (Sem rInitial) x -> Sem r x)
-> Sem (CustomBackendStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  GetCustomBackend Domain
dom -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CustomBackendStore.GetCustomBackend"
    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
$ Domain -> Client (Maybe CustomBackend)
forall (m :: * -> *).
MonadClient m =>
Domain -> m (Maybe CustomBackend)
getCustomBackend Domain
dom
  SetCustomBackend Domain
dom CustomBackend
b -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CustomBackendStore.SetCustomBackend"
    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
$ Domain -> CustomBackend -> Client ()
forall (m :: * -> *).
MonadClient m =>
Domain -> CustomBackend -> m ()
setCustomBackend Domain
dom CustomBackend
b
  DeleteCustomBackend Domain
dom -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CustomBackendStore.DeleteCustomBackend"
    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
$ Domain -> Client ()
forall (m :: * -> *). MonadClient m => Domain -> m ()
deleteCustomBackend Domain
dom

getCustomBackend :: (MonadClient m) => Domain -> m (Maybe CustomBackend)
getCustomBackend :: forall (m :: * -> *).
MonadClient m =>
Domain -> m (Maybe CustomBackend)
getCustomBackend Domain
domain =
  ((HttpsUrl, HttpsUrl) -> CustomBackend)
-> Maybe (HttpsUrl, HttpsUrl) -> Maybe CustomBackend
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpsUrl, HttpsUrl) -> CustomBackend
toCustomBackend (Maybe (HttpsUrl, HttpsUrl) -> Maybe CustomBackend)
-> m (Maybe (HttpsUrl, HttpsUrl)) -> m (Maybe CustomBackend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    RetrySettings
-> m (Maybe (HttpsUrl, HttpsUrl)) -> m (Maybe (HttpsUrl, HttpsUrl))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (m (Maybe (HttpsUrl, HttpsUrl)) -> m (Maybe (HttpsUrl, HttpsUrl)))
-> m (Maybe (HttpsUrl, HttpsUrl)) -> m (Maybe (HttpsUrl, HttpsUrl))
forall a b. (a -> b) -> a -> b
$ PrepQuery R (Identity Domain) (HttpsUrl, HttpsUrl)
-> QueryParams (Identity Domain) -> m (Maybe (HttpsUrl, HttpsUrl))
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 Domain) (HttpsUrl, HttpsUrl)
Cql.selectCustomBackend (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
domain))
  where
    toCustomBackend :: (HttpsUrl, HttpsUrl) -> CustomBackend
toCustomBackend (HttpsUrl
backendConfigJsonUrl, HttpsUrl
backendWebappWelcomeUrl) =
      CustomBackend {HttpsUrl
backendConfigJsonUrl :: HttpsUrl
backendWebappWelcomeUrl :: HttpsUrl
$sel:backendConfigJsonUrl:CustomBackend :: HttpsUrl
$sel:backendWebappWelcomeUrl:CustomBackend :: HttpsUrl
..}

setCustomBackend :: (MonadClient m) => Domain -> CustomBackend -> m ()
setCustomBackend :: forall (m :: * -> *).
MonadClient m =>
Domain -> CustomBackend -> m ()
setCustomBackend Domain
domain CustomBackend {HttpsUrl
$sel:backendConfigJsonUrl:CustomBackend :: CustomBackend -> HttpsUrl
$sel:backendWebappWelcomeUrl:CustomBackend :: CustomBackend -> HttpsUrl
backendConfigJsonUrl :: HttpsUrl
backendWebappWelcomeUrl :: HttpsUrl
..} = 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 (HttpsUrl, HttpsUrl, Domain) ()
-> QueryParams (HttpsUrl, HttpsUrl, Domain) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (HttpsUrl, HttpsUrl, Domain) ()
Cql.upsertCustomBackend (Consistency
-> (HttpsUrl, HttpsUrl, Domain)
-> QueryParams (HttpsUrl, HttpsUrl, Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (HttpsUrl
backendConfigJsonUrl, HttpsUrl
backendWebappWelcomeUrl, Domain
domain))

deleteCustomBackend :: (MonadClient m) => Domain -> m ()
deleteCustomBackend :: forall (m :: * -> *). MonadClient m => Domain -> m ()
deleteCustomBackend Domain
domain = 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 (Identity Domain) ()
-> QueryParams (Identity Domain) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity Domain) ()
Cql.deleteCustomBackend (Consistency -> Identity Domain -> QueryParams (Identity Domain)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Domain -> Identity Domain
forall a. a -> Identity a
Identity Domain
domain))