{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | MSSQL Connection
--
--   This module handles the connection against an MS SQL Server.
--   It defines the connection string, connection pool, default settings,
--   and conversion functions between MSSQL and graphql-engine.
module Hasura.Backends.MSSQL.Connection
  ( MSSQLConnConfiguration (MSSQLConnConfiguration),
    MSSQLSourceConfig (MSSQLSourceConfig, _mscExecCtx, _mscReadReplicas),
    MSSQLConnectionInfo (..),
    MSSQLPoolSettings (..),
    MSSQLExecCtx (..),
    MonadMSSQLTx (..),
    defaultMSSQLMaxConnections,
    createMSSQLPool,
    resizeMSSQLPool,
    getEnv,
    odbcValueToJValue,
    mkMSSQLExecCtx,
    mkMSSQLAnyQueryTx,
    runMSSQLSourceReadTx,
    runMSSQLSourceWriteTx,
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, disjointEitherCodec, optionalFieldOrNull', optionalFieldWithDefault', requiredField')
import Autodocodec qualified as AC
import Autodocodec.Extended (fromEnvCodec)
import Control.Lens (united)
import Control.Monad.Morph (hoist)
import Control.Monad.Trans.Control
import Data.Aeson
import Data.Aeson qualified as J
import Data.Environment qualified as Env
import Data.Has
import Data.Text (pack, unpack)
import Data.Text qualified as T
import Data.Time (localTimeToUTC)
import Database.MSSQL.Pool qualified as MSPool
import Database.MSSQL.Transaction qualified as MSTx
import Database.ODBC.SQLServer qualified as ODBC
import Hasura.Backends.MSSQL.SQL.Error
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.ResizePool

class (MonadError QErr m) => MonadMSSQLTx m where
  liftMSSQLTx :: MSTx.TxE QErr a -> m a

instance (MonadMSSQLTx m) => MonadMSSQLTx (ReaderT s m) where
  liftMSSQLTx :: forall a. TxE QErr a -> ReaderT s m a
liftMSSQLTx = m a -> ReaderT s m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT s m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> ReaderT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadMSSQLTx m => TxE QErr a -> m a
liftMSSQLTx

instance (MonadMSSQLTx m) => MonadMSSQLTx (StateT s m) where
  liftMSSQLTx :: forall a. TxE QErr a -> StateT s m a
liftMSSQLTx = m a -> StateT s m a
forall (m :: * -> *) a. Monad m => m a -> StateT s m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StateT s m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> StateT s m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadMSSQLTx m => TxE QErr a -> m a
liftMSSQLTx

instance (Monoid w, MonadMSSQLTx m) => MonadMSSQLTx (WriterT w m) where
  liftMSSQLTx :: forall a. TxE QErr a -> WriterT w m a
liftMSSQLTx = m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> WriterT w m a)
-> (TxE QErr a -> m a) -> TxE QErr a -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxE QErr a -> m a
forall a. TxE QErr a -> m a
forall (m :: * -> *) a. MonadMSSQLTx m => TxE QErr a -> m a
liftMSSQLTx

instance (MonadIO m) => MonadMSSQLTx (MSTx.TxET QErr m) where
  liftMSSQLTx :: forall a. TxE QErr a -> TxET QErr m a
liftMSSQLTx = (forall a. IO a -> m a) -> TxET QErr IO a -> TxET QErr m a
forall {k} (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> TxET QErr m b -> TxET QErr n b
hoist IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | ODBC connection string for MSSQL server
newtype MSSQLConnectionString = MSSQLConnectionString {MSSQLConnectionString -> Text
unMSSQLConnectionString :: Text}
  deriving (Int -> MSSQLConnectionString -> ShowS
[MSSQLConnectionString] -> ShowS
MSSQLConnectionString -> String
(Int -> MSSQLConnectionString -> ShowS)
-> (MSSQLConnectionString -> String)
-> ([MSSQLConnectionString] -> ShowS)
-> Show MSSQLConnectionString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSSQLConnectionString -> ShowS
showsPrec :: Int -> MSSQLConnectionString -> ShowS
$cshow :: MSSQLConnectionString -> String
show :: MSSQLConnectionString -> String
$cshowList :: [MSSQLConnectionString] -> ShowS
showList :: [MSSQLConnectionString] -> ShowS
Show, MSSQLConnectionString -> MSSQLConnectionString -> Bool
(MSSQLConnectionString -> MSSQLConnectionString -> Bool)
-> (MSSQLConnectionString -> MSSQLConnectionString -> Bool)
-> Eq MSSQLConnectionString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MSSQLConnectionString -> MSSQLConnectionString -> Bool
== :: MSSQLConnectionString -> MSSQLConnectionString -> Bool
$c/= :: MSSQLConnectionString -> MSSQLConnectionString -> Bool
/= :: MSSQLConnectionString -> MSSQLConnectionString -> Bool
Eq, [MSSQLConnectionString] -> Value
[MSSQLConnectionString] -> Encoding
MSSQLConnectionString -> Value
MSSQLConnectionString -> Encoding
(MSSQLConnectionString -> Value)
-> (MSSQLConnectionString -> Encoding)
-> ([MSSQLConnectionString] -> Value)
-> ([MSSQLConnectionString] -> Encoding)
-> ToJSON MSSQLConnectionString
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: MSSQLConnectionString -> Value
toJSON :: MSSQLConnectionString -> Value
$ctoEncoding :: MSSQLConnectionString -> Encoding
toEncoding :: MSSQLConnectionString -> Encoding
$ctoJSONList :: [MSSQLConnectionString] -> Value
toJSONList :: [MSSQLConnectionString] -> Value
$ctoEncodingList :: [MSSQLConnectionString] -> Encoding
toEncodingList :: [MSSQLConnectionString] -> Encoding
ToJSON, Value -> Parser [MSSQLConnectionString]
Value -> Parser MSSQLConnectionString
(Value -> Parser MSSQLConnectionString)
-> (Value -> Parser [MSSQLConnectionString])
-> FromJSON MSSQLConnectionString
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser MSSQLConnectionString
parseJSON :: Value -> Parser MSSQLConnectionString
$cparseJSONList :: Value -> Parser [MSSQLConnectionString]
parseJSONList :: Value -> Parser [MSSQLConnectionString]
FromJSON, Eq MSSQLConnectionString
Eq MSSQLConnectionString
-> (Int -> MSSQLConnectionString -> Int)
-> (MSSQLConnectionString -> Int)
-> Hashable MSSQLConnectionString
Int -> MSSQLConnectionString -> Int
MSSQLConnectionString -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> MSSQLConnectionString -> Int
hashWithSalt :: Int -> MSSQLConnectionString -> Int
$chash :: MSSQLConnectionString -> Int
hash :: MSSQLConnectionString -> Int
Hashable, MSSQLConnectionString -> ()
(MSSQLConnectionString -> ()) -> NFData MSSQLConnectionString
forall a. (a -> ()) -> NFData a
$crnf :: MSSQLConnectionString -> ()
rnf :: MSSQLConnectionString -> ()
NFData)

-- * Orphan instances

instance Hashable MSPool.ConnectionString

instance NFData MSPool.ConnectionString

data InputConnectionString
  = RawString MSPool.ConnectionString
  | FromEnvironment Text
  deriving stock (Int -> InputConnectionString -> ShowS
[InputConnectionString] -> ShowS
InputConnectionString -> String
(Int -> InputConnectionString -> ShowS)
-> (InputConnectionString -> String)
-> ([InputConnectionString] -> ShowS)
-> Show InputConnectionString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputConnectionString -> ShowS
showsPrec :: Int -> InputConnectionString -> ShowS
$cshow :: InputConnectionString -> String
show :: InputConnectionString -> String
$cshowList :: [InputConnectionString] -> ShowS
showList :: [InputConnectionString] -> ShowS
Show, InputConnectionString -> InputConnectionString -> Bool
(InputConnectionString -> InputConnectionString -> Bool)
-> (InputConnectionString -> InputConnectionString -> Bool)
-> Eq InputConnectionString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputConnectionString -> InputConnectionString -> Bool
== :: InputConnectionString -> InputConnectionString -> Bool
$c/= :: InputConnectionString -> InputConnectionString -> Bool
/= :: InputConnectionString -> InputConnectionString -> Bool
Eq, (forall x. InputConnectionString -> Rep InputConnectionString x)
-> (forall x. Rep InputConnectionString x -> InputConnectionString)
-> Generic InputConnectionString
forall x. Rep InputConnectionString x -> InputConnectionString
forall x. InputConnectionString -> Rep InputConnectionString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputConnectionString -> Rep InputConnectionString x
from :: forall x. InputConnectionString -> Rep InputConnectionString x
$cto :: forall x. Rep InputConnectionString x -> InputConnectionString
to :: forall x. Rep InputConnectionString x -> InputConnectionString
Generic)

instance Hashable InputConnectionString

instance NFData InputConnectionString

instance HasCodec InputConnectionString where
  codec :: JSONCodec InputConnectionString
codec =
    (Either ConnectionString Text -> InputConnectionString)
-> (InputConnectionString -> Either ConnectionString Text)
-> Codec
     Value (Either ConnectionString Text) (Either ConnectionString Text)
-> JSONCodec InputConnectionString
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec
      ((ConnectionString -> InputConnectionString)
-> (Text -> InputConnectionString)
-> Either ConnectionString Text
-> InputConnectionString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConnectionString -> InputConnectionString
RawString Text -> InputConnectionString
FromEnvironment)
      (\case RawString ConnectionString
m -> ConnectionString -> Either ConnectionString Text
forall a b. a -> Either a b
Left ConnectionString
m; FromEnvironment Text
wEnv -> Text -> Either ConnectionString Text
forall a b. b -> Either a b
Right Text
wEnv)
      (Codec
   Value (Either ConnectionString Text) (Either ConnectionString Text)
 -> JSONCodec InputConnectionString)
-> Codec
     Value (Either ConnectionString Text) (Either ConnectionString Text)
-> JSONCodec InputConnectionString
forall a b. (a -> b) -> a -> b
$ Codec Value ConnectionString ConnectionString
-> Codec Value Text Text
-> Codec
     Value (Either ConnectionString Text) (Either ConnectionString Text)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value ConnectionString ConnectionString
forall value. HasCodec value => JSONCodec value
codec Codec Value Text Text
fromEnvCodec

instance ToJSON InputConnectionString where
  toJSON :: InputConnectionString -> Value
toJSON =
    \case
      (RawString ConnectionString
m) -> ConnectionString -> Value
forall a. ToJSON a => a -> Value
toJSON ConnectionString
m
      (FromEnvironment Text
wEnv) -> [Pair] -> Value
object [Key
"from_env" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
wEnv]

instance FromJSON InputConnectionString where
  parseJSON :: Value -> Parser InputConnectionString
parseJSON =
    \case
      (Object Object
o) -> Text -> InputConnectionString
FromEnvironment (Text -> InputConnectionString)
-> Parser Text -> Parser InputConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"from_env"
      s :: Value
s@(String Text
_) -> ConnectionString -> InputConnectionString
RawString (ConnectionString -> InputConnectionString)
-> Parser ConnectionString -> Parser InputConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ConnectionString
forall a. FromJSON a => Value -> Parser a
parseJSON Value
s
      Value
_ -> String -> Parser InputConnectionString
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"one of string or object must be provided"

data MSSQLPoolSettings
  = MSSQLPoolSettings
      { MSSQLPoolSettings -> Maybe Int
_mpsMaxConnections :: Maybe Int,
        MSSQLPoolSettings -> Maybe Int
_mpsTotalMaxConnections :: Maybe Int,
        MSSQLPoolSettings -> Int
_mpsIdleTimeout :: Int
      }
  | MSSQLPoolSettingsNoPool
  deriving (Int -> MSSQLPoolSettings -> ShowS
[MSSQLPoolSettings] -> ShowS
MSSQLPoolSettings -> String
(Int -> MSSQLPoolSettings -> ShowS)
-> (MSSQLPoolSettings -> String)
-> ([MSSQLPoolSettings] -> ShowS)
-> Show MSSQLPoolSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSSQLPoolSettings -> ShowS
showsPrec :: Int -> MSSQLPoolSettings -> ShowS
$cshow :: MSSQLPoolSettings -> String
show :: MSSQLPoolSettings -> String
$cshowList :: [MSSQLPoolSettings] -> ShowS
showList :: [MSSQLPoolSettings] -> ShowS
Show, MSSQLPoolSettings -> MSSQLPoolSettings -> Bool
(MSSQLPoolSettings -> MSSQLPoolSettings -> Bool)
-> (MSSQLPoolSettings -> MSSQLPoolSettings -> Bool)
-> Eq MSSQLPoolSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MSSQLPoolSettings -> MSSQLPoolSettings -> Bool
== :: MSSQLPoolSettings -> MSSQLPoolSettings -> Bool
$c/= :: MSSQLPoolSettings -> MSSQLPoolSettings -> Bool
/= :: MSSQLPoolSettings -> MSSQLPoolSettings -> Bool
Eq, (forall x. MSSQLPoolSettings -> Rep MSSQLPoolSettings x)
-> (forall x. Rep MSSQLPoolSettings x -> MSSQLPoolSettings)
-> Generic MSSQLPoolSettings
forall x. Rep MSSQLPoolSettings x -> MSSQLPoolSettings
forall x. MSSQLPoolSettings -> Rep MSSQLPoolSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MSSQLPoolSettings -> Rep MSSQLPoolSettings x
from :: forall x. MSSQLPoolSettings -> Rep MSSQLPoolSettings x
$cto :: forall x. Rep MSSQLPoolSettings x -> MSSQLPoolSettings
to :: forall x. Rep MSSQLPoolSettings x -> MSSQLPoolSettings
Generic)

instance Hashable MSSQLPoolSettings

instance NFData MSSQLPoolSettings

deriving via AC.Autodocodec MSSQLPoolSettings instance ToJSON MSSQLPoolSettings

deriving via AC.Autodocodec MSSQLPoolSettings instance FromJSON MSSQLPoolSettings

instance HasCodec MSSQLPoolSettings where
  codec :: JSONCodec MSSQLPoolSettings
codec =
    JSONCodec MSSQLPoolSettings
-> JSONCodec MSSQLPoolSettings
-> (MSSQLPoolSettings
    -> Either MSSQLPoolSettings MSSQLPoolSettings)
-> JSONCodec MSSQLPoolSettings
forall context input output input' newInput.
Codec context input output
-> Codec context input' output
-> (newInput -> Either input input')
-> Codec context newInput output
AC.matchChoiceCodec JSONCodec MSSQLPoolSettings
codecNoPool JSONCodec MSSQLPoolSettings
codecWithPool MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
toInput
    where
      toInput :: MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
      toInput :: MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
toInput = \case
        p :: MSSQLPoolSettings
p@MSSQLPoolSettingsNoPool {} -> MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
forall a b. a -> Either a b
Left MSSQLPoolSettings
p
        p :: MSSQLPoolSettings
p@MSSQLPoolSettings {} -> MSSQLPoolSettings -> Either MSSQLPoolSettings MSSQLPoolSettings
forall a b. b -> Either a b
Right MSSQLPoolSettings
p

      codecNoPool :: AC.JSONCodec MSSQLPoolSettings
      codecNoPool :: JSONCodec MSSQLPoolSettings
codecNoPool =
        (Bool -> Either String MSSQLPoolSettings)
-> (MSSQLPoolSettings -> Bool)
-> Codec Value Bool Bool
-> JSONCodec MSSQLPoolSettings
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.bimapCodec
          ( \case
              Bool
False -> MSSQLPoolSettings -> Either String MSSQLPoolSettings
forall a b. b -> Either a b
Right MSSQLPoolSettings
MSSQLPoolSettingsNoPool
              Bool
True -> String -> Either String MSSQLPoolSettings
forall a b. a -> Either a b
Left String
"impossible, guarded by 'EqCodec False"
          )
          ( \case
              MSSQLPoolSettings
MSSQLPoolSettingsNoPool -> Bool
False
              MSSQLPoolSettings
_ -> Bool
True
          )
          (Codec Value Bool Bool -> JSONCodec MSSQLPoolSettings)
-> Codec Value Bool Bool -> JSONCodec MSSQLPoolSettings
forall a b. (a -> b) -> a -> b
$ Bool -> Codec Value Bool Bool -> Codec Value Bool Bool
forall input.
(Show input, Eq input) =>
input -> JSONCodec input -> JSONCodec input
AC.EqCodec Bool
False
          (Codec Value Bool Bool -> Codec Value Bool Bool)
-> Codec Value Bool Bool -> Codec Value Bool Bool
forall a b. (a -> b) -> a -> b
$ Text -> ObjectCodec Bool Bool -> Codec Value Bool Bool
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLPoolSettingsNoPool"
          (ObjectCodec Bool Bool -> Codec Value Bool Bool)
-> ObjectCodec Bool Bool -> Codec Value Bool Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ObjectCodec Bool Bool
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"enable" Text
"Whether the connection pool is entirely disabled"

      codecWithPool :: AC.JSONCodec MSSQLPoolSettings
      codecWithPool :: JSONCodec MSSQLPoolSettings
codecWithPool =
        Text
-> ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
-> JSONCodec MSSQLPoolSettings
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLPoolSettings"
          (ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
 -> JSONCodec MSSQLPoolSettings)
-> ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
-> JSONCodec MSSQLPoolSettings
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Maybe Int -> Int -> MSSQLPoolSettings
MSSQLPoolSettings
          (Maybe Int -> Maybe Int -> Int -> MSSQLPoolSettings)
-> Codec Object MSSQLPoolSettings (Maybe Int)
-> Codec
     Object MSSQLPoolSettings (Maybe Int -> Int -> MSSQLPoolSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe Int -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"max_connections" (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
defaultMSSQLMaxConnections)
          ObjectCodec (Maybe Int) (Maybe Int)
-> (MSSQLPoolSettings -> Maybe Int)
-> Codec Object MSSQLPoolSettings (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLPoolSettings -> Maybe Int
_mpsMaxConnections
            Codec
  Object MSSQLPoolSettings (Maybe Int -> Int -> MSSQLPoolSettings)
-> Codec Object MSSQLPoolSettings (Maybe Int)
-> Codec Object MSSQLPoolSettings (Int -> MSSQLPoolSettings)
forall a b.
Codec Object MSSQLPoolSettings (a -> b)
-> Codec Object MSSQLPoolSettings a
-> Codec Object MSSQLPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Int) (Maybe Int)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"total_max_connections"
          ObjectCodec (Maybe Int) (Maybe Int)
-> (MSSQLPoolSettings -> Maybe Int)
-> Codec Object MSSQLPoolSettings (Maybe Int)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLPoolSettings -> Maybe Int
_mpsTotalMaxConnections
            Codec Object MSSQLPoolSettings (Int -> MSSQLPoolSettings)
-> Codec Object MSSQLPoolSettings Int
-> ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
forall a b.
Codec Object MSSQLPoolSettings (a -> b)
-> Codec Object MSSQLPoolSettings a
-> Codec Object MSSQLPoolSettings b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Int -> ObjectCodec Int Int
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"idle_timeout" (MSSQLPoolSettings -> Int
_mpsIdleTimeout MSSQLPoolSettings
defaultMSSQLPoolSettings)
          ObjectCodec Int Int
-> (MSSQLPoolSettings -> Int) -> Codec Object MSSQLPoolSettings Int
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLPoolSettings -> Int
_mpsIdleTimeout

defaultMSSQLMaxConnections :: Int
defaultMSSQLMaxConnections :: Int
defaultMSSQLMaxConnections = Int
50

defaultMSSQLPoolSettings :: MSSQLPoolSettings
defaultMSSQLPoolSettings :: MSSQLPoolSettings
defaultMSSQLPoolSettings =
  MSSQLPoolSettings
    { _mpsMaxConnections :: Maybe Int
_mpsMaxConnections = Maybe Int
forall a. Maybe a
Nothing,
      _mpsTotalMaxConnections :: Maybe Int
_mpsTotalMaxConnections = Maybe Int
forall a. Maybe a
Nothing,
      _mpsIdleTimeout :: Int
_mpsIdleTimeout = Int
5
    }

data MSSQLConnectionInfo = MSSQLConnectionInfo
  { MSSQLConnectionInfo -> InputConnectionString
_mciConnectionString :: InputConnectionString,
    MSSQLConnectionInfo -> MSSQLPoolSettings
_mciPoolSettings :: MSSQLPoolSettings,
    MSSQLConnectionInfo -> TxIsolation
_mciIsolationLevel :: MSTx.TxIsolation
  }
  deriving (Int -> MSSQLConnectionInfo -> ShowS
[MSSQLConnectionInfo] -> ShowS
MSSQLConnectionInfo -> String
(Int -> MSSQLConnectionInfo -> ShowS)
-> (MSSQLConnectionInfo -> String)
-> ([MSSQLConnectionInfo] -> ShowS)
-> Show MSSQLConnectionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSSQLConnectionInfo -> ShowS
showsPrec :: Int -> MSSQLConnectionInfo -> ShowS
$cshow :: MSSQLConnectionInfo -> String
show :: MSSQLConnectionInfo -> String
$cshowList :: [MSSQLConnectionInfo] -> ShowS
showList :: [MSSQLConnectionInfo] -> ShowS
Show, MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool
(MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool)
-> (MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool)
-> Eq MSSQLConnectionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool
== :: MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool
$c/= :: MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool
/= :: MSSQLConnectionInfo -> MSSQLConnectionInfo -> Bool
Eq, (forall x. MSSQLConnectionInfo -> Rep MSSQLConnectionInfo x)
-> (forall x. Rep MSSQLConnectionInfo x -> MSSQLConnectionInfo)
-> Generic MSSQLConnectionInfo
forall x. Rep MSSQLConnectionInfo x -> MSSQLConnectionInfo
forall x. MSSQLConnectionInfo -> Rep MSSQLConnectionInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MSSQLConnectionInfo -> Rep MSSQLConnectionInfo x
from :: forall x. MSSQLConnectionInfo -> Rep MSSQLConnectionInfo x
$cto :: forall x. Rep MSSQLConnectionInfo x -> MSSQLConnectionInfo
to :: forall x. Rep MSSQLConnectionInfo x -> MSSQLConnectionInfo
Generic)

instance Hashable MSSQLConnectionInfo

instance NFData MSSQLConnectionInfo

instance HasCodec MSSQLConnectionInfo where
  codec :: JSONCodec MSSQLConnectionInfo
codec =
    Text
-> ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
-> JSONCodec MSSQLConnectionInfo
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLConnectionInfo"
      (ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
 -> JSONCodec MSSQLConnectionInfo)
-> ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
-> JSONCodec MSSQLConnectionInfo
forall a b. (a -> b) -> a -> b
$ InputConnectionString
-> MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo
MSSQLConnectionInfo
      (InputConnectionString
 -> MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
-> Codec Object MSSQLConnectionInfo InputConnectionString
-> Codec
     Object
     MSSQLConnectionInfo
     (MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec InputConnectionString InputConnectionString
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"connection_string"
      ObjectCodec InputConnectionString InputConnectionString
-> (MSSQLConnectionInfo -> InputConnectionString)
-> Codec Object MSSQLConnectionInfo InputConnectionString
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLConnectionInfo -> InputConnectionString
_mciConnectionString
        Codec
  Object
  MSSQLConnectionInfo
  (MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
-> Codec Object MSSQLConnectionInfo MSSQLPoolSettings
-> Codec
     Object MSSQLConnectionInfo (TxIsolation -> MSSQLConnectionInfo)
forall a b.
Codec Object MSSQLConnectionInfo (a -> b)
-> Codec Object MSSQLConnectionInfo a
-> Codec Object MSSQLConnectionInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"pool_settings"
      ObjectCodec MSSQLPoolSettings MSSQLPoolSettings
-> (MSSQLConnectionInfo -> MSSQLPoolSettings)
-> Codec Object MSSQLConnectionInfo MSSQLPoolSettings
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLConnectionInfo -> MSSQLPoolSettings
_mciPoolSettings
        Codec
  Object MSSQLConnectionInfo (TxIsolation -> MSSQLConnectionInfo)
-> Codec Object MSSQLConnectionInfo TxIsolation
-> ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
forall a b.
Codec Object MSSQLConnectionInfo (a -> b)
-> Codec Object MSSQLConnectionInfo a
-> Codec Object MSSQLConnectionInfo b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> TxIsolation -> Text -> ObjectCodec TxIsolation TxIsolation
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
AC.optionalFieldWithDefault Text
"isolation_level" TxIsolation
MSTx.ReadCommitted Text
isolationLevelDoc
      ObjectCodec TxIsolation TxIsolation
-> (MSSQLConnectionInfo -> TxIsolation)
-> Codec Object MSSQLConnectionInfo TxIsolation
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLConnectionInfo -> TxIsolation
_mciIsolationLevel
    where
      isolationLevelDoc :: Text
isolationLevelDoc =
        [Text] -> Text
T.unwords
          [ Text
"The transaction isolation level in which the queries made to the",
            Text
"source will be run with (default: read-committed)."
          ]

instance ToJSON MSSQLConnectionInfo where
  toJSON :: MSSQLConnectionInfo -> Value
toJSON = Options -> MSSQLConnectionInfo -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON
  toEncoding :: MSSQLConnectionInfo -> Encoding
toEncoding = Options -> MSSQLConnectionInfo -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON

instance FromJSON MSSQLConnectionInfo where
  parseJSON :: Value -> Parser MSSQLConnectionInfo
parseJSON = String
-> (Object -> Parser MSSQLConnectionInfo)
-> Value
-> Parser MSSQLConnectionInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser MSSQLConnectionInfo)
 -> Value -> Parser MSSQLConnectionInfo)
-> (Object -> Parser MSSQLConnectionInfo)
-> Value
-> Parser MSSQLConnectionInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    InputConnectionString
-> MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo
MSSQLConnectionInfo
      (InputConnectionString
 -> MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
-> Parser InputConnectionString
-> Parser (MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Object
o Object -> Key -> Parser InputConnectionString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"database_url") Parser InputConnectionString
-> Parser InputConnectionString -> Parser InputConnectionString
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Object
o Object -> Key -> Parser InputConnectionString
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"connection_string"))
      Parser (MSSQLPoolSettings -> TxIsolation -> MSSQLConnectionInfo)
-> Parser MSSQLPoolSettings
-> Parser (TxIsolation -> MSSQLConnectionInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe MSSQLPoolSettings)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pool_settings"
      Parser (Maybe MSSQLPoolSettings)
-> MSSQLPoolSettings -> Parser MSSQLPoolSettings
forall a. Parser (Maybe a) -> a -> Parser a
.!= MSSQLPoolSettings
defaultMSSQLPoolSettings
      Parser (TxIsolation -> MSSQLConnectionInfo)
-> Parser TxIsolation -> Parser MSSQLConnectionInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe TxIsolation)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"isolation_level"
      Parser (Maybe TxIsolation) -> TxIsolation -> Parser TxIsolation
forall a. Parser (Maybe a) -> a -> Parser a
.!= TxIsolation
MSTx.ReadCommitted

data MSSQLConnConfiguration = MSSQLConnConfiguration
  { MSSQLConnConfiguration -> MSSQLConnectionInfo
_mccConnectionInfo :: MSSQLConnectionInfo,
    MSSQLConnConfiguration -> Maybe (NonEmpty MSSQLConnectionInfo)
_mccReadReplicas :: Maybe (NonEmpty MSSQLConnectionInfo)
  }
  deriving (Int -> MSSQLConnConfiguration -> ShowS
[MSSQLConnConfiguration] -> ShowS
MSSQLConnConfiguration -> String
(Int -> MSSQLConnConfiguration -> ShowS)
-> (MSSQLConnConfiguration -> String)
-> ([MSSQLConnConfiguration] -> ShowS)
-> Show MSSQLConnConfiguration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MSSQLConnConfiguration -> ShowS
showsPrec :: Int -> MSSQLConnConfiguration -> ShowS
$cshow :: MSSQLConnConfiguration -> String
show :: MSSQLConnConfiguration -> String
$cshowList :: [MSSQLConnConfiguration] -> ShowS
showList :: [MSSQLConnConfiguration] -> ShowS
Show, MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool
(MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool)
-> (MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool)
-> Eq MSSQLConnConfiguration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool
== :: MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool
$c/= :: MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool
/= :: MSSQLConnConfiguration -> MSSQLConnConfiguration -> Bool
Eq, (forall x. MSSQLConnConfiguration -> Rep MSSQLConnConfiguration x)
-> (forall x.
    Rep MSSQLConnConfiguration x -> MSSQLConnConfiguration)
-> Generic MSSQLConnConfiguration
forall x. Rep MSSQLConnConfiguration x -> MSSQLConnConfiguration
forall x. MSSQLConnConfiguration -> Rep MSSQLConnConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MSSQLConnConfiguration -> Rep MSSQLConnConfiguration x
from :: forall x. MSSQLConnConfiguration -> Rep MSSQLConnConfiguration x
$cto :: forall x. Rep MSSQLConnConfiguration x -> MSSQLConnConfiguration
to :: forall x. Rep MSSQLConnConfiguration x -> MSSQLConnConfiguration
Generic)

instance Hashable MSSQLConnConfiguration

instance NFData MSSQLConnConfiguration

instance HasCodec MSSQLConnConfiguration where
  codec :: JSONCodec MSSQLConnConfiguration
codec =
    Text
-> ObjectCodec MSSQLConnConfiguration MSSQLConnConfiguration
-> JSONCodec MSSQLConnConfiguration
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"MSSQLConnConfiguration"
      (ObjectCodec MSSQLConnConfiguration MSSQLConnConfiguration
 -> JSONCodec MSSQLConnConfiguration)
-> ObjectCodec MSSQLConnConfiguration MSSQLConnConfiguration
-> JSONCodec MSSQLConnConfiguration
forall a b. (a -> b) -> a -> b
$ MSSQLConnectionInfo
-> Maybe (NonEmpty MSSQLConnectionInfo) -> MSSQLConnConfiguration
MSSQLConnConfiguration
      (MSSQLConnectionInfo
 -> Maybe (NonEmpty MSSQLConnectionInfo) -> MSSQLConnConfiguration)
-> Codec Object MSSQLConnConfiguration MSSQLConnectionInfo
-> Codec
     Object
     MSSQLConnConfiguration
     (Maybe (NonEmpty MSSQLConnectionInfo) -> MSSQLConnConfiguration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"connection_info"
      ObjectCodec MSSQLConnectionInfo MSSQLConnectionInfo
-> (MSSQLConnConfiguration -> MSSQLConnectionInfo)
-> Codec Object MSSQLConnConfiguration MSSQLConnectionInfo
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLConnConfiguration -> MSSQLConnectionInfo
_mccConnectionInfo
        Codec
  Object
  MSSQLConnConfiguration
  (Maybe (NonEmpty MSSQLConnectionInfo) -> MSSQLConnConfiguration)
-> Codec
     Object
     MSSQLConnConfiguration
     (Maybe (NonEmpty MSSQLConnectionInfo))
-> ObjectCodec MSSQLConnConfiguration MSSQLConnConfiguration
forall a b.
Codec Object MSSQLConnConfiguration (a -> b)
-> Codec Object MSSQLConnConfiguration a
-> Codec Object MSSQLConnConfiguration b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (Maybe (NonEmpty MSSQLConnectionInfo))
     (Maybe (NonEmpty MSSQLConnectionInfo))
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalFieldOrNull' Text
"read_replicas"
      ObjectCodec
  (Maybe (NonEmpty MSSQLConnectionInfo))
  (Maybe (NonEmpty MSSQLConnectionInfo))
-> (MSSQLConnConfiguration -> Maybe (NonEmpty MSSQLConnectionInfo))
-> Codec
     Object
     MSSQLConnConfiguration
     (Maybe (NonEmpty MSSQLConnectionInfo))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= MSSQLConnConfiguration -> Maybe (NonEmpty MSSQLConnectionInfo)
_mccReadReplicas

instance FromJSON MSSQLConnConfiguration where
  parseJSON :: Value -> Parser MSSQLConnConfiguration
parseJSON = Options -> Value -> Parser MSSQLConnConfiguration
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

instance ToJSON MSSQLConnConfiguration where
  toJSON :: MSSQLConnConfiguration -> Value
toJSON = Options -> MSSQLConnConfiguration -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}
  toEncoding :: MSSQLConnConfiguration -> Encoding
toEncoding = Options -> MSSQLConnConfiguration -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
hasuraJSON {omitNothingFields :: Bool
omitNothingFields = Bool
True}

createMSSQLPool ::
  (MonadIO m) =>
  (QErrM m) =>
  InputConnectionString ->
  MSPool.ConnectionOptions ->
  Env.Environment ->
  m (MSPool.ConnectionString, MSPool.MSSQLPool)
createMSSQLPool :: forall (m :: * -> *).
(MonadIO m, QErrM m) =>
InputConnectionString
-> ConnectionOptions
-> Environment
-> m (ConnectionString, MSSQLPool)
createMSSQLPool InputConnectionString
iConnString ConnectionOptions
connOptions Environment
env = do
  ConnectionString
connString <- Environment -> InputConnectionString -> m ConnectionString
forall (m :: * -> *).
QErrM m =>
Environment -> InputConnectionString -> m ConnectionString
resolveInputConnectionString Environment
env InputConnectionString
iConnString
  MSSQLPool
pool <- IO MSSQLPool -> m MSSQLPool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MSSQLPool -> m MSSQLPool) -> IO MSSQLPool -> m MSSQLPool
forall a b. (a -> b) -> a -> b
$ ConnectionString -> ConnectionOptions -> IO MSSQLPool
MSPool.initMSSQLPool ConnectionString
connString ConnectionOptions
connOptions
  (ConnectionString, MSSQLPool) -> m (ConnectionString, MSSQLPool)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionString
connString, MSSQLPool
pool)

resolveInputConnectionString ::
  (QErrM m) =>
  Env.Environment ->
  InputConnectionString ->
  m MSPool.ConnectionString
resolveInputConnectionString :: forall (m :: * -> *).
QErrM m =>
Environment -> InputConnectionString -> m ConnectionString
resolveInputConnectionString Environment
env =
  \case
    (RawString ConnectionString
cs) -> ConnectionString -> m ConnectionString
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConnectionString
cs
    (FromEnvironment Text
envVar) -> Text -> ConnectionString
MSPool.ConnectionString (Text -> ConnectionString) -> m Text -> m ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Environment -> Text -> m Text
forall (m :: * -> *). QErrM m => Environment -> Text -> m Text
getEnv Environment
env Text
envVar

getEnv :: (QErrM m) => Env.Environment -> Text -> m Text
getEnv :: forall (m :: * -> *). QErrM m => Environment -> Text -> m Text
getEnv Environment
env Text
k = do
  let mEnv :: Maybe String
mEnv = Environment -> String -> Maybe String
Env.lookupEnv Environment
env (Text -> String
unpack Text
k)
  case Maybe String
mEnv of
    Maybe String
Nothing -> Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text
"environment variable '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not set"
    Just String
envVal -> Text -> m Text
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
pack String
envVal)

