sandwich-contexts 0.3.0.1 → 0.3.0.2

raw patch · 7 files changed

+108/−43 lines, 7 filesdep ~conduit-extradep ~streaming-commonsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: conduit-extra, streaming-commons

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• lib/Test/Sandwich/Contexts/Container.hs +20/−2
• lib/Test/Sandwich/Contexts/FakeSmtpServer.hs +11/−4
• lib/Test/Sandwich/Contexts/Nix.hs +24/−19
• lib/Test/Sandwich/Contexts/PostgreSQL.hs +45/−10
• lib/Test/Sandwich/Contexts/ReverseProxy/TCP.hs +0/−4
• sandwich-contexts.cabal +4/−4

@@ -1,5 +1,9 @@ # Changelog for sandwich-contexts +## Unreleased++* Add `postgresNixConfExtraLines` to `PostgresNixOptions`, to be able to add extra lines to `postgresql.conf`.+ ## 0.3.0.1  * Automatically find sufficiently short Unix socket paths when the system temp ones are too long

@@ -6,7 +6,10 @@ -}  module Test.Sandwich.Contexts.Container (-  ContainerSystem (..)+  ContainerOptions (..)+  , defaultContainerOptions++  , ContainerSystem (..)   , waitForHealth    -- * Container/host conversions@@ -36,8 +39,23 @@ import UnliftIO.Process  +-- | Type to represent generic options for launching containers.+data ContainerOptions = ContainerOptions {+  containerOptionsSystem :: ContainerSystem+  , containerOptionsName :: Maybe Text+  }+  deriving (Show, Eq)++defaultContainerOptions :: ContainerOptions+defaultContainerOptions = ContainerOptions {+  containerOptionsSystem = ContainerSystemPodman+  , containerOptionsName = Nothing+  }+ -- | Type to represent which container system we're using.-data ContainerSystem = ContainerSystemDocker | ContainerSystemPodman+data ContainerSystem =+  ContainerSystemDocker+  | ContainerSystemPodman   deriving (Eq)  instance Show ContainerSystem where

@@ -44,7 +44,7 @@ import Data.String.Interpolate import GHC.TypeLits import Network.HTTP.Client-import Network.Socket (PortNumber)+import Network.Socket (HostName, PortNumber) import Relude import System.FilePath import System.IO@@ -90,8 +90,10 @@ $(A.deriveJSON (A.defaultOptions { A.fieldLabelModifier = dropNAndCamelCase (length ("emailInfo" :: String)) }) ''EmailInfo)  data FakeSmtpServer = FakeSmtpServer {+  -- | The hostname of the fake SMTP server.+  fakeSmtpServerHostname :: HostName   -- | The port on which the fake SMTP server is running.-  fakeSmtpServerSmtpPort :: PortNumber+  , fakeSmtpServerSmtpPort :: PortNumber   -- | Callback to retrieve the emails the server has received.   , fakeSmtpServerGetEmails :: forall m. (MonadLoggerIO m, MonadUnliftIO m, MonadThrow m) => m [EmailInfo]   }@@ -181,6 +183,7 @@               void $ liftIO (interruptProcessGroupOf p >> waitForProcess p)           )           (\_ -> do+              let hostname = "localhost"               httpPort <- waitForPortFile 120.0 httpPortFile               smtpPort <- waitForPortFile 120.0 smtpPortFile @@ -188,10 +191,14 @@                     Just (username, password) -> [i|#{username}:#{password}@|] :: Text                     Nothing -> "" -              waitUntilStatusCodeWithTimeout (2, 0, 0) (1_000_000 * 60 * 2) YesVerify [i|http://#{authPart}localhost:#{httpPort}/api/emails|]+              waitUntilStatusCodeWithTimeout (2, 0, 0) (1_000_000 * 60 * 2) YesVerify [i|http://#{authPart}#{hostname}:#{httpPort}/api/emails|]                manager <- liftIO $ newManager defaultManagerSettings-              void $ action $ FakeSmtpServer smtpPort (getEmails manager authPart httpPort)+              void $ action $ FakeSmtpServer {+                fakeSmtpServerHostname = hostname+                , fakeSmtpServerSmtpPort = smtpPort+                , fakeSmtpServerGetEmails = getEmails manager authPart httpPort+                }           )  

@@ -31,6 +31,8 @@   introduceNixContext   , introduceNixContext'   , introduceNixContext''+  , makeNixContext+  , makeNixContext'    -- * Nix environments   , introduceNixEnvironment@@ -42,7 +44,7 @@   , buildNixCallPackageDerivation   , buildNixCallPackageDerivation' -  -- * Nixpkgs releases+  -- * Nixpkgs releases #releases#   , nixpkgsReleaseDefault   , nixpkgsRelease2405   , nixpkgsRelease2311@@ -176,14 +178,7 @@   -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()   -- | Parent spec   -> SpecFree context m ()-introduceNixContext' nodeOptions nixpkgsDerivation = introduce' nodeOptions "Introduce Nix context" nixContext getNixContext (const $ return ())-  where-    getNixContext = findExecutable "nix" >>= \case-      Nothing -> expectationFailure [i|Couldn't find "nix" binary when introducing Nix context. A Nix binary and store must already be available in the environment.|]-      Just p -> do-        -- TODO: make sure the Nixpkgs derivation works-        buildCache <- newMVar mempty-        pure (NixContext p nixpkgsDerivation buildCache)+introduceNixContext' nodeOptions nixpkgsDerivation = introduce' nodeOptions "Introduce Nix context" nixContext (makeNixContext nixpkgsDerivation) (const $ return ())  -- | Same as 'introduceNixContext'', but allows specifying the Nix binary via 'HasFile'. introduceNixContext'' :: (@@ -199,19 +194,29 @@   -> SpecFree (LabelValue "nixContext" NixContext :> context) m ()   -- | Parent spec   -> SpecFree context m ()-introduceNixContext'' nodeOptions nixpkgsDerivation = introduce' nodeOptions "Introduce Nix context" nixContext getNixContext (const $ return ())-  where-    getNixContext = do-      nix <- askFile @"nix"-      -- TODO: make sure the Nixpkgs derivation works-      buildCache <- newMVar mempty-      pure (NixContext nix nixpkgsDerivation buildCache)+introduceNixContext'' nodeOptions nixpkgsDerivation = introduce' nodeOptions "Introduce Nix context" nixContext (makeNixContext' nixpkgsDerivation) (const $ return ()) +-- | Build a 'NixContext' directly. Throws an exception if the @nix@ binary is not found.+makeNixContext :: (MonadIO m) => NixpkgsDerivation -> m NixContext+makeNixContext nixpkgsDerivation = findExecutable "nix" >>= \case+  Nothing -> expectationFailure [i|Couldn't find "nix" binary when introducing Nix context. A Nix binary and store must already be available in the environment.|]+  Just p -> do+    -- TODO: make sure the Nixpkgs derivation works+    buildCache <- newMVar mempty+    pure (NixContext p nixpkgsDerivation buildCache)++-- | Build a 'NixContext' directly, specifying the Nix binary via 'HasFile'.+makeNixContext' :: (MonadIO m, MonadReader ctx m, HasFile ctx "nix") => NixpkgsDerivation -> m NixContext+makeNixContext' nixpkgsDerivation = do+  nix <- askFile @"nix"+  buildCache <- newMVar mempty+  pure (NixContext nix nixpkgsDerivation buildCache)+ -- | Introduce a Nix environment containing the given list of packages, using the current 'NixContext'. -- These packages are mashed together using the Nix @symlinkJoin@ function. Their binaries will generally--- be found in "\<environment path\>\/bin".+-- be found in @\<environment path\>\/bin@. introduceNixEnvironment :: (-  HasBaseContextMonad context m, HasNixContext context+  HasBaseContext context, HasNixContext context   , MonadUnliftIO m   )   -- | List of package names to include in the Nix environment@@ -222,7 +227,7 @@  -- | Same as 'introduceNixEnvironment', but allows passing custom 'NodeOptions'. introduceNixEnvironment' :: (-  HasBaseContextMonad context m, HasNixContext context+  HasBaseContext context, HasNixContext context   , MonadUnliftIO m   )   -- | Custom 'NodeOptions'

@@ -22,14 +22,15 @@ -}  module Test.Sandwich.Contexts.PostgreSQL (-#ifndef mingw32_HOST_OS   -- * Raw PostgreSQL via Nix (TCP socket)   introducePostgresViaNix   , withPostgresViaNix+  , withPostgresViaNix'    -- * Raw PostgreSQL via Nix (Unix socket)   , introducePostgresUnixSocketViaNix   , withPostgresUnixSocketViaNix+  , withPostgresUnixSocketViaNix'    -- * Containerized PostgreSQL   , introducePostgresViaContainer@@ -47,10 +48,8 @@    -- * Re-exports   , NetworkAddress(..)-#endif   ) where -#ifndef mingw32_HOST_OS import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift import Control.Monad.Logger@@ -68,8 +67,8 @@ import Test.Sandwich.Contexts.Nix import Test.Sandwich.Contexts.ReverseProxy.TCP import Test.Sandwich.Contexts.Types.Network-import Test.Sandwich.Contexts.Util.UUID (makeUUID) import Test.Sandwich.Contexts.UnixSocketPath+import Test.Sandwich.Contexts.Util.UUID (makeUUID) import UnliftIO.Directory import UnliftIO.Environment import UnliftIO.Exception@@ -96,6 +95,8 @@   -- | Postgres default database. The @postgres@ database is always created, but you   -- can create an additional one here. Defaults to @test@.   , postgresNixDatabase :: Text+  -- | Extra lines to append to `postgresql.conf`+  , postgresNixConfExtraLines :: [Text]   } defaultPostgresNixOptions :: PostgresNixOptions defaultPostgresNixOptions = PostgresNixOptions {@@ -103,6 +104,7 @@   , postgresNixUsername = "postgres"   , postgresNixPassword = "postgres"   , postgresNixDatabase = "test"+  , postgresNixConfExtraLines = []   }  data PostgresContext = PostgresContext {@@ -146,8 +148,23 @@   => PostgresNixOptions   -> (PostgresContext -> m a)   -> m a-withPostgresViaNix opts@(PostgresNixOptions {..}) action = do-  withPostgresUnixSocketViaNix opts $ \unixSocket ->+withPostgresViaNix opts action = do+  nc <- getContext nixContext+  withPostgresViaNix' nc opts action++-- | Lower-level variant of 'withPostgresViaNix'.+withPostgresViaNix' :: (+  HasBaseContextMonad context m+  , MonadUnliftIO m, MonadMask m, MonadFail m, MonadLogger m+  )+  -- | Nix context+  => NixContext+  -- | Options+  -> PostgresNixOptions+  -> (PostgresContext -> m a)+  -> m a+withPostgresViaNix' nc opts@(PostgresNixOptions {..}) action = do+  withPostgresUnixSocketViaNix' nc opts $ \unixSocket ->     withProxyToUnixSocket unixSocket $ \port ->       action $ PostgresContext {         postgresUsername = postgresNixUsername@@ -189,8 +206,22 @@   -> m a withPostgresUnixSocketViaNix (PostgresNixOptions {..}) action = do   postgresBinDir <- (</> "bin") <$> buildNixSymlinkJoin [postgresNixPostgres]-  withPostgresUnixSocket postgresBinDir postgresNixUsername postgresNixPassword postgresNixDatabase action+  withPostgresUnixSocket postgresBinDir postgresNixUsername postgresNixPassword postgresNixDatabase postgresNixConfExtraLines action +-- | Lower-level variant of 'withPostgresUnixSocket'.+withPostgresUnixSocketViaNix' :: (+  HasBaseContextMonad context m+  , MonadUnliftIO m, MonadFail m, MonadMask m, MonadLogger m+  )+  -- | Options+  => NixContext+  -> PostgresNixOptions+  -> (FilePath -> m a)+  -> m a+withPostgresUnixSocketViaNix' nc (PostgresNixOptions {..}) action = do+  postgresBinDir <- (</> "bin") <$> buildNixSymlinkJoin' nc [postgresNixPostgres]+  withPostgresUnixSocket postgresBinDir postgresNixUsername postgresNixPassword postgresNixDatabase postgresNixConfExtraLines action+ -- | The lowest-level raw process version. withPostgresUnixSocket :: (   HasBaseContextMonad context m@@ -204,10 +235,12 @@   -> Text   -- | Database   -> Text+  -- | Extra postgresql.conf lines+  -> [Text]   -- | Action callback   -> (FilePath -> m a)   -> m a-withPostgresUnixSocket postgresBinDir username password database action = do+withPostgresUnixSocket postgresBinDir username password database extraLines action = do   Just dir <- getCurrentFolder   baseDir <- liftIO $ createTempDirectory dir "postgres-nix"   let dbDirName = baseDir </> "db"@@ -243,6 +276,10 @@           T.hPutStr h "\n"           T.hPutStrLn h [i|listen_addresses=''|] +          forM_ extraLines $ \line -> do+            T.hPutStr h "\n"+            T.hPutStrLn h line+         -- Run pg_ctl to start the DB         createProcessWithLogging ((proc (postgresBinDir </> "pg_ctl") [                                       "-D", dbDirName@@ -379,5 +416,3 @@   -- waitForSimpleQuery pc    return pc--#endif

@@ -6,8 +6,6 @@  module Test.Sandwich.Contexts.ReverseProxy.TCP where -#ifndef mingw32_HOST_OS- import Control.Monad.IO.Unlift import Data.Conduit import qualified Data.Conduit.Network as DCN@@ -39,5 +37,3 @@       concurrently_         (runConduit $ DCN.appSource appdata .| DCN.appSink appdataServer)         (runConduit $ DCN.appSource appdataServer .| DCN.appSink appdata)--#endif

@@ -5,12 +5,12 @@ -- see: https://github.com/sol/hpack  name:           sandwich-contexts-version:        0.3.0.1+version:        0.3.0.2 synopsis:       Contexts for the Sandwich test library description:    Please see the <https://codedownio.github.io/sandwich documentation>. author:         Tom McLaughlin maintainer:     tom@codedown.io-copyright:      2024 Tom McLaughlin+copyright:      2025 Tom McLaughlin license:        BSD3 build-type:     Simple extra-source-files:@@ -57,7 +57,7 @@     , aeson     , base >=4.11 && <5     , conduit-    , conduit-extra+    , conduit-extra >=1.3.7     , containers     , exceptions     , filepath@@ -73,7 +73,7 @@     , retry     , safe     , sandwich >=0.3.0.0-    , streaming-commons+    , streaming-commons >=0.2.3.0     , string-interpolate     , temporary     , text