module IHP.Hasql.Pool (usePoolWithRetry) where

import Prelude
import Control.Exception (throwIO)
import qualified Hasql.Pool as HasqlPool
import qualified Hasql.Session as Hasql
import qualified Hasql.Errors as HasqlErrors
import IHP.ModelSupport.Types (HasqlError(..))

-- | Run a session on the pool, retrying on stale prepared-statement errors.
--
-- After schema changes (e.g. @make db@), pooled connections have stale caches.
-- hasql-pool auto-discards these connections, so retrying cycles through the
-- pool until a fresh connection is created. Retries are bounded to avoid
-- infinite loops if the error is persistent rather than transient.
usePoolWithRetry :: HasqlPool.Pool -> Hasql.Session a -> IO a
usePoolWithRetry :: forall a. Pool -> Session a -> IO a
usePoolWithRetry Pool
pool Session a
session = Int -> IO a
go Int
maxRetries
    where
        -- Generous upper bound. In practice the pool has far fewer connections,
        -- so a fresh connection is reached well before this limit.
        maxRetries :: Int
        maxRetries :: Int
maxRetries = Int
32

        go :: Int -> IO a
go Int
0 = do
            result <- Pool -> Session a -> IO (Either UsageError a)
forall a. Pool -> Session a -> IO (Either UsageError a)
HasqlPool.use Pool
pool Session a
session
            case result of
                Left UsageError
err -> HasqlError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (UsageError -> HasqlError
HasqlError UsageError
err)
                Right a
a -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
        go !Int
n = do
            result <- Pool -> Session a -> IO (Either UsageError a)
forall a. Pool -> Session a -> IO (Either UsageError a)
HasqlPool.use Pool
pool Session a
session
            case result of
                Left UsageError
err
                    | UsageError -> Bool
isCachedPlanError UsageError
err -> Int -> IO a
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                    | Bool
otherwise -> HasqlError -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO (UsageError -> HasqlError
HasqlError UsageError
err)
                Right a
a -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

isCachedPlanError :: HasqlPool.UsageError -> Bool
isCachedPlanError :: UsageError -> Bool
isCachedPlanError (HasqlPool.SessionUsageError SessionError
sessionError) = SessionError -> Bool
isCachedPlanSessionError SessionError
sessionError
isCachedPlanError UsageError
_ = Bool
False

isCachedPlanSessionError :: HasqlErrors.SessionError -> Bool
isCachedPlanSessionError :: SessionError -> Bool
isCachedPlanSessionError (HasqlErrors.StatementSessionError Int
_ Int
_ Text
_ [Text]
_ Bool
_ (HasqlErrors.ServerStatementError (HasqlErrors.ServerError Text
"0A000" Text
_ Maybe Text
_ Maybe Text
_ Maybe Int
_))) = Bool
True
isCachedPlanSessionError (HasqlErrors.StatementSessionError Int
_ Int
_ Text
_ [Text]
_ Bool
_ (HasqlErrors.ServerStatementError (HasqlErrors.ServerError Text
"XX000" Text
_ Maybe Text
_ Maybe Text
_ Maybe Int
_))) = Bool
True
isCachedPlanSessionError (HasqlErrors.ScriptSessionError Text
_ (HasqlErrors.ServerError Text
"0A000" Text
_ Maybe Text
_ Maybe Text
_ Maybe Int
_)) = Bool
True
isCachedPlanSessionError (HasqlErrors.ScriptSessionError Text
_ (HasqlErrors.ServerError Text
"XX000" Text
_ Maybe Text
_ Maybe Text
_ Maybe Int
_)) = Bool
True
isCachedPlanSessionError (HasqlErrors.MissingTypesSessionError HashSet (Maybe Text, Text)
_) = Bool
True
isCachedPlanSessionError (HasqlErrors.StatementSessionError Int
_ Int
_ Text
_ [Text]
_ Bool
_ (HasqlErrors.UnexpectedColumnTypeStatementError Int
_ Word32
_ Word32
_)) = Bool
True
isCachedPlanSessionError SessionError
_ = Bool
False