type MSSQLRunTx =
  forall m a. (MonadIO m, MonadBaseControl IO m) => MSTx.TxET QErr m a -> ExceptT QErr m a

-- | Execution Context required to execute MSSQL transactions
data MSSQLExecCtx = MSSQLExecCtx
  { -- | A function that runs read-only queries
    MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly :: MSSQLRunTx,
    -- | A function that runs read-write queries; run in a transaction
    MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadWrite :: MSSQLRunTx,
    -- | A function that runs a transaction in the SERIALIZABLE transaction isolation
    --   level. This is mainly intended to run source catalog migrations.
    MSSQLExecCtx -> MSSQLRunTx
mssqlRunSerializableTx :: MSSQLRunTx,
    -- | Destroys connection pools
    MSSQLExecCtx -> IO ()
mssqlDestroyConn :: IO (),
    -- | Resize pools based on number of server instances
    MSSQLExecCtx -> ServerReplicas -> IO SourceResizePoolSummary
mssqlResizePools :: ServerReplicas -> IO SourceResizePoolSummary
  }

-- | Creates a MSSQL execution context for a single primary pool
mkMSSQLExecCtx :: MSTx.TxIsolation -> MSPool.MSSQLPool -> ResizePoolStrategy -> MSSQLExecCtx
mkMSSQLExecCtx :: TxIsolation -> MSSQLPool -> ResizePoolStrategy -> MSSQLExecCtx
mkMSSQLExecCtx TxIsolation
isolationLevel MSSQLPool
pool ResizePoolStrategy
resizeStrategy =
  MSSQLExecCtx
    { mssqlRunReadOnly :: MSSQLRunTx
mssqlRunReadOnly = \TxET QErr m a
tx -> (MSSQLTxError -> QErr)
-> TxIsolation -> TxET QErr m a -> MSSQLPool -> ExceptT QErr m a
forall (m :: * -> *) e a.
(MonadIO m, MonadBaseControl IO m) =>
(MSSQLTxError -> e)
-> TxIsolation -> TxET e m a -> MSSQLPool -> ExceptT e m a
MSTx.runTxE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler TxIsolation
isolationLevel TxET QErr m a
tx MSSQLPool
pool,
      mssqlRunReadWrite :: MSSQLRunTx
mssqlRunReadWrite = \TxET QErr m a
tx -> (MSSQLTxError -> QErr)
-> TxIsolation -> TxET QErr m a -> MSSQLPool -> ExceptT QErr m a
forall (m :: * -> *) e a.
(MonadIO m, MonadBaseControl IO m) =>
(MSSQLTxError -> e)
-> TxIsolation -> TxET e m a -> MSSQLPool -> ExceptT e m a
MSTx.runTxE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler TxIsolation
isolationLevel TxET QErr m a
tx MSSQLPool
pool,
      mssqlRunSerializableTx :: MSSQLRunTx
mssqlRunSerializableTx = \TxET QErr m a
tx -> (MSSQLTxError -> QErr)
-> TxIsolation -> TxET QErr m a -> MSSQLPool -> ExceptT QErr m a
forall (m :: * -> *) e a.
(MonadIO m, MonadBaseControl IO m) =>
(MSSQLTxError -> e)
-> TxIsolation -> TxET e m a -> MSSQLPool -> ExceptT e m a
MSTx.runTxE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler TxIsolation
MSTx.Serializable TxET QErr m a
tx MSSQLPool
pool,
      mssqlDestroyConn :: IO ()
mssqlDestroyConn = MSSQLPool -> IO ()
MSPool.drainMSSQLPool MSSQLPool
pool,
      mssqlResizePools :: ServerReplicas -> IO SourceResizePoolSummary
mssqlResizePools =
        case ResizePoolStrategy
resizeStrategy of
          ResizePoolStrategy
NeverResizePool -> IO SourceResizePoolSummary
-> ServerReplicas -> IO SourceResizePoolSummary
forall a b. a -> b -> a
const (IO SourceResizePoolSummary
 -> ServerReplicas -> IO SourceResizePoolSummary)
-> IO SourceResizePoolSummary
-> ServerReplicas
-> IO SourceResizePoolSummary
forall a b. (a -> b) -> a -> b
$ SourceResizePoolSummary -> IO SourceResizePoolSummary
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourceResizePoolSummary
noPoolsResizedSummary
          ResizePool Int
maxConnections -> Int -> ServerReplicas -> IO SourceResizePoolSummary
resizeMSSQLPool' Int
maxConnections
    }
  where
    resizeMSSQLPool' :: Int -> ServerReplicas -> IO SourceResizePoolSummary
resizeMSSQLPool' Int
maxConnections ServerReplicas
serverReplicas = do
      -- Resize the primary pool
      MSSQLPool -> Int -> ServerReplicas -> IO ()
resizeMSSQLPool MSSQLPool
pool Int
maxConnections ServerReplicas
serverReplicas
      -- Return the summary. Only the primary pool is resized
      SourceResizePoolSummary -> IO SourceResizePoolSummary
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (SourceResizePoolSummary -> IO SourceResizePoolSummary)
-> SourceResizePoolSummary -> IO SourceResizePoolSummary
forall a b. (a -> b) -> a -> b
$ SourceResizePoolSummary
          { _srpsPrimaryResized :: Bool
_srpsPrimaryResized = Bool
True,
            _srpsReadReplicasResized :: Bool
_srpsReadReplicasResized = Bool
False,
            _srpsConnectionSet :: [Text]
_srpsConnectionSet = []
          }

-- | Resize MSSQL pool by setting the number of connections equal to
-- allowed maximum connections across all server instances divided by
-- number of instances
resizeMSSQLPool :: MSPool.MSSQLPool -> Int -> ServerReplicas -> IO ()
resizeMSSQLPool :: MSSQLPool -> Int -> ServerReplicas -> IO ()
resizeMSSQLPool MSSQLPool
mssqlPool Int
maxConnections ServerReplicas
serverReplicas =
  MSSQLPool -> Int -> IO ()
MSPool.resizePool MSSQLPool
mssqlPool (Int
maxConnections Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` ServerReplicas -> Int
getServerReplicasInt ServerReplicas
serverReplicas)

-- | Run any query discarding its results
mkMSSQLAnyQueryTx :: ODBC.Query -> MSTx.TxET QErr IO ()
mkMSSQLAnyQueryTx :: Query -> TxET QErr IO ()
mkMSSQLAnyQueryTx Query
q = do
  [[Value]]
_discard :: [[ODBC.Value]] <- (MSSQLTxError -> QErr) -> Query -> TxET QErr IO [[Value]]
forall (m :: * -> *) a e.
(MonadIO m, FromRow a) =>
(MSSQLTxError -> e) -> Query -> TxET e m [a]
MSTx.multiRowQueryE MSSQLTxError -> QErr
defaultMSSQLTxErrorHandler Query
q
  () -> TxET QErr IO ()
forall a. a -> TxET QErr IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data MSSQLSourceConfig = MSSQLSourceConfig
  { MSSQLSourceConfig -> ConnectionString
_mscConnectionString :: MSPool.ConnectionString,
    MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx :: MSSQLExecCtx,
    -- | Number of read replicas used by the execution context
    MSSQLSourceConfig -> Int
_mscReadReplicas :: Int
  }
  deriving ((forall x. MSSQLSourceConfig -> Rep MSSQLSourceConfig x)
-> (forall x. Rep MSSQLSourceConfig x -> MSSQLSourceConfig)
-> Generic MSSQLSourceConfig
forall x. Rep MSSQLSourceConfig x -> MSSQLSourceConfig
forall x. MSSQLSourceConfig -> Rep MSSQLSourceConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MSSQLSourceConfig -> Rep MSSQLSourceConfig x
from :: forall x. MSSQLSourceConfig -> Rep MSSQLSourceConfig x
$cto :: forall x. Rep MSSQLSourceConfig x -> MSSQLSourceConfig
to :: forall x. Rep MSSQLSourceConfig x -> MSSQLSourceConfig
Generic)

instance Show MSSQLSourceConfig where
  show :: MSSQLSourceConfig -> String
show = ConnectionString -> String
forall a. Show a => a -> String
show (ConnectionString -> String)
-> (MSSQLSourceConfig -> ConnectionString)
-> MSSQLSourceConfig
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSSQLSourceConfig -> ConnectionString
_mscConnectionString

instance Eq MSSQLSourceConfig where
  MSSQLSourceConfig ConnectionString
connStr1 MSSQLExecCtx
_ Int
_ == :: MSSQLSourceConfig -> MSSQLSourceConfig -> Bool
== MSSQLSourceConfig ConnectionString
connStr2 MSSQLExecCtx
_ Int
_ =
    ConnectionString
connStr1 ConnectionString -> ConnectionString -> Bool
forall a. Eq a => a -> a -> Bool
== ConnectionString
connStr2

instance ToJSON MSSQLSourceConfig where
  toJSON :: MSSQLSourceConfig -> Value
toJSON = ConnectionString -> Value
forall a. ToJSON a => a -> Value
toJSON (ConnectionString -> Value)
-> (MSSQLSourceConfig -> ConnectionString)
-> MSSQLSourceConfig
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSSQLSourceConfig -> ConnectionString
_mscConnectionString

-- Note: () ~ ScalarTypeParsingContext 'MSSQL but we can't use the type family instance in the Has instance.
instance Has () MSSQLSourceConfig where
  hasLens :: Lens MSSQLSourceConfig ()
hasLens = (() -> f ()) -> MSSQLSourceConfig -> f MSSQLSourceConfig
forall a (f :: * -> *). Functor f => (() -> f ()) -> a -> f a
united

odbcValueToJValue :: ODBC.Value -> J.Value
odbcValueToJValue :: Value -> Value
odbcValueToJValue = \case
  ODBC.TextValue Text
t -> Text -> Value
J.String Text
t
  ODBC.ByteStringValue ByteString
b -> Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt ByteString
b
  ODBC.BinaryValue Binary
b -> Text -> Value
J.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
bsToTxt (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Binary -> ByteString
ODBC.unBinary Binary
b
  ODBC.BoolValue Bool
b -> Bool -> Value
J.Bool Bool
b
  ODBC.DoubleValue Double
d -> Double -> Value
forall a. ToJSON a => a -> Value
J.toJSON Double
d
  ODBC.FloatValue Float
f -> Float -> Value
forall a. ToJSON a => a -> Value
J.toJSON Float
f
  ODBC.IntValue Int
i -> Int -> Value
forall a. ToJSON a => a -> Value
J.toJSON Int
i
  ODBC.ByteValue Word8
b -> Word8 -> Value
forall a. ToJSON a => a -> Value
J.toJSON Word8
b
  ODBC.DayValue Day
d -> Day -> Value
forall a. ToJSON a => a -> Value
J.toJSON Day
d
  ODBC.TimeOfDayValue TimeOfDay
td -> TimeOfDay -> Value
forall a. ToJSON a => a -> Value
J.toJSON TimeOfDay
td
  ODBC.LocalTimeValue LocalTime
l -> LocalTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON LocalTime
l
  Value
ODBC.NullValue -> Value
J.Null
  ODBC.ZonedTimeValue LocalTime
lt TimeZone
tz -> UTCTime -> Value
forall a. ToJSON a => a -> Value
J.toJSON (TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
tz LocalTime
lt)

runMSSQLSourceReadTx ::
  (MonadIO m, MonadBaseControl IO m) =>
  MSSQLSourceConfig ->
  MSTx.TxET QErr m a ->
  m (Either QErr a)
runMSSQLSourceReadTx :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig -> TxET QErr m a -> m (Either QErr a)
runMSSQLSourceReadTx MSSQLSourceConfig
msc =
  ExceptT QErr m a -> m (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m a -> m (Either QErr a))
-> (TxET QErr m a -> ExceptT QErr m a)
-> TxET QErr m a
-> m (Either QErr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadOnly (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
msc)

runMSSQLSourceWriteTx ::
  (MonadIO m, MonadBaseControl IO m) =>
  MSSQLSourceConfig ->
  MSTx.TxET QErr m a ->
  m (Either QErr a)
runMSSQLSourceWriteTx :: forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
MSSQLSourceConfig -> TxET QErr m a -> m (Either QErr a)
runMSSQLSourceWriteTx MSSQLSourceConfig
msc =
  ExceptT QErr m a -> m (Either QErr a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT QErr m a -> m (Either QErr a))
-> (TxET QErr m a -> ExceptT QErr m a)
-> TxET QErr m a
-> m (Either QErr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MSSQLExecCtx -> MSSQLRunTx
mssqlRunReadWrite (MSSQLSourceConfig -> MSSQLExecCtx
_mscExecCtx MSSQLSourceConfig
msc)