1
0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-23 15:32:27 +03:00
graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Instances/Execute.hs
Vamshi Surabhi e9f85ce6e6 mssql: connection pooling
GitOrigin-RevId: c1a6509f19a903724ce2b770ae23cbd925b537f8
2021-02-25 18:16:52 +00:00

107 lines
3.2 KiB
Haskell

{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hasura.Backends.MSSQL.Instances.Execute (NoMultiplex(..)) where
import Hasura.Prelude
import qualified Data.Environment as Env
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Database.ODBC.SQLServer as ODBC
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types as HTTP
import Data.Text.Extended
import Hasura.Backends.MSSQL.Connection
import Hasura.Backends.MSSQL.Plan
import Hasura.Backends.MSSQL.ToQuery
import Hasura.EncJSON
import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.Backend
import Hasura.GraphQL.Execute.LiveQuery.Plan
import Hasura.GraphQL.Parser
import Hasura.RQL.Types
import Hasura.Session
instance BackendExecute 'MSSQL where
type PreparedQuery 'MSSQL = Text
type MultiplexedQuery 'MSSQL = NoMultiplex
type ExecutionMonad 'MSSQL = ExceptT QErr IO
getRemoteJoins = const []
mkDBQueryPlan = msDBQueryPlan
mkDBMutationPlan = msDBMutationPlan
mkDBSubscriptionPlan = msDBSubscriptionPlan
-- multiplexed query
newtype NoMultiplex = NoMultiplex (G.Name, ODBC.Query)
instance ToTxt NoMultiplex where
toTxt (NoMultiplex (_name, query)) = toTxt query
-- query
msDBQueryPlan
:: forall m.
( MonadError QErr m
)
=> Env.Environment
-> HTTP.Manager
-> [HTTP.Header]
-> UserInfo
-> [G.Directive G.Name]
-> SourceConfig 'MSSQL
-> QueryDB 'MSSQL (UnpreparedValue 'MSSQL)
-> m ExecutionStep
msDBQueryPlan _env _manager _reqHeaders userInfo _directives sourceConfig qrf = do
select <- fromSelect <$> planNoPlan userInfo qrf
let queryString = ODBC.renderQuery $ toQueryPretty select
pool = _mscConnectionPool sourceConfig
odbcQuery = encJFromText <$> runJSONPathQuery pool (toQueryFlat select)
pure $ ExecStepDB sourceConfig (Just queryString) [] odbcQuery
-- mutation
msDBMutationPlan
:: forall m.
( MonadError QErr m
)
=> Env.Environment
-> HTTP.Manager
-> [HTTP.Header]
-> UserInfo
-> Bool
-> SourceConfig 'MSSQL
-> MutationDB 'MSSQL (UnpreparedValue 'MSSQL)
-> m ExecutionStep
msDBMutationPlan _env _manager _reqHeaders _userInfo _stringifyNum _sourceConfig _mrf =
throw500 "mutations are not supported in MSSQL; this should be unreachable"
-- subscription
msDBSubscriptionPlan
:: forall m.
( MonadError QErr m
)
=> UserInfo
-> SourceConfig 'MSSQL
-> InsOrdHashMap G.Name (QueryDB 'MSSQL (UnpreparedValue 'MSSQL))
-> m (LiveQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
msDBSubscriptionPlan userInfo sourceConfig rootFields = do
-- WARNING: only keeping the first root field for now!
query <- traverse mkQuery $ head $ OMap.toList rootFields
let roleName = _uiRole userInfo
parameterizedPlan = ParameterizedLiveQueryPlan roleName $ NoMultiplex query
pure
$ LiveQueryPlan parameterizedPlan sourceConfig
$ mkCohortVariables mempty mempty mempty mempty
where
mkQuery = fmap (toQueryFlat . fromSelect) . planNoPlan userInfo