2021-11-17 22:50:39 +03:00
|
|
|
{-# OPTIONS -Wno-redundant-constraints #-}
|
|
|
|
|
|
|
|
-- | PostgreSQL helpers.
|
2022-01-21 10:48:27 +03:00
|
|
|
module Harness.Backend.Postgres
|
2021-11-17 22:50:39 +03:00
|
|
|
( livenessCheck,
|
|
|
|
run_,
|
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
import Control.Concurrent
|
|
|
|
import Control.Exception
|
2021-11-26 21:21:01 +03:00
|
|
|
import Control.Monad.Reader
|
2021-11-17 22:50:39 +03:00
|
|
|
import Data.ByteString.Char8 qualified as S8
|
|
|
|
import Data.String
|
|
|
|
import Database.PostgreSQL.Simple qualified as Postgres
|
|
|
|
import GHC.Stack
|
2021-11-26 21:21:01 +03:00
|
|
|
import Harness.Constants as Constants
|
2021-11-17 22:50:39 +03:00
|
|
|
import System.Process.Typed
|
|
|
|
import Prelude
|
|
|
|
|
|
|
|
-- | Check the postgres server is live and ready to accept connections.
|
|
|
|
livenessCheck :: HasCallStack => IO ()
|
|
|
|
livenessCheck = loop Constants.postgresLivenessCheckAttempts
|
|
|
|
where
|
|
|
|
loop 0 = error ("Liveness check failed for PostgreSQL.")
|
|
|
|
loop attempts =
|
|
|
|
catch
|
|
|
|
( bracket
|
2021-12-30 14:00:52 +03:00
|
|
|
( Postgres.connectPostgreSQL
|
|
|
|
(fromString Constants.postgresqlConnectionString)
|
|
|
|
)
|
|
|
|
Postgres.close
|
2021-11-17 22:50:39 +03:00
|
|
|
(const (pure ()))
|
|
|
|
)
|
|
|
|
( \(_failure :: ExitCodeException) -> do
|
|
|
|
threadDelay
|
|
|
|
Constants.postgresLivenessCheckIntervalMicroseconds
|
|
|
|
loop (attempts - 1)
|
|
|
|
)
|
|
|
|
|
|
|
|
-- | Run a plain SQL query. On error, print something useful for
|
|
|
|
-- debugging.
|
|
|
|
run_ :: HasCallStack => String -> IO ()
|
|
|
|
run_ q =
|
|
|
|
catch
|
|
|
|
( bracket
|
|
|
|
( Postgres.connectPostgreSQL
|
|
|
|
(fromString Constants.postgresqlConnectionString)
|
|
|
|
)
|
|
|
|
Postgres.close
|
|
|
|
(\conn -> void (Postgres.execute_ conn (fromString q)))
|
|
|
|
)
|
|
|
|
( \(e :: Postgres.SqlError) ->
|
|
|
|
error
|
|
|
|
( unlines
|
|
|
|
[ "PostgreSQL query error:",
|
|
|
|
S8.unpack (Postgres.sqlErrorMsg e),
|
|
|
|
"SQL was:",
|
|
|
|
q
|
|
|
|
]
|
|
|
|
)
|
|
|
|
)
|