graphql-engine/server/src-lib/Hasura/Backends/MSSQL/Instances/Execute.hs
Vladimir Ciobanu 281cb771ff server: add MSSQL support
Co-authored-by: Rakesh Emmadi <12475069+rakeshkky@users.noreply.github.com>
Co-authored-by: Antoine Leblanc <1618949+nicuveo@users.noreply.github.com>
Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com>
Co-authored-by: Aravind K P <8335904+scriptonist@users.noreply.github.com>
GitOrigin-RevId: 699c453b9692e1b822f393f23ff5e6db4e010d57
2021-02-23 17:38:36 +00:00

110 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.Plan
import Hasura.Backends.MSSQL.ToQuery
import Hasura.Backends.MSSQL.Types
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 = 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
connection = _mscConnection sourceConfig
odbcQuery = ODBC.query connection (toQueryFlat select) <&> toResultJSON
pure $ ExecStepDB sourceConfig (Just queryString) [] odbcQuery
where
toResultJSON :: [Text] -> EncJSON
toResultJSON = encJFromText . mconcat
-- 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