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

-- | Helpers for executing raw SQL against the galley Postgres database from
-- integration tests (via the @psql@ binary).
module Testlib.PG (execSql) where

import Control.Exception (try)
import qualified Data.ByteString.Lazy as BS
import Data.Scientific (toBoundedInteger)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..))
import System.Process
import Testlib.Prelude

-- | Execute a SQL statement against the given backend's galley Postgres
-- database by spawning @psql@ with the connection parameters read from
-- galley's configuration. Dynamic backends share the static Postgres server
-- and differ only in @postgresql.dbname@, which is taken from the backend
-- resource. The optional top-level @postgresqlPassword@ secret file takes
-- precedence over the optional inline @postgresql.password@ value — same
-- precedence as galley (see 'lookupPassword' for the accepted file formats).
-- Fails if @psql@ exits non-zero.
execSql :: (HasCallStack) => BackendResource -> Text -> App ()
execSql :: HasCallStack => BackendResource -> Text -> App ()
execSql BackendResource
resource Text
sql = do
  cfg <- Service -> App Value
readServiceConfig Service
Galley
  host <- cfgStr cfg "postgresql.host"
  port <- cfgStr cfg "postgresql.port"
  let dbname = BackendResource
resource.berPostgresqlDBName
  user <- cfgStr cfg "postgresql.user"
  mPassword <- lookupPassword cfg
  baseEnv <- liftIO getEnvironment
  let cp =
        ( String -> [String] -> CreateProcess
proc
            String
"psql"
            [String
"-w", String
"-h", String
host, String
"-p", String
port, String
"-d", String
dbname, String
"-U", String
user, String
"-v", String
"ON_ERROR_STOP=1", String
"-c", Text -> String
T.unpack Text
sql]
        )
          { env = Just (maybe baseEnv (\String
pw -> (String
"PGPASSWORD", String
pw) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: ((String, String) -> Bool)
-> [(String, String)] -> [(String, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"PGPASSWORD") (String -> Bool)
-> ((String, String) -> String) -> (String, String) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) [(String, String)]
baseEnv) mPassword)
          }
  (_, _, _, ph) <- liftIO $ createProcess cp
  exitCode <- liftIO $ waitForProcess ph
  case exitCode of
    ExitCode
ExitSuccess -> () -> App ()
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    ExitFailure Int
code ->
      String -> App ()
forall a. HasCallStack => String -> App a
failApp
        (String -> App ()) -> String -> App ()
forall a b. (a -> b) -> a -> b
$ String
"psql failed (exit "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
code
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
") running: "
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
sql

-- | Resolve the DB password: the @postgresqlPassword@ secret file wins over
-- the inline @postgresql.password@ value. The file is expected to hold a
-- JSON-encoded string (as consumed by galley itself); if it is not valid
-- JSON, its raw (trimmed) content is used as the password. A configured but
-- unreadable file is a hard error.
lookupPassword :: (HasCallStack) => Value -> App (Maybe String)
lookupPassword :: HasCallStack => Value -> App (Maybe String)
lookupPassword Value
cfg =
  Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
cfg String
"postgresqlPassword" App (Maybe Value)
-> (Maybe Value -> App (Maybe String)) -> App (Maybe String)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Value
pathVal -> do
      path <- String -> Value -> App String
forall {a}. Show a => a -> Value -> App String
requireScalar String
"postgresqlPassword" Value
pathVal
      contents <- liftIO (try (BS.readFile path)) >>= either (\IOException
e -> String -> App ByteString
forall a. HasCallStack => String -> App a
failApp (String
"Testlib.PG.execSql: cannot read postgresqlPassword file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException))) pure
      case eitherDecode contents of
        Right String
pw -> Maybe String -> App (Maybe String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just String
pw)
        -- Secret files rendered by the helm charts (e.g. from a plain-text
        -- @secrets.pgPassword@ value) hold the raw password rather than a
        -- JSON string; accept the raw content as a fallback.
        Left String
_ -> do
          let raw :: String
raw = Text -> String
T.unpack (Text -> Text
T.strip (ByteString -> Text
decodeUtf8 (ByteString -> ByteString
BS.toStrict ByteString
contents)))
          Bool -> App () -> App ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
raw) (App () -> App ()) -> App () -> App ()
forall a b. (a -> b) -> a -> b
$ String -> App ()
forall a. HasCallStack => String -> App a
failApp (String
"Testlib.PG.execSql: postgresqlPassword file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
path String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is empty")
          Maybe String -> App (Maybe String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just String
raw)
    Maybe Value
Nothing ->
      Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
cfg String
"postgresql.password" App (Maybe Value)
-> (Maybe Value -> App (Maybe String)) -> App (Maybe String)
forall a b. App a -> (a -> App b) -> App b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just (String Text
t) -> Maybe String -> App (Maybe String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe String
forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
t))
        Maybe Value
Nothing -> Maybe String -> App (Maybe String)
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
        Just Value
v -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> App String -> App (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Value -> App String
forall {a}. Show a => a -> Value -> App String
requireScalar String
"postgresql.password" Value
v
  where
    requireScalar :: a -> Value -> App String
requireScalar a
k Value
v = case Value
v of
      String Text
t -> String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
t)
      Value
_ -> String -> App String
forall a. HasCallStack => String -> App a
failApp (String
"Testlib.PG.execSql: config key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of galley is missing or not a scalar")

-- | Read a scalar (string or integer) config value.
cfgStr :: (HasCallStack) => Value -> String -> App String
cfgStr :: HasCallStack => Value -> String -> App String
cfgStr Value
cfg String
key = do
  mv <- Value -> String -> App (Maybe Value)
forall a.
(HasCallStack, MakesValue a) =>
a -> String -> App (Maybe Value)
lookupField Value
cfg String
key
  case mv of
    Just (String Text
t) -> String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> String
T.unpack Text
t)
    Just (Number Scientific
n) -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
n of
      Just (Int
i :: Int) -> String -> App String
forall a. a -> App a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> String
forall a. Show a => a -> String
show Int
i)
      Maybe Int
Nothing -> String -> App String
forall {a} {a}. Show a => a -> App a
scalarFail String
key
    Maybe Value
_ -> String -> App String
forall {a} {a}. Show a => a -> App a
scalarFail String
key
  where
    scalarFail :: a -> App a
scalarFail a
k = String -> App a
forall a. HasCallStack => String -> App a
failApp (String
"Testlib.PG.execSql: config key " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" of galley is missing or not a scalar")