{-# OPTIONS -Wno-redundant-constraints #-} -- | SQLServer helpers. module Harness.Backend.Sqlserver ( livenessCheck, run_, ) where import Control.Concurrent import Control.Exception import Control.Monad.Reader import Data.String import Database.ODBC.SQLServer qualified as Sqlserver import GHC.Stack import Harness.Constants as Constants import System.Process.Typed import Prelude -- | Check that the SQLServer service is live and ready to accept connections. livenessCheck :: HasCallStack => IO () livenessCheck = loop Constants.sqlserverLivenessCheckAttempts where loop 0 = error ("Liveness check failed for SQLServer.") loop attempts = catch ( bracket (Sqlserver.connect Constants.sqlserverConnectInfo) Sqlserver.close (const (pure ())) ) ( \(_failure :: ExitCodeException) -> do threadDelay Constants.sqlserverLivenessCheckIntervalMicroseconds loop (attempts - 1) ) -- | Run a plain SQL string against the server, ignore the -- result. Just checks for errors. run_ :: HasCallStack => String -> IO () run_ query' = catch ( bracket (Sqlserver.connect Constants.sqlserverConnectInfo) Sqlserver.close (\conn -> void (Sqlserver.exec conn (fromString query'))) ) ( \(e :: SomeException) -> error ( unlines [ "SQLServer query error:", show e, "SQL was:", query' ] ) )