-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2025 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 Wire.UserKeyStore.Cassandra (interpretUserKeyStoreCassandra) where

import Cassandra
import Data.Id
import Imports
import Polysemy
import Polysemy.Embed
import Wire.UserKeyStore
import Wire.UserStore

interpretUserKeyStoreCassandra :: (Member (Embed IO) r, Member UserStore r) => ClientState -> InterpreterFor UserKeyStore r
interpretUserKeyStoreCassandra casClient =
  interpret $
    runEmbedded (runClient casClient) . \case
      LookupKey key -> embed $ lookupKeyImpl key
      InsertKey uid key -> embed $ insertKeyImpl uid key
      DeleteKey key -> embed $ deleteKeyImpl key
      DeleteKeyForUser uid key -> embed $ deleteKeyForUserImpl uid key
      ClaimKey key uid -> claimKeyImpl casClient key uid
      KeyAvailable key uid -> keyAvailableImpl casClient key uid

-- | Claim an 'EmailKey' for a user.
claimKeyImpl ::
  (Member (Embed IO) r, Member UserStore r) =>
  ClientState ->
  -- | The key to claim.
  EmailKey ->
  -- | The user claiming the key.
  UserId ->
  Sem r Bool
claimKeyImpl client k u = do
  free <- keyAvailableImpl client k (Just u)
  when free (runClient client $ insertKeyImpl u k)
  pure free

-- | Check whether an 'EmailKey' is available.
-- A key is available if it is not already activated for another user or
-- if the other user and the user looking to claim the key are the same.
keyAvailableImpl ::
  (Member (Embed IO) r, Member UserStore r) =>
  ClientState ->
  -- | The key to check.
  EmailKey ->
  -- | The user looking to claim the key, if any.
  Maybe UserId ->
  Sem r Bool
keyAvailableImpl client k u = do
  o <- runClient client $ lookupKeyImpl k
  case (o, u) of
    (Nothing, _) -> pure True
    (Just x, Just y) | x == y -> pure True
    (Just x, _) -> not <$> isActivated x

lookupKeyImpl :: (MonadClient m) => EmailKey -> m (Maybe UserId)
lookupKeyImpl k =
  fmap runIdentity
    <$> retry x1 (query1 keySelect (params LocalQuorum (Identity $ emailKeyUniq k)))

insertKeyImpl :: UserId -> EmailKey -> Client ()
insertKeyImpl u k = do
  retry x5 $ write keyInsert (params LocalQuorum (emailKeyUniq k, u))

deleteKeyImpl :: (MonadClient m) => EmailKey -> m ()
deleteKeyImpl k = do
  retry x5 $ write keyDelete (params LocalQuorum (Identity $ emailKeyUniq k))

-- | Delete `EmailKey` for `UserId`
--
-- This function ensures that keys of other users aren't accidentally deleted.
-- E.g. the email address or phone number of a partially deleted user could
-- already belong to a new user. To not interrupt deletion flows (that may be
-- executed several times due to cassandra not supporting transactions)
-- `deleteKeyImplForUser` does not fail for missing keys or keys that belong to
-- another user: It always returns `()` as result.
deleteKeyForUserImpl :: (MonadClient m) => UserId -> EmailKey -> m ()
deleteKeyForUserImpl uid k = do
  mbKeyUid <- lookupKeyImpl k
  case mbKeyUid of
    Just keyUid | keyUid == uid -> deleteKeyImpl k
    _ -> pure ()

--------------------------------------------------------------------------------
-- Queries

keyInsert :: PrepQuery W (Text, UserId) ()
keyInsert = "INSERT INTO user_keys (key, user) VALUES (?, ?)"

keySelect :: PrepQuery R (Identity Text) (Identity UserId)
keySelect = "SELECT user FROM user_keys WHERE key = ?"

keyDelete :: PrepQuery W (Identity Text) ()
keyDelete = "DELETE FROM user_keys WHERE key = ?"
