module Hasura.Backends.Postgres.Instances.PingSource
  ( runCockroachDBPing,
  )
where

import Data.Environment qualified as Env
import Data.Text qualified as T
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection qualified as PG
import Hasura.Backends.Postgres.Connection.Connect (withPostgresDB)
import Hasura.Prelude
import Hasura.RQL.Types.Common (SourceName, sourceNameToText)
import Hasura.Server.Version

runCockroachDBPing ::
  Env.Environment ->
  (String -> IO ()) ->
  SourceName ->
  PG.PostgresConnConfiguration ->
  IO ()
runCockroachDBPing :: Environment
-> (String -> IO ())
-> SourceName
-> PostgresConnConfiguration
-> IO ()
runCockroachDBPing Environment
env String -> IO ()
pingLog SourceName
sourceName PostgresConnConfiguration
sourceConnection = do
  let versionMessage :: Text
versionMessage = Text
"hasura-graphql-engine-version=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
forall a. Show a => a -> Text
tshow Version
currentVersion
      query :: Query
query = Text -> Query
PG.fromText (Text
"select 1 /* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
versionMessage Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" */")
  Either QErr ()
result <- Environment
-> PostgresConnConfiguration
-> TxET QErr IO ()
-> IO (Either QErr ())
forall a.
Environment
-> PostgresConnConfiguration
-> TxET QErr IO a
-> IO (Either QErr a)
withPostgresDB Environment
env PostgresConnConfiguration
sourceConnection (TxET QErr IO () -> IO (Either QErr ()))
-> TxET QErr IO () -> IO (Either QErr ())
forall a b. (a -> b) -> a -> b
$ do
    (PGTxErr -> QErr) -> Query -> () -> Bool -> TxET QErr IO ()
forall (m :: * -> *) r e.
(MonadIO m, ToPrepArgs r) =>
(PGTxErr -> e) -> Query -> r -> Bool -> TxET e m ()
PG.discardQE PGTxErr -> QErr
PG.dmlTxErrorHandler Query
query () Bool
False
  case Either QErr ()
result of
    Left QErr
_ ->
      String -> IO ()
pingLog (String
"Ping for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (SourceName -> Text
sourceNameToText SourceName
sourceName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" failed")
    Right ()
_ ->
      String -> IO ()
pingLog (String
"Ping for " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (SourceName -> Text
sourceNameToText SourceName
sourceName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" succeeded")