{-# LANGUAGE CPP #-}
{-|
Description: Database-specific types and core functions

TsWeb has a strong notion that postgres should be configured in a warm-standby
mode, with read-only queries being shipped to synchronous standbys whenever
possible. This module defines types for descriminating between read-only and
read-write connections, and also functions for making postgres connections,
pools, etc. The 'connect' function is working well enough for me, but will
undoubtedly need to be improved to support the full depth of postgresql
connection options.
-}
module TsWeb.Types.Db
  ( SomeConn
  , ReadOnlyConn
  , ReadWriteConn
  , ReadOnlyPool
  , ReadWritePool
  , ReadOnly
  , ReadWrite
  , HostName
  , DbName
  , SubPools
  , KeepOpen
  , count
  , pool
  , withConnection
  , connect
  , withSavepoint
  , withTransaction
  , readOnly
  , readOnlyDebug
  , readWrite
  , readWriteDebug
  ) where

import qualified Database.Beam.Postgres as PG
import qualified Database.PostgreSQL.Simple as Simple

import Data.Pool (Pool, createPool, withResource)
import Data.Tagged (Tagged(..))
import Data.Time.Clock (NominalDiffTime)
import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
import Database.Beam.Postgres
  ( Connection
  , Pg
  , runBeamPostgres
  , runBeamPostgresDebug
  )
import qualified Database.Beam.Query.Internal as BI

#if MIN_VERSION_beam_core(0, 8, 0)
import Database.Beam.Postgres (Postgres)
#else
import Database.Beam.Postgres.Syntax (PgExpressionSyntax, PgSelectSyntax)
#endif

-- | An example of how @Database.Beam@ does counts; this really doesn't belong
-- here, and was just written for preliminary testing.
#if MIN_VERSION_beam_core(0, 8, 0)
count ::
     (BI.ProjectibleWithPredicate BI.AnyType Postgres (BI.WithExprContext
           (BI.BeamSqlBackendExpressionSyntax' Postgres)) t)
  => Q Postgres db (BI.QNested s0) t
  -> Q Postgres db s0 (QGenExpr QValueContext Postgres s0 Int)
#else
count ::
     BI.ProjectibleWithPredicate BI.AnyType PgExpressionSyntax t
  => Q PgSelectSyntax db (BI.QNested s0) t
  -> Q PgSelectSyntax db s0 (QGenExpr QValueContext PgExpressionSyntax s0 Int)
#endif
count = aggregate_ (const countAll_)

-- | Empty type to mark read-only db connections
data ReadOnly

-- | Empty type to mark read-write db connections
data ReadWrite

-- | Wrapper for some sort of Postgres connection; a raw `SomeConn t`
-- represents either a read-only or a read-write connection, but the concrete
-- `ReadOnlyConn` and `ReadWriteConn` are probably more useful in general.
type SomeConn t = Tagged t Connection

-- | Concrete read-only connection. Instantiate with 'connect'
type ReadOnlyConn = SomeConn ReadOnly

-- | Concrete read-write connection. Instantiate with 'connect'
type ReadWriteConn = SomeConn ReadWrite

-- | Pool of read-only connections. Instantiate with 'pool'
type ReadOnlyPool = Pool ReadOnlyConn

-- | Pool of read-write connections. Instantiate with 'pool'
type ReadWritePool = Pool ReadWriteConn

-- | String alias for the postgres host to connect to
type HostName = String

-- | String alias for the postgres database to connect to
type DbName = String

-- | Int alias for the 'Data.Pool.createPool' function @numStripes@ argument
type SubPools = Int

-- | Int alias for the 'Data.Pool.createPool' function @maxResources@ argument
type KeepOpen = Int

-- | Create a resource pool of either read-only or read-write postgres
-- connections. The docs for `Data.Pool.createPool' give the best description
-- for how this works.
pool ::
     HostName        -- ^Postgres hostname/address
  -> DbName          -- ^Postgres database name
  -> String          -- ^User to connect as
  -> SubPools        -- ^Number of sub-pools to maintain (1 is fine)
  -> NominalDiffTime -- ^How long to let an idle db connection linger
  -> KeepOpen        -- ^Max number of connections per stripe
  -> IO (Pool (SomeConn t))
pool host db username =
  createPool (connect host db username) (PG.close . unTagged)

-- | Run an action in a 'Pool' connection
withConnection :: Pool (SomeConn a) -> (SomeConn a -> IO b) -> IO b
withConnection = withResource

-- | Create a 'ReadOnly' or 'ReadWrite' postgres connection. This doesn't
-- actually check whether the connection is read-only or read-write, so it's
-- really just to help with type juggling.
connect :: HostName -> DbName -> String -> IO (SomeConn t)
connect host db username =
  print db >>
  Tagged <$>
  (PG.connect $
   PG.defaultConnectInfo
     {PG.connectUser = username, PG.connectDatabase = db, PG.connectHost = host})

-- | Run an action within a postgresql savepoint
withSavepoint :: SomeConn t -> IO a -> IO a
withSavepoint (Tagged c) = Simple.withSavepoint c

-- | Run an action within a postgresql transaction
withTransaction :: SomeConn t -> IO a -> IO a
withTransaction (Tagged c) = Simple.withTransaction c

-- | Run a read-only query; this will actually run any query at all, so
-- higher-level logic should ensure that only read-only queries hit this
-- function.
readOnly :: SomeConn t -> Pg a -> IO a
readOnly (Tagged conn) = runBeamPostgres conn

-- | Same as 'readOnly', but prints any SQL that it runs.
readOnlyDebug :: SomeConn t -> Pg a -> IO a
readOnlyDebug (Tagged conn) = runBeamPostgresDebug putStrLn conn

-- | Run a query against a ReadWriteConn
readWrite :: ReadWriteConn -> Pg a -> IO a
readWrite (Tagged conn) = runBeamPostgres conn

-- | Same as 'readWrite', but printing all the SQL that gets executed.
readWriteDebug :: ReadWriteConn -> Pg a -> IO a
readWriteDebug (Tagged conn) = runBeamPostgresDebug putStrLn conn