-- This file is part of the Wire Server implementation.
--
-- Copyright (C) 2026 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 Test.Migration.BlockList (testBlockListMigration) where

import qualified API.BrigInternal as BrigInternal
import API.Common
import Control.Monad.Codensity
import Control.Monad.Reader
import Test.Migration.Util (waitForMigration)
import Testlib.Prelude
import Testlib.ResourcePool

-- | Migrate the 'blacklist' store (brig) from Cassandra to PostgreSQL.
--
-- The blacklist holds email keys with no read-back payload, so the migration is
-- a straight copy: a key blacklisted in Cassandra must survive the cutover and
-- remain deletable once PostgreSQL is the sole source of truth.
testBlockListMigration :: (HasCallStack) => App ()
testBlockListMigration :: HasCallStack => App ()
testBlockListMigration = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  email <- randomEmail
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain

    -- Cassandra: blacklist an email key and confirm it is reported as such.
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"cassandra" Bool
False)) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.addBlacklist String
domain String
email
      HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200 (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.checkBlacklist String
domain String
email

    -- migration-to-postgresql with the worker running: backfill the existing key
    -- and confirm it is still blacklisted once the migration is finished.
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"migration-to-postgresql" Bool
True)) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => String -> String -> App ()
String -> String -> App ()
waitForMigration String
domain String
counterName
      HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200 (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.checkBlacklist String
domain String
email

    -- PostgreSQL only: the migrated key must persist, and deleting it must
    -- remove it.
    Codensity App String -> forall b. (String -> App b) -> App b
forall k (m :: k -> *) a.
Codensity m a -> forall (b :: k). (a -> m b) -> m b
runCodensity (HasCallStack =>
BackendResource -> ServiceOverrides -> Codensity App String
BackendResource -> ServiceOverrides -> Codensity App String
startDynamicBackend BackendResource
backend (String -> Bool -> ServiceOverrides
conf String
"postgresql" Bool
False)) ((String -> App ()) -> App ()) -> (String -> App ()) -> App ()
forall a b. (a -> b) -> a -> b
$ \String
_ -> do
      HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
200 (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.checkBlacklist String
domain String
email
      HasCallStack => Response -> App ()
Response -> App ()
assertSuccess (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.deleteBlacklist String
domain String
email
      HasCallStack => Int -> Response -> App ()
Int -> Response -> App ()
assertStatus Int
404 (Response -> App ()) -> App Response -> App ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> String -> App Response
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> String -> App Response
BrigInternal.checkBlacklist String
domain String
email
  where
    conf :: String -> Bool -> ServiceOverrides
    conf :: String -> Bool -> ServiceOverrides
conf String
db Bool
runMigration =
      ServiceOverrides
forall a. Default a => a
def
        { brigCfg = setField "postgresMigration.blockList" db,
          backgroundWorkerCfg =
            setField "postgresMigration.blockList" db
              >=> setField "migrateBlockList" runMigration
        }

    counterName :: String
    counterName :: String
counterName = String
"^wire_block_list_migration_finished"