module Refurb.Run.Backup where
import ClassyPrelude
import Control.Monad.Logger (logInfo, logError)
import Refurb.Run.Internal (MonadRefurb, contextDbConnInfo)
import Refurb.Types (ConnInfo(ConnInfo), connDbName, connUser, connHost, connPort, connPassword)
import System.Environment (getEnvironment)
import System.Exit (ExitCode(ExitSuccess, ExitFailure))
import qualified System.Process as Proc
backup :: MonadRefurb m => FilePath -> m ()
backup path = do
ConnInfo {..} <- asks contextDbConnInfo
$logInfo $ "Backing up database to " <> tshow path
env <- liftBase getEnvironment
let createProcess =
( Proc.proc "pg_dump"
[ "-Z", "9"
, "-F", "c"
, "-f", path
, "-d", unpack connDbName
, "-U", unpack connUser
, "-h", unpack connHost
, "-p", show connPort
]
) { Proc.env = Just $ ("PGPASS", unpack connPassword) : env }
(exitCode, out, err) <- liftBase $ Proc.readCreateProcessWithExitCode createProcess ""
case exitCode of
ExitSuccess ->
$logInfo "Backup complete."
ExitFailure code -> do
$logError $ "Backup failed with code " <> tshow code
$logError $ "pg_dump stdout:\n" <> pack out
$logError $ "pg_dump stderr:\n" <> pack err
fail "pg_dump failed"