tmp-proc-postgres 0.5.2.3 → 0.5.3.0
raw patch · 4 files changed
+92/−73 lines, 4 filesdep ~postgresql-simple
Dependency ranges changed: postgresql-simple
Files
- ChangeLog.md +10/−0
- src/System/TmpProc/Docker/Postgres.hs +56/−45
- test/Test/TmpProc/Docker/PostgresSpec.hs +18/−22
- tmp-proc-postgres.cabal +8/−6
ChangeLog.md view
@@ -1,5 +1,13 @@ # Revision history for tmp-proc-postgres +`tmp-proc-postgres` uses [PVP Versioning][1].++## 0.5.3.0 -- 2023-08-11++* Extend the upper version bound for postgresql-simple+* Use the new `only` constructor+* Refactor the integration test+ ## 0.5.2.3 -- 2023-07-12 * Extend the version bounds of bytestring to allow 0.12@@ -20,3 +28,5 @@ * First version. Extracted from an unreleased version of the tmp-proc library * Initial upload to hackage++[1]: https://pvp.haskell.org
src/System/TmpProc/Docker/Postgres.hs view
@@ -1,11 +1,12 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_HADDOCK prune not-home #-}-{-|++{- | Copyright : (c) 2020-2021 Tim Emiola SPDX-License-Identifier: BSD3 Maintainer : Tim Emiola <adetokunbo@users.noreply.github.com >@@ -16,11 +17,10 @@ It's also possible to write other instances that launch @postgres@ in different ways; for those, this instance can be used as a reference example.- -} module System.TmpProc.Docker.Postgres ( -- * 'Proc' instance- TmpPostgres(..)+ TmpPostgres (..) -- * Useful definitions , aProc@@ -31,72 +31,82 @@ ) where -import Control.Exception (catch)-import qualified Data.ByteString.Char8 as C8-import Data.String (fromString)-import Data.Text (Text)-import qualified Data.Text as Text--import Database.PostgreSQL.Simple (Connection, SqlError, close,- connectPostgreSQL, execute_)--import System.TmpProc (Connectable (..), HList (..),- HandlesOf, HostIpAddress,- Pinged (..), Proc (..),- ProcHandle (..), SvcURI,- startupAll, withTmpConn)+import Control.Exception (catch)+import qualified Data.ByteString.Char8 as C8+import Data.String (fromString)+import Data.Text (Text)+import qualified Data.Text as Text+import Database.PostgreSQL.Simple+ ( Connection+ , SqlError+ , close+ , connectPostgreSQL+ , execute_+ )+import System.TmpProc+ ( Connectable (..)+ , HList (..)+ , HandlesOf+ , HostIpAddress+ , Pinged (..)+ , Proc (..)+ , ProcHandle (..)+ , SvcURI+ , only+ , startupAll+ , withTmpConn+ ) -{-| A singleton 'HList' containing a 'TmpPostgres'. -}+-- | A singleton 'HList' containing a 'TmpPostgres'. aProc :: HList '[TmpPostgres]-aProc = TmpPostgres [] `HCons` HNil+aProc = only $ TmpPostgres [] -{-| An 'HList' that contains the handle created from 'aProc'. -}+-- | An 'HList' that contains the handle created from 'aProc'. aHandle :: IO (HandlesOf '[TmpPostgres]) aHandle = startupAll aProc -{-| Provides the capability to launch a Postgres database as a @tmp proc@.+{- | Provides the capability to launch a Postgres database as a @tmp proc@. The constructor receives the names of the tables to be dropped on 'reset'.- -}-data TmpPostgres = TmpPostgres [Text]+newtype TmpPostgres = TmpPostgres [Text] -{-| Specifies how to run @postgres@ as a @tmp proc@. -}+-- | Specifies how to run @postgres@ as a @tmp proc@. instance Proc TmpPostgres where type Image TmpPostgres = "postgres:10.6" type Name TmpPostgres = "a-postgres-db"- uriOf = mkUri' runArgs = runArgs' ping = toPinged . connectPostgreSQL . hUri reset = reset' -{-| Specifies how to connect to a tmp @postgres@ db. -}++-- | Specifies how to connect to a tmp @postgres@ db. instance Connectable TmpPostgres where type Conn TmpPostgres = Connection- openConn = connectPostgreSQL . hUri closeConn = close -{-| Makes a uri whose password matches the one specified in 'runArgs''. -}+-- | Makes a uri whose password matches the one specified in 'runArgs''. mkUri' :: HostIpAddress -> SvcURI-mkUri' ip = "postgres://postgres:"- <> dbPassword- <> "@"- <> (C8.pack (Text.unpack ip))- <> "/postgres"+mkUri' ip =+ "postgres://postgres:"+ <> dbPassword+ <> "@"+ <> C8.pack (Text.unpack ip)+ <> "/postgres" dbPassword :: C8.ByteString dbPassword = "mysecretpassword" -{-| Match the password used in 'mkUri''. -}+-- | Match the password used in 'mkUri''. runArgs' :: [Text] runArgs' = [ "-e"@@ -105,16 +115,17 @@ toPinged :: IO a -> IO Pinged-toPinged action = ((action >> pure OK)- `catch` (\(_ :: SqlError) -> pure NotOK))- `catch` (\(_ :: IOError) -> pure NotOK)-+toPinged action =+ ( (action >> pure OK)+ `catch` (\(_ :: SqlError) -> pure NotOK)+ )+ `catch` (\(_ :: IOError) -> pure NotOK) -{-| Empty all rows in the tables, if any are specified. -}+-- | Empty all rows in the tables, if any are specified. reset' :: ProcHandle TmpPostgres -> IO () reset' handle@(ProcHandle {hProc}) = let go (TmpPostgres []) = pure () go (TmpPostgres tables) = withTmpConn handle $ \c -> mapM_ (execute_ c . (fromString . (++) "DELETE FROM ") . Text.unpack) tables- in go hProc+ in go hProc
test/Test/TmpProc/Docker/PostgresSpec.hs view
@@ -1,42 +1,38 @@-{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-}-module Test.TmpProc.Docker.PostgresSpec where--import Test.Hspec-import Test.Hspec.TmpProc+{-# LANGUAGE TypeApplications #-} -import Control.Exception (onException)-import Data.Proxy (Proxy (..))-import Data.Text (Text)-import qualified Data.Text as Text-import Database.PostgreSQL.Simple (execute_)+module Test.TmpProc.Docker.PostgresSpec where -import System.TmpProc.Docker.Postgres+import Control.Exception (onException)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import qualified Data.Text as Text+import Database.PostgreSQL.Simple (execute_)+import System.TmpProc.Docker.Postgres+import Test.Hspec+import Test.Hspec.TmpProc spec :: Spec spec = tdescribe desc $ do beforeAll setupHandles $ afterAll terminateAll $ do context "when accessing from a list of other procs" $ do- context "ixPing" $ do-- it "should succeed" $ \hs- -> ixPing @TmpPostgres Proxy hs `shouldReturn` OK+ it "should succeed" $ \hs ->+ ixPing @TmpPostgres Proxy hs `shouldReturn` OK context "ixReset" $ do-- it "should succeed when accessed by Name" $ \hs- -> ixReset @"a-postgres-db" Proxy hs `shouldReturn` ()+ it "should succeed when accessed by Name" $ \hs ->+ ixReset @"a-postgres-db" Proxy hs `shouldReturn` () - it "should succeed when accessed by Type" $ \hs- -> ixReset @TmpPostgres Proxy hs `shouldReturn` ()+ it "should succeed when accessed by Type" $ \hs ->+ ixReset @TmpPostgres Proxy hs `shouldReturn` () setupHandles :: IO (HList '[ProcHandle TmpPostgres]) setupHandles = do- hs <- startupAll $ testProc `HCons` HNil+ hs <- startupAll $ only testProc initTable hs `onException` terminateAll hs pure hs
tmp-proc-postgres.cabal view
@@ -1,9 +1,9 @@ cabal-version: 3.0 name: tmp-proc-postgres-version: 0.5.2.3-synopsis: Shows how to run a PostgreSQL database as a tmp proc+version: 0.5.3.0+synopsis: Launch a PostgreSQL database in docker using tmp-proc description:- An example of using tmp-proc to launch dockerized PostgreSQL in integration tests.+ Demos how to use tmp-proc to run a PostgreSQL database in docker in a unittest. license: BSD-3-Clause license-file: LICENSE@@ -17,13 +17,15 @@ ChangeLog.md tested-with: GHC == 8.8.4- GHC == 8.10.5 GHC == 8.10.7- GHC == 9.2.2+ GHC == 9.0.2+ GHC == 9.2.8+ GHC == 9.4.5 source-repository head type: git location: https://github.com/adetokunbo/tmp-proc.git+ subdir: tmp-proc-postgres library exposed-modules: System.TmpProc.Docker.Postgres@@ -31,7 +33,7 @@ build-depends: , base >=4.11 && <5 , bytestring >=0.10.8.2 && <0.12.1- , postgresql-simple >=0.5.4 && <0.7+ , postgresql-simple >=0.5.4 && <0.8 , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1 , tmp-proc >=0.5 && <0.6