server: mssql_add_source: allow connection strings from environment

GitOrigin-RevId: d51e14bdfbb57b83a453f5954397792cbe81455b

CHANGELOG.md

@@ -1,6 +1,7 @@
 # Hasura GraphQL Engine Changelog
 
 ## Next release
+- server/mssql: `mssql_add_source` can now take connection strings from environment variables
 
 ### Bug fixes and improvements
 (Add entries here in the order of: server, console, cli, docs, others)

server/src-lib/Hasura/Backends/MSSQL/Connection.hs

@@ -10,6 +10,8 @@ import           Data.Aeson
 import           Data.Aeson.Casing
 import           Data.Aeson.TH
 
+import qualified Data.Environment        as Env
+import           Data.Text               (pack, unpack)
 import           Hasura.Incremental      (Cacheable (..))
 import           Hasura.RQL.Types.Error
 
@@ -18,6 +20,30 @@ newtype MSSQLConnectionString
   = MSSQLConnectionString {unMSSQLConnectionString :: Text}
   deriving (Show, Eq, ToJSON, FromJSON, Cacheable, Hashable, NFData, Arbitrary)
 
+data InputConnectionString
+  = RawString !MSSQLConnectionString
+  | FromEnvironment !Text
+  deriving stock (Show, Eq, Generic)
+instance Cacheable InputConnectionString
+instance Hashable InputConnectionString
+instance NFData InputConnectionString
+
+instance Arbitrary InputConnectionString where
+  arbitrary = genericArbitrary
+
+instance ToJSON InputConnectionString where
+  toJSON =
+    \case
+      (RawString m)          -> toJSON m
+      (FromEnvironment wEnv) -> object ["from_env" .= wEnv]
+
+instance FromJSON InputConnectionString where
+  parseJSON =
+    \case
+      (Object o)   -> FromEnvironment <$> o .: "from_env"
+      s@(String _) -> RawString <$> parseJSON s
+      _            -> fail "one of string or object must be provided"
+
 data MSSQLPoolSettings
   = MSSQLPoolSettings
   { _mpsMaxConnections :: !Int
@@ -46,7 +72,7 @@ defaultMSSQLPoolSettings =
 
 data MSSQLConnectionInfo
   = MSSQLConnectionInfo
-  { _mciConnectionString :: !MSSQLConnectionString
+  { _mciConnectionString :: !InputConnectionString
   , _mciPoolSettings     :: !MSSQLPoolSettings
   } deriving (Show, Eq, Generic)
 instance Cacheable MSSQLConnectionInfo
@@ -79,11 +105,39 @@ instance Arbitrary MSSQLConnConfiguration where
 newtype MSSQLPool
   = MSSQLPool { unMSSQLPool :: Pool.Pool ODBC.Connection }
 
-createMSSQLPool :: MSSQLConnectionInfo -> IO MSSQLPool
-createMSSQLPool (MSSQLConnectionInfo connString MSSQLPoolSettings{..}) =
-  MSSQLPool <$>
-    Pool.createPool (ODBC.connect $ unMSSQLConnectionString connString)
-    ODBC.close 1 (fromIntegral _mpsIdleTimeout) _mpsMaxConnections
+createMSSQLPool
+  :: MonadIO m
+  => QErrM m
+  => MSSQLConnectionInfo
+  -> m (MSSQLConnectionString, MSSQLPool)
+createMSSQLPool (MSSQLConnectionInfo iConnString MSSQLPoolSettings{..}) = do
+  env        <- liftIO Env.getEnvironment
+  connString <- resolveInputConnectionString env iConnString
+  pool       <- liftIO
+                  $ MSSQLPool
+                  <$> Pool.createPool
+                        (ODBC.connect $ unMSSQLConnectionString connString)
+                        ODBC.close
+                        1
+                        (fromIntegral _mpsIdleTimeout) _mpsMaxConnections
+  pure (connString, pool)
+
+resolveInputConnectionString
+  :: QErrM m
+  => Env.Environment
+  -> InputConnectionString
+  -> m MSSQLConnectionString
+resolveInputConnectionString env =
+  \case
+      (RawString cs)           -> pure cs
+      (FromEnvironment envVar) -> MSSQLConnectionString <$> getEnv env envVar
+
+getEnv :: QErrM m => Env.Environment -> Text -> m Text
+getEnv env k = do
+  let mEnv = Env.lookupEnv env (unpack k)
+  case mEnv of
+    Nothing     -> throw400 NotFound $ "environment variable '" <> k <> "' not set"
+    Just envVal -> return (pack envVal)
 
 drainMSSQLPool :: MSSQLPool -> IO ()
 drainMSSQLPool (MSSQLPool pool) =

server/src-lib/Hasura/Backends/MSSQL/DDL/Source.hs

@@ -19,11 +19,9 @@ resolveSourceConfig
   => SourceName
   -> MSSQLConnConfiguration
   -> m (Either QErr MSSQLSourceConfig)
-resolveSourceConfig _name (MSSQLConnConfiguration connInfo) = do
-  mssqlPool <- liftIO $ createMSSQLPool connInfo
-  pure $ Right $ MSSQLSourceConfig connString mssqlPool
-  where
-    connString = _mciConnectionString connInfo
+resolveSourceConfig _name (MSSQLConnConfiguration connInfo) = runExceptT do
+  (connString, mssqlPool) <- createMSSQLPool connInfo
+  pure $ MSSQLSourceConfig connString mssqlPool
 
 resolveDatabaseMetadata
   :: (MonadIO m)