orville-postgresql-1.0.0.0: test/Test/Execution.hs

module Test.Execution
  ( executionTests
  )
where

import qualified Data.ByteString as BS
import qualified Data.IORef as IORef
import Hedgehog ((===))
import qualified Hedgehog as HH

import qualified Orville.PostgreSQL as Orville
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Test.Property as Property

executionTests :: Orville.ConnectionPool -> Property.Group
executionTests pool =
  Property.group
    "Execution"
    [ prop_executeVoidCallbacks pool
    , prop_executeAndDecodeCallbacks pool
    , prop_executeAndReturnAffectedRows pool
    , prop_executeAndReturnAffectedRowsCallbacks pool
    ]

prop_executeVoidCallbacks :: Property.NamedDBProperty
prop_executeVoidCallbacks =
  Property.singletonNamedDBProperty "exceuteVoid makes execution callbacks" $ \pool -> do
    traceRef <- HH.evalIO $ IORef.newIORef []

    let
      selectOne =
        RawSql.fromString "SELECT 1 as number"

    HH.evalIO . Orville.runOrville pool $
      Orville.localOrvilleState
        ( Orville.addSqlExecutionCallback (appendTrace traceRef "Outer")
            . Orville.addSqlExecutionCallback (appendTrace traceRef "Inner")
        )
        (Orville.executeVoid Orville.SelectQuery selectOne)

    callbackTrace <- HH.evalIO $ IORef.readIORef traceRef
    callbackTrace
      === [ ("Outer", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          , ("Inner", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          ]

prop_executeAndDecodeCallbacks :: Property.NamedDBProperty
prop_executeAndDecodeCallbacks =
  Property.singletonNamedDBProperty "exceuteAndDecode makes execution callbacks" $ \pool -> do
    traceRef <- HH.evalIO $ IORef.newIORef []

    let
      selectOne =
        RawSql.fromString "SELECT 1 as number"

      marshaller =
        Orville.annotateSqlMarshallerEmptyAnnotation $
          Orville.marshallField id (Orville.integerField "number")
    _ <-
      HH.evalIO . Orville.runOrville pool $
        Orville.localOrvilleState
          ( Orville.addSqlExecutionCallback (appendTrace traceRef "Outer")
              . Orville.addSqlExecutionCallback (appendTrace traceRef "Inner")
          )
          (Orville.executeAndDecode Orville.SelectQuery selectOne marshaller)

    callbackTrace <- HH.evalIO $ IORef.readIORef traceRef
    callbackTrace
      === [ ("Outer", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          , ("Inner", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          ]

prop_executeAndReturnAffectedRows :: Property.NamedDBProperty
prop_executeAndReturnAffectedRows =
  Property.singletonNamedDBProperty "executeAndReturnAffectedRows works as advertised" $ \pool -> do
    let
      selectOne =
        RawSql.fromString "SELECT 1 as number"

    affectedRows <-
      HH.evalIO . Orville.runOrville pool $ do
        Orville.executeAndReturnAffectedRows Orville.UpdateQuery selectOne

    affectedRows === 1

prop_executeAndReturnAffectedRowsCallbacks :: Property.NamedDBProperty
prop_executeAndReturnAffectedRowsCallbacks =
  Property.singletonNamedDBProperty "executeAndReturnAffectedRows makes execution callbacks" $ \pool -> do
    traceRef <- HH.evalIO $ IORef.newIORef []

    let
      selectOne =
        RawSql.fromString "SELECT 1 as number"

    _ <-
      HH.evalIO . Orville.runOrville pool $
        Orville.localOrvilleState
          ( Orville.addSqlExecutionCallback (appendTrace traceRef "Outer")
              . Orville.addSqlExecutionCallback (appendTrace traceRef "Inner")
          )
          (Orville.executeAndReturnAffectedRows Orville.SelectQuery selectOne)

    callbackTrace <- HH.evalIO $ IORef.readIORef traceRef
    callbackTrace
      === [ ("Outer", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          , ("Inner", Orville.SelectQuery, RawSql.toExampleBytes selectOne)
          ]

appendTrace ::
  IORef.IORef [(String, Orville.QueryType, BS.ByteString)] ->
  String ->
  Orville.QueryType ->
  RawSql.RawSql ->
  IO a ->
  IO a
appendTrace traceRef label queryType sql action = do
  let
    trace = (label, queryType, RawSql.toExampleBytes sql)
  IORef.modifyIORef traceRef (++ [trace])
  action