tmp-postgres (empty) → 0.1.0.0
raw patch · 8 files changed
+433/−0 lines, 8 filesdep +basedep +bytestringdep +directorysetup-changed
Dependencies added: base, bytestring, directory, hspec, hspec-discover, network, postgresql-simple, process, temporary, tmp-postgres, unix
Files
- LICENSE +30/−0
- README.md +13/−0
- Setup.hs +2/−0
- src/Database/Postgres/Temp.hs +62/−0
- src/Database/Postgres/Temp/Internal.hs +194/−0
- test/Database/Postgres/Temp/InternalSpec.hs +67/−0
- test/Spec.hs +1/−0
- tmp-postgres.cabal +64/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,13 @@+[](http://travis-ci.org/jfischoff/tmp-postgres)+# tmp-postgres++`tmp-postgres` is a libary for greating a temporary `postgres` instance on a random port for testing.++```haskell+result <- start []+case result of+ Left err -> print err+ Right tempDB -> do+ -- Do stuff+ stop tempDB+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Database/Postgres/Temp.hs view
@@ -0,0 +1,62 @@+{-|+This module provides functions greating a temporary postgres instance on a random port for testing.++ @+ result <- 'start' []+ case result of+ Left err -> print err+ Right tempDB -> do+ -- Do stuff+ 'stop' tempDB+ @++The are few different methods for starting @postgres@ which provide different+methods of dealing with @stdout@ and @stderr@.++The start methods use a config based on the one used by [pg_tmp](http://ephemeralpg.org/), but can be overriden+by in different values to the first argument of the start functions.++-}+{-# LANGUAGE RecordWildCards, LambdaCase, ScopedTypeVariables #-}+module Database.Postgres.Temp+ ( -- * Types+ DB (..)+ , StartError (..)+ -- * Starting @postgres@+ -- $options+ , start+ , startAndLogToTmp+ , startWithHandles+ -- * Stopping @postgres@+ , stop+ ) where+import Database.Postgres.Temp.Internal++{- $options+'startWithHandles' is the most general way to start postgres. It allows the user to+pass in it's own handles for @stdout@ and @stderr@. 'start' and 'startAndLogToTmp'+both call 'startWithHandles' passing in different handles. 'start' uses the current+process's @stdout@ and @stderr@ and 'startAndLogToTmp' logs to files in the 'mainDir'.++@postgres@ is started with a default config with the following options:++ @+ listen_addresses = ''+ shared_buffers = 12MB+ fsync = off+ synchronous_commit = off+ full_page_writes = off+ log_min_duration_statement = 0+ log_connections = on+ log_disconnections = on+ unix_socket_directories = {mainDir}+ client_min_messages = ERROR+ @++ Any of the options can be overriden by passing in a different value when starting++ @+ Right db <- 'start' [("log_min_duration_statement", "1000")]+ @++-}
+ src/Database/Postgres/Temp/Internal.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE RecordWildCards, LambdaCase, ScopedTypeVariables #-}+module Database.Postgres.Temp.Internal where+import System.IO.Temp+import System.Process+import System.Process.Internals+import Control.Concurrent+import System.IO+import System.Exit+import System.Directory+import Network.Socket+import Control.Exception+import Data.Typeable++openFreePort :: IO Int+openFreePort = bracket (socket AF_INET Stream defaultProtocol) close $ \s -> do+ localhost <- inet_addr "127.0.0.1"+ bind s (SockAddrInet aNY_PORT localhost)+ listen s 1+ fromIntegral <$> socketPort s++waitForDB :: FilePath -> Int -> IO ()+waitForDB mainDir port+ = handle (\(_ :: IOException) -> threadDelay 10000 >> waitForDB mainDir port)+ $ do bracket+ (socket AF_UNIX Stream 0)+ close+ $ \sock -> connect sock+ $ SockAddrUnix+ $ mainDir ++ "/.s.PGSQL." ++ show port++data DB = DB+ { mainDir :: FilePath+ -- ^ Temporary directory where the unix socket, logs and data directory live.+ , connectionString :: String+ -- ^ PostgreSQL connection string.+ , pid :: ProcessHandle+ -- ^ The process handle for the @postgres@ process.+ }++-- | start postgres and use the current processes stdout and stderr+start :: [(String, String)]+ -- ^ Extra options which override the defaults+ -> IO (Either StartError DB)+start options = startWithHandles options stdout stderr++fourth :: (a, b, c, d) -> d+fourth (_, _, _, x) = x++shellWith :: Handle -> Handle -> String -> CreateProcess+shellWith stdOut stdErr cmd =+ (shell cmd)+ { std_err = UseHandle stdErr+ , std_out = UseHandle stdOut+ }++config :: FilePath -> String+config mainDir = unlines+ [ "listen_addresses = ''"+ , "shared_buffers = 12MB"+ , "fsync = off"+ , "synchronous_commit = off"+ , "full_page_writes = off"+ , "log_min_duration_statement = 0"+ , "log_connections = on"+ , "log_disconnections = on"+ , "unix_socket_directories = '" ++ mainDir ++ "'"+ , "client_min_messages = ERROR"+ ]++data StartError+ = InitDBFailed ExitCode+ | CreateDBFailed ExitCode+ deriving (Show, Eq, Typeable)++instance Exception StartError++throwIfError :: (ExitCode -> StartError) -> ExitCode -> IO ()+throwIfError f e = case e of+ ExitSuccess -> return ()+ _ -> throwIO $ f e++pidString :: ProcessHandle -> IO String+pidString phandle = withProcessHandle phandle (\case+ OpenHandle p -> return $ show p+ ClosedHandle _ -> return ""+ )++runProcessWith :: Handle -> Handle -> String -> String -> IO ExitCode+runProcessWith stdOut stdErr name cmd+ = createProcess_ name (shellWith stdOut stdErr cmd)+ >>= waitForProcess . fourth++-- | Start postgres and pass in handles for stdout and stderr+startWithHandles :: [(String, String)]+ -- ^ Extra options which override the defaults+ -> Handle+ -- ^ @stdout@+ -> Handle+ -- ^ @stderr@+ -> IO (Either StartError DB)+startWithHandles options stdOut stdErr = do+ mainDir <- createTempDirectory "/tmp" "tmp-postgres"+ startWithHandlesAndDir options mainDir stdOut stdErr++startWithHandlesAndDir :: [(String, String)]+ -> FilePath+ -> Handle+ -> Handle+ -> IO (Either StartError DB)+startWithHandlesAndDir = startWithLogger $ \_ -> return ()++data Event+ = InitDB+ | WriteConfig+ | FreePort+ | StartPostgres+ | WaitForDB+ | CreateDB+ | Finished+ deriving (Show, Eq, Enum, Bounded, Ord)++rmDirIgnoreErrors :: FilePath -> IO ()+rmDirIgnoreErrors mainDir =+ removeDirectoryRecursive mainDir `catch` (\(_ :: IOException) -> return ())++startWithLogger :: (Event -> IO ())+ -> [(String, String)]+ -> FilePath+ -> Handle+ -> Handle+ -> IO (Either StartError DB)+startWithLogger logger options mainDir stdOut stdErr = try $ flip onException (rmDirIgnoreErrors mainDir) $ do+ let dataDir = mainDir ++ "/data"++ logger InitDB+ initDBExitCode <- runProcessWith stdOut stdErr "initDB"+ ("initDB --nosync -E UNICODE -A trust -D " ++ dataDir)+ throwIfError InitDBFailed initDBExitCode++ logger WriteConfig+ writeFile (dataDir ++ "/postgresql.conf") $ config mainDir++ logger FreePort+ port <- openFreePort+ -- slight race here, the port might not be free anymore!+ let connectionString = "postgresql:///test?host=" ++ mainDir ++ "&port=" ++ show port+ logger StartPostgres+ let extraOptions = unwords $ map (\(key, value) -> "--" ++ key ++ "=" ++ value) options+ bracketOnError ( fmap (DB mainDir connectionString . fourth)+ $ createProcess_ "postgres"+ ( shellWith stdOut stdErr+ $ "postgres -D "+ ++ dataDir+ ++ " -p "+ ++ show port+ ++ " "+ ++ extraOptions+ )+ )+ stop+ $ \result -> do+ logger WaitForDB+ waitForDB mainDir port++ logger CreateDB+ throwIfError CreateDBFailed =<<+ runProcessWith stdOut stdErr "createDB"+ ( "createDB --host=" ++ mainDir+ ++ " --port=" ++ show port+ ++ " test"+ )++ logger Finished+ return result++-- | Start postgres and log it's all stdout to {'mainDir'}\/output.txt and {'mainDir'}\/error.txt+startAndLogToTmp :: [(String, String)]+ -- ^ Extra options which override the defaults+ -> IO (Either StartError DB)+startAndLogToTmp options = do+ mainDir <- createTempDirectory "/tmp" "tmp-postgres"++ stdOutFile <- openFile (mainDir ++ "/" ++ "output.txt") WriteMode+ stdErrFile <- openFile (mainDir ++ "/" ++ "error.txt") WriteMode++ startWithHandlesAndDir options mainDir stdOutFile stdErrFile++-- | Stop postgres and clean up the temporary database folder.+stop :: DB -> IO ExitCode+stop DB {..} = do+ terminateProcess pid+ result <- waitForProcess pid+ removeDirectoryRecursive mainDir+ return result
+ test/Database/Postgres/Temp/InternalSpec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}+module Database.Postgres.Temp.InternalSpec (main, spec) where+import Test.Hspec+import System.IO.Temp+import Database.Postgres.Temp.Internal+import Data.Typeable+import Control.Exception+import System.IO+import System.Directory+import Control.Monad+import System.Process+import Database.PostgreSQL.Simple+import qualified Data.ByteString.Char8 as BSC+import System.Exit++main :: IO ()+main = hspec spec++mkDevNull :: IO Handle+mkDevNull = openFile "/dev/null" WriteMode++data Except = Except+ deriving (Show, Eq, Typeable)++instance Exception Except++countPostgresProcesses :: IO Int+countPostgresProcesses = length . lines <$> readProcess "pgrep" ["postgres"] []++spec :: Spec+spec = describe "Database.Postgres.Temp.Internal" $ do+ before (createTempDirectory "/tmp" "tmp-postgres") $ after rmDirIgnoreErrors $ describe "startWithLogger/stop" $ do+ forM_ [minBound .. maxBound] $ \event ->+ it ("deletes the temp dir and postgres on exception in " ++ show event) $ \mainFilePath -> do+ -- This is not the best method ... but it works+ beforePostgresCount <- countPostgresProcesses+ shouldThrow+ (startWithLogger (\currentEvent -> when (currentEvent == event) $ throwIO Except) [] mainFilePath stdout stderr)+ (\Except -> True)+ doesDirectoryExist mainFilePath `shouldReturn` False+ countPostgresProcesses `shouldReturn` beforePostgresCount++ it "creates a useful connection string and stop still cleans up" $ \mainFilePath -> do+ beforePostgresCount <- countPostgresProcesses+ stdOut <- mkDevNull+ stdErr <- mkDevNull+ result <- startWithLogger (\_ -> return ()) [] mainFilePath stdOut stdErr+ db <- case result of+ Right x -> return x+ Left err -> error $ show err+ conn <- connectPostgreSQL $ BSC.pack $ connectionString db+ execute_ conn "create table users (id int)"++ stop db `shouldReturn` ExitSuccess+ doesDirectoryExist mainFilePath `shouldReturn` False+ countPostgresProcesses `shouldReturn` beforePostgresCount++ it "can override settings" $ \_ -> do+ let expectedDuration = "100ms"+ bracket (start [("log_min_duration_statement", expectedDuration)])+ (either (\_ -> return ()) (void . stop)) $ \result -> do+ db <- case result of+ Right x -> return x+ Left err -> error $ show err+ conn <- connectPostgreSQL $ BSC.pack $ connectionString db+ [Only actualDuration] <- query_ conn "SHOW log_min_duration_statement"+ actualDuration `shouldBe` expectedDuration
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tmp-postgres.cabal view
@@ -0,0 +1,64 @@+name: tmp-postgres+version: 0.1.0.0+synopsis: Start and stop a temporary postgres for testing+description:+ This module provides functions greating a temporary postgres instance on a random port for testing.+ .+ @+ result <- 'start' []+ case result of+ Left err -> print err+ Right tempDB -> do+ -- Do stuff+ 'stop' tempDB+ @+ .+ The are few different methods for starting @postgres@ which provide different+ methods of dealing with @stdout@ and @stderr@.+ .+ The start methods use a config based on the one used by [pg_tmp](http://ephemeralpg.org/), but can be overriden+ by in different values to the first argument of the start functions.+homepage: https://github.com/jfischoff/tmp-postgres#readme+license: BSD3+license-file: LICENSE+author: Jonathan Fischoff+maintainer: jonathangfischoff@gmail.com+copyright: 2017 Jonathan Fischoff+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Database.Postgres.Temp+ , Database.Postgres.Temp.Internal+ build-depends: base >= 4.7 && < 5+ , temporary+ , process+ , unix+ , directory+ , network+ ghc-options: -Wall+ default-language: Haskell2010++test-suite tmp-postgres-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Database.Postgres.Temp.InternalSpec+ build-depends: base+ , tmp-postgres+ , hspec+ , hspec-discover+ , temporary+ , directory+ , process+ , postgresql-simple+ , bytestring+ ghc-options: -Wall -Wno-unused-do-bind -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/jfischoff/tmp-postgres