1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
{-# LANGUAGE TupleSections #-}
module Test.Database.Setup (
withTestDB
, fakeIniPath
, testEnvToPgConnectionInfo
) where
import Data.Pool hiding (withResource)
import Data.Pool qualified as Pool
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Database.PostgreSQL.Simple qualified as PG
import Database.PostgreSQL.Simple.Options qualified as Client
import Database.PostgreSQL.Simple.Options qualified as Opts
import Database.Postgres.Temp qualified as Tmp
import Gargantext.API.Admin.EnvTypes (Mode(Mock))
import Gargantext.Prelude
import Gargantext.Prelude.Config
import Gargantext.System.Logging (withLoggerHoisted)
import Paths_gargantext
import Prelude qualified
import Shelly hiding (FilePath, run)
import Shelly qualified as SH
import Test.Database.Types
-- | Test DB settings.
dbUser, dbPassword, dbName :: Prelude.String
dbUser = "gargantua"
dbPassword = "gargantua_test"
dbName = "gargandb_test"
fakeIniPath :: IO FilePath
fakeIniPath = getDataFileName "test-data/test_config.ini"
gargDBSchema :: IO FilePath
gargDBSchema = getDataFileName "devops/postgres/schema.sql"
teardown :: TestEnv -> IO ()
teardown TestEnv{..} = do
destroyAllResources $ _DBHandle test_db
Tmp.stop $ _DBTmp test_db
-- | Bootstraps the DB, by creating the DB and the schema.
bootstrapDB :: Tmp.DB -> Pool PG.Connection -> GargConfig -> IO ()
bootstrapDB tmpDB pool _cfg = Pool.withResource pool $ \conn -> do
void $ PG.execute_ conn (fromString $ "ALTER USER \"" <> dbUser <> "\" with PASSWORD '" <> dbPassword <> "'")
schemaPath <- gargDBSchema
let connString = Tmp.toConnectionString tmpDB
(res,ec) <- shelly $ silently $ escaping False $ do
result <- SH.run "psql" ["-d", "\"" <> TE.decodeUtf8 connString <> "\"", "<", fromString schemaPath]
(result,) <$> lastExitCode
unless (ec == 0) $ throwIO (Prelude.userError $ show ec <> ": " <> T.unpack res)
tmpPgConfig :: Tmp.Config
tmpPgConfig = Tmp.defaultConfig <>
Tmp.optionsToDefaultConfig mempty
{ Client.dbname = pure dbName
, Client.user = pure dbUser
, Client.password = pure dbPassword
}
setup :: IO TestEnv
setup = do
res <- Tmp.startConfig tmpPgConfig
case res of
Left err -> Prelude.fail $ show err
Right db -> do
gargConfig <- fakeIniPath >>= readConfig
pool <- createPool (PG.connectPostgreSQL (Tmp.toConnectionString db))
(PG.close) 2 60 2
bootstrapDB db pool gargConfig
ugen <- emptyCounter
withLoggerHoisted Mock $ \logger -> do
pure $ TestEnv (DBHandle pool db) gargConfig ugen logger
withTestDB :: (TestEnv -> IO ()) -> IO ()
withTestDB = bracket setup teardown
testEnvToPgConnectionInfo :: TestEnv -> PG.ConnectInfo
testEnvToPgConnectionInfo TestEnv{..} =
PG.ConnectInfo { PG.connectHost = "0.0.0.0"
, PG.connectPort = fromIntegral $ fromMaybe 5432
$ getLast
$ Opts.port
$ Tmp.toConnectionOptions
$ _DBTmp test_db
, PG.connectUser = dbUser
, PG.connectPassword = dbPassword
, PG.connectDatabase = dbName
}