orville-postgresql-1.1.0.0: test/Main.hs

module Main
  ( main
  , recheckDBProperty
  )
where

import qualified Control.Monad as Monad
import qualified Hedgehog as HH
import qualified System.Environment as Env
import qualified System.Exit as SE

import qualified Orville.PostgreSQL as Orville

import qualified Test.AutoMigration as AutoMigration
import qualified Test.Connection as Connection
import qualified Test.Cursor as Cursor
import qualified Test.EntityOperations as EntityOperations
import qualified Test.Execution as Execution
import qualified Test.Expr.Aggregate as ExprAggregate
import qualified Test.Expr.ConditionalExpr as ExprConditional
import qualified Test.Expr.Count as ExprCount
import qualified Test.Expr.Cursor as ExprCursor
import qualified Test.Expr.GroupBy as ExprGroupBy
import qualified Test.Expr.GroupByOrderBy as ExprGroupByOrderBy
import qualified Test.Expr.InsertUpdateDelete as ExprInsertUpdateDelete
import qualified Test.Expr.Join as ExprJoin
import qualified Test.Expr.Math as ExprMath
import qualified Test.Expr.OrderBy as ExprOrderBy
import qualified Test.Expr.SequenceDefinition as ExprSequenceDefinition
import qualified Test.Expr.TableDefinition as ExprTableDefinition
import qualified Test.Expr.TableReferenceList as ExprTableReferenceList
import qualified Test.Expr.TextSearch as ExprTextSearch
import qualified Test.Expr.Time as ExprTime
import qualified Test.Expr.Trigger as ExprTrigger
import qualified Test.Expr.Vacuum as ExprVacuum
import qualified Test.Expr.Where as ExprWhere
import qualified Test.Expr.Window as ExprWindow
import qualified Test.FieldDefinition as FieldDefinition
import qualified Test.MarshallError as MarshallError
import qualified Test.PgCatalog as PgCatalog
import qualified Test.PgTime as PgTime
import qualified Test.Plan as Plan
import qualified Test.PostgreSQLAxioms as PostgreSQLAxioms
import qualified Test.Property as Property
import qualified Test.RawSql as RawSql
import qualified Test.ReservedWords as ReservedWords
import qualified Test.SelectOptions as SelectOptions
import qualified Test.Sequence as Sequence
import qualified Test.SqlCommenter as SqlCommenter
import qualified Test.SqlMarshaller as SqlMarshaller
import qualified Test.SqlType as SqlType
import qualified Test.TableDefinition as TableDefinition
import qualified Test.Transaction as Transaction

main :: IO ()
main = do
  pool <- createTestConnectionPool

  summary <-
    Property.checkGroups
      [ Connection.connectionTests pool
      , RawSql.rawSqlTests pool
      , Execution.executionTests pool
      , PgTime.pgTimeTests pool
      , SqlType.sqlTypeTests pool
      , PostgreSQLAxioms.postgreSQLAxiomTests pool
      , ExprAggregate.aggregateTests pool
      , ExprInsertUpdateDelete.insertUpdateDeleteTests pool
      , ExprWhere.whereTests pool
      , ExprOrderBy.orderByTests pool
      , ExprGroupBy.groupByTests pool
      , ExprGroupByOrderBy.groupByOrderByTests pool
      , ExprTableDefinition.tableDefinitionTests pool
      , ExprSequenceDefinition.sequenceDefinitionTests pool
      , ExprCursor.cursorTests pool
      , ExprCount.countTests pool
      , ExprMath.mathTests pool
      , ExprTime.timeTests pool
      , ExprTrigger.triggerTests pool
      , ExprVacuum.vacuumTests
      , ExprJoin.joinTests
      , ExprTableReferenceList.tableReferenceListTests
      , ExprConditional.conditionalTests
      , ExprWindow.windowTests
      , ExprTextSearch.textSearchTests pool
      , FieldDefinition.fieldDefinitionTests pool
      , SqlMarshaller.sqlMarshallerTests
      , MarshallError.marshallErrorTests pool
      , TableDefinition.tableDefinitionTests pool
      , EntityOperations.entityOperationsTests pool
      , SelectOptions.selectOptionsTests
      , ReservedWords.reservedWordsTests pool
      , Transaction.transactionTests pool
      , Sequence.sequenceTests pool
      , Plan.planTests pool
      , PgCatalog.pgCatalogTests pool
      , AutoMigration.autoMigrationTests pool
      , Cursor.cursorTests pool
      , SqlCommenter.sqlCommenterTests pool
      ]

  Monad.unless (Property.allPassed summary) SE.exitFailure

createTestConnectionPool :: IO Orville.ConnectionPool
createTestConnectionPool = do
  connStr <- lookupConnStr
  -- Some tests use more than one connection, so the pool size must be greater
  -- than 1
  Orville.createConnectionPool $
    Orville.ConnectionOptions
      { Orville.connectionString = connStr
      , Orville.connectionNoticeReporting = Orville.DisableNoticeReporting
      , Orville.connectionPoolStripes = Orville.OneStripePerCapability
      , Orville.connectionPoolLingerTime = 10
      , Orville.connectionPoolMaxConnections = Orville.MaxConnectionsPerStripe 2
      }

recheckDBProperty :: HH.Size -> HH.Seed -> Property.NamedDBProperty -> IO ()
recheckDBProperty size seed namedProperty = do
  pool <- createTestConnectionPool
  HH.recheck size seed (snd $ namedProperty pool)

lookupConnStr :: IO String
lookupConnStr = do
  mbConnHostStr <- Env.lookupEnv "TEST_CONN_HOST"
  let
    connStrUserPass = " user=orville_test password=orville"
  case mbConnHostStr of
    Nothing -> fail "TEST_CONN_HOST not set, so we don't know what database to connect to!"
    Just connHost -> pure $ connHost <> connStrUserPass