module Galley.Cassandra.Proposal
( interpretProposalStoreToCassandra,
ProposalOrigin (..),
)
where
import Cassandra
import Data.Timeout
import Galley.Cassandra.Instances ()
import Galley.Cassandra.Store
import Galley.Cassandra.Util
import Galley.Effects.ProposalStore
import Imports
import Polysemy
import Polysemy.Input
import Polysemy.TinyLog
import Wire.API.MLS.Epoch
import Wire.API.MLS.Group
import Wire.API.MLS.Proposal
import Wire.API.MLS.Serialisation
defaultTTL :: Timeout
defaultTTL :: Timeout
defaultTTL = Word64
28 Word64 -> TimeoutUnit -> Timeout
# TimeoutUnit
Day
interpretProposalStoreToCassandra ::
( Member (Embed IO) r,
Member (Input ClientState) r,
Member TinyLog r
) =>
Sem (ProposalStore ': r) a ->
Sem r a
interpretProposalStoreToCassandra :: forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r,
Member TinyLog r) =>
Sem (ProposalStore : r) a -> Sem r a
interpretProposalStoreToCassandra = (forall (rInitial :: EffectRow) x.
ProposalStore (Sem rInitial) x -> Sem r x)
-> Sem (ProposalStore : 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.
ProposalStore (Sem rInitial) x -> Sem r x)
-> Sem (ProposalStore : r) a -> Sem r a)
-> (forall (rInitial :: EffectRow) x.
ProposalStore (Sem rInitial) x -> Sem r x)
-> Sem (ProposalStore : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
StoreProposal GroupId
groupId Epoch
epoch ProposalRef
ref ProposalOrigin
origin RawMLS Proposal
raw -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ProposalStore.StoreProposal"
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 -> Client x) -> Client x -> Sem r x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RetrySettings -> Client x -> Client x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (Client x -> Sem r x) -> Client x -> Sem r x
forall a b. (a -> b) -> a -> b
$
PrepQuery
W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
-> QueryParams
(GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal)
-> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write (Timeout
-> PrepQuery
W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
storeQuery Timeout
defaultTTL) (Consistency
-> (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal)
-> QueryParams
(GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (GroupId
groupId, Epoch
epoch, ProposalRef
ref, ProposalOrigin
origin, RawMLS Proposal
raw))
GetProposal GroupId
groupId Epoch
epoch ProposalRef
ref -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ProposalStore.GetProposal"
Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Identity (RawMLS Proposal) -> RawMLS Proposal
forall a. Identity a -> a
runIdentity (Identity (RawMLS Proposal) -> RawMLS Proposal)
-> Client (Maybe (Identity (RawMLS Proposal)))
-> Client (Maybe (RawMLS Proposal))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings
-> Client (Maybe (Identity (RawMLS Proposal)))
-> Client (Maybe (Identity (RawMLS Proposal)))
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
R (GroupId, Epoch, ProposalRef) (Identity (RawMLS Proposal))
-> QueryParams (GroupId, Epoch, ProposalRef)
-> Client (Maybe (Identity (RawMLS Proposal)))
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 (GroupId, Epoch, ProposalRef) (Identity (RawMLS Proposal))
getQuery (Consistency
-> (GroupId, Epoch, ProposalRef)
-> QueryParams (GroupId, Epoch, ProposalRef)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (GroupId
groupId, Epoch
epoch, ProposalRef
ref))))
GetAllPendingProposalRefs GroupId
groupId Epoch
epoch -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ProposalStore.GetAllPendingProposalRefs"
Client x -> Sem r x
forall (r :: EffectRow) a.
(Member (Embed IO) r, Member (Input ClientState) r) =>
Client a -> Sem r a
embedClient (Identity ProposalRef -> ProposalRef
forall a. Identity a -> a
runIdentity (Identity ProposalRef -> ProposalRef)
-> Client [Identity ProposalRef] -> Client [ProposalRef]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> RetrySettings
-> Client [Identity ProposalRef] -> Client [Identity ProposalRef]
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery R (GroupId, Epoch) (Identity ProposalRef)
-> QueryParams (GroupId, Epoch) -> Client [Identity ProposalRef]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery R (GroupId, Epoch) (Identity ProposalRef)
getAllPendingRef (Consistency -> (GroupId, Epoch) -> QueryParams (GroupId, Epoch)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (GroupId
groupId, Epoch
epoch))))
GetAllPendingProposals GroupId
groupId Epoch
epoch -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ProposalStore.GetAllPendingProposals"
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
$ RetrySettings -> Client x -> Client x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x1 (PrepQuery
R (GroupId, Epoch) (Maybe ProposalOrigin, RawMLS Proposal)
-> QueryParams (GroupId, Epoch)
-> Client [(Maybe ProposalOrigin, RawMLS Proposal)]
forall (m :: * -> *) a b (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, Tuple b, RunQ q) =>
q R a b -> QueryParams a -> m [b]
query PrepQuery
R (GroupId, Epoch) (Maybe ProposalOrigin, RawMLS Proposal)
getAllPending (Consistency -> (GroupId, Epoch) -> QueryParams (GroupId, Epoch)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (GroupId
groupId, Epoch
epoch)))
DeleteAllProposals GroupId
groupId -> do
ByteString -> Sem r ()
forall (r :: EffectRow). Member TinyLog r => ByteString -> Sem r ()
logEffect ByteString
"ProposalStore.DeleteAllProposals"
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
$ RetrySettings -> Client x -> Client x
forall (m :: * -> *) a.
MonadClient m =>
RetrySettings -> m a -> m a
retry RetrySettings
x5 (PrepQuery W (Identity GroupId) ()
-> QueryParams (Identity GroupId) -> Client ()
forall (m :: * -> *) a (q :: * -> * -> * -> *).
(MonadClient m, Tuple a, RunQ q) =>
q W a () -> QueryParams a -> m ()
write PrepQuery W (Identity GroupId) ()
deleteAllProposalsForGroup (Consistency -> Identity GroupId -> QueryParams (Identity GroupId)
forall a. Consistency -> a -> QueryParams a
params Consistency
LocalQuorum (GroupId -> Identity GroupId
forall a. a -> Identity a
Identity GroupId
groupId)))
storeQuery :: Timeout -> PrepQuery W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
storeQuery :: Timeout
-> PrepQuery
W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
storeQuery Timeout
ttl =
String
-> PrepQuery
W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
forall a. IsString a => String -> a
fromString (String
-> PrepQuery
W
(GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal)
())
-> String
-> PrepQuery
W (GroupId, Epoch, ProposalRef, ProposalOrigin, RawMLS Proposal) ()
forall a b. (a -> b) -> a -> b
$
String
"insert into mls_proposal_refs (group_id, epoch, ref, origin, proposal)\
\ values (?, ?, ?, ?, ?) using ttl "
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show (Timeout
ttl Timeout -> TimeoutUnit -> Word64
#> TimeoutUnit
Second)
getQuery :: PrepQuery R (GroupId, Epoch, ProposalRef) (Identity (RawMLS Proposal))
getQuery :: PrepQuery
R (GroupId, Epoch, ProposalRef) (Identity (RawMLS Proposal))
getQuery = PrepQuery
R (GroupId, Epoch, ProposalRef) (Identity (RawMLS Proposal))
"select proposal from mls_proposal_refs where group_id = ? and epoch = ? and ref = ?"
getAllPendingRef :: PrepQuery R (GroupId, Epoch) (Identity ProposalRef)
getAllPendingRef :: PrepQuery R (GroupId, Epoch) (Identity ProposalRef)
getAllPendingRef = PrepQuery R (GroupId, Epoch) (Identity ProposalRef)
"select ref from mls_proposal_refs where group_id = ? and epoch = ?"
getAllPending :: PrepQuery R (GroupId, Epoch) (Maybe ProposalOrigin, RawMLS Proposal)
getAllPending :: PrepQuery
R (GroupId, Epoch) (Maybe ProposalOrigin, RawMLS Proposal)
getAllPending = PrepQuery
R (GroupId, Epoch) (Maybe ProposalOrigin, RawMLS Proposal)
"select origin, proposal from mls_proposal_refs where group_id = ? and epoch = ?"
deleteAllProposalsForGroup :: PrepQuery W (Identity GroupId) ()
deleteAllProposalsForGroup :: PrepQuery W (Identity GroupId) ()
deleteAllProposalsForGroup = PrepQuery W (Identity GroupId) ()
"delete from mls_proposal_refs where group_id = ?"