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

-- | Insert a conversation code
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)))

-- | Lookup a conversation by code.
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)))

-- | Delete a code associated with the given conversation key
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))