content: module IHP.IDE.Postgres (withPostgres, withBuiltinOrDevenvPostgres) where
  
  import IHP.IDE.Types
  import IHP.Prelude
  import qualified System.Process as Process
  import qualified System.Directory as Directory
  import qualified Data.ByteString.Char8 as ByteString
  import qualified Data.ByteString.Builder as ByteString
  import Control.Concurrent (threadDelay)
  import Control.Concurrent.MVar
  import GHC.IO.Handle
  import qualified Control.Exception.Safe as Exception
  
  import qualified IHP.Log as Log
  import qualified IHP.EnvVar as EnvVar
  import Paths_ihp_ide (getDataFileName)
  
  withPostgres :: (?context :: Context) => (MVar () -> IORef ByteString.Builder -> IORef ByteString.Builder -> IO a) -> IO a
  withPostgres callback = do
      currentDir <- Directory.getCurrentDirectory
      ensureNoOtherPostgresIsRunning
      shouldInit <- needsDatabaseInit
      when shouldInit initDatabase
  
      Process.withCreateProcess (postgresProcessParams currentDir) \(Just inputHandle) (Just outputHandle) (Just errorHandle) processHandle -> do
          let main = do
                  standardOutput <- newIORef mempty
                  errorOutput <- newIORef mempty
                  databaseIsReady <- newEmptyMVar
  
                  redirectHandleToVariable standardOutput outputHandle handleOutdatedDatabase
                  redirectHandleToVariable errorOutput errorHandle (handleOutdatedDatabase >> handleDatabaseReady databaseIsReady)
  
                  callback databaseIsReady standardOutput errorOutput
  
          Exception.finally main (softStopPostgres processHandle)
  
  softStopPostgres :: Process.ProcessHandle -> IO ()
  softStopPostgres processHandle = do
      let interruptAndWait = Process.interruptProcessGroupOf processHandle >> Process.waitForProcess processHandle
      let waitAndKill = threadDelay 1000000 >> pure ()
      race_
          interruptAndWait
          waitAndKill
  
  postgresProcessParams :: (?context :: Context) => FilePath -> Process.CreateProcess
  postgresProcessParams workingDirectory =
      let
          args = ["-D", "build/db/state", "-k", workingDirectory <> "/build/db", "-c", "listen_addresses="]
      in (procDirenvAware "postgres" args)
          { Process.std_in = Process.CreatePipe
          , Process.std_out = Process.CreatePipe
          , Process.std_err = Process.CreatePipe
          , Process.create_group = True
          }
  
  handleDatabaseReady :: MVar () -> ByteString -> IO ()
  handleDatabaseReady onReady line = when ("database system is ready to accept connections" `ByteString.isInfixOf` line) (putMVar onReady ())
  
  handleOutdatedDatabase :: (?context :: Context) => ByteString -> IO ()
  handleOutdatedDatabase line =
          -- Always log fatal errors to the output:
          -- 2021-09-04 12:18:08.888 CEST [55794] FATAL:  database files are incompatible with server
          --
          -- If we're in debug mode, log all output
          if "FATAL" `ByteString.isInfixOf` line
              then if "database files are incompatible with server" `ByteString.isInfixOf` line
                  then Log.error ("The current database state has been created with a different postgres server. Likely you just upgraded the IHP version. Delete your local dev database with 'rm -rf build/db'. You can use 'make dumpdb' to save your database state to Fixtures.sql, otherwise all changes in your local db will be lost. After that run 'devenv up' again." :: Text)
                  else Log.error line
              else when ?context.isDebugMode (Log.debug line)
  
  redirectHandleToVariable :: IORef ByteString.Builder -> Handle -> (ByteString -> IO ()) -> IO (Async ())
  redirectHandleToVariable !ref !handle !onLine = do
      async $ forever $ do
          line <- ByteString.hGetLine handle
          onLine line
          modifyIORef ref (\log -> log <> "\n" <> ByteString.byteString line)
  
  ensureNoOtherPostgresIsRunning :: IO ()
  ensureNoOtherPostgresIsRunning = do
      pidFileExists <- Directory.doesPathExist "build/db/state/postmaster.pid"
      let stopFailedHandler (exception :: SomeException) = do
              -- pg_ctl: could not send stop signal (PID: 123456765432): No such process
              if ("No such process" `isInfixOf` (tshow exception))
                  then Directory.removeFile "build/db/state/postmaster.pid"
                  else putStrLn "Found postgres lockfile at 'build/db/state/postmaster.pid'. Could not bring the other postgres instance to halt. Please stop the running postgres manually and then restart this dev server"
      when pidFileExists do
          (Process.callProcess "pg_ctl" ["stop", "-D", "build/db/state"]) `catch` stopFailedHandler
  
  needsDatabaseInit :: IO Bool
  needsDatabaseInit = not <$> Directory.doesDirectoryExist "build/db/state"
  
  initDatabase :: IO ()
  initDatabase = do
      currentDir <- Directory.getCurrentDirectory
      Directory.createDirectoryIfMissing True "build/db"
  
      Process.callProcess "initdb" [
                  "build/db/state"
                  , "--no-locale" -- Avoid issues with impure host system locale in dev mode
                  , "--encoding"
                  , "UTF8"
              ]
  
      let params = (Process.proc "postgres" ["-D", "build/db/state", "-k", currentDir <> "/build/db", "-c", "listen_addresses="])
                  { Process.std_in = Process.CreatePipe
                  , Process.std_out = Process.CreatePipe
                  , Process.std_err = Process.CreatePipe
                  }
  
      Process.withCreateProcess params \(Just inputHandle) (Just outputHandle) (Just errorHandle) processHandle -> do
          waitUntilReady errorHandle do
              Process.callProcess "createdb" ["app", "-h", currentDir <> "/build/db"]
  
              let importSql file = Process.callCommand ("psql -h '" <> currentDir <> "/build/db' -d app < " <> file)
              ihpSchemaSql <- getDataFileName "IHPSchema.sql"
              importSql ihpSchemaSql
              importSql "Application/Schema.sql"
              importSql "Application/Fixtures.sql"
  
              Process.terminateProcess processHandle
              _ <- Process.waitForProcess processHandle
              pure ()
  
  waitUntilReady handle callback = do
      line <- ByteString.hGetLine handle
      if "database system is ready to accept connections" `ByteString.isInfixOf` line
          then callback
          else waitUntilReady handle callback
  
  waitPostgres :: (?context :: Context) => IO ()
  waitPostgres = do
      let isDebugMode = ?context.isDebugMode
      threadDelay 1000000
      (_, stdout, _) <- Process.readProcessWithExitCode "pg_ctl" ["status"] ""
      if "server is running" `isInfixOf` (cs stdout)
      then pure ()
      else do
          when isDebugMode (Log.debug ("Waiting for postgres to start" :: Text))
          waitPostgres
  
  
  withBuiltinOrDevenvPostgres :: (?context :: Context) => (MVar () -> IORef ByteString.Builder -> IORef ByteString.Builder -> IO a) -> IO a
  withBuiltinOrDevenvPostgres callback = do
      useDevenv <- EnvVar.envOrDefault "IHP_DEVENV" False
      if useDevenv
      then do
          waitPostgres
  
          -- For devenv postgres we don't have access to the postgres logs
          standardOutput <- newIORef mempty
          errorOutput <- newIORef mempty
          databaseIsReady <- newMVar ()
  
          callback databaseIsReady standardOutput errorOutput
      else do
          withPostgres callback