-- 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.Connections (testConnectionsMigrationToPostgres) where

import API.Brig (getConnection, postConnection, putConnection)
import Control.Monad.Codensity
import Control.Monad.Reader
import GHC.Stack
import SetupHelpers
import Test.Migration.Util (assertMigrationSuccessful, waitForMigration)
import Testlib.Prelude
import Testlib.ResourcePool

-- | Drives the connections store through the full cutover lifecycle
-- (cassandra -> migration-to-postgresql -> postgresql) on a dynamic backend.
-- Every phase creates a fresh pair of users and connects them via the brig
-- public API, exercising the writes of all three interpreters (Cassandra,
-- dual-write, Postgres). Connections written by earlier interpreters must
-- remain readable afterwards: the pair connected during the pure-Cassandra
-- phase proves the background worker backfilled rows that only ever existed
-- in Cassandra.
--
-- Remote ('connection_remote') rows are not seeded explicitly here; the
-- migration's copy loop still runs over whatever dual-write produced, and
-- federated connections are covered by the brig integration suite.
testConnectionsMigrationToPostgres :: (HasCallStack) => App ()
testConnectionsMigrationToPostgres :: HasCallStack => App ()
testConnectionsMigrationToPostgres = do
  resourcePool <- (Env -> ResourcePool BackendResource)
-> App (ResourcePool BackendResource)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.resourcePool)
  runCodensity (acquireResources 1 resourcePool) $ \[BackendResource
backend] -> do
    let domain :: String
domain = BackendResource
backend.berDomain

    -- P1 cassandra: connect a pair via the pure Cassandra interpreter
    cassandraPair <-
      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
forall {b} {b}. (ToJSON b, ToJSON b) => b -> b -> ServiceOverrides
conf String
"cassandra" Bool
False)) ((String -> App (Value, Value)) -> App (Value, Value))
-> (String -> App (Value, Value)) -> App (Value, Value)
forall a b. (a -> b) -> a -> b
$ \String
_ ->
        String -> App (Value, Value)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value)
connectFreshPair String
domain

    -- P2 migration-to-postgresql (worker off): reads still come from
    -- Cassandra, writes go to both stores
    dualWritePair <-
      runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" False)) $ \String
_ -> do
        HasCallStack => (Value, Value) -> App ()
(Value, Value) -> App ()
checkConnection (Value, Value)
cassandraPair
        String -> App (Value, Value)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value)
connectFreshPair String
domain

    -- P3 migration-to-postgresql (worker on): dual-write while backfilling
    workerOnPair <-
      runCodensity (startDynamicBackend backend (conf "migration-to-postgresql" True)) $ \String
_ -> do
        HasCallStack => (Value, Value) -> App ()
(Value, Value) -> App ()
checkConnection (Value, Value)
dualWritePair
        pair <- String -> App (Value, Value)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value)
connectFreshPair String
domain
        waitForMigration domain connectionsMigrationFinishedCounterName
        -- The failed counter is only registered while the migration worker
        -- runs, so assert it in this phase (worker on), not in P4.
        assertMigrationSuccessful domain "^wire_connections_migration_failed"
        pure pair

    -- P4 postgresql: reads are served exclusively from Postgres
    runCodensity (startDynamicBackend backend (conf "postgresql" False)) $ \String
_ -> do
      -- Connections written by every interpreter are visible to the pure
      -- Postgres interpreter.
      HasCallStack => (Value, Value) -> App ()
(Value, Value) -> App ()
checkConnection (Value, Value)
cassandraPair
      HasCallStack => (Value, Value) -> App ()
(Value, Value) -> App ()
checkConnection (Value, Value)
dualWritePair
      HasCallStack => (Value, Value) -> App ()
(Value, Value) -> App ()
checkConnection (Value, Value)
workerOnPair

      -- Write and read via the pure Postgres interpreter.
      pgPair <- String -> App (Value, Value)
forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value)
connectFreshPair String
domain
      checkConnection pgPair
  where
    conf :: b -> b -> ServiceOverrides
conf b
db b
runMigration =
      ServiceOverrides
forall a. Default a => a
def
        { brigCfg = setField "postgresMigration.connections" db,
          backgroundWorkerCfg =
            setField "postgresMigration.connections" db
              >=> setField "migrateConnections" runMigration
        }

connectionsMigrationFinishedCounterName :: String
connectionsMigrationFinishedCounterName :: String
connectionsMigrationFinishedCounterName = String
"^wire_connections_migration_finished"

-- | Create two fresh users on the given domain and connect them (request +
-- accept) via the brig public connection API.
connectFreshPair :: (HasCallStack, MakesValue domain) => domain -> App (Value, Value)
connectFreshPair :: forall domain.
(HasCallStack, MakesValue domain) =>
domain -> App (Value, Value)
connectFreshPair domain
domain = do
  [u1, u2] <- [domain] -> App [Value]
forall domain.
(HasCallStack, MakesValue domain) =>
[domain] -> App [Value]
createUsers [domain
domain, domain
domain]
  void $ postConnection u1 u2 >>= assertSuccess
  void $ putConnection u2 u1 "accepted" >>= assertSuccess
  pure (u1, u2)

-- | The connection between the two users is visible with status 'accepted'.
checkConnection :: (HasCallStack) => (Value, Value) -> App ()
checkConnection :: HasCallStack => (Value, Value) -> App ()
checkConnection (Value
u1, Value
u2) =
  Value -> Value -> App Response
forall userFrom userTo.
(HasCallStack, MakesValue userFrom, MakesValue userTo) =>
userFrom -> userTo -> App Response
getConnection Value
u1 Value
u2 App Response -> (Response -> App ()) -> App ()
forall a.
HasCallStack =>
App Response -> (Response -> App a) -> App a
`bindResponse` \Response
resp -> do
    Response
resp.status Int -> Int -> App ()
forall a. (MakesValue a, HasCallStack) => a -> Int -> App ()
`shouldMatchInt` Int
200
    Response
resp.json Maybe Value -> String -> App Value
forall a. (HasCallStack, MakesValue a) => a -> String -> App Value
%. String
"status" App Value -> String -> App ()
forall a b.
(MakesValue a, MakesValue b, HasCallStack) =>
a -> b -> App ()
`shouldMatch` String
"accepted"