valiant-fused-effects-0.1.0.0: test/Main.hs

module Main where

import Control.Carrier.Lift (runM)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS8
import Data.Int (Int32)
import Data.Text (Text)
import Valiant (defaultPoolConfig, newPool, closePool)
import Valiant qualified
import Valiant.FusedEffects (fetchAllF, fetchOneF, executeF, runValiantPool)
import PgWire.Pool.Config (PoolConfig (..))
import System.Environment (lookupEnv)
import Test.Hspec
import TestSupport

main :: IO ()
main = hspec $ do
  describe "Valiant.FusedEffects" $ do
    it "fetchAllF returns all rows" $ do
      withTestConnection $ \conn -> withSchema conn $ do
        insertTestUsers conn
        pool <- mkPool
        result <- runM . runValiantPool pool $ fetchAllF stmtListAll ()
        closePool pool
        length result `shouldBe` 5

    it "fetchOneF returns Just for existing row" $ do
      withTestConnection $ \conn -> withSchema conn $ do
        insertTestUsers conn
        pool <- mkPool
        result <- runM . runValiantPool pool $ fetchOneF stmtSelectOne 1
        closePool pool
        case result of
          Just (_, name, _) -> name `shouldBe` "Alice"
          Nothing -> expectationFailure "Expected a row"

    it "fetchOneF returns Nothing for missing row" $ do
      withTestConnection $ \conn -> withSchema conn $ do
        pool <- mkPool
        result <- runM . runValiantPool pool $ fetchOneF stmtSelectOne (-1)
        closePool pool
        result `shouldBe` (Nothing :: Maybe (Int32, Text, Maybe Text))

    it "executeF returns rows affected" $ do
      withTestConnection $ \conn -> withSchema conn $ do
        insertTestUsers conn
        pool <- mkPool
        let stmtDel = Valiant.mkStatement "DELETE FROM users_fused_effects WHERE id = $1" [23] [] "<test>" :: Valiant.Statement Int32 ()
        n <- runM . runValiantPool pool $ executeF stmtDel (1 :: Int32)
        closePool pool
        n `shouldBe` 1

    it "composes multiple operations" $ do
      withTestConnection $ \conn -> withSchema conn $ do
        insertTestUsers conn
        pool <- mkPool
        (users, mUser) <- runM . runValiantPool pool $ do
          us <- fetchAllF stmtListAll ()
          mu <- fetchOneF stmtSelectOne 1
          pure (us, mu)
        closePool pool
        length users `shouldBe` 5
        case mUser of
          Just (_, name, _) -> name `shouldBe` "Alice"
          Nothing -> expectationFailure "Expected a row"

mkPool :: IO Valiant.Pool
mkPool = do
  url <- requireDatabaseUrl'
  newPool defaultPoolConfig { poolConnString = url, poolSize = 2, poolAcquireTimeout = 5 }

requireDatabaseUrl' :: IO ByteString
requireDatabaseUrl' = do
  mUrl <- lookupEnv "DATABASE_URL"
  case mUrl of
    Just url -> pure (BS8.pack url)
    Nothing -> error "DATABASE_URL is not set."