module Galley.Cassandra.Code
( interpretCodeStoreToCassandra,
)
where
import Cassandra
import Control.Lens
import Data.Code
import Data.Map qualified as Map
import Galley.Cassandra.Queries qualified as Cql
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Data.Types
import Galley.Data.Types qualified as Code
import Galley.Effects.CodeStore (CodeStore (..))
import Galley.Env
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.Password
interpretCodeStoreToCassandra ::
( Member (Embed IO) r,
Member (Input ClientState) r,
Member (Input Env) r,
Member TinyLog r
) =>
Sem (CodeStore ': r) a ->
Sem r a
interpretCodeStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
Member (Input Env) r, Member TinyLog r) =>
Sem (CodeStore : r) a -> Sem r a
interpretCodeStoreToCassandra = (forall (rInitial :: EffectRow) x.
CodeStore (Sem rInitial) x -> Sem r x)
-> Sem (CodeStore : 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.
CodeStore (Sem rInitial) x -> Sem r x)
-> Sem (CodeStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
CodeStore (Sem rInitial) x -> Sem r x)
-> Sem (CodeStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
GetCode Key
k Scope
s -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.GetCode"
Client (Maybe (Code, Maybe Password))
-> Sem r (Maybe (Code, Maybe Password))
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client (Maybe (Code, Maybe Password))
-> Sem r (Maybe (Code, Maybe Password)))
-> Client (Maybe (Code, Maybe Password))
-> Sem r (Maybe (Code, Maybe Password))
forall a b. (a -> b) -> a -> b
$ Key -> Scope -> Client (Maybe (Code, Maybe Password))
lookupCode Key
k Scope
s
CreateCode Code
code Maybe Password
mPw -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.CreateCode"
Client () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client () -> Sem r ()) -> Client () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Code -> Maybe Password -> Client ()
insertCode Code
code Maybe Password
mPw
DeleteCode Key
k Scope
s -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.DeleteCode"
Client () -> Sem r ()
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Client () -> Sem r ()) -> Client () -> Sem r ()
forall a b. (a -> b) -> a -> b
$ Key -> Scope -> Client ()
deleteCode Key
k Scope
s
MakeKey ConvId
cid -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.MakeKey"
ConvId -> Sem r Key
forall (m :: * -> *). MonadIO m => ConvId -> m Key
Code.mkKey ConvId
cid
GenerateCode ConvId
cid Scope
s Timeout
t -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.GenerateCode"
ConvId -> Scope -> Timeout -> Sem r Code
forall (m :: * -> *).
MonadIO m =>
ConvId -> Scope -> Timeout -> m Code
Code.generate ConvId
cid Scope
s Timeout
t
GetConversationCodeURI Maybe Text
mbHost -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"CodeStore.GetConversationCodeURI"
Env
env <- Sem r Env
forall i (r :: EffectRow). Member (Input i) r => Sem r i
input
case Env
env Env
-> Getting
(Either HttpsUrl (Map Text HttpsUrl))
Env
(Either HttpsUrl (Map Text HttpsUrl))
-> Either HttpsUrl (Map Text HttpsUrl)
forall s a. s -> Getting a s a -> a
^. Getting
(Either HttpsUrl (Map Text HttpsUrl))
Env
(Either HttpsUrl (Map Text HttpsUrl))
Lens' Env (Either HttpsUrl (Map Text HttpsUrl))
convCodeURI of
Left HttpsUrl
uri -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HttpsUrl -> Maybe HttpsUrl
forall a. a -> Maybe a
Just HttpsUrl
uri)
Right Map Text HttpsUrl
map' ->
case Maybe Text
mbHost of
Just Text
host -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Map Text HttpsUrl -> Maybe HttpsUrl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
host Map Text HttpsUrl
map')
Maybe Text
Nothing -> x -> Sem r x
forall a. a -> Sem r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
Maybe HttpsUrl
forall a. Maybe a
Nothing
insertCode :: Code -> Maybe Password -> Client ()
insertCode :: Code -> Maybe Password -> Client ()
insertCode Code
c Maybe Password
mPw = do
let k :: Key
k = Code -> Key
codeKey Code
c
let v :: Value
v = Code -> Value
codeValue Code
c
let cnv :: ConvId
cnv = Code -> ConvId
codeConversation Code
c
let t :: Int32
t = Timeout -> Int32
forall b. Integral b => Timeout -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Code -> Timeout
codeTTL Code
c)
let s :: Scope
s = Code -> Scope
codeScope Code
c
RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Key, Value, ConvId, Scope, Maybe Password, Int32) ()
-> QueryParams (Key, Value, ConvId, Scope, Maybe Password, Int32)
-> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Key, Value, ConvId, Scope, Maybe Password, Int32) ()
Cql.insertCode (Consistency
-> (Key, Value, ConvId, Scope, Maybe Password, Int32)
-> QueryParams (Key, Value, ConvId, Scope, Maybe Password, Int32)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Value
v, ConvId
cnv, Scope
s, Maybe Password
mPw, Int32
t)))
lookupCode :: Key -> Scope -> Client (Maybe (Code, Maybe Password))
lookupCode :: Key -> Scope -> Client (Maybe (Code, Maybe Password))
lookupCode Key
k Scope
s =
((Value, Int32, ConvId, Maybe Password) -> (Code, Maybe Password))
-> Maybe (Value, Int32, ConvId, Maybe Password)
-> Maybe (Code, Maybe Password)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key
-> Scope
-> (Value, Int32, ConvId, Maybe Password)
-> (Code, Maybe Password)
toCode Key
k Scope
s) (Maybe (Value, Int32, ConvId, Maybe Password)
-> Maybe (Code, Maybe Password))
-> Client (Maybe (Value, Int32, ConvId, Maybe Password))
-> Client (Maybe (Code, Maybe Password))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RetrySettings
-> Client (Maybe (Value, Int32, ConvId, Maybe Password))
-> Client (Maybe (Value, Int32, ConvId, Maybe Password))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (Key, Scope) (Value, Int32, ConvId, Maybe Password)
-> QueryParams (Key, Scope)
-> Client (Maybe (Value, Int32, ConvId, Maybe Password))
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 (Key, Scope) (Value, Int32, ConvId, Maybe Password)
Cql.lookupCode (Consistency -> (Key, Scope) -> QueryParams (Key, Scope)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s)))
deleteCode :: Key -> Scope -> Client ()
deleteCode :: Key -> Scope -> Client ()
deleteCode Key
k Scope
s = RetrySettings -> Client () -> Client ()
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client () -> Client ()) -> Client () -> Client ()
forall a b. (a -> b) -> a -> b
$ PrepQuery W (Key, Scope) ()
-> QueryParams (Key, Scope) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Key, Scope) ()
Cql.deleteCode (Consistency -> (Key, Scope) -> QueryParams (Key, Scope)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (Key
k, Scope
s))