refurb 0.3.0.2 → 0.3.0.3
raw patch · 6 files changed
+102/−80 lines, 6 filesdep ~opaleye
Dependency ranges changed: opaleye
Files
- refurb.cabal +3/−8
- src/Refurb.hs +23/−9
- src/Refurb/Cli.hs +55/−11
- src/Refurb/Run/Backup.hs +8/−8
- src/Refurb/Run/Internal.hs +5/−5
- src/Refurb/Types.hs +8/−39
refurb.cabal view
@@ -1,11 +1,6 @@ cabal-version: 1.12---- This file has been generated from package.yaml by hpack version 0.34.7.------ see: https://github.com/sol/hpack- name: refurb-version: 0.3.0.2+version: 0.3.0.3 synopsis: Tools for maintaining a database description: Tools for maintaining a database category: Database@@ -46,7 +41,7 @@ , monad-control , monad-logger , old-locale- , opaleye ==0.9.2.*+ , opaleye >= 0.9.2 && <0.9.4 , optparse-applicative , postgresql-simple , process@@ -84,7 +79,7 @@ , monad-control , monad-logger , old-locale- , opaleye ==0.9.2.*+ , opaleye >= 0.9.2 && <0.9.4 , optparse-applicative , postgresql-simple , process
src/Refurb.hs view
@@ -5,6 +5,7 @@ -- |Top level module of Refurb along which re-exports the library portion of Refurb ('Refurb.Types' and 'Refurb.MigrationUtils') module Refurb ( refurbMain+ , refurbArgs , module Refurb.MigrationUtils , module Refurb.Types ) where@@ -14,7 +15,7 @@ import Control.Monad.Logger (LogLevel(LevelDebug), filterLogger, logDebug, runStdoutLoggingT) import qualified Database.PostgreSQL.Simple as PG import qualified Options.Applicative as OA-import Refurb.Cli (Command(CommandMigrate, CommandShowLog, CommandShowMigration, CommandBackup), Opts(Opts, debug, command, configFile), optsParser)+import Refurb.Cli (Command(CommandMigrate, CommandShowLog, CommandShowMigration, CommandBackup), ConnectOps(ConnectOpsFile, ConnectOpsParams), Opts(Opts, debug, command, config), optsParser) import Refurb.MigrationUtils import Refurb.Run.Backup (backup) import Refurb.Run.Internal (Context(Context))@@ -22,6 +23,7 @@ import Refurb.Run.Migrate (migrate) import Refurb.Store (isSchemaPresent, initializeSchema) import Refurb.Types+import System.Environment (lookupEnv) -- |Main entry point for refurbishing. --@@ -45,22 +47,34 @@ -- void $ execute_ "create table my_table (...)" -- -- main :: IO ()--- main = refurbMain readDatabaseConnInfo migrations+-- main = refurbMain readDatabaseConnectInfo migrations -- @-refurbMain :: (FilePath -> IO ConnInfo) -> [Migration] -> IO ()-refurbMain readConnInfo migrations = do+refurbMain :: (FilePath -> IO PG.ConnectInfo) -> [Migration] -> IO ()+refurbMain readConnectInfo migrations = do opts@(Opts {..}) <- OA.execParser optsParser-- connInfo <- readConnInfo configFile+ connectInfo <- case config of+ ConnectOpsFile file -> readConnectInfo file+ ConnectOpsParams host port dbname user -> do+ password <- lookupEnv "PGPASS"+ pure PG.ConnectInfo+ { connectHost = host,+ connectPort = port,+ connectUser = user,+ connectPassword = fromMaybe "" password,+ connectDatabase = dbname+ }+ refurbArgs opts connectInfo migrations +refurbArgs :: Opts -> PG.ConnectInfo -> [Migration] -> IO ()+refurbArgs opts@(Opts {..}) connectInfo migrations = do let logFilter = if debug then \ _ _ -> True else \ _ lvl -> lvl > LevelDebug runStdoutLoggingT . filterLogger logFilter $ do- $logDebug $ "Connecting to " <> tshow (connInfoAsLogString connInfo)- bracket (liftBase . PG.connectPostgreSQL $ connInfoAsConnString connInfo) (liftBase . PG.close) $ \ conn -> do- let context = Context opts conn connInfo migrations+ $logDebug $ "Connecting to " <> tshow (connectInfoAsLogString connectInfo)+ bracket (liftBase $ PG.connect connectInfo) (liftBase . PG.close) $ \ conn -> do+ let context = Context opts conn connectInfo migrations unlessM (isSchemaPresent conn) $ initializeSchema conn
src/Refurb/Cli.hs view
@@ -4,6 +4,7 @@ import ClassyPrelude import Composite.Record ((:->)(Val))+import Data.Word (Word16) import qualified Options.Applicative as OA import Refurb.Store (FQualifiedKey) @@ -86,18 +87,66 @@ ) ( OA.progDesc "Back up the database" ) +-- |Options for connecting to database.+data ConnectOps+ = ConnectOpsFile FilePath+ -- ^Connect via a file+ | ConnectOpsParams String Word16 String String+ -- ^Connect via parameters - reads password from PGPASS+ -- |Structure holding the parsed command line arguments and options. data Opts = Opts- { debug :: Bool+ { debug :: Bool -- ^Whether to turn on debug logging to the console- , colorize :: Bool+ , colorize :: Bool -- ^Whether to colorize console output- , configFile :: FilePath- -- ^The configuration file where (presumably) the database connection information is stored- , command :: Command+ , config :: ConnectOps+ -- ^See 'ConnectOps'+ , command :: Command -- ^Which command the user chose and the options for that command } +connectOpsParser :: OA.Parser ConnectOps+connectOpsParser = fileParser <|> paramsParser+ where+ fileParser = ConnectOpsFile+ <$> OA.strOption+ ( OA.long "config"+ <> OA.short 'c'+ <> OA.metavar "SERVER-CONFIG"+ <> OA.help "Path to server config file to read database connection information from"+ )+ paramsParser = ConnectOpsParams+ <$> OA.strOption+ ( OA.long "host"+ <> OA.metavar "DATABASE-HOST"+ <> OA.value "localhost"+ <> OA.help "Database host"+ <> OA.showDefault+ )+ <*> OA.option OA.auto+ ( OA.long "port"+ <> OA.metavar "DATABASE-PORT"+ <> OA.value 5432+ <> OA.help "Database port"+ <> OA.showDefault+ )+ <*> OA.strOption+ ( OA.long "dbname"+ <> OA.metavar "DATABASE-NAME"+ <> OA.value "postgres"+ <> OA.help "Database name"+ <> OA.showDefault+ )+ <*> OA.strOption+ ( OA.long "user"+ <> OA.metavar "DATABASE-USER"+ <> OA.value "postgres"+ <> OA.help "Database user"+ <> OA.showDefault+ )++ -- |Parser for the command line arguments optsParser :: OA.ParserInfo Opts optsParser =@@ -111,12 +160,7 @@ <> OA.help "Turn on debug diagnostic logging" ) <*> (not <$> OA.switch (OA.long "no-color" <> OA.help "disable ANSI colorization"))- <*> OA.strOption- ( OA.long "config"- <> OA.short 'c'- <> OA.metavar "SERVER-CONFIG"- <> OA.help "Path to server config file to read database connection information from"- )+ <*> connectOpsParser <*> OA.hsubparser ( OA.command "migrate" commandMigrateParser <> OA.command "show-log" commandShowLogParser
src/Refurb/Run/Backup.hs view
@@ -7,8 +7,8 @@ import ClassyPrelude import Control.Monad.Base (liftBase) import Control.Monad.Logger (logInfo, logError)-import Refurb.Run.Internal (MonadRefurb, contextDbConnInfo)-import Refurb.Types (ConnInfo(ConnInfo), connDbName, connUser, connHost, connPort, connPassword)+import qualified Database.PostgreSQL.Simple as PG+import Refurb.Run.Internal (MonadRefurb, contextDbConnectInfo) import System.Environment (getEnvironment) import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import qualified System.Process as Proc@@ -16,7 +16,7 @@ -- |Handle the @backup@ command by calling @pg_dump@ to save a database backup. backup :: MonadRefurb m => FilePath -> m () backup path = do- ConnInfo {..} <- asks contextDbConnInfo+ PG.ConnectInfo {..} <- asks contextDbConnectInfo $logInfo $ "Backing up database to " <> tshow path env <- liftBase getEnvironment let createProcess =@@ -24,12 +24,12 @@ [ "-Z", "9" -- max compression , "-F", "c" -- "custom" format - custom to pg_dump / pg_restore , "-f", path- , "-d", unpack connDbName- , "-U", unpack connUser- , "-h", unpack connHost- , "-p", show connPort+ , "-d", connectDatabase+ , "-U", connectUser+ , "-h", connectHost+ , "-p", show connectPort ]- ) { Proc.env = Just $ ("PGPASS", unpack connPassword) : env }+ ) { Proc.env = Just $ ("PGPASS", connectPassword) : env } (exitCode, out, err) <- liftBase $ Proc.readCreateProcessWithExitCode createProcess ""
src/Refurb/Run/Internal.hs view
@@ -15,18 +15,18 @@ import qualified Database.PostgreSQL.Simple as PG import Refurb.Cli (Opts, colorize) import Refurb.Store (MigrationResult(MigrationSuccess, MigrationFailure))-import Refurb.Types (ConnInfo, Migration)+import Refurb.Types (Migration) import Text.PrettyPrint.ANSI.Leijen (Doc, green, red, plain, text, putDoc) -- |Reader context for all command execution which contains the command line options, database connection and connection information, and known migrations. data Context = Context- { contextOptions :: Opts+ { contextOptions :: Opts -- ^The 'Opts' structure parsed from the command line by @Refurb.Cli@.- , contextDbConn :: PG.Connection+ , contextDbConn :: PG.Connection -- ^The open database 'PG.Connection'.- , contextDbConnInfo :: ConnInfo+ , contextDbConnectInfo :: PG.ConnectInfo -- ^The information used to connect to the database, required for running command line tools like @pg_dump@ against the same database.- , contextMigrations :: [Migration]+ , contextMigrations :: [Migration] -- ^The known migrations passed in to 'Refurb.refurbMain'. }
src/Refurb/Types.hs view
@@ -8,8 +8,7 @@ {-# LANGUAGE TemplateHaskell #-} -- |Module containing externally useful types for Refurb, most notably the 'Migration' type. module Refurb.Types- ( ConnInfo(..)- , connInfoAsConnString, connInfoAsLogString+ ( connectInfoAsLogString , MigrationType(..) , MonadMigration , Migration(..), migrationSchema, migrationKey, migrationType, migrationCheck, migrationExecute, migrationQualifiedKey@@ -21,46 +20,16 @@ import Control.Monad.Catch (MonadMask) import Control.Monad.Logger (MonadLogger) import Control.Monad.Trans.Control (MonadBaseControl)-import qualified Data.ByteString.Char8 as BSC8-import Data.Word (Word16) import qualified Database.PostgreSQL.Simple as PG --- |Structure with connection information for connecting to the database.-data ConnInfo = ConnInfo- { connHost :: Text- -- ^Hostname or IP address of the PostgreSQL server.- , connPort :: Word16- -- ^Port number the PostgreSQL server is running on (usually @5432@).- , connUser :: Text- -- ^What user to connect to the database as.- , connPassword :: Text- -- ^What password to connect to the database with.- , connDbName :: Text- -- ^What database in the PostgreSQL server to attach to.- }---- |Given a 'ConnInfo' generate the connection string pairs that are shared between the loggable and real version, that is all of them except password.-commonParams :: ConnInfo -> [(ByteString, ByteString)]-commonParams (ConnInfo {..}) =- [ ("host", encodeUtf8 connHost)- , ("port", encodeUtf8 . tshow $ connPort)- , ("user", encodeUtf8 connUser)- , ("dbname", encodeUtf8 connDbName)- ]---- |Given a list of key/value pairs, make up a @key1=value1 key2=value2@ string that PostgreSQL expects.-asConnString :: [(ByteString, ByteString)] -> ByteString-asConnString = BSC8.intercalate " " . map (\ (key, val) -> key <> "=" <> val)---- |Given a 'ConnInfo' make up the real connection string to pass when connecting to the database. Includes password, so never log this.-connInfoAsConnString :: ConnInfo -> ByteString-connInfoAsConnString connInfo@(ConnInfo { connPassword }) =- asConnString (("password", encodeUtf8 connPassword) : commonParams connInfo)+-- |Omit password from 'PG.ConnectInfo'+omitPassword :: PG.ConnectInfo -> PG.ConnectInfo+omitPassword info = info { PG.connectPassword = "<redacted>" } --- |Given a 'ConnInfo' make up the log-safe connection string to show to humans, which omits the password.-connInfoAsLogString :: ConnInfo -> Text-connInfoAsLogString =- decodeUtf8 . asConnString . commonParams+-- |Given a 'PG.ConnectInfo' make up the log-safe connection string to show to humans, which omits the password.+connectInfoAsLogString :: PG.ConnectInfo -> Text+connectInfoAsLogString =+ decodeUtf8 . PG.postgreSQLConnectionString . omitPassword -- |Enumeration of the types of migration that are known about. data MigrationType