postgres-tmp (empty) → 0.1.0.0

raw patch · 4 files changed

+156/−0 lines, 4 filesdep +basedep +bytestringdep +postgresql-simplesetup-changed

Dependencies added: base, bytestring, postgresql-simple, text

Files

LICENSE +30/−0
Setup.hs +2/−0
postgres-tmp.cabal +29/−0
src/Database/PostgreSQL/Tmp.hs +95/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Moritz Kiefer (c) 2016++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 Moritz Kiefer 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.

+ Setup.hs view

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

+ postgres-tmp.cabal view

@@ -0,0 +1,29 @@+name:                postgres-tmp+version:             0.1.0.0+synopsis:            Create a temporary database that is deleted after performing some operation+description:         Please see README.md+homepage:            https://github.com/cocreature/postgres-tmp#readme+license:             BSD3+license-file:        LICENSE+author:              Moritz Kiefer+maintainer:          moritz.kiefer@purelyfunctional.org+copyright:           2016+category:            Unknown+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10+tested-with:         GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1++library+  hs-source-dirs:      src+  exposed-modules:     Database.PostgreSQL.Tmp+  build-depends:       base >= 4.7 && < 5+                     , bytestring >= 0.10 && < 0.11+                     , postgresql-simple >= 0.5 && < 0.6+                     , text >= 1.2 && < 1.3+  default-language:    Haskell2010+  ghc-options:         -Wall++source-repository head+  type:     git+  location: https://github.com/cocreature/postgres-tmp

+ src/Database/PostgreSQL/Tmp.hs view

@@ -0,0 +1,95 @@+{-| Create temporary postgresql databases.++The main usecase for this are tests where you don’t want to assume that a certain database exists.+-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Database.PostgreSQL.Tmp +  (withTmpDB+  ,withTmpDB'+  ,newRole+  ,newDB+  ,defaultDB) where++import           Control.Applicative (pure)+import           Control.Exception+import           Data.ByteString (ByteString)+import           Data.Coerce+import           Data.Int+import           Data.Monoid+import qualified Data.Text as T+import           Database.PostgreSQL.Simple+import           Database.PostgreSQL.Simple.Types++-- | Connection string for the @postgres@ database owned by the+-- @postgres@ user+defaultDB :: ByteString+defaultDB = "dbname='postgres' user='postgres'"++-- | The data necessary to connect to the temporary database+data DBInfo =+  DBInfo {dbName :: T.Text+         ,roleName :: T.Text} deriving (Show,Read,Eq,Ord)++-- | Convenience wrapper for 'withTmpDB'' using 'defaultDB'+withTmpDB :: (DBInfo -> IO a) -> IO a+withTmpDB = withTmpDB' defaultDB++-- | Create a temporary database and a temporary role that the+-- callback can operate on. After the action has finished the database+-- and the role are destroyed.+--+-- This function assumes that the connection string points to a+-- database containing the tables called @pg_roles@ and @pg_database@+-- and that the user has the @CREATEDB@ and @CREATEROLE@ privileges.+withTmpDB' :: ByteString -> (DBInfo -> IO a) -> IO a+withTmpDB' conStr f =+  bracket (connectPostgreSQL conStr) close $+    \conn ->+       bracket (newRole conn) (dropRole conn) $ \role -> do+       bracket (newDB conn role) (dropDatabase conn) $ \db -> do+         f (DBInfo {dbName = db, roleName = role})++-- | Create a new role that does not already exist and return its name.+--+-- The new role does not have a password and has the @CREATEDB@+-- privilege. The database that the connection points to is assumed to+-- contain a table called @pg_roles@ with a @rolname@ column.+newRole :: Connection -> IO T.Text+newRole conn =+  do (roles :: [Only T.Text]) <- query_ conn "SELECT rolname FROM pg_roles"+     let newName = freshName "tmp" (coerce roles)+     _ <- execute conn "CREATE USER ? WITH CREATEDB" (Only (Identifier newName))+     pure newName++-- | Drop the role.+dropRole :: Connection -> T.Text -> IO Int64+dropRole conn name = execute conn "DROP ROLE ?" (Only (Identifier name))++-- | Create a new database that is owned by the user.+newDB :: Connection -> T.Text -> IO T.Text+newDB conn role =+  do (dbNames :: [Only T.Text]) <- query_ conn "SELECT datname FROM pg_database"+     let newName = freshName "tmp" (coerce dbNames)+     _ <- execute conn "CREATE DATABASE ? OWNER ?" (Identifier newName,Identifier role)+     pure newName++-- | Drop the database.+dropDatabase :: Connection -> T.Text -> IO Int64+dropDatabase conn name =+  execute conn "DROP DATABASE ?" (Only (Identifier name))++-- | Create a fresh name that is not in the list of already existing names.+--+-- The fresh name is generated by appending a number to the supplied+-- template.+freshName :: T.Text -> [T.Text] -> T.Text+freshName template existingNames = loop 0+-- We could use a Set here to speed up the lookup, however the+-- construction of that Set is linear as well so it would only pay off+-- if at least one of the lookups fails.+  where loop :: Int -> T.Text+        loop i =+          if (template <> T.pack (show i)) `elem` existingNames+             then loop (i + 1)+             else (template <> T.pack (show i))