mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
104 lines
3.4 KiB
Haskell
104 lines
3.4 KiB
Haskell
-- | API related to Postgres' pg dump
|
|
module Hasura.Server.API.PGDump
|
|
( PGDumpReqBody(..)
|
|
, execPGDump
|
|
) where
|
|
|
|
import Control.Exception (IOException, try)
|
|
import Data.Aeson
|
|
import Data.Aeson.TH
|
|
import Data.Char (isSpace)
|
|
import Data.Text.Conversions
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.Types (SourceName, defaultSource)
|
|
import System.Exit
|
|
import System.Process
|
|
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.List as L
|
|
import qualified Data.Text as T
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Hasura.Base.Error as RTE
|
|
import qualified Text.Regex.TDFA as TDFA
|
|
|
|
|
|
data PGDumpReqBody =
|
|
PGDumpReqBody
|
|
{ prbSource :: !SourceName
|
|
, prbOpts :: ![String]
|
|
, prbCleanOutput :: !Bool
|
|
} deriving (Show, Eq)
|
|
|
|
$(deriveToJSON hasuraJSON ''PGDumpReqBody)
|
|
|
|
instance FromJSON PGDumpReqBody where
|
|
parseJSON = withObject "Object" $ \o ->
|
|
PGDumpReqBody
|
|
<$> o .:? "source" .!= defaultSource
|
|
<*> o .: "opts"
|
|
<*> o .:? "clean_output" .!= False
|
|
|
|
execPGDump
|
|
:: (MonadError RTE.QErr m, MonadIO m)
|
|
=> PGDumpReqBody
|
|
-> Q.ConnInfo
|
|
-> m BL.ByteString
|
|
execPGDump b ci = do
|
|
eOutput <- liftIO $ try execProcess
|
|
output <- onLeft eOutput throwException
|
|
onLeft output $ \err ->
|
|
RTE.throw500 $ "error while executing pg_dump: " <> err
|
|
where
|
|
throwException :: (MonadError RTE.QErr m) => IOException -> m a
|
|
throwException _ = RTE.throw500 "internal exception while executing pg_dump"
|
|
|
|
execProcess = do
|
|
(exitCode, stdOut, stdErr) <- readProcessWithExitCode "pg_dump" opts ""
|
|
return $ case exitCode of
|
|
ExitSuccess -> Right $ unUTF8 $ convertText (clean stdOut)
|
|
ExitFailure _ -> Left $ toText stdErr
|
|
|
|
connString = T.unpack $ bsToTxt $ Q.pgConnString $ Q.ciDetails ci
|
|
opts = connString : "--encoding=utf8" : prbOpts b
|
|
|
|
clean str
|
|
| prbCleanOutput b =
|
|
unlines $ filter (not . shouldDropLine) (lines str)
|
|
| otherwise = str
|
|
|
|
shouldDropLine line =
|
|
-- delete empty lines
|
|
all isSpace line
|
|
-- delete comments
|
|
|| "--" `L.isPrefixOf` line
|
|
-- delete front matter
|
|
|| line `elem` preambleLines
|
|
-- delete notify triggers
|
|
|| eventTriggerRegex `TDFA.match` line
|
|
|
|
preambleLines =
|
|
[ "SET statement_timeout = 0;"
|
|
, "SET lock_timeout = 0;"
|
|
, "SET idle_in_transaction_session_timeout = 0;"
|
|
, "SET client_encoding = 'UTF8';"
|
|
, "SET standard_conforming_strings = on;"
|
|
, "SELECT pg_catalog.set_config('search_path', '', false);"
|
|
, "SET xmloption = content;"
|
|
, "SET client_min_messages = warning;"
|
|
, "SET row_security = off;"
|
|
, "SET default_tablespace = '';"
|
|
, "SET default_with_oids = false;"
|
|
, "SET default_table_access_method = heap;"
|
|
, "CREATE SCHEMA public;"
|
|
, "COMMENT ON SCHEMA public IS 'standard public schema';"
|
|
]
|
|
|
|
eventTriggerRegex =
|
|
let regexStr :: String =
|
|
-- pg functions created by hasura for event triggers used "notify_hasura"
|
|
-- These changes are also documented on the method pgIdenTrigger
|
|
"^CREATE TRIGGER \"?notify_hasura_.+\"? AFTER [[:alnum:]]+ "
|
|
<> "ON .+ FOR EACH ROW EXECUTE (FUNCTION|PROCEDURE) "
|
|
<> "\"?hdb_catalog\"?\\.\"?notify_hasura_.+\"?\\(\\);$"
|
|
in TDFA.makeRegex regexStr :: TDFA.Regex
|