mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 01:12:56 +03:00
1a052dd44b
This turns on the `partial-fields` warning, which yells at you if you try and create fields on sum types that end up being partial functions. These are dangerous; we had a bug because we introduced a new case to a data type, making the field accessors partial, and leading to a crash in certain cases. This means that we have introduced a few wrappers in various places where the field names are useful, but we want to avoid partial matches. Unfortunately this can be turned off by prefixing the field name with an underscore. Ideally we would try and avoid exporting any field names with underscores, but lenses make this hard. I have removed some underscores for the areas in which we've seen this break in the past. We will have to be vigilant. [NDAT-794]: https://hasurahq.atlassian.net/browse/NDAT-794?atlOrigin=eyJpIjoiNWRkNTljNzYxNjVmNDY3MDlhMDU5Y2ZhYzA5YTRkZjUiLCJwIjoiZ2l0aHViLWNvbS1KU1cifQ PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9991 GitOrigin-RevId: fd69b1ef999682969f3507f0e97513f983da4da6
95 lines
2.6 KiB
Haskell
95 lines
2.6 KiB
Haskell
-- | MSSQL Connection Pooling
|
|
module Database.MSSQL.Pool
|
|
( -- * Types
|
|
ConnectionString (..),
|
|
ConnectionOptions (..),
|
|
MSSQLPool (..),
|
|
PoolOptions (..),
|
|
|
|
-- * Functions
|
|
initMSSQLPool,
|
|
drainMSSQLPool,
|
|
withMSSQLPool,
|
|
resizePool,
|
|
getInUseConnections,
|
|
)
|
|
where
|
|
|
|
import Autodocodec (HasCodec (codec), dimapCodec)
|
|
import Control.Exception.Lifted
|
|
import Control.Monad.Trans.Control
|
|
import Data.Aeson
|
|
import Data.Pool qualified as Pool
|
|
import Database.ODBC.SQLServer qualified as ODBC
|
|
import Hasura.Prelude (Generic, Text)
|
|
import Prelude
|
|
|
|
-- | ODBC connection string for MSSQL server
|
|
newtype ConnectionString = ConnectionString {unConnectionString :: Text}
|
|
deriving (Show, Eq, ToJSON, FromJSON, Generic)
|
|
|
|
instance HasCodec ConnectionString where
|
|
codec = dimapCodec ConnectionString unConnectionString codec
|
|
|
|
data ConnectionOptions
|
|
= ConnectionOptionsPool PoolOptions
|
|
| ConnectionOptionsNoPool
|
|
deriving (Show, Eq)
|
|
|
|
data PoolOptions = PoolOptions
|
|
{ poConnections :: Int,
|
|
poStripes :: Int,
|
|
poIdleTime :: Int
|
|
}
|
|
deriving (Show, Eq)
|
|
|
|
-- | ODBC connection pool
|
|
data MSSQLPool
|
|
= MSSQLPool (Pool.Pool ODBC.Connection)
|
|
| MSSQLNoPool (IO ODBC.Connection)
|
|
|
|
-- | Initialize an MSSQL pool with given connection configuration
|
|
initMSSQLPool ::
|
|
ConnectionString ->
|
|
ConnectionOptions ->
|
|
IO MSSQLPool
|
|
initMSSQLPool (ConnectionString connString) ConnectionOptionsNoPool = do
|
|
return $ MSSQLNoPool (ODBC.connect connString)
|
|
initMSSQLPool (ConnectionString connString) (ConnectionOptionsPool PoolOptions {..}) = do
|
|
MSSQLPool
|
|
<$> Pool.createPool
|
|
(ODBC.connect connString)
|
|
ODBC.close
|
|
poStripes
|
|
(fromIntegral poIdleTime)
|
|
poConnections
|
|
|
|
-- | Destroy all pool resources
|
|
drainMSSQLPool :: MSSQLPool -> IO ()
|
|
drainMSSQLPool (MSSQLPool pool) =
|
|
Pool.destroyAllResources pool
|
|
drainMSSQLPool MSSQLNoPool {} = return ()
|
|
|
|
withMSSQLPool ::
|
|
(MonadBaseControl IO m) =>
|
|
MSSQLPool ->
|
|
(ODBC.Connection -> m a) ->
|
|
m (Either ODBC.ODBCException a)
|
|
withMSSQLPool (MSSQLPool pool) action = do
|
|
try $ Pool.withResource pool action
|
|
withMSSQLPool (MSSQLNoPool connect) action = do
|
|
try $ bracket (liftBaseWith (const connect)) (\conn -> liftBaseWith (const (ODBC.close conn))) action
|
|
|
|
-- | Resize a pool
|
|
resizePool :: MSSQLPool -> Int -> IO ()
|
|
resizePool (MSSQLPool pool) resizeTo = do
|
|
-- Resize the pool max resources
|
|
Pool.resizePool pool resizeTo
|
|
-- Trim pool by destroying excess resources, if any
|
|
Pool.tryTrimPool pool
|
|
resizePool (MSSQLNoPool {}) _ = return ()
|
|
|
|
getInUseConnections :: MSSQLPool -> IO Int
|
|
getInUseConnections (MSSQLPool pool) = Pool.getInUseResourceCount $ pool
|
|
getInUseConnections MSSQLNoPool {} = return 0
|