-- 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.VerificationCodeStore.Cassandra where

import Cassandra hiding (Value)
import Data.RetryAfter
import Data.UUID
import Imports
import Polysemy
import Polysemy.Embed
import Wire.API.User.Identity
import Wire.VerificationCode
import Wire.VerificationCodeStore

interpretVerificationCodeStoreCassandra :: (Member (Embed IO) r) => ClientState -> InterpreterFor VerificationCodeStore r
interpretVerificationCodeStoreCassandra casClient =
  interpret $
    runEmbedded (runClient casClient) . \case
      InsertCode code -> embed $ insertCodeImpl code
      LookupCode key scope -> embed $ lookupCodeImpl key scope
      DeleteCode key scope -> embed $ deleteCodeImpl key scope
      InsertThrottle key scope ttl -> embed $ insertThrottleImpl key scope ttl
      LookupThrottle key scope -> embed $ lookupThrottleImpl key scope

insertCodeImpl :: (MonadClient m) => Code -> m ()
insertCodeImpl c = do
  let k = codeKey c
  let s = codeScope c
  let v = codeValue c
  let r = fromIntegral (codeRetries c)
  let a = codeAccount c
  let e = codeFor c
  let t = round (codeTTL c)
  retry x5 (write cql (params LocalQuorum (k, s, v, r, e, a, t)))
  where
    cql :: PrepQuery W (Key, Scope, Value, Retries, EmailAddress, Maybe UUID, Int32) ()
    cql =
      "INSERT INTO vcodes (key, scope, value, retries, email, account) \
      \VALUES (?, ?, ?, ?, ?, ?) USING TTL ?"

-- | Lookup a pending code.
lookupCodeImpl :: (MonadClient m) => Key -> Scope -> m (Maybe Code)
lookupCodeImpl k s = toCode <$$> retry x1 (query1 cql (params LocalQuorum (k, s)))
  where
    cql :: PrepQuery R (Key, Scope) (Value, Int32, Retries, EmailAddress, Maybe UUID)
    cql =
      "SELECT value, ttl(value), retries, email, account \
      \FROM vcodes WHERE key = ? AND scope = ?"

    toCode :: (Value, Int32, Retries, EmailAddress, Maybe UUID) -> Code
    toCode (val, ttl, retries, email, account) =
      Code
        { codeKey = k,
          codeScope = s,
          codeValue = val,
          codeTTL = Timeout (fromIntegral ttl),
          codeRetries = retries,
          codeFor = email,
          codeAccount = account
        }

-- | Delete a code associated with the given key and scope.
deleteCodeImpl :: (MonadClient m) => Key -> Scope -> m ()
deleteCodeImpl k s = retry x5 $ write cql (params LocalQuorum (k, s))
  where
    cql :: PrepQuery W (Key, Scope) ()
    cql = "DELETE FROM vcodes WHERE key = ? AND scope = ?"

lookupThrottleImpl :: (MonadClient m) => Key -> Scope -> m (Maybe RetryAfter)
lookupThrottleImpl k s = do
  fmap (RetryAfter . fromIntegral . runIdentity) <$> retry x1 (query1 cql (params LocalQuorum (k, s)))
  where
    cql :: PrepQuery R (Key, Scope) (Identity Int32)
    cql =
      "SELECT ttl(initial_delay) \
      \FROM vcodes_throttle WHERE key = ? AND scope = ?"

insertThrottleImpl :: (MonadClient m) => Key -> Scope -> Word -> m ()
insertThrottleImpl k s t = do
  retry x5 (write cql (params LocalQuorum (k, s, fromIntegral t, fromIntegral t)))
  where
    cql :: PrepQuery W (Key, Scope, Int32, Int32) ()
    cql =
      "INSERT INTO vcodes_throttle (key, scope, initial_delay) \
      \VALUES (?, ?, ?) USING TTL ?"
