sandwich-contexts: more documentation

This commit is contained in:
thomasjm 2024-05-18 02:31:12 -07:00
parent e9f207ddbe
commit 852f25be69
2 changed files with 57 additions and 33 deletions

View File

@ -2,24 +2,28 @@
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Test.Sandwich.Contexts.PostgreSQL ( module Test.Sandwich.Contexts.PostgreSQL (
postgres -- * Raw PostgreSQL via Nix (TCP socket)
, introducePostgres introducePostgresViaNix
, PostgresContext(..)
-- * Raw
, PostgresNixOptions(..)
, defaultPostgresNixOptions
, introducePostgresViaNix
, withPostgresViaNix , withPostgresViaNix
-- * Raw PostgreSQL via Nix (Unix socket)
, introducePostgresUnixSocketViaNix , introducePostgresUnixSocketViaNix
, withPostgresUnixSocketViaNix , withPostgresUnixSocketViaNix
-- * Containers -- * Containerized PostgreSQL
, PostgresContainerOptions(..)
, defaultPostgresContainerOptions
, introducePostgresViaContainer , introducePostgresViaContainer
, withPostgresContainer , withPostgresContainer
-- * Types
, PostgresNixOptions(..)
, defaultPostgresNixOptions
, postgres
, PostgresContext(..)
, PostgresContainerOptions(..)
, defaultPostgresContainerOptions
-- * Re-exports -- * Re-exports
, NetworkAddress(..) , NetworkAddress(..)
) where ) where
@ -95,36 +99,29 @@ data PostgresContext = PostgresContext {
-- initdb -D mydb -- initdb -D mydb
-- echo "listen_addresses=''" >> mydb/postgresql.conf -- echo "listen_addresses=''" >> mydb/postgresql.conf
-- pg_ctl -D mydb -l logfile -o "--unix_socket_directories='$PWD'" start --wait -- pg_ctl -D mydb -l logfile -o "--unix_socket_directories='$PWD'" start --wait
-- pg_ctl -D mydb -l logfile stop --wait -- pg_ctl -D mydb -l logfile stop --wait
introducePostgres :: ( -- | Introduce a PostgreSQL instance, using a suitable package from Nix.
HasBaseContext context, HasNixContext context
, MonadUnliftIO m, MonadMask m
) => PostgresNixOptions -> SpecFree (LabelValue "postgres" PostgresContext :> context) m () -> SpecFree context m ()
introducePostgres opts@(PostgresNixOptions {..}) = introduceWith "PostgreSQL via Nix" postgres $ \action -> do
withPostgresUnixSocketViaNix opts $ \unixSocket -> do
debug [i|Got Postgres unix socket: #{unixSocket}|]
void $ action $ PostgresContext {
postgresUsername = postgresNixUsername
, postgresPassword = postgresNixPassword
, postgresDatabase = postgresNixDatabase
, postgresAddress = NetworkAddressUnix unixSocket
, postgresConnString = [i|postgresql://#{postgresNixUsername}:#{postgresNixPassword}@/#{postgresNixDatabase}?host=#{takeDirectory unixSocket}|]
, postgresContainerAddress = Nothing
}
introducePostgresViaNix :: ( introducePostgresViaNix :: (
HasBaseContext context, HasNixContext context HasBaseContext context, HasNixContext context
, MonadUnliftIO m, MonadMask m , MonadUnliftIO m, MonadMask m
) => PostgresNixOptions -> SpecFree (LabelValue "postgres" PostgresContext :> context) m () -> SpecFree context m () )
-- | Options
=> PostgresNixOptions
-> SpecFree (LabelValue "postgres" PostgresContext :> context) m ()
-> SpecFree context m ()
introducePostgresViaNix opts = introduceWith "PostgreSQL via Nix" postgres $ \action -> introducePostgresViaNix opts = introduceWith "PostgreSQL via Nix" postgres $ \action ->
withPostgresViaNix opts (void . action) withPostgresViaNix opts (void . action)
-- | Bracket-style variant of 'introducePostgresViaNix'.
withPostgresViaNix :: ( withPostgresViaNix :: (
MonadReader context m, HasBaseContext context, HasNixContext context MonadReader context m, HasBaseContext context, HasNixContext context
, MonadUnliftIO m, MonadMask m, MonadFail m, MonadLogger m , MonadUnliftIO m, MonadMask m, MonadFail m, MonadLogger m
) => PostgresNixOptions -> (PostgresContext -> m a) -> m a )
-- | Options
=> PostgresNixOptions
-> (PostgresContext -> m a)
-> m a
withPostgresViaNix opts@(PostgresNixOptions {..}) action = do withPostgresViaNix opts@(PostgresNixOptions {..}) action = do
withPostgresUnixSocketViaNix opts $ \unixSocket -> withPostgresUnixSocketViaNix opts $ \unixSocket ->
withProxyToUnixSocket unixSocket $ \port -> withProxyToUnixSocket unixSocket $ \port ->
@ -137,10 +134,15 @@ withPostgresViaNix opts@(PostgresNixOptions {..}) action = do
, postgresContainerAddress = Nothing , postgresContainerAddress = Nothing
} }
-- | Same as 'introducePostgresViaNix', but the 'postgresAddress' of the 'PostgresContext' will be a Unix socket.
introducePostgresUnixSocketViaNix :: ( introducePostgresUnixSocketViaNix :: (
HasBaseContext context, HasNixContext context HasBaseContext context, HasNixContext context
, MonadUnliftIO m, MonadMask m , MonadUnliftIO m, MonadMask m
) => PostgresNixOptions -> SpecFree (LabelValue "postgres" PostgresContext :> context) m () -> SpecFree context m () )
-- | Options
=> PostgresNixOptions
-> SpecFree (LabelValue "postgres" PostgresContext :> context) m ()
-> SpecFree context m ()
introducePostgresUnixSocketViaNix opts@(PostgresNixOptions {..}) = introduceWith "PostgreSQL via Nix" postgres $ \action -> do introducePostgresUnixSocketViaNix opts@(PostgresNixOptions {..}) = introduceWith "PostgreSQL via Nix" postgres $ \action -> do
withPostgresUnixSocketViaNix opts $ \unixSocket -> do withPostgresUnixSocketViaNix opts $ \unixSocket -> do
void $ action $ PostgresContext { void $ action $ PostgresContext {
@ -152,10 +154,15 @@ introducePostgresUnixSocketViaNix opts@(PostgresNixOptions {..}) = introduceWith
, postgresContainerAddress = Nothing , postgresContainerAddress = Nothing
} }
-- | Bracket-style variant of 'introducePostgresUnixSocketViaNix'.
withPostgresUnixSocketViaNix :: ( withPostgresUnixSocketViaNix :: (
MonadReader context m, HasBaseContext context, HasNixContext context MonadReader context m, HasBaseContext context, HasNixContext context
, MonadUnliftIO m, MonadFail m, MonadMask m, MonadLogger m , MonadUnliftIO m, MonadFail m, MonadMask m, MonadLogger m
) => PostgresNixOptions -> (FilePath -> m a) -> m a )
-- | Options
=> PostgresNixOptions
-> (FilePath -> m a)
-> m a
withPostgresUnixSocketViaNix (PostgresNixOptions {..}) action = do withPostgresUnixSocketViaNix (PostgresNixOptions {..}) action = do
nixEnv <- buildNixSymlinkJoin [postgresNixPostgres] nixEnv <- buildNixSymlinkJoin [postgresNixPostgres]
@ -247,6 +254,7 @@ defaultPostgresContainerOptions = PostgresContainerOptions {
, postgresContainerImage = "docker.io/postgres:15" , postgresContainerImage = "docker.io/postgres:15"
} }
-- | Introduce a PostgresSQL instance via a container (either Docker or Podman).
introducePostgresViaContainer :: ( introducePostgresViaContainer :: (
HasBaseContext context HasBaseContext context
, MonadUnliftIO m, MonadMask m , MonadUnliftIO m, MonadMask m
@ -254,6 +262,7 @@ introducePostgresViaContainer :: (
introducePostgresViaContainer opts = introduceWith "PostgreSQL via container" postgres $ \action -> do introducePostgresViaContainer opts = introduceWith "PostgreSQL via container" postgres $ \action -> do
withPostgresContainer opts (void . action) withPostgresContainer opts (void . action)
-- | Bracket-style variant of 'introducePostgresViaContainer'.
withPostgresContainer :: ( withPostgresContainer :: (
HasCallStack, MonadUnliftIO m, MonadLoggerIO m, MonadMask m, MonadReader context m, HasBaseContext context HasCallStack, MonadUnliftIO m, MonadLoggerIO m, MonadMask m, MonadReader context m, HasBaseContext context
) => PostgresContainerOptions -> (PostgresContext -> m a) -> m a ) => PostgresContainerOptions -> (PostgresContext -> m a) -> m a

View File

@ -1,7 +1,21 @@
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
module Test.Sandwich.Contexts.Types.S3 where module Test.Sandwich.Contexts.Types.S3 (
TestS3Server(..)
, HttpMode(..)
-- * Contexts
, testS3Server
, HasTestS3Server
-- * Endpoints
, testS3ServerEndpoint
, testS3ServerContainerEndpoint
-- * Misc
, s3Protocol
) where
import Data.String.Interpolate import Data.String.Interpolate
import Relude import Relude
@ -12,6 +26,7 @@ import Test.Sandwich.Contexts.Types.Network
testS3Server :: Label "testS3Server" TestS3Server testS3Server :: Label "testS3Server" TestS3Server
testS3Server = Label testS3Server = Label
-- | A generic test S3 server. This can be used by downstream packages like sandwich-contexts-minio.
data TestS3Server = TestS3Server { data TestS3Server = TestS3Server {
testS3ServerAddress :: NetworkAddress testS3ServerAddress :: NetworkAddress
-- | The address of the S3 server within its container, if present. -- | The address of the S3 server within its container, if present.