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)
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}
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)))