-- | The differential-testing harness: a throwaway PostgreSQL container and
-- the comparison combinators.
module Pqi.Conformance.Harness
  ( -- * Container
    containerHook,

    -- * Comparison
    differential,
    differentialConnect,
  )
where

import Control.Exception (bracket, bracket_)
import qualified Data.ByteString.Char8 as ByteString.Char8
import qualified Data.Text as Text
import Data.Unique (hashUnique, newUnique)
import qualified Pqi
import Pqi.Conformance.Prelude
import qualified Pqi.Conformance.Reference as Reference
import Test.Hspec
import qualified TestcontainersPostgresql as TcPg

-- | Boot a single trust-auth PostgreSQL container for the whole spec tree and
-- hand each example a ready conninfo string.
containerHook :: SpecWith ByteString -> Spec
containerHook :: SpecWith ByteString -> Spec
containerHook = (ActionWith (Text, Word16) -> IO ())
-> SpecWith (Text, Word16) -> Spec
forall a.
HasCallStack =>
(ActionWith a -> IO ()) -> SpecWith a -> Spec
aroundAll (Config -> ActionWith (Text, Word16) -> IO ()
TcPg.run Config
config) (SpecWith (Text, Word16) -> Spec)
-> (SpecWith ByteString -> SpecWith (Text, Word16))
-> SpecWith ByteString
-> Spec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ActionWith ByteString -> ActionWith (Text, Word16))
-> SpecWith ByteString -> SpecWith (Text, Word16)
forall a b.
(ActionWith a -> ActionWith b) -> SpecWith a -> SpecWith b
aroundWith ActionWith ByteString -> ActionWith (Text, Word16)
forall {a} {t}. Show a => (ByteString -> t) -> (Text, a) -> t
withConninfo
  where
    config :: Config
config =
      TcPg.Config
        { tagName :: Text
TcPg.tagName = Text
"postgres:17",
          forwardLogs :: Bool
TcPg.forwardLogs = Bool
False,
          auth :: Auth
TcPg.auth = Auth
TcPg.TrustAuth
        }
    withConninfo :: (ByteString -> t) -> (Text, a) -> t
withConninfo ByteString -> t
action (Text
host, a
port) = ByteString -> t
action (Text -> a -> ByteString
forall {a}. Show a => Text -> a -> ByteString
conninfo Text
host a
port)
    conninfo :: Text -> a -> ByteString
conninfo Text
host a
port =
      String -> ByteString
ByteString.Char8.pack
        ( String
"host="
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
host
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" port="
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
port
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" user=postgres dbname=postgres"
        )

-- | Run a scenario on both the candidate and the FFI reference (each on its own
-- fresh connection to the same database) and assert that the two observations
-- are equal.
--
-- Each call creates a fresh database for the scenario and drops it afterwards,
-- so tests are isolated even when the container is shared.
differential ::
  (Eq a, Show a, HasCallStack) =>
  Pqi.Adapter ->
  ByteString ->
  (Pqi.Connection -> IO a) ->
  Expectation
differential :: forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Connection -> IO a) -> IO ()
differential Adapter
adapter ByteString
adminConninfo Connection -> IO a
scenario =
  ByteString -> ActionWith ByteString -> IO ()
forall a. ByteString -> (ByteString -> IO a) -> IO a
withTestDb ByteString
adminConninfo \ByteString
testConninfo -> do
    candidate <- IO Connection
-> (Connection -> IO ()) -> (Connection -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
adapter ByteString
testConninfo) Connection -> IO ()
Pqi.finish Connection -> IO a
scenario
    reference <- bracket (Pqi.connectdb Reference.adapter testConninfo) Pqi.finish scenario
    candidate `shouldBe` reference

-- Create a uniquely named database, run the action against it, and drop it on
-- exit (including on exception). The admin conninfo must point to an existing
-- database (e.g. @dbname=postgres@); the test conninfo appended with the new
-- database name is passed to the action. In libpq keyword=value strings the
-- last occurrence of a keyword wins, so appending @dbname=…@ overrides any
-- earlier value.
withTestDb :: ByteString -> (ByteString -> IO a) -> IO a
withTestDb :: forall a. ByteString -> (ByteString -> IO a) -> IO a
withTestDb ByteString
adminConninfo ByteString -> IO a
action = do
  u <- IO Unique
newUnique
  let dbName = String -> ByteString
ByteString.Char8.pack (String
"lq" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int -> Int
forall a. Num a => a -> a
abs (Unique -> Int
hashUnique Unique
u)))
  bracket_
    (adminExec adminConninfo ("create database " <> dbName))
    (adminExec adminConninfo ("drop database " <> dbName))
    (action (adminConninfo <> " dbname=" <> dbName))

adminExec :: ByteString -> ByteString -> IO ()
adminExec :: ByteString -> ActionWith ByteString
adminExec ByteString
conninfo ByteString
sql = do
  conn <- Adapter -> ByteString -> IO Connection
Pqi.connectdb Adapter
Reference.adapter ByteString
conninfo
  _ <- Pqi.exec conn sql
  Pqi.finish conn

-- | Like 'differential', but for scenarios that exercise connection
-- establishment itself ('Pqi.connectdb' on a broken conninfo,
-- 'Pqi.connectStart', 'Pqi.newNullConnection', ...): instead of an opened
-- connection the scenario receives the conninfo and the adapter to use, and
-- manages any connections it opens itself.
differentialConnect ::
  (Eq a, Show a, HasCallStack) =>
  Pqi.Adapter ->
  ByteString ->
  (Pqi.Adapter -> ByteString -> IO a) ->
  Expectation
differentialConnect :: forall a.
(Eq a, Show a, HasCallStack) =>
Adapter -> ByteString -> (Adapter -> ByteString -> IO a) -> IO ()
differentialConnect Adapter
adapter ByteString
conninfo Adapter -> ByteString -> IO a
scenario = do
  candidate <- Adapter -> ByteString -> IO a
scenario Adapter
adapter ByteString
conninfo
  reference <- scenario Reference.adapter conninfo
  candidate `shouldBe` reference