mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
da8f6981d4
Fixes https://github.com/hasura/graphql-engine-mono/issues/712 Main point of interest: the `Hasura.SQL.Backend` module. This PR creates an `Exists` type indexed by indexed type and packed constraint while hiding all of its complexity by not exporting the constructor. Existential constructors/types which are no longer (directly) existential: - [X] BackendSourceInfo :: BackendSourceInfo - [x] BackendSourceMetadata :: BackendSourceMetadata - [x] MOSourceObjId :: MetadatObjId - [x] SOSourceObj :: SchemaObjId - [x] RFDB :: RootField - [x] LQP :: LiveQueryPlan - [x] ExecutionStep :: ExecStepDB This PR also removes ALL usages of `Typeable.cast` from our codebase. We still need to derive `Typeable` in a few places in order to be able to derive `Data` in one place. I have not dug deeper to see why this is needed. GitOrigin-RevId: bb47e957192e4bb0af4c4116aee7bb92f7983445
111 lines
3.3 KiB
Haskell
111 lines
3.3 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 qualified Hasura.SQL.AnyBackend as AB
|
|
|
|
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 []
|
|
. AB.mkAnyBackend
|
|
$ DBStepInfo 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
|