-- |
-- An interface for testing @hasql@ queries. As @hasql@ is a pretty low-level
-- library and does not provide additional checks in compile time we are 
-- interested if the queries are well-formed from the database point of view.
-- 
-- This library provides a number of tests that helps to check that the
-- basic properties are held. In order to run the tests, the library provides
-- helpers for running the temporary database.
--
module Test.Database.Hasql
  ( -- * Running tests
    -- $running-tests
    startupPostgres
  , startupPostgresInit
  , teardownPostgres 
  , allocateConnection
  , freeConnection
  , InitException(..)
    -- * Explain tests
    -- $explain-tests
  , explain
  ) where

import Control.Exception
import Control.Monad.IO.Class
import Data.ByteString (ByteString)
import Data.Profunctor
import Data.Typeable
import Database.Postgres.Temp qualified as Temp
import Hasql.Connection qualified       as HC
import Hasql.Decoders qualified         as HD
import Hasql.Session qualified          as HS
import Hasql.Statement qualified        as HST
import Test.QuickCheck
import Test.Hspec

-- $explain-tests
--
-- Explain tests are the tests that are based on the idea to run
-- @explain@ on the query. It means that if we have some SQL query we run
-- @EXPLAIN $SQL@ and provide some variables. Then we check if this query
-- succeeds.
--
-- If this test passes it guarantees:
--
--   1. that the query is well-formed and that encoders works.
--
-- However it does not check:
--
--   1. If encoder works
--   2. The complexity of the query
--   3. Locks that the query holds

-- | Runs explain test.
--
-- __Note__ In order to run the query we need to substitute parameters,
-- we chose to pass an arbitrary value (using quickcheck), however some values may
-- miss the arbitrary instance, in such cases one can use 'lmap' to map values from
-- the ones that have this interface. I.e.
--
-- @
-- explain (lmap (\() -> constValue) query)
-- @
-- 
explain
  :: (Arbitrary input)
  => HST.Statement input output -- ^ Original statement
  -> HC.Connection -- ^ Connection to the database
  -> Expectation 
explain :: Statement input output -> Connection -> Expectation
explain Statement input output
t Connection
c = do
  let t' :: Statement input ()
t' = case Statement input output
t of
             HST.Statement ByteString
sql Params input
enc Result output
_dec Bool
_ -> ByteString
-> Params input -> Result () -> Bool -> Statement input ()
forall a b.
ByteString -> Params a -> Result b -> Bool -> Statement a b
HST.Statement (ByteString
"EXPLAIN " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sql) Params input
enc Result ()
HD.noResult Bool
False
  input
input <- IO input -> IO input
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO input -> IO input) -> IO input -> IO input
forall a b. (a -> b) -> a -> b
$ Gen input -> IO input
forall a. Gen a -> IO a
generate (Gen input -> IO input) -> Gen input -> IO input
forall a b. (a -> b) -> a -> b
$ Int -> Gen input -> Gen input
forall a. Int -> Gen a -> Gen a
resize Int
2 (Gen input -> Gen input) -> Gen input -> Gen input
forall a b. (a -> b) -> a -> b
$ Gen input
forall a. Arbitrary a => Gen a
arbitrary
  Session () -> Connection -> IO (Either QueryError ())
forall a. Session a -> Connection -> IO (Either QueryError a)
HS.run (input -> Statement input () -> Session ()
forall params result.
params -> Statement params result -> Session result
HS.statement input
input Statement input ()
t') Connection
c IO (Either QueryError ()) -> Either QueryError () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` () -> Either QueryError ()
forall a b. b -> Either a b
Right ()

-- $running-tests
--
-- The library if the test-framework agnostic so it provides only the basic
-- commands that can be used in order to run the tests using differrent frameworks.
--
-- For example, using tasty + tasty-hunit one can do:
-- 
-- @
-- import Test.Tasty
-- import Test.Tasty.HUnit
--
-- main = defaultMain $
--   withResource (startupPostgres) (teardownPostgres) $ \mkDb ->
--     withResource (mkDb >>= allocateConnection) (freeConnection) $ \conn ->
--       tests conn
--
-- tests :: IO HC.Connection -> TestGroup
-- tests mkConn = testGroup "explain-tests"
--   [ testCase "select 1" $ mkConn >>= explain select1
--   ]
-- @

-- | Possible exceptions that may happen during the initialization process
data InitException
  = InitException HS.QueryError
    -- ^ Exception during running of the initialization script
  | ConnectException HC.ConnectionError
    -- ^ Can't allocate connection to the local db
  | PostgresStartException Temp.StartError
    -- ^ We have failed to start the temporary postgres.
  deriving (Int -> InitException -> ShowS
[InitException] -> ShowS
InitException -> String
(Int -> InitException -> ShowS)
-> (InitException -> String)
-> ([InitException] -> ShowS)
-> Show InitException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitException] -> ShowS
$cshowList :: [InitException] -> ShowS
show :: InitException -> String
$cshow :: InitException -> String
showsPrec :: Int -> InitException -> ShowS
$cshowsPrec :: Int -> InitException -> ShowS
Show, Typeable)

instance Exception InitException

-- | Start and initialize the temporary database using the init script.
--
-- Accepts database initialization script that can contain multiple commands
-- and is run in a separate transaction.
--
-- @throws: In case the database initialization fails throws 'InitException'.
startupPostgres :: ByteString -> IO Temp.DB
startupPostgres :: ByteString -> IO DB
startupPostgres ByteString
init_script = (Connection -> Expectation) -> IO DB
startupPostgresInit Connection -> Expectation
script where
  script :: Connection -> Expectation
script Connection
c = do
    Session () -> Connection -> IO (Either QueryError ())
forall a. Session a -> Connection -> IO (Either QueryError a)
HS.run (ByteString -> Session ()
HS.sql ByteString
init_script ) Connection
c IO (Either QueryError ())
-> (Either QueryError () -> Expectation) -> Expectation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right {} -> () -> Expectation
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Left QueryError
e -> InitException -> Expectation
forall e a. Exception e => e -> IO a
throwIO (InitException -> Expectation) -> InitException -> Expectation
forall a b. (a -> b) -> a -> b
$ QueryError -> InitException
InitException QueryError
e

-- | Start and initialize temporary database.
--
-- Accepts database initialization funciton from the user.
--
-- @throws: In case if the database initialization fails throws 'InitException' in
-- addition to any exception that could be thrown by the user function.
startupPostgresInit :: (HC.Connection -> IO ()) -> IO Temp.DB
startupPostgresInit :: (Connection -> Expectation) -> IO DB
startupPostgresInit Connection -> Expectation
run_init = do
  IO (Either StartError DB)
Temp.start IO (Either StartError DB)
-> (Either StartError DB -> IO DB) -> IO DB
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left StartError
e -> InitException -> IO DB
forall e a. Exception e => e -> IO a
throwIO (InitException -> IO DB) -> InitException -> IO DB
forall a b. (a -> b) -> a -> b
$ StartError -> InitException
PostgresStartException StartError
e
    Right DB
db -> do
      Connection
c <- ByteString -> IO (Either ConnectionError Connection)
HC.acquire (DB -> ByteString
Temp.toConnectionString DB
db) IO (Either ConnectionError Connection)
-> (Either ConnectionError Connection -> IO Connection)
-> IO Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
             Left ConnectionError
e -> InitException -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (InitException -> IO Connection) -> InitException -> IO Connection
forall a b. (a -> b) -> a -> b
$ ConnectionError -> InitException
ConnectException ConnectionError
e
             Right Connection
c -> Connection -> IO Connection
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
c
      Connection -> Expectation
run_init Connection
c
      DB -> IO DB
forall (f :: * -> *) a. Applicative f => a -> f a
pure DB
db

-- | Teardown database and associated resources
teardownPostgres :: Temp.DB -> IO ()
teardownPostgres :: DB -> Expectation
teardownPostgres = DB -> Expectation
Temp.stop

-- | Allocates connection to the temporary database
allocateConnection :: Temp.DB -> IO HC.Connection
allocateConnection :: DB -> IO Connection
allocateConnection DB
db = ByteString -> IO (Either ConnectionError Connection)
HC.acquire (DB -> ByteString
Temp.toConnectionString DB
db) IO (Either ConnectionError Connection)
-> (Either ConnectionError Connection -> IO Connection)
-> IO Connection
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Left ConnectionError
e -> InitException -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (InitException -> IO Connection) -> InitException -> IO Connection
forall a b. (a -> b) -> a -> b
$ ConnectionError -> InitException
ConnectException ConnectionError
e
  Right Connection
conn -> Connection -> IO Connection
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection
conn

-- | Frees connection to the temporary database
freeConnection :: HC.Connection -> IO ()
freeConnection :: Connection -> Expectation
freeConnection = Connection -> Expectation
HC.release