-- 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.Services where

import Cassandra
import Control.Lens
import Data.Id
import Galley.Cassandra.Queries
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Data.Services
import Galley.Effects.ServiceStore hiding (deleteService)
import Galley.Types.Conversations.Members (lmService, newMember)
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.Bot.Service qualified as Bot
import Wire.API.Provider.Service hiding (DeleteService)

-- FUTUREWORK: support adding bots to a remote conversation
addBotMember :: ServiceRef -> BotId -> ConvId -> Client BotMember
addBotMember :: ServiceRef -> BotId -> ConvId -> Client BotMember
addBotMember ServiceRef
s BotId
bot ConvId
cnv = do
  RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ())
-> (BatchM () -> Client ()) -> BatchM () -> Client ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BatchM () -> Client ()
forall (m :: * -> *). MonadClient m => BatchM () -> m ()
batch (BatchM () -> Client ()) -> BatchM () -> Client ()
forall a b. (a -> b) -> a -> b
$ do
    BatchType -> BatchM ()
setType BatchType
BatchLogged
    Consistency -> BatchM ()
setConsistency Consistency
LocalQuorum
    PrepQuery W (UserId, ConvId) () -> (UserId, ConvId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (UserId, ConvId) ()
insertUserConv (BotId -> UserId
botUserId BotId
bot, ConvId
cnv)
    PrepQuery W (ConvId, BotId, ServiceId, ProviderId) ()
-> (ConvId, BotId, ServiceId, ProviderId) -> BatchM ()
forall a b.
(Show a, Tuple a, Tuple b) =>
PrepQuery W a b -> a -> BatchM ()
addPrepQuery PrepQuery W (ConvId, BotId, ServiceId, ProviderId) ()
insertBot (ConvId
cnv, BotId
bot, ServiceId
sid, ProviderId
pid)
  BotMember -> Client BotMember
forall a. a -> Client a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalMember -> BotMember
BotMember LocalMember
mem)
  where
    pid :: ProviderId
pid = ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider
    sid :: ServiceId
sid = ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId
    mem :: LocalMember
mem = (UserId -> LocalMember
newMember (BotId -> UserId
botUserId BotId
bot)) {lmService = Just s}

-- Service --------------------------------------------------------------------

interpretServiceStoreToCassandra ::
  ( Member (Embed IO) r,
    Member (Input ClientState) r,
    Member TinyLog r
  ) =>
  Sem (ServiceStore ': r) a ->
  Sem r a
interpretServiceStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
 Member TinyLog r) =>
Sem (ServiceStore : r) a -> Sem r a
interpretServiceStoreToCassandra = (forall (rInitial :: EffectRow) x.
 ServiceStore (Sem rInitial) x -> Sem r x)
-> Sem (ServiceStore : 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.
  ServiceStore (Sem rInitial) x -> Sem r x)
 -> Sem (ServiceStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
    ServiceStore (Sem rInitial) x -> Sem r x)
-> Sem (ServiceStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  CreateService Service
s -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ServiceStore.CreateService"
    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
$ Service -> Client ()
forall (m :: * -> *). MonadClient m => Service -> m ()
insertService Service
s
  GetService ServiceRef
sr -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ServiceStore.GetService"
    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
$ ServiceRef -> Client (Maybe Service)
forall (m :: * -> *).
MonadClient m =>
ServiceRef -> m (Maybe Service)
lookupService ServiceRef
sr
  DeleteService ServiceRef
sr -> do
    ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ServiceStore.DeleteService"
    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
$ ServiceRef -> Client ()
forall (m :: * -> *). MonadClient m => ServiceRef -> m ()
deleteService ServiceRef
sr

insertService :: (MonadClient m) => Bot.Service -> m ()
insertService :: forall (m :: * -> *). MonadClient m => Service -> m ()
insertService Service
s = do
  let sid :: ServiceId
sid = Service
s Service -> Getting ServiceId Service ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. (ServiceRef -> Const ServiceId ServiceRef)
-> Service -> Const ServiceId Service
Lens' Service ServiceRef
Bot.serviceRef ((ServiceRef -> Const ServiceId ServiceRef)
 -> Service -> Const ServiceId Service)
-> Getting ServiceId ServiceRef ServiceId
-> Getting ServiceId Service ServiceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId
  let pid :: ProviderId
pid = Service
s Service -> Getting ProviderId Service ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. (ServiceRef -> Const ProviderId ServiceRef)
-> Service -> Const ProviderId Service
Lens' Service ServiceRef
Bot.serviceRef ((ServiceRef -> Const ProviderId ServiceRef)
 -> Service -> Const ProviderId Service)
-> Getting ProviderId ServiceRef ProviderId
-> Getting ProviderId Service ProviderId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider
  let tok :: ServiceToken
tok = Service
s Service
-> Getting ServiceToken Service ServiceToken -> ServiceToken
forall s a. s -> Getting a s a -> a
^. Getting ServiceToken Service ServiceToken
Lens' Service ServiceToken
Bot.serviceToken
  let url :: HttpsUrl
url = Service
s Service -> Getting HttpsUrl Service HttpsUrl -> HttpsUrl
forall s a. s -> Getting a s a -> a
^. Getting HttpsUrl Service HttpsUrl
Lens' Service HttpsUrl
Bot.serviceUrl
  let fps :: Set (Fingerprint Rsa)
fps = [Fingerprint Rsa] -> Set (Fingerprint Rsa)
forall a. [a] -> Set a
Set (Service
s Service
-> Getting [Fingerprint Rsa] Service [Fingerprint Rsa]
-> [Fingerprint Rsa]
forall s a. s -> Getting a s a -> a
^. Getting [Fingerprint Rsa] Service [Fingerprint Rsa]
Lens' Service [Fingerprint Rsa]
Bot.serviceFingerprints)
  let ena :: Bool
ena = Service
s Service -> Getting Bool Service Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Service Bool
Lens' Service Bool
Bot.serviceEnabled
  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
  (ProviderId, ServiceId, HttpsUrl, ServiceToken,
   Set (Fingerprint Rsa), Bool)
  ()
-> QueryParams
     (ProviderId, ServiceId, HttpsUrl, ServiceToken,
      Set (Fingerprint Rsa), Bool)
-> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery
  W
  (ProviderId, ServiceId, HttpsUrl, ServiceToken,
   Set (Fingerprint Rsa), Bool)
  ()
insertSrv (Consistency
-> (ProviderId, ServiceId, HttpsUrl, ServiceToken,
    Set (Fingerprint Rsa), Bool)
-> QueryParams
     (ProviderId, ServiceId, HttpsUrl, ServiceToken,
      Set (Fingerprint Rsa), Bool)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (ProviderId
pid, ServiceId
sid, HttpsUrl
url, ServiceToken
tok, Set (Fingerprint Rsa)
fps, Bool
ena))

lookupService :: (MonadClient m) => ServiceRef -> m (Maybe Bot.Service)
lookupService :: forall (m :: * -> *).
MonadClient m =>
ServiceRef -> m (Maybe Service)
lookupService ServiceRef
s =
  ((HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool) -> Service)
-> Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool)
-> Maybe Service
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool) -> Service
toService
    (Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool)
 -> Maybe Service)
-> m (Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool))
-> m (Maybe Service)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> m (Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool))
-> m (Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
  R
  (ProviderId, ServiceId)
  (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool)
-> QueryParams (ProviderId, ServiceId)
-> m (Maybe (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool))
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
  (ProviderId, ServiceId)
  (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool)
selectSrv (Consistency
-> (ProviderId, ServiceId) -> QueryParams (ProviderId, ServiceId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider, ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId)))
  where
    toService :: (HttpsUrl, ServiceToken, Set (Fingerprint Rsa), Bool) -> Service
toService (HttpsUrl
url, ServiceToken
tok, Set [Fingerprint Rsa]
fps, Bool
ena) =
      ServiceRef
-> HttpsUrl -> ServiceToken -> [Fingerprint Rsa] -> Service
Bot.newService ServiceRef
s HttpsUrl
url ServiceToken
tok [Fingerprint Rsa]
fps Service -> (Service -> Service) -> Service
forall a b. a -> (a -> b) -> b
& ASetter Service Service Bool Bool -> Bool -> Service -> Service
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Service Service Bool Bool
Lens' Service Bool
Bot.serviceEnabled Bool
ena

deleteService :: (MonadClient m) => ServiceRef -> m ()
deleteService :: forall (m :: * -> *). MonadClient m => ServiceRef -> m ()
deleteService ServiceRef
s = RetrySettings -> m () -> m ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (ProviderId, ServiceId) ()
-> QueryParams (ProviderId, ServiceId) -> m ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (ProviderId, ServiceId) ()
rmSrv (Consistency
-> (ProviderId, ServiceId) -> QueryParams (ProviderId, ServiceId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (ServiceRef
s ServiceRef
-> Getting ProviderId ServiceRef ProviderId -> ProviderId
forall s a. s -> Getting a s a -> a
^. Getting ProviderId ServiceRef ProviderId
Lens' ServiceRef ProviderId
serviceRefProvider, ServiceRef
s ServiceRef -> Getting ServiceId ServiceRef ServiceId -> ServiceId
forall s a. s -> Getting a s a -> a
^. Getting ServiceId ServiceRef ServiceId
Lens' ServiceRef ServiceId
serviceRefId)))