ephemeral-pg-0.2.2.0: test/Main.hs

module Main where

import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
import Control.Monad (forM_, replicateM)
import Data.Text qualified as T
import EphemeralPg qualified as Pg
import EphemeralPg.Config qualified as Config
import EphemeralPg.Internal.Cache
  ( CacheKey (..),
    createCache,
    getCacheDirectory,
    restoreFromCache,
  )
import Hasql.Connection qualified as Connection
import System.Directory (createDirectoryIfMissing, doesDirectoryExist, doesFileExist)
import System.FilePath ((</>))
import System.IO.Temp (withSystemTempDirectory)
import Test.Hspec
import Test.QuickCheck

main :: IO ()
main = hspec $ do
  describe "EphemeralPg" $ do
    it "can start and stop a database" $ do
      result <- Pg.with $ \db -> do
        -- Just verify we can get connection settings
        let _settings = Pg.connectionSettings db
        pure ()
      result `shouldSatisfy` isRight

    it "can connect to the database" $ do
      result <- Pg.with $ \db -> do
        connResult <- Connection.acquire (Pg.connectionSettings db)
        case connResult of
          Left err -> fail $ "Connection failed: " <> show err
          Right conn -> do
            Connection.release conn
            pure ()
      result `shouldSatisfy` isRight

    it "can restart a database" $ do
      result <- Pg.with $ \db -> do
        -- Get initial port
        let port1 = db.port

        -- Restart the database
        restartResult <- Pg.restart db
        case restartResult of
          Left err -> fail $ "Restart failed: " <> show err
          Right db' -> do
            -- Verify we can still connect after restart
            connResult <- Connection.acquire (Pg.connectionSettings db')
            case connResult of
              Left err -> fail $ "Connection after restart failed: " <> show err
              Right conn -> do
                Connection.release conn
                -- Port should be the same
                db'.port `shouldBe` port1
      result `shouldSatisfy` isRight

  describe "EphemeralPg caching" $ do
    it "can start with caching enabled" $ do
      result <- Pg.withCached $ \db -> do
        connResult <- Connection.acquire (Pg.connectionSettings db)
        case connResult of
          Left err -> fail $ "Connection failed: " <> show err
          Right conn -> do
            Connection.release conn
            pure ()
      result `shouldSatisfy` isRight

    it "second cached startup is faster" $ do
      -- First run creates the cache
      result1 <- Pg.withCached $ \db -> do
        let _settings = Pg.connectionSettings db
        pure ()
      result1 `shouldSatisfy` isRight

      -- Second run should use the cache
      result2 <- Pg.withCached $ \db -> do
        connResult <- Connection.acquire (Pg.connectionSettings db)
        case connResult of
          Left err -> fail $ "Connection failed: " <> show err
          Right conn -> do
            Connection.release conn
            pure ()
      result2 `shouldSatisfy` isRight

    it "publishes concurrently-created caches atomically" $ do
      withSystemTempDirectory "ephemeral-pg-cache-race-" $ \root -> do
        let key = CacheKey {pgVersion = "test", configHash = "atomic"}
            sourceDir = root </> "source-data"
            restoreDir = root </> "restore-data"

        createDirectoryIfMissing True (sourceDir </> "base")
        writeFile (sourceDir </> "PG_VERSION") "test\n"
        writeFile (sourceDir </> "base" </> "marker") "ok\n"

        done <- replicateM 8 newEmptyMVar
        forM_ done $ \var ->
          forkIO (createCache key sourceDir (Just root) >>= putMVar var)
        results <- traverse takeMVar done
        results `shouldSatisfy` all isRight

        cacheDir <- getCacheDirectory key (Just root)
        doesFileExist (cacheDir </> "data" </> "PG_VERSION") `shouldReturn` True
        doesFileExist (cacheDir </> "data" </> "base" </> "marker") `shouldReturn` True
        doesDirectoryExist (cacheDir </> "data" </> "source-data") `shouldReturn` False

        restoreResult <- restoreFromCache key restoreDir (Just root)
        restoreResult `shouldSatisfy` isRight
        doesFileExist (restoreDir </> "PG_VERSION") `shouldReturn` True

  describe "Config" $ do
    it "satisfies left identity (mempty <> x = x)" $
      property $ \dbName ->
        let x = Config.defaultConfig {Config.databaseName = T.pack dbName}
         in (mempty <> x).databaseName == x.databaseName

    it "satisfies right identity (x <> mempty = x)" $
      property $ \dbName ->
        let x = Config.defaultConfig {Config.databaseName = T.pack dbName}
         in (x <> mempty).databaseName == x.databaseName

    it "satisfies associativity ((x <> y) <> z = x <> (y <> z))" $
      property $ \(n1, n2, n3) ->
        let x = mempty {Config.databaseName = T.pack n1}
            y = mempty {Config.databaseName = T.pack n2}
            z = mempty {Config.databaseName = T.pack n3}
         in ((x <> y) <> z).databaseName
              == (x <> (y <> z)).databaseName

    it "combines postgres settings" $ do
      let c1 = mempty {Config.postgresSettings = [("a", "1")]}
          c2 = mempty {Config.postgresSettings = [("b", "2")]}
          combined = c1 <> c2
      combined.postgresSettings `shouldBe` [("a", "1"), ("b", "2")]

  describe "Socket path validation" $ do
    it "rejects paths that are too long" $ do
      -- Unix socket path limit is typically 104-108 bytes
      -- PostgreSQL adds ".s.PGSQL.<port>" (~17 chars) to the path
      let longPath = replicate 200 'x'
      -- This should fail during startup due to socket path length
      -- We test this indirectly through the config
      length longPath `shouldSatisfy` (> Config.maxSocketPathLength)

isRight :: Either a b -> Bool
isRight (Right _) = True
isRight (Left _) = False