gargoyle-postgresql (empty) → 0.1

raw patch · 6 files changed

+280/−0 lines, 6 filesdep +basedep +bytestringdep +directorysetup-changed

Dependencies added: base, bytestring, directory, filepath, gargoyle, gargoyle-postgresql, process, stringsearch, text, unix

Files

Setup.hs +2/−0
gargoyle-postgresql.cabal +98/−0
src-bin/gargoyle-postgres-monitor.hs +7/−0
src-bin/gargoyle-psql.hs +21/−0
src/Gargoyle/PostgreSQL.hs +132/−0
tests/gargoyle-psql-test.hs +20/−0

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ gargoyle-postgresql.cabal view

@@ -0,0 +1,98 @@+name: gargoyle-postgresql+version: 0.1+license: BSD3+author: Obsidian Systems LLC+maintainer: maintainer@obsidian.systems+copyright: Copyright (C) 2017 Obsidian Systems LLC+category: PostgreSQL+build-type: Simple+cabal-version: >=1.10+synopsis: Manage PostgreSQL servers with gargoyle+description:+  This package provides tools for managing PostgreSQL servers that live in local folders and communicate via a Unix domain socket. It uses the <https://hackage.haskell.org/package/gargoyle gargoyle> package in order to automatically initialize, spin up, and spin down such servers according to client demand.+  .+  The `gargoyle-psql` executable is such a client which will try to connect to a PostgreSQL server at a given location:+  .+  > gargoyle-psql db+  .+  > psql (9.5.6)+  > Type "help" for help.+  >+  > postgres=#+  .+  Note that `gargoyle-psql` assumes that PostgreSQL executables such as `psql` are available on the PATH. A custom 'Gargoyle' is required to use non-standard PostgreSQL installations.+  .+  The following is an example of using this package to run <https://hackage.haskell.org/package/postgresql-simple postgresql-simple> actions using a local DB:+  .+  > import Database.PostgreSQL.Simple+  > import Gargoyle+  > import Gargoyle.PostgreSQL+  >+  > withDb :: String -> (Connection -> IO a) -> IO a+  > withDb dbPath a = withGargoyle defaultPostgres dbPath $ \dbUri -> a =<< connectPostgreSQL dbUri++-- Requires postgres to be in the environment to run+flag enable-psql-test+  default: False+  manual: True++library+  exposed-modules: Gargoyle.PostgreSQL+  ghc-options: -Wall+  ghc-prof-options: -fprof-auto+  build-depends: base >= 4.9 && < 4.11+               , bytestring == 0.10.*+               , directory == 1.3.*+               , gargoyle == 0.1.*+               , process == 1.4.*+               , stringsearch == 0.3.*+               , text == 1.2.*+               , unix == 2.7.*+  hs-source-dirs: src+  default-language: Haskell2010++executable gargoyle-psql+  main-is: gargoyle-psql.hs+  hs-source-dirs: src-bin+  ghc-options: -Wall -threaded+  ghc-prof-options: -fprof-auto+  default-language: Haskell2010+  build-depends: base+               , bytestring+               , gargoyle+               , gargoyle-postgresql+               , process+               , text+               , unix++executable gargoyle-postgres-monitor+  main-is: gargoyle-postgres-monitor.hs+  hs-source-dirs: src-bin+  ghc-options: -Wall -threaded+  ghc-prof-options: -fprof-auto+  default-language: Haskell2010+  build-depends: base+               , bytestring+               , gargoyle+               , gargoyle-postgresql+               , process+               , text++test-suite gargoyle-psql-test+  type: exitcode-stdio-1.0+  main-is: gargoyle-psql-test.hs+  ghc-options: -Wall -threaded+  ghc-prof-options: -fprof-auto+  hs-source-dirs: tests+  if !flag(enable-psql-test)+    buildable: False+  else+    build-depends: base+                 , bytestring+                 , directory+                 , filepath+                 , gargoyle+                 , gargoyle-postgresql+                 , process+                 , text+                 , unix

+ src-bin/gargoyle-postgres-monitor.hs view

@@ -0,0 +1,7 @@+module Main where++import Gargoyle+import Gargoyle.PostgreSQL++main :: IO ()+main = gargoyleMain defaultPostgres

+ src-bin/gargoyle-psql.hs view

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Data.List+import System.Environment+import System.Exit++import Gargoyle.PostgreSQL++main :: IO ()+main = do+  args <- getArgs+  case args of+    [dbPath] -> psqlLocal defaultPostgres "psql" dbPath Nothing+    _ -> do+      pname <- getProgName+      putStrLn $ intercalate " "+        [ "USAGE:", pname, "<path>" ]+      putStrLn "\t<path>: path to local db"+      exitFailure+  return ()

+ src/Gargoyle/PostgreSQL.hs view

@@ -0,0 +1,132 @@+{-# LANGUAGE OverloadedStrings #-}+module Gargoyle.PostgreSQL where++import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Search as BS+import Data.Function+import Data.Maybe+import Data.Monoid+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import System.Directory+import System.Exit+import System.IO+import System.Posix.Signals+import System.Process+import System.Process.Internals++import Gargoyle++-- | A 'Gargoyle' that assumes `initdb` and `postgres` are in the path and+-- will perform a 'fast shutdown' on termination (see below).+defaultPostgres :: Gargoyle ProcessHandle ByteString+defaultPostgres = mkPostgresGargoyle "initdb" "postgres" shutdownPostgresFast++-- | Create a gargoyle by telling it where the relevant PostgreSQL executables are and+-- what it should do in order to shut down the server. This module provides two options:+-- 'shutdownPostgresSmart' and 'shutdownPostgresFast'.+mkPostgresGargoyle :: FilePath -- ^ Path to `initdb`+                   -> FilePath -- ^ Path to `postgres`+                   -> (ProcessHandle -> IO ()) -- ^ Shutdown function+                   -> Gargoyle ProcessHandle ByteString+                   -- ^ The 'Gargoyle' returned provides to client code the connection+                   -- string that can be used to connect to the PostgreSQL server+mkPostgresGargoyle initdbPath postgresPath shutdownFun = Gargoyle+  { _gargoyle_exec = "gargoyle-postgres-monitor"+  , _gargoyle_init = initLocalPostgres initdbPath+  , _gargoyle_start = startLocalPostgres postgresPath+  , _gargoyle_stop = shutdownFun+  , _gargoyle_getInfo = getLocalPostgresConnectionString+  }++-- | Create a new PostgreSQL database in a local folder. This is a low level function used to+-- define the PostgreSQL 'Gargoyle'.+initLocalPostgres :: FilePath -- ^ Path to PostgreSQL `initdb` executable+                  -> FilePath -- ^ Path in which to initialize PostgreSQL Server+                  -> IO ()+initLocalPostgres binPath dbDir = do+  (_, _, _, initdb) <- runInteractiveProcess binPath+    [ "-D", dbDir+    , "-U", "postgres"+    , "--no-locale"+    , "-E", "UTF8"+    ] Nothing Nothing+  ExitSuccess <- waitForProcess initdb+  return ()++-- | Produces the connection string for a local postgresql database. This is a low level function+-- used to define the PostgreSQL 'Gargoyle'+getLocalPostgresConnectionString :: FilePath -> IO ByteString+getLocalPostgresConnectionString dbDir = do+  absoluteDbDir <- makeAbsolute dbDir+  return $ mconcat $+    [ "postgresql://postgres@"+    , (LBS.toStrict $ BS.replace "/" ("%2F" :: LBS.ByteString) $ T.encodeUtf8 $ T.pack absoluteDbDir)+    , "/postgres"+    ]++-- | Start a postgres server that is assumed to be in the given folder. This is a low level function+-- used to define the PostgreSQL 'Gargoyle'+startLocalPostgres :: FilePath -- ^ Path to PostgreSQL `postgres` executable+                   -> FilePath -- ^ Path where the server to start is located+                   -> IO ProcessHandle -- ^ handle of the PostgreSQL server+startLocalPostgres binPath dbDir = do+  absoluteDbDir <- makeAbsolute dbDir+  (_, _, err, postgres) <- runInteractiveProcess binPath+    [ "-h", ""+    , "-D", absoluteDbDir+    , "-k", absoluteDbDir+    ] Nothing Nothing+  fix $ \loop -> do+    l <- hGetLine err+    let (tag, rest) = span (/= ':') l+    when (tag /= "LOG") $ fail $ "startLocalPostgres: Unexpected output from postgres: " <> show l+    when (rest /= ":  database system is ready to accept connections") loop+  return postgres++-- | Perform a "Smart Shutdown" of Postgres;+-- see http://www.postgresql.org/docs/current/static/server-shutdown.html+shutdownPostgresSmart :: ProcessHandle -- ^ handle of the PostgreSQL server+                      -> IO ()+shutdownPostgresSmart postgres = do+  terminateProcess postgres+  _ <- waitForProcess postgres+  return ()++-- | Perform a "Fast Shutdown" of Postgres;+-- see http://www.postgresql.org/docs/current/static/server-shutdown.html+shutdownPostgresFast :: ProcessHandle -- ^ handle of the PostgreSQL server+                     -> IO ()+shutdownPostgresFast postgres = do+  withProcessHandle postgres $ \p -> do+    case p of+      ClosedHandle _ -> return ()+      OpenHandle h -> signalProcess sigINT h+  _ <- waitForProcess postgres+  return ()++-- | Run `psql` against a Gargoyle managed db.+psqlLocal :: Gargoyle pid ByteString -- ^ 'Gargoyle' against which to run+          -> FilePath -- ^ The path to `psql`+          -> FilePath -- ^ The path where the managed daemon is expected+          -> Maybe String+          -- ^ Optionally provide stdin input instead of an inheriting current stdin.+          -- It will have a newline and quit command appended to it.+          -> IO ()+psqlLocal g psqlPath dbPath minput = withGargoyle g dbPath $ \dbUri -> do+  void $ installHandler keyboardSignal Ignore Nothing+  let psqlProc = (proc psqlPath [ T.unpack $ T.decodeUtf8 dbUri ])+        { std_in = case minput of+            Nothing -> Inherit+            Just _ -> CreatePipe+        , std_out = Inherit+        , std_err = Inherit+        }+  (mStdin, _, _, psql) <- createProcess psqlProc+  case minput of+    Nothing -> return ()+    Just input -> hPutStrLn (fromJust mStdin) (input ++ "\n\\q")+  ExitSuccess <- waitForProcess psql+  return ()

+ tests/gargoyle-psql-test.hs view

@@ -0,0 +1,20 @@+module Main where++import System.Directory+import System.Exit+import System.FilePath+import System.Posix.Temp++import Gargoyle+import Gargoyle.PostgreSQL++main :: IO ()+main = do+  let testPostgres = defaultPostgres+        { _gargoyle_exec = "dist/build" </> "gargoyle-postgres-monitor/gargoyle-postgres-monitor"+        }+  --TODO make this exception safe+  testPath <- mkdtemp "psql-test"+  psqlLocal testPostgres "psql" (testPath </> "db") (Just "")+  removeDirectoryRecursive testPath+  exitSuccess