From 946248424b39a547aa37a630307f726ea3dd84b9 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 17 Dec 2019 22:04:21 +0530 Subject: [PATCH] wip: graphql transactions over websockets --- server/graphql-engine.cabal | 8 +- server/src-lib/Hasura/Db.hs | 24 +- .../Hasura/GraphQL/Transport/WebSocket.hs | 563 ++---------------- .../GraphQL/Transport/WebSocket/Common.hs | 68 +++ .../Transport/WebSocket/Queries/Handlers.hs | 372 ++++++++++++ .../WebSocket/{ => Queries}/Protocol.hs | 10 +- .../Transport/WebSocket/Queries/Types.hs | 117 ++++ .../GraphQL/Transport/WebSocket/Server.hs | 25 +- .../WebSocket/Transaction/Handlers.hs | 186 ++++++ .../WebSocket/Transaction/Protocol.hs | 111 ++++ .../Transport/WebSocket/Transaction/Types.hs | 85 +++ server/src-lib/Hasura/Logging.hs | 3 +- server/stack.yaml | 4 +- server/stack.yaml.lock | 10 +- 14 files changed, 1054 insertions(+), 532 deletions(-) create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Common.hs create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Handlers.hs rename server/src-lib/Hasura/GraphQL/Transport/WebSocket/{ => Queries}/Protocol.hs (90%) create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Types.hs create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Handlers.hs create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Protocol.hs create mode 100644 server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Types.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 0e5ffecdb60c8..e2021619ed3f1 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -227,7 +227,13 @@ library , Hasura.GraphQL.Transport.HTTP.Protocol , Hasura.GraphQL.Transport.HTTP - , Hasura.GraphQL.Transport.WebSocket.Protocol + , Hasura.GraphQL.Transport.WebSocket.Queries.Protocol + , Hasura.GraphQL.Transport.WebSocket.Queries.Types + , Hasura.GraphQL.Transport.WebSocket.Queries.Handlers + , Hasura.GraphQL.Transport.WebSocket.Transaction.Protocol + , Hasura.GraphQL.Transport.WebSocket.Transaction.Types + , Hasura.GraphQL.Transport.WebSocket.Transaction.Handlers + , Hasura.GraphQL.Transport.WebSocket.Common , Hasura.GraphQL.Transport.WebSocket.Server , Hasura.GraphQL.Transport.WebSocket , Hasura.GraphQL.Schema.BoolExp diff --git a/server/src-lib/Hasura/Db.hs b/server/src-lib/Hasura/Db.hs index e820169914fa9..99031b0bc4066 100644 --- a/server/src-lib/Hasura/Db.hs +++ b/server/src-lib/Hasura/Db.hs @@ -7,6 +7,10 @@ module Hasura.Db , PGExecCtx(..) , runLazyTx , runLazyTx' + , runLazyTxWithConn + , beginTx + , abortTx + , commitTx , withUserInfo , RespTx @@ -19,6 +23,7 @@ import Control.Lens import Control.Monad.Validate import qualified Data.Aeson.Extended as J +import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Database.PG.Query.Connection as Q @@ -79,6 +84,23 @@ runLazyTx' (PGExecCtx pgPool _) = \case LTNoTx a -> return a LTTx tx -> Q.runTx' pgPool tx +runLazyTxWithConn :: MonadIO m => Q.PGConn -> LazyTx QErr a -> ExceptT QErr m a +runLazyTxWithConn pgConn = \case + LTErr e -> throwError e + LTNoTx a -> pure a + LTTx tx -> ExceptT <$> liftIO $ runExceptT $ Q.runTxWithConn pgConn tx + +beginTx :: Q.TxIsolation -> LazyTx QErr () +beginTx txIso = liftTx $ Q.unitQE defaultTxErrorHandler query () False + where + query = Q.fromText $ T.pack $ "BEGIN " <> show txIso + +abortTx :: LazyTx QErr () +abortTx = liftTx $ Q.unitQE defaultTxErrorHandler "ABORT" () False + +commitTx :: LazyTx QErr () +commitTx = liftTx $ Q.unitQE defaultTxErrorHandler "COMMIT" () False + type RespTx = Q.TxE QErr EncJSON type LazyRespTx = LazyTx QErr EncJSON @@ -118,7 +140,7 @@ mkTxErrorHandler isExpectedError txe = fromMaybe unexpectedError expectedError PGDataException code -> case code of Just (PGErrorSpecific PGInvalidEscapeSequence) -> (BadRequest, message) - _ -> (DataException, message) + _ -> (DataException, message) PGSyntaxErrorOrAccessRuleViolation code -> (ConstraintError,) $ case code of Just (PGErrorSpecific PGInvalidColumnReference) -> diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index 8595883c5adce..fc06fe1505517 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE RankNTypes #-} - module Hasura.GraphQL.Transport.WebSocket ( createWSServerApp , createWSServerEnv @@ -7,522 +5,61 @@ module Hasura.GraphQL.Transport.WebSocket , WSServerEnv ) where -import qualified Control.Concurrent.Async as A -import qualified Control.Concurrent.STM as STM -import qualified Data.Aeson as J -import qualified Data.Aeson.Casing as J -import qualified Data.Aeson.TH as J -import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL -import qualified Data.CaseInsensitive as CI -import qualified Data.HashMap.Strict as Map -import qualified Data.IORef as IORef -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Time.Clock as TC -import qualified Language.GraphQL.Draft.Syntax as G -import qualified ListT -import qualified Network.HTTP.Client as H -import qualified Network.HTTP.Types as H -import qualified Network.WebSockets as WS -import qualified StmContainers.Map as STMMap +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as BL +import qualified Data.Text as T +import qualified Network.HTTP.Types as H +import qualified Network.WebSockets as WS -import Control.Concurrent (threadDelay) -import Hasura.EncJSON -import Hasura.GraphQL.Logging -import Hasura.GraphQL.Transport.HTTP.Protocol -import Hasura.GraphQL.Transport.WebSocket.Protocol +import qualified Hasura.GraphQL.Execute.LiveQuery as LQ +import Hasura.GraphQL.Transport.WebSocket.Common +import qualified Hasura.GraphQL.Transport.WebSocket.Queries.Handlers as WQH +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.GraphQL.Transport.WebSocket.Transaction.Handlers as WTH +import qualified Hasura.Logging as L import Hasura.Prelude import Hasura.RQL.Types -import Hasura.RQL.Types.Error (Code (StartFailed)) -import Hasura.Server.Auth (AuthMode, getUserInfoWithExpTime) -import Hasura.Server.Context -import Hasura.Server.Cors -import Hasura.Server.Utils (RequestId, - diffTimeToMicro, - getRequestId) - -import qualified Hasura.GraphQL.Execute as E -import qualified Hasura.GraphQL.Execute.LiveQuery as LQ -import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS -import qualified Hasura.Logging as L - - -type OperationMap - = STMMap.Map OperationId (LQ.LiveQueryId, Maybe OperationName) - -newtype WsHeaders - = WsHeaders { unWsHeaders :: [H.Header] } - deriving (Show, Eq) - -data ErrRespType - = ERTLegacy - | ERTGraphqlCompliant - deriving (Show) - -data WSConnState - -- headers from the client for websockets - = CSNotInitialised !WsHeaders - | CSInitError Text - -- headers from the client (in conn params) to forward to the remote schema - -- and JWT expiry time if any - | CSInitialised UserInfo (Maybe TC.UTCTime) [H.Header] - -data WSConnData - = WSConnData - -- the role and headers are set only on connection_init message - { _wscUser :: !(STM.TVar WSConnState) - -- we only care about subscriptions, - -- the other operations (query/mutations) - -- are not tracked here - , _wscOpMap :: !OperationMap - , _wscErrRespTy :: !ErrRespType - } - -type WSServer = WS.WSServer WSConnData - -type WSConn = WS.WSConn WSConnData -sendMsg :: (MonadIO m) => WSConn -> ServerMsg -> m () -sendMsg wsConn = - liftIO . WS.sendMsg wsConn . encodeServerMsg - -data OpDetail - = ODStarted - | ODProtoErr !Text - | ODQueryErr !QErr - | ODCompleted - | ODStopped - deriving (Show, Eq) -$(J.deriveToJSON - J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 - , J.sumEncoding = J.TaggedObject "type" "detail" - } - ''OpDetail) - -data OperationDetails - = OperationDetails - { _odOperationId :: !OperationId - , _odRequestId :: !(Maybe RequestId) - , _odOperationName :: !(Maybe OperationName) - , _odOperationType :: !OpDetail - , _odQuery :: !(Maybe GQLReqUnparsed) - } deriving (Show, Eq) -$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''OperationDetails) - -data WSEvent - = EAccepted - | ERejected !QErr - | EConnErr !ConnErrMsg - | EOperation !OperationDetails - | EClosed - deriving (Show, Eq) -$(J.deriveToJSON - J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 1 - , J.sumEncoding = J.TaggedObject "type" "detail" - } - ''WSEvent) - -data WsConnInfo - = WsConnInfo - { _wsciWebsocketId :: !WS.WSId - , _wsciJwtExpiry :: !(Maybe TC.UTCTime) - , _wsciMsg :: !(Maybe Text) - } deriving (Show, Eq) -$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WsConnInfo) - -data WSLogInfo - = WSLogInfo - { _wsliUserVars :: !(Maybe UserVars) - , _wsliConnectionInfo :: !WsConnInfo - , _wsliEvent :: !WSEvent - } deriving (Show, Eq) -$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WSLogInfo) - -data WSLog - = WSLog - { _wslLogLevel :: !L.LogLevel - , _wslInfo :: !WSLogInfo - } -instance L.ToEngineLog WSLog where - toEngineLog (WSLog logLevel wsLog) = - (logLevel, L.ELTWebsocketLog, J.toJSON wsLog) - -mkWsInfoLog :: Maybe UserVars -> WsConnInfo -> WSEvent -> WSLog -mkWsInfoLog uv ci ev = - WSLog L.LevelInfo $ WSLogInfo uv ci ev - -mkWsErrorLog :: Maybe UserVars -> WsConnInfo -> WSEvent -> WSLog -mkWsErrorLog uv ci ev = - WSLog L.LevelError $ WSLogInfo uv ci ev - -data WSServerEnv - = WSServerEnv - { _wseLogger :: !L.Logger - , _wseRunTx :: !PGExecCtx - , _wseLiveQMap :: !LQ.LiveQueriesState - , _wseGCtxMap :: !(IORef.IORef (SchemaCache, SchemaCacheVer)) - , _wseHManager :: !H.Manager - , _wseCorsPolicy :: !CorsPolicy - , _wseSQLCtx :: !SQLGenCtx - , _wseQueryCache :: !E.PlanCache - , _wseServer :: !WSServer - , _wseEnableAllowlist :: !Bool - } - -onConn :: L.Logger -> CorsPolicy -> WS.OnConnH WSConnData -onConn (L.Logger logger) corsPolicy wsId requestHead = do - res <- runExceptT $ do - errType <- checkPath - let reqHdrs = WS.requestHeaders requestHead - headers <- maybe (return reqHdrs) (flip enforceCors reqHdrs . snd) getOrigin - return (WsHeaders $ filterWsHeaders headers, errType) - either reject (uncurry accept) res - - where - keepAliveAction wsConn = forever $ do - sendMsg wsConn SMConnKeepAlive - threadDelay $ 5 * 1000 * 1000 - - jwtExpiryHandler wsConn = do - expTime <- STM.atomically $ do - connState <- STM.readTVar $ (_wscUser . WS.getData) wsConn - case connState of - CSNotInitialised _ -> STM.retry - CSInitError _ -> STM.retry - CSInitialised _ expTimeM _ -> - maybe STM.retry return expTimeM - currTime <- TC.getCurrentTime - threadDelay $ diffTimeToMicro $ TC.diffUTCTime expTime currTime - - accept hdrs errType = do - logger $ mkWsInfoLog Nothing (WsConnInfo wsId Nothing Nothing) EAccepted - connData <- WSConnData - <$> STM.newTVarIO (CSNotInitialised hdrs) - <*> STMMap.newIO - <*> pure errType - let acceptRequest = WS.defaultAcceptRequest - { WS.acceptSubprotocol = Just "graphql-ws"} - return $ Right $ WS.AcceptWith connData acceptRequest - (Just keepAliveAction) (Just jwtExpiryHandler) - - reject qErr = do - logger $ mkWsErrorLog Nothing (WsConnInfo wsId Nothing Nothing) (ERejected qErr) - return $ Left $ WS.RejectRequest - (H.statusCode $ qeStatus qErr) - (H.statusMessage $ qeStatus qErr) [] - (BL.toStrict $ J.encode $ encodeGQLErr False qErr) - - checkPath = case WS.requestPath requestHead of - "/v1alpha1/graphql" -> return ERTLegacy - "/v1/graphql" -> return ERTGraphqlCompliant - _ -> - throw404 "only '/v1/graphql', '/v1alpha1/graphql' are supported on websockets" - - getOrigin = - find ((==) "Origin" . fst) (WS.requestHeaders requestHead) - - enforceCors :: B.ByteString -> [H.Header] -> ExceptT QErr IO [H.Header] - enforceCors origin reqHdrs = case cpConfig corsPolicy of - CCAllowAll -> return reqHdrs - CCDisabled readCookie -> - if readCookie - then return reqHdrs - else do - liftIO $ logger $ - mkWsInfoLog Nothing (WsConnInfo wsId Nothing (Just corsNote)) EAccepted - return $ filter (\h -> fst h /= "Cookie") reqHdrs - CCAllowedOrigins ds - -- if the origin is in our cors domains, no error - | bsToTxt origin `elem` dmFqdns ds -> return reqHdrs - -- if current origin is part of wildcard domain list, no error - | inWildcardList ds (bsToTxt origin) -> return reqHdrs - -- otherwise error - | otherwise -> corsErr - - filterWsHeaders hdrs = flip filter hdrs $ \(n, _) -> - n `notElem` [ "sec-websocket-key" - , "sec-websocket-version" - , "upgrade" - , "connection" - ] - - corsErr = throw400 AccessDenied - "received origin header does not match configured CORS domains" - - corsNote = "Cookie is not read when CORS is disabled, because it is a potential " - <> "security issue. If you're already handling CORS before Hasura and enforcing " - <> "CORS on websocket connections, then you can use the flag --ws-read-cookie or " - <> "HASURA_GRAPHQL_WS_READ_COOKIE to force read cookie when CORS is disabled." - - -onStart :: WSServerEnv -> WSConn -> StartMsg -> IO () -onStart serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do - - opM <- liftIO $ STM.atomically $ STMMap.lookup opId opMap - - when (isJust opM) $ withComplete $ sendStartErr $ - "an operation already exists with this id: " <> unOperationId opId - - userInfoM <- liftIO $ STM.readTVarIO userInfoR - (userInfo, reqHdrs) <- case userInfoM of - CSInitialised userInfo _ reqHdrs -> return (userInfo, reqHdrs) - CSInitError initErr -> do - let e = "cannot start as connection_init failed with : " <> initErr - withComplete $ sendStartErr e - CSNotInitialised _ -> do - let e = "start received before the connection is initialised" - withComplete $ sendStartErr e - - requestId <- getRequestId reqHdrs - (sc, scVer) <- liftIO $ IORef.readIORef gCtxMapRef - execPlanE <- runExceptT $ E.getResolvedExecPlan pgExecCtx - planCache userInfo sqlGenCtx enableAL sc scVer httpMgr q - execPlan <- either (withComplete . preExecErr requestId) return execPlanE - let execCtx = E.ExecutionCtx logger sqlGenCtx pgExecCtx - planCache sc scVer httpMgr enableAL - - case execPlan of - E.GExPHasura resolvedOp -> - runHasuraGQ requestId q userInfo resolvedOp - E.GExPRemote rsi opDef -> - runRemoteGQ execCtx requestId userInfo reqHdrs opDef rsi - where - runHasuraGQ :: RequestId -> GQLReqUnparsed -> UserInfo -> E.ExecOp - -> ExceptT () IO () - runHasuraGQ reqId query userInfo = \case - E.ExOpQuery opTx genSql -> - execQueryOrMut reqId query genSql $ runLazyTx' pgExecCtx opTx - E.ExOpMutation opTx -> - execQueryOrMut reqId query Nothing $ - runLazyTx pgExecCtx $ withUserInfo userInfo opTx - E.ExOpSubs lqOp -> do - -- log the graphql query - liftIO $ logGraphqlQuery logger $ QueryLog query Nothing reqId - lqId <- liftIO $ LQ.addLiveQuery lqMap lqOp liveQOnChange - liftIO $ STM.atomically $ - STMMap.insert (lqId, _grOperationName q) opId opMap - logOpEv ODStarted (Just reqId) - - execQueryOrMut reqId query genSql action = do - logOpEv ODStarted (Just reqId) - -- log the generated SQL and the graphql query - liftIO $ logGraphqlQuery logger $ QueryLog query genSql reqId - resp <- liftIO $ runExceptT action - either (postExecErr reqId) sendSuccResp resp - sendCompleted (Just reqId) - - runRemoteGQ :: E.ExecutionCtx -> RequestId -> UserInfo -> [H.Header] - -> G.TypedOperationDefinition -> RemoteSchemaInfo - -> ExceptT () IO () - runRemoteGQ execCtx reqId userInfo reqHdrs opDef rsi = do - when (G._todType opDef == G.OperationTypeSubscription) $ - withComplete $ preExecErr reqId $ - err400 NotSupported "subscription to remote server is not supported" - - -- if it's not a subscription, use HTTP to execute the query on the remote - resp <- runExceptT $ flip runReaderT execCtx $ - E.execRemoteGQ reqId userInfo reqHdrs q rsi opDef - either (postExecErr reqId) (sendRemoteResp reqId . _hrBody) resp - sendCompleted (Just reqId) - - sendRemoteResp reqId resp = - case J.eitherDecodeStrict (encJToBS resp) of - Left e -> postExecErr reqId $ invalidGqlErr $ T.pack e - Right res -> sendMsg wsConn $ SMData $ DataMsg opId (GRRemote res) - - invalidGqlErr err = err500 Unexpected $ - "Failed parsing GraphQL response from remote: " <> err - - WSServerEnv logger pgExecCtx lqMap gCtxMapRef httpMgr _ sqlGenCtx planCache - _ enableAL = serverEnv - - WSConnData userInfoR opMap errRespTy = WS.getData wsConn - - logOpEv opTy reqId = - logWSEvent logger wsConn $ EOperation opDet - where - opDet = OperationDetails opId reqId (_grOperationName q) opTy query - -- log the query only in errors - query = case opTy of - ODQueryErr _ -> Just q - _ -> Nothing - - getErrFn errTy = - case errTy of - ERTLegacy -> encodeQErr - ERTGraphqlCompliant -> encodeGQLErr - - sendStartErr e = do - let errFn = getErrFn errRespTy - sendMsg wsConn $ SMErr $ ErrorMsg opId $ errFn False $ - err400 StartFailed e - logOpEv (ODProtoErr e) Nothing - - sendCompleted reqId = do - sendMsg wsConn $ SMComplete $ CompletionMsg opId - logOpEv ODCompleted reqId - - postExecErr reqId qErr = do - let errFn = getErrFn errRespTy - logOpEv (ODQueryErr qErr) (Just reqId) - sendMsg wsConn $ SMData $ DataMsg opId $ - GRHasura $ GQExecError $ pure $ errFn False qErr - - -- why wouldn't pre exec error use graphql response? - preExecErr reqId qErr = do - let errFn = getErrFn errRespTy - logOpEv (ODQueryErr qErr) (Just reqId) - let err = case errRespTy of - ERTLegacy -> errFn False qErr - ERTGraphqlCompliant -> J.object ["errors" J..= [errFn False qErr]] - sendMsg wsConn $ SMErr $ ErrorMsg opId err - - sendSuccResp encJson = - sendMsg wsConn $ SMData $ DataMsg opId $ - GRHasura $ GQSuccess $ encJToLBS encJson - - withComplete :: ExceptT () IO () -> ExceptT () IO a - withComplete action = do - action - sendCompleted Nothing - throwError () - - -- on change, send message on the websocket - liveQOnChange resp = - WS.sendMsg wsConn $ encodeServerMsg $ SMData $ - DataMsg opId (GRHasura resp) - - catchAndIgnore :: ExceptT () IO () -> IO () - catchAndIgnore m = void $ runExceptT m +import Hasura.Server.Auth (AuthMode) + +onConn + :: AuthMode -> WSServerEnv -> WS.OnConnH ConnState +onConn authMode serverEnv wsId requestHead = do + let requestHeaders = WS.requestHeaders requestHead + case find (\h -> fst h == "sec-websocket-protocol") requestHeaders of + Nothing -> queryConnHandler + Just (_, bs) -> do + let valueText = bsToTxt bs + headerVals = map T.strip $ T.splitOn "," valueText + case headerVals of + [] -> queryConnHandler + ("graphql-ws":_) -> queryConnHandler + ("graphql-tx":_) -> txConnHandler + _ -> reject $ err404 BadRequest $ "protocol not supported: " <> valueText + where + logger = _wseLogger serverEnv + corsPolicy = _wseCorsPolicy serverEnv + pgExecCtx = _wseRunTx serverEnv + httpMgr = _wseHManager serverEnv + queryConnHandler = WQH.onConnHandler logger corsPolicy wsId requestHead + txConnHandler = WTH.onConnHandler logger authMode httpMgr pgExecCtx wsId requestHead + reject qErr = pure $ Left $ WS.RejectRequest + (H.statusCode $ qeStatus qErr) + (H.statusMessage $ qeStatus qErr) [] + (BL.toStrict $ J.encode $ encodeGQLErr False qErr) onMessage - :: AuthMode - -> WSServerEnv - -> WSConn -> BL.ByteString -> IO () -onMessage authMode serverEnv wsConn msgRaw = - case J.eitherDecode msgRaw of - Left e -> do - let err = ConnErrMsg $ "parsing ClientMessage failed: " <> T.pack e - logWSEvent logger wsConn $ EConnErr err - sendMsg wsConn $ SMConnErr err - - Right msg -> case msg of - CMConnInit params -> onConnInit (_wseLogger serverEnv) - (_wseHManager serverEnv) - wsConn authMode params - CMStart startMsg -> onStart serverEnv wsConn startMsg - CMStop stopMsg -> onStop serverEnv wsConn stopMsg - CMConnTerm -> WS.closeConn wsConn "GQL_CONNECTION_TERMINATE received" - where - logger = _wseLogger serverEnv - -onStop :: WSServerEnv -> WSConn -> StopMsg -> IO () -onStop serverEnv wsConn (StopMsg opId) = do - -- probably wrap the whole thing in a single tx? - opM <- liftIO $ STM.atomically $ STMMap.lookup opId opMap - case opM of - Just (lqId, opNameM) -> do - logWSEvent logger wsConn $ EOperation $ opDet opNameM - LQ.removeLiveQuery lqMap lqId - Nothing -> return () - STM.atomically $ STMMap.delete opId opMap - where - logger = _wseLogger serverEnv - lqMap = _wseLiveQMap serverEnv - opMap = _wscOpMap $ WS.getData wsConn - opDet n = OperationDetails opId Nothing n ODStopped Nothing - -logWSEvent - :: (MonadIO m) - => L.Logger -> WSConn -> WSEvent -> m () -logWSEvent (L.Logger logger) wsConn wsEv = do - userInfoME <- liftIO $ STM.readTVarIO userInfoR - let (userVarsM, jwtExpM) = case userInfoME of - CSInitialised userInfo jwtM _ -> ( Just $ userVars userInfo - , jwtM - ) - _ -> (Nothing, Nothing) - liftIO $ logger $ WSLog logLevel $ WSLogInfo userVarsM (WsConnInfo wsId jwtExpM Nothing) wsEv - where - WSConnData userInfoR _ _ = WS.getData wsConn - wsId = WS.getWSId wsConn - logLevel = bool L.LevelInfo L.LevelError isError - isError = case wsEv of - EAccepted -> False - ERejected _ -> True - EConnErr _ -> True - EClosed -> False - EOperation op -> case _odOperationType op of - ODStarted -> False - ODProtoErr _ -> True - ODQueryErr _ -> True - ODCompleted -> False - ODStopped -> False - -onConnInit - :: (MonadIO m) - => L.Logger -> H.Manager -> WSConn -> AuthMode -> Maybe ConnParams -> m () -onConnInit logger manager wsConn authMode connParamsM = do - headers <- mkHeaders <$> liftIO (STM.readTVarIO (_wscUser $ WS.getData wsConn)) - res <- runExceptT $ getUserInfoWithExpTime logger manager headers authMode - case res of - Left e -> do - liftIO $ STM.atomically $ STM.writeTVar (_wscUser $ WS.getData wsConn) $ - CSInitError $ qeError e - let connErr = ConnErrMsg $ qeError e - logWSEvent logger wsConn $ EConnErr connErr - sendMsg wsConn $ SMConnErr connErr - Right (userInfo, expTimeM) -> do - liftIO $ STM.atomically $ STM.writeTVar (_wscUser $ WS.getData wsConn) $ - CSInitialised userInfo expTimeM paramHeaders - sendMsg wsConn SMConnAck - -- TODO: send it periodically? Why doesn't apollo's protocol use - -- ping/pong frames of websocket spec? - sendMsg wsConn SMConnKeepAlive - where - mkHeaders st = - paramHeaders ++ getClientHdrs st - - paramHeaders = - [ (CI.mk $ TE.encodeUtf8 h, TE.encodeUtf8 v) - | (h, v) <- maybe [] Map.toList $ connParamsM >>= _cpHeaders - ] - - getClientHdrs st = case st of - CSNotInitialised h -> unWsHeaders h - _ -> [] - -onClose - :: L.Logger - -> LQ.LiveQueriesState - -> WSConn - -> IO () -onClose logger lqMap wsConn = do - logWSEvent logger wsConn EClosed - operations <- STM.atomically $ ListT.toList $ STMMap.listT opMap - void $ A.forConcurrently operations $ \(_, (lqId, _)) -> - LQ.removeLiveQuery lqMap lqId - where - opMap = _wscOpMap $ WS.getData wsConn - -createWSServerEnv - :: L.Logger - -> PGExecCtx - -> LQ.LiveQueriesState - -> IORef.IORef (SchemaCache, SchemaCacheVer) - -> H.Manager - -> CorsPolicy - -> SQLGenCtx - -> Bool - -> E.PlanCache - -> IO WSServerEnv -createWSServerEnv logger pgExecCtx lqState cacheRef httpManager - corsPolicy sqlGenCtx enableAL planCache = do - wsServer <- STM.atomically $ WS.createWSServer logger - return $ - WSServerEnv logger pgExecCtx lqState cacheRef httpManager corsPolicy - sqlGenCtx planCache wsServer enableAL + :: AuthMode -> WSServerEnv -> WS.OnMessageH ConnState +onMessage authMode serverEnv wsConn bytes = + case WS.getData wsConn of + CSQueries connData -> WQH.onMessageHandler authMode serverEnv connData wsConn bytes + CSTransaction pgConnCtx -> WTH.onMessageHandler serverEnv pgConnCtx wsConn bytes + +onClose :: L.Logger -> LQ.LiveQueriesState -> WS.OnCloseH ConnState +onClose logger lqMap wsConn = + case WS.getData wsConn of + CSQueries connData -> WQH.onCloseHandler logger lqMap connData wsConn + CSTransaction wsTxData -> WTH.onCloseHandler logger (WS.getWSId wsConn) wsTxData createWSServerApp :: AuthMode -> WSServerEnv -> WS.ServerApp createWSServerApp authMode serverEnv = @@ -530,7 +67,7 @@ createWSServerApp authMode serverEnv = where handlers = WS.WSHandlers - (onConn (_wseLogger serverEnv) (_wseCorsPolicy serverEnv)) + (onConn authMode serverEnv) (onMessage authMode serverEnv) (onClose (_wseLogger serverEnv) $ _wseLiveQMap serverEnv) diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Common.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Common.hs new file mode 100644 index 0000000000000..662d20bff9a85 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Common.hs @@ -0,0 +1,68 @@ +module Hasura.GraphQL.Transport.WebSocket.Common where + +import Hasura.Prelude + +import qualified Control.Concurrent.STM as STM +import qualified Data.IORef as IORef +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as H + + +import Hasura.RQL.Types +import Hasura.Server.Cors + +import qualified Hasura.GraphQL.Execute as E +import qualified Hasura.GraphQL.Execute.LiveQuery as LQ +import qualified Hasura.GraphQL.Transport.WebSocket.Queries.Types as WQT +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.GraphQL.Transport.WebSocket.Transaction.Types as WTT +import qualified Hasura.Logging as L + +data ConnState + = CSQueries !WQT.WSConnData + | CSTransaction !WTT.WSTxData + +type WSConn = WS.WSConn ConnState +type WSServer = WS.WSServer ConnState + +data WSServerEnv + = WSServerEnv + { _wseLogger :: !(L.Logger) + , _wseRunTx :: !PGExecCtx + , _wseLiveQMap :: !LQ.LiveQueriesState + , _wseGCtxMap :: !(IORef.IORef (SchemaCache, SchemaCacheVer)) + , _wseHManager :: !H.Manager + , _wseCorsPolicy :: !CorsPolicy + , _wseSQLCtx :: !SQLGenCtx + , _wseQueryCache :: !E.PlanCache + , _wseServer :: !WSServer + , _wseEnableAllowlist :: !Bool + } + +createWSServerEnv + :: (MonadIO m) + => L.Logger + -> PGExecCtx + -> LQ.LiveQueriesState + -> IORef.IORef (SchemaCache, SchemaCacheVer) + -> H.Manager + -> CorsPolicy + -> SQLGenCtx + -> Bool + -> E.PlanCache + -> m WSServerEnv +createWSServerEnv logger pgExecCtx lqState cacheRef httpManager + corsPolicy sqlGenCtx enableAL planCache = do + wsServer <- liftIO $ STM.atomically $ WS.createWSServer logger + return $ + WSServerEnv logger pgExecCtx lqState cacheRef httpManager corsPolicy + sqlGenCtx planCache wsServer enableAL + +filterWsHeaders :: [H.Header] -> [H.Header] +filterWsHeaders hdrs = flip filter hdrs $ \(n, _) -> + n `notElem` [ "sec-websocket-key" + , "sec-websocket-version" + , "sec-websocket-protocol" + , "upgrade" + , "connection" + ] diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Handlers.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Handlers.hs new file mode 100644 index 0000000000000..c552fab415e7a --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Handlers.hs @@ -0,0 +1,372 @@ +module Hasura.GraphQL.Transport.WebSocket.Queries.Handlers where + +import qualified Control.Concurrent.Async as A +import qualified Control.Concurrent.STM as STM +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as BL +import qualified Data.CaseInsensitive as CI +import qualified Data.HashMap.Strict as Map +import qualified Data.IORef as IORef +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Time.Clock as TC +import qualified Language.GraphQL.Draft.Syntax as G +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as H +import qualified Network.WebSockets as WS +import qualified StmContainers.Map as STMMap + +import Control.Concurrent (threadDelay) +import qualified ListT + +import Hasura.EncJSON +import Hasura.GraphQL.Logging +import Hasura.GraphQL.Transport.HTTP.Protocol +import Hasura.GraphQL.Transport.WebSocket.Common +import Hasura.GraphQL.Transport.WebSocket.Queries.Protocol +import Hasura.GraphQL.Transport.WebSocket.Queries.Types +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.RQL.Types.Error (Code (StartFailed)) +import Hasura.Server.Auth (AuthMode, getUserInfoWithExpTime) +import Hasura.Server.Context +import Hasura.Server.Cors +import Hasura.Server.Utils (RequestId, diffTimeToMicro, + getRequestId) + +import qualified Hasura.GraphQL.Execute as E +import qualified Hasura.GraphQL.Execute.LiveQuery as LQ +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.Logging as L + +onConnHandler :: L.Logger -> CorsPolicy -> WS.OnConnH ConnState +onConnHandler (L.Logger logger) corsPolicy wsId requestHead = do + res <- runExceptT $ do + errType <- WS.checkPath requestHead + let reqHdrs = WS.requestHeaders requestHead + headers <- maybe (return reqHdrs) (flip enforceCors reqHdrs . snd) getOrigin + return (WsHeaders $ filterWsHeaders headers, errType) + either reject (uncurry accept) res + + where + keepAliveAction wsConn = liftIO $ forever $ do + sendMsg wsConn SMConnKeepAlive + threadDelay $ 5 * 1000 * 1000 + + jwtExpiryHandler connData _ = do + expTime <- liftIO $ STM.atomically $ do + connState <- STM.readTVar $ _wscUser connData + case connState of + CSNotInitialised _ -> STM.retry + CSInitError _ -> STM.retry + CSInitialised _ expTimeM _ -> + maybe STM.retry return expTimeM + currTime <- TC.getCurrentTime + threadDelay $ diffTimeToMicro $ TC.diffUTCTime expTime currTime + + accept hdrs errType = do + logger $ mkWsInfoLog Nothing (WsConnInfo wsId Nothing Nothing) EAccepted + connData <- liftIO $ WSConnData + <$> STM.newTVarIO (CSNotInitialised hdrs) + <*> STMMap.newIO + <*> pure errType + let acceptRequest = WS.defaultAcceptRequest + { WS.acceptSubprotocol = Just "graphql-ws"} + return $ Right $ WS.AcceptWith (CSQueries connData) acceptRequest + (Just keepAliveAction) (Just (jwtExpiryHandler connData)) + + reject qErr = do + logger $ mkWsErrorLog Nothing (WsConnInfo wsId Nothing Nothing) (ERejected qErr) + return $ Left $ WS.RejectRequest + (H.statusCode $ qeStatus qErr) + (H.statusMessage $ qeStatus qErr) [] + (BL.toStrict $ J.encode $ encodeGQLErr False qErr) + + getOrigin = + find ((==) "Origin" . fst) (WS.requestHeaders requestHead) + + enforceCors origin reqHdrs = case cpConfig corsPolicy of + CCAllowAll -> return reqHdrs + CCDisabled readCookie -> + if readCookie + then return reqHdrs + else do + lift $ logger $ mkWsInfoLog Nothing (WsConnInfo wsId Nothing (Just corsNote)) EAccepted + return $ filter (\h -> fst h /= "Cookie") reqHdrs + CCAllowedOrigins ds + -- if the origin is in our cors domains, no error + | bsToTxt origin `elem` dmFqdns ds -> return reqHdrs + -- if current origin is part of wildcard domain list, no error + | inWildcardList ds (bsToTxt origin) -> return reqHdrs + -- otherwise error + | otherwise -> corsErr + + corsErr = throw400 AccessDenied + "received origin header does not match configured CORS domains" + + corsNote = "Cookie is not read when CORS is disabled, because it is a potential " + <> "security issue. If you're already handling CORS before Hasura and enforcing " + <> "CORS on websocket connections, then you can use the flag --ws-read-cookie or " + <> "HASURA_GRAPHQL_WS_READ_COOKIE to force read cookie when CORS is disabled." + +onMessageHandler + :: AuthMode + -> WSServerEnv + -> WSConnData + -> WSConn + -> BL.ByteString -> IO () +onMessageHandler authMode serverEnv connData wsConn msgRaw = + case J.eitherDecode msgRaw of + Left e -> do + let err = ConnErrMsg $ "parsing ClientMessage failed: " <> T.pack e + logWSEvent logger wsConn connData $ EConnErr err + sendMsg wsConn $ SMConnErr err + + Right msg -> case msg of + CMConnInit params -> onConnInit logger (_wseHManager serverEnv) + wsConn connData authMode params + CMStart startMsg -> liftIO $ onStart serverEnv wsConn connData startMsg + CMStop stopMsg -> liftIO $ onStop logger (_wseLiveQMap serverEnv) + wsConn connData stopMsg + CMConnTerm -> liftIO $ WS.closeConn wsConn "GQL_CONNECTION_TERMINATE received" + where + logger = _wseLogger serverEnv + +onConnInit + :: L.Logger -> H.Manager -> WSConn -> WSConnData -> AuthMode -> Maybe ConnParams -> IO () +onConnInit logger manager wsConn connData authMode connParamsM = do + headers <- mkHeaders <$> liftIO (STM.readTVarIO (_wscUser connData)) + res <- runExceptT $ getUserInfoWithExpTime logger manager headers authMode + case res of + Left e -> do + liftIO $ STM.atomically $ STM.writeTVar (_wscUser connData) $ + CSInitError $ qeError e + let connErr = ConnErrMsg $ qeError e + logWSEvent logger wsConn connData $ EConnErr connErr + sendMsg wsConn $ SMConnErr connErr + Right (userInfo, expTimeM) -> do + liftIO $ STM.atomically $ STM.writeTVar (_wscUser connData) $ + CSInitialised userInfo expTimeM paramHeaders + sendMsg wsConn SMConnAck + -- TODO: send it periodically? Why doesn't apollo's protocol use + -- ping/pong frames of websocket spec? + sendMsg wsConn SMConnKeepAlive + where + mkHeaders st = + paramHeaders ++ getClientHdrs st + + paramHeaders = + [ (CI.mk $ TE.encodeUtf8 h, TE.encodeUtf8 v) + | (h, v) <- maybe [] Map.toList $ connParamsM >>= _cpHeaders + ] + + getClientHdrs st = case st of + CSNotInitialised h -> unWsHeaders h + _ -> [] + +onStart :: WSServerEnv -> WSConn -> WSConnData -> StartMsg -> IO () +onStart serverEnv wsConn connData (StartMsg opId q) = catchAndIgnore $ do + + opM <- liftIO $ STM.atomically $ STMMap.lookup opId opMap + + when (isJust opM) $ withComplete $ sendStartErr $ + "an operation already exists with this id: " <> unOperationId opId + + userInfoM <- liftIO $ STM.readTVarIO userInfoR + (userInfo, reqHdrs) <- case userInfoM of + CSInitialised userInfo _ reqHdrs -> return (userInfo, reqHdrs) + CSInitError initErr -> do + let e = "cannot start as connection_init failed with : " <> initErr + withComplete $ sendStartErr e + CSNotInitialised _ -> do + let e = "start received before the connection is initialised" + withComplete $ sendStartErr e + + requestId <- getRequestId reqHdrs + (sc, scVer) <- liftIO $ IORef.readIORef gCtxMapRef + execPlanE <- runExceptT $ E.getResolvedExecPlan pgExecCtx + planCache userInfo sqlGenCtx enableAL sc scVer httpMgr q + execPlan <- either (withComplete . preExecErr requestId) return execPlanE + let execCtx = E.ExecutionCtx logger sqlGenCtx pgExecCtx + planCache sc scVer httpMgr enableAL + + case execPlan of + E.GExPHasura resolvedOp -> + runHasuraGQ requestId q userInfo resolvedOp + E.GExPRemote rsi opDef -> + runRemoteGQ execCtx requestId userInfo reqHdrs opDef rsi + where + runHasuraGQ :: RequestId -> GQLReqUnparsed -> UserInfo -> E.ExecOp + -> ExceptT () IO () + runHasuraGQ reqId query userInfo = \case + E.ExOpQuery opTx genSql -> + execQueryOrMut reqId query genSql $ runLazyTx' pgExecCtx opTx + E.ExOpMutation opTx -> + execQueryOrMut reqId query Nothing $ + runLazyTx pgExecCtx $ withUserInfo userInfo opTx + E.ExOpSubs lqOp -> do + -- log the graphql query + liftIO $ L.unLogger logger $ QueryLog query Nothing reqId + lqId <- liftIO $ LQ.addLiveQuery lqMap lqOp liveQOnChange + liftIO $ STM.atomically $ + STMMap.insert (lqId, _grOperationName q) opId opMap + logOpEv ODStarted (Just reqId) + + execQueryOrMut reqId query genSql action = do + logOpEv ODStarted (Just reqId) + -- log the generated SQL and the graphql query + liftIO $ L.unLogger logger $ QueryLog query genSql reqId + resp <- liftIO $ runExceptT action + either (postExecErr reqId) sendSuccResp resp + sendCompleted (Just reqId) + + runRemoteGQ :: E.ExecutionCtx -> RequestId -> UserInfo -> [H.Header] + -> G.TypedOperationDefinition -> RemoteSchemaInfo + -> ExceptT () IO () + runRemoteGQ execCtx reqId userInfo reqHdrs opDef rsi = do + when (G._todType opDef == G.OperationTypeSubscription) $ + withComplete $ preExecErr reqId $ + err400 NotSupported "subscription to remote server is not supported" + + -- if it's not a subscription, use HTTP to execute the query on the remote + resp <- runExceptT $ flip runReaderT execCtx $ + E.execRemoteGQ reqId userInfo reqHdrs q rsi opDef + either (postExecErr reqId) (sendRemoteResp reqId . _hrBody) resp + sendCompleted (Just reqId) + + sendRemoteResp reqId resp = + case J.eitherDecodeStrict (encJToBS resp) of + Left e -> postExecErr reqId $ invalidGqlErr $ T.pack e + Right res -> sendMsg wsConn $ SMData $ DataMsg opId (GRRemote res) + + invalidGqlErr err = err500 Unexpected $ + "Failed parsing GraphQL response from remote: " <> err + + WSServerEnv logger pgExecCtx lqMap gCtxMapRef httpMgr _ sqlGenCtx planCache + _ enableAL = serverEnv + + WSConnData userInfoR opMap errRespTy = connData + + logOpEv opTy reqId = + logWSEvent logger wsConn connData $ EOperation opDet + where + opDet = OperationDetails opId reqId (_grOperationName q) opTy query + -- log the query only in errors + query = case opTy of + ODQueryErr _ -> Just q + _ -> Nothing + + getErrFn errTy = + case errTy of + WS.ERTLegacy -> encodeQErr + WS.ERTGraphqlCompliant -> encodeGQLErr + + sendStartErr :: Text -> ExceptT () IO () + sendStartErr e = do + let errFn = getErrFn errRespTy + sendMsg wsConn $ SMErr $ ErrorMsg opId $ errFn False $ + err400 StartFailed e + logOpEv (ODProtoErr e) Nothing + + sendCompleted reqId = do + sendMsg wsConn $ SMComplete $ CompletionMsg opId + logOpEv ODCompleted reqId + + postExecErr reqId qErr = do + let errFn = getErrFn errRespTy + logOpEv (ODQueryErr qErr) (Just reqId) + sendMsg wsConn $ SMData $ DataMsg opId $ + GRHasura $ GQExecError $ pure $ errFn False qErr + + -- why wouldn't pre exec error use graphql response? + preExecErr reqId qErr = do + let errFn = getErrFn errRespTy + logOpEv (ODQueryErr qErr) (Just reqId) + let err = case errRespTy of + WS.ERTLegacy -> errFn False qErr + WS.ERTGraphqlCompliant -> J.object ["errors" J..= [errFn False qErr]] + sendMsg wsConn $ SMErr $ ErrorMsg opId err + + sendSuccResp encJson = + sendMsg wsConn $ SMData $ DataMsg opId $ + GRHasura $ GQSuccess $ encJToLBS encJson + + withComplete :: ExceptT () IO () -> ExceptT () IO a + withComplete action = do + action + sendCompleted Nothing + throwError () + + -- on change, send message on the websocket + liveQOnChange resp = + WS.sendMsg wsConn $ encodeServerMsg $ SMData $ + DataMsg opId (GRHasura resp) + + catchAndIgnore :: ExceptT () IO () -> IO () + catchAndIgnore m = void $ runExceptT m + +onStop + :: L.Logger + -> LQ.LiveQueriesState + -> WSConn + -> WSConnData + -> StopMsg + -> IO () +onStop logger lqMap wsConn connData (StopMsg opId) = do + -- probably wrap the whole thing in a single tx? + opM <- liftIO $ STM.atomically $ STMMap.lookup opId opMap + case opM of + Just (lqId, opNameM) -> do + logWSEvent logger wsConn connData $ EOperation $ opDet opNameM + LQ.removeLiveQuery lqMap lqId + Nothing -> return () + STM.atomically $ STMMap.delete opId opMap + where + -- logger = _wseLogger serverEnv + -- lqMap = _wseLiveQMap serverEnv + opMap = _wscOpMap connData + opDet n = OperationDetails opId Nothing n ODStopped Nothing + +onCloseHandler + :: L.Logger + -> LQ.LiveQueriesState + -> WSConnData + -> WSConn + -> IO () +onCloseHandler logger lqMap connData wsConn = do + logWSEvent logger wsConn connData EClosed + operations <- liftIO $ STM.atomically $ ListT.toList $ STMMap.listT opMap + void $ liftIO $ A.forConcurrently operations $ \(_, (lqId, _)) -> + LQ.removeLiveQuery lqMap lqId + where + opMap = _wscOpMap connData + +logWSEvent + :: MonadIO m => L.Logger -> WSConn -> WSConnData -> WSEvent -> m () +logWSEvent (L.Logger logger) wsConn connData wsEv = do + userInfoME <- liftIO $ STM.readTVarIO userInfoR + let (userVarsM, jwtExpM) = case userInfoME of + CSInitialised userInfo jwtM _ -> ( Just $ userVars userInfo + , jwtM + ) + _ -> (Nothing, Nothing) + liftIO $ logger $ WSLog logLevel $ WSLogInfo userVarsM (WsConnInfo wsId jwtExpM Nothing) wsEv + where + WSConnData userInfoR _ _ = connData + wsId = WS.getWSId wsConn + logLevel = bool L.LevelInfo L.LevelError isError + isError = case wsEv of + EAccepted -> False + ERejected _ -> True + EConnErr _ -> True + EClosed -> False + EOperation op -> case _odOperationType op of + ODStarted -> False + ODProtoErr _ -> True + ODQueryErr _ -> True + ODCompleted -> False + ODStopped -> False + +sendMsg :: MonadIO m => WSConn -> ServerMsg -> m () +sendMsg wsConn = + liftIO . WS.sendMsg wsConn . encodeServerMsg diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Protocol.hs similarity index 90% rename from server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs rename to server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Protocol.hs index 45180bd568903..402cf6b66257a 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Protocol.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Protocol.hs @@ -1,4 +1,4 @@ -module Hasura.GraphQL.Transport.WebSocket.Protocol +module Hasura.GraphQL.Transport.WebSocket.Queries.Protocol ( OperationId(..) , ConnParams(..) , StartMsg(..) @@ -56,11 +56,11 @@ instance J.FromJSON ClientMsg where parseJSON = J.withObject "ClientMessage" $ \obj -> do t <- obj J..: "type" case t of - "connection_init" -> CMConnInit <$> obj J..:? "payload" - "start" -> CMStart <$> J.parseJSON (J.Object obj) - "stop" -> CMStop <$> J.parseJSON (J.Object obj) + "connection_init" -> CMConnInit <$> obj J..:? "payload" + "start" -> CMStart <$> J.parseJSON (J.Object obj) + "stop" -> CMStop <$> J.parseJSON (J.Object obj) "connection_terminate" -> return CMConnTerm - _ -> fail $ "unexpected type for ClientMessage: " <> t + _ -> fail $ "unexpected type for ClientMessage: " <> t -- server to client messages diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Types.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Types.hs new file mode 100644 index 0000000000000..1e2ac3c04b0b9 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Queries/Types.hs @@ -0,0 +1,117 @@ +module Hasura.GraphQL.Transport.WebSocket.Queries.Types where + +import qualified Control.Concurrent.STM as STM +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J +import qualified Data.Time.Clock as TC +import qualified Network.HTTP.Types as H +import qualified StmContainers.Map as STMMap + +import Hasura.GraphQL.Transport.HTTP.Protocol +import Hasura.GraphQL.Transport.WebSocket.Queries.Protocol +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.Server.Utils (RequestId) + +import qualified Hasura.GraphQL.Execute.LiveQuery as LQ +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.Logging as L + +type OperationMap + = STMMap.Map OperationId (LQ.LiveQueryId, Maybe OperationName) + +newtype WsHeaders + = WsHeaders { unWsHeaders :: [H.Header] } + deriving (Show, Eq) + +data WSConnState + -- headers from the client for websockets + = CSNotInitialised !WsHeaders + | CSInitError Text + -- headers from the client (in conn params) to forward to the remote schema + -- and JWT expiry time if any + | CSInitialised UserInfo (Maybe TC.UTCTime) [H.Header] + +data WSConnData + = WSConnData + -- the role and headers are set only on connection_init message + { _wscUser :: !(STM.TVar WSConnState) + -- we only care about subscriptions, + -- the other operations (query/mutations) + -- are not tracked here + , _wscOpMap :: !OperationMap + , _wscErrRespTy :: !WS.ErrRespType + } + +-- Log related types + +data OpDetail + = ODStarted + | ODProtoErr !Text + | ODQueryErr !QErr + | ODCompleted + | ODStopped + deriving (Show, Eq) +$(J.deriveToJSON + J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 + , J.sumEncoding = J.TaggedObject "type" "detail" + } + ''OpDetail) + +data OperationDetails + = OperationDetails + { _odOperationId :: !OperationId + , _odRequestId :: !(Maybe RequestId) + , _odOperationName :: !(Maybe OperationName) + , _odOperationType :: !OpDetail + , _odQuery :: !(Maybe GQLReqUnparsed) + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''OperationDetails) + +data WSEvent + = EAccepted + | ERejected !QErr + | EConnErr !ConnErrMsg + | EOperation !OperationDetails + | EClosed + deriving (Show, Eq) +$(J.deriveToJSON + J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 1 + , J.sumEncoding = J.TaggedObject "type" "detail" + } + ''WSEvent) + +data WsConnInfo + = WsConnInfo + { _wsciWebsocketId :: !WS.WSId + , _wsciJwtExpiry :: !(Maybe TC.UTCTime) + , _wsciMsg :: !(Maybe Text) + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WsConnInfo) + +data WSLogInfo + = WSLogInfo + { _wsliUserVars :: !(Maybe UserVars) + , _wsliConnectionInfo :: !WsConnInfo + , _wsliEvent :: !WSEvent + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 5 J.snakeCase) ''WSLogInfo) + +data WSLog + = WSLog + { _wslLogLevel :: !L.LogLevel + , _wslInfo :: !WSLogInfo + } + +instance L.ToEngineLog WSLog where + toEngineLog (WSLog logLevel wsLog) = + (logLevel, L.ELTWebsocketLog, J.toJSON wsLog) + +mkWsInfoLog :: Maybe UserVars -> WsConnInfo -> WSEvent -> WSLog +mkWsInfoLog uv ci ev = + WSLog L.LevelInfo $ WSLogInfo uv ci ev + +mkWsErrorLog :: Maybe UserVars -> WsConnInfo -> WSEvent -> WSLog +mkWsErrorLog uv ci ev = + WSLog L.LevelError $ WSLogInfo uv ci ev diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs index fa96be1ba2788..c88315bbb1458 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Server.hs @@ -20,8 +20,14 @@ module Hasura.GraphQL.Transport.WebSocket.Server , closeAll , createServerApp , shutdown + + , ErrRespType(..) + , checkPath ) where +import Control.Exception (try) +import Hasura.RQL.Types.Error + import qualified Control.Concurrent.Async as A import qualified Control.Concurrent.STM as STM import qualified Data.Aeson as J @@ -31,12 +37,11 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.TByteString as TBS import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID +import Data.Word (Word16) import qualified ListT import qualified Network.WebSockets as WS import qualified StmContainers.Map as STMMap -import Data.Word (Word16) -import Control.Exception (try) import qualified Hasura.Logging as L import Hasura.Prelude @@ -118,7 +123,7 @@ data ServerStatus a data WSServer a = WSServer - { _wssLogger :: L.Logger + { _wssLogger :: L.Logger , _wssStatus :: !(STM.TVar (ServerStatus a)) } @@ -215,7 +220,7 @@ createServerApp (WSServer logger@(L.Logger writeLog) serverStatus) wsHandlers pe status <- STM.atomically $ do status <- STM.readTVar serverStatus case status of - ShuttingDown -> pure () + ShuttingDown -> pure () AcceptingConns connMap -> STMMap.insert wsConn wsId connMap return status @@ -268,3 +273,15 @@ shutdown (WSServer (L.Logger writeLog) serverStatus) = do STM.writeTVar serverStatus ShuttingDown return conns closeAllWith (flip forceConnReconnect) "shutting server down" conns + +data ErrRespType + = ERTLegacy + | ERTGraphqlCompliant + deriving (Show) + +checkPath :: MonadError QErr m => WS.RequestHead -> m ErrRespType +checkPath requestHead = case WS.requestPath requestHead of + "/v1alpha1/graphql" -> return ERTLegacy + "/v1/graphql" -> return ERTGraphqlCompliant + _ -> + throw404 "only '/v1/graphql', '/v1alpha1/graphql' are supported on websockets" diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Handlers.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Handlers.hs new file mode 100644 index 0000000000000..563e15c16c01b --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Handlers.hs @@ -0,0 +1,186 @@ +module Hasura.GraphQL.Transport.WebSocket.Transaction.Handlers + ( onMessageHandler + , onCloseHandler + , onConnHandler + ) where + +import Hasura.Db +import Hasura.GraphQL.Logging +import Hasura.GraphQL.Transport.HTTP.Protocol +import Hasura.GraphQL.Transport.WebSocket.Common +import Hasura.GraphQL.Transport.WebSocket.Transaction.Protocol +import Hasura.GraphQL.Transport.WebSocket.Transaction.Types +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.Server.Auth (AuthMode, + getUserInfoWithExpTime) +import Hasura.Server.Init (readIsoLevel) +import Hasura.Server.Utils + +import Control.Concurrent (threadDelay) +import Data.Aeson + +import qualified Hasura.GraphQL.Execute as E +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.Logging as L + +import qualified Control.Concurrent.STM as STM +import qualified Data.ByteString.Lazy as BL +import qualified Data.IORef as IORef +import qualified Data.Text as T +import qualified Data.Time.Clock as TC +import qualified Database.PG.Query as PG +import qualified Network.HTTP.Client as H +import qualified Network.HTTP.Types as H +import qualified Network.WebSockets as WS + +onConnHandler + :: L.Logger + -> AuthMode + -> H.Manager + -> PGExecCtx + -> WS.OnConnH ConnState +onConnHandler lg@(L.Logger logger) authMode httpMgr pgExecCtx wsId requestHead = do + resE <- runExceptT resolveAll + case resE of + Left e -> reject e + Right (pgConn, localPool, userInfo, expTyM, errTy) -> do + txStatus <- liftIO $ STM.newTVarIO TxBegin + let acceptRequest = WS.defaultAcceptRequest + { WS.acceptSubprotocol = Just "graphql-tx"} + pgConnCtx = PGConnCtx pgConn localPool + connData = WSTxData userInfo errTy pgConnCtx txStatus + logger $ mkInfoLog wsId EAccepted + pure $ Right $ WS.AcceptWith (CSTransaction connData) acceptRequest Nothing (jwtExpiryHandler <$> expTyM) + where + PGExecCtx pool txIso = pgExecCtx + resolveIsolevelHeader headers = do + let isoLevelHeader = "x-hasura-tx-isolation" + case getRequestHeader isoLevelHeader headers of + Nothing -> pure txIso + Just val -> either (throw404 . ((bsToTxt isoLevelHeader <> ": ") <>) . T.pack) + pure $ readIsoLevel $ T.unpack $ bsToTxt val + + jwtExpiryHandler expTime _ = do + currTime <- TC.getCurrentTime + threadDelay $ diffTimeToMicro $ TC.diffUTCTime expTime currTime + + resolveAll = do + errTy <- WS.checkPath requestHead + let headers = WS.requestHeaders requestHead + (userInfo, expTyM) <- getUserInfoWithExpTime lg httpMgr headers authMode + maybePGConn <- liftIO $ PG.getPGConnMaybe pool + (pgConn, localPool) <- maybe (throw404 "unable to acquire connection from pool, please try again") pure maybePGConn + -- Run begin transaction + txIsoLevel <- resolveIsolevelHeader headers + runLazyTxWithConn pgConn $ beginTx txIsoLevel + pure (pgConn, localPool, userInfo, expTyM, errTy) + + reject qErr = do + logger $ mkErrorLog wsId $ ERejected qErr + pure $ Left $ WS.RejectRequest + (H.statusCode $ qeStatus qErr) + (H.statusMessage $ qeStatus qErr) [] + (BL.toStrict $ encode $ encodeGQLErr False qErr) + +onMessageHandler :: WSServerEnv -> WSTxData -> WSConn -> BL.ByteString -> IO () +onMessageHandler serverEnv wsTxData wsConn rawMessage = + case eitherDecode rawMessage of + Left e -> do + let errMsg = ErrorMessage Nothing wsId $ errFn $ err400 BadRequest $ + "parsing ClientMessage failed: " <> T.pack e + sendMsg wsConn $ SMError errMsg + Right msg -> case msg of + CMExecute (ExecutePayload maybeReqId query) -> do + reqId <- liftIO $ maybe (RequestId <$> generateFingerprint) pure maybeReqId + handleError (Just reqId) $ execute reqId query + CMAbort -> + handleError Nothing $ do + logOp OAbort + runLazyTxWithConn pgConn abortTx + modifyTxStatus TxAbort + pure $ SMClose wsId "Executed 'ABORT' command" + CMCommit -> + handleError Nothing $ do + logOp OCommit + runLazyTxWithConn pgConn commitTx + modifyTxStatus TxCommit + pure $ SMClose wsId "Executed 'COMMIT' command" + where + WSServerEnv lg@(L.Logger logger) pgExecCtx _ gCtxMapRef hMgr _ sqlGenCtx planCache _ enableAL = serverEnv + wsId = WS.getWSId wsConn + pgConn = _pccConn $ _wtdPgConn wsTxData + userInfo = _wtdUserInfo wsTxData + errTy = _wtdErrorType wsTxData + logOp op = liftIO $ logger $ mkInfoLog wsId $ EOperation op + modifyTxStatus status = liftIO $ STM.atomically $ STM.writeTVar (_wtdTxStatus wsTxData) status + + execute :: RequestId -> GQLReqUnparsed -> ExceptT QErr IO ServerMessage + execute reqId query = do + logOp $ OExecute $ ExecuteQuery reqId query + (sc, scVer) <- liftIO $ IORef.readIORef gCtxMapRef + execPlan <- E.getResolvedExecPlan pgExecCtx + planCache userInfo sqlGenCtx enableAL sc scVer hMgr query + case execPlan of + E.GExPHasura resolvedOp -> do + logOp $ OExecute $ ExecuteQuery reqId query + (tx, genSql) <- case resolvedOp of + E.ExOpQuery queryTx genSql -> pure (queryTx, genSql) + E.ExOpMutation mutationTx -> pure (mutationTx, Nothing) + E.ExOpSubs _ -> throw400 NotSupported "Subscriptions are not allowed in graphql transactions" + lift $ logger $ QueryLog query genSql reqId + res <- runLazyTxWithConn pgConn tx + pure $ SMData $ DataMessage reqId wsId res + E.GExPRemote _ _ -> + throw400 NotSupported "Remote server queries are not supported over graphql transactions" + + handleError :: Maybe RequestId -> ExceptT QErr IO ServerMessage -> IO () + handleError maybeReqId action = do + resE <- runExceptT action + case resE of + Right m -> do + sendMsg wsConn m + case m of + SMClose _ _ -> liftIO $ do + onCloseHandler lg wsId wsTxData + WS.closeConn wsConn "Closing connection after 'Commit' and 'Abort'" + _ -> pure () + Left e -> do + logger $ mkErrorLog wsId $ EQueryError e + sendMsg wsConn $ SMError $ ErrorMessage maybeReqId wsId $ errFn e + when (qeError e == "connection error") $ do + onCloseHandler lg wsId wsTxData + liftIO $ WS.closeConn wsConn "PG Connection error occured, closing the connection now" + + errFn = + let isAdmin' = isAdmin $ userRole userInfo + in case errTy of + WS.ERTLegacy -> encodeQErr isAdmin' + WS.ERTGraphqlCompliant -> encodeGQLErr isAdmin' + +onCloseHandler + :: L.Logger + -> WS.WSId + -> WSTxData + -> IO () +onCloseHandler (L.Logger logger) wsId wsTxData = do + txStatus <- liftIO $ STM.atomically $ STM.readTVar txStatusTVar + when (txStatus == TxBegin) $ do + -- If transaction is not committed or aborted, abort now + eRes <- runExceptT $ runLazyTxWithConn pgConn abortTx + either (logger . mkErrorLog wsId . EQueryError) pure eRes + logger $ mkInfoLog wsId EClosed + liftIO $ PG.returnPGConnToPool localPool pgConn + where + txStatusTVar = _wtdTxStatus wsTxData + PGConnCtx pgConn localPool = _wtdPgConn wsTxData + +mkInfoLog :: WS.WSId -> WSEvent -> WSLog +mkInfoLog wsId event = WSLog L.LevelInfo $ WSLogInfo wsId event + +mkErrorLog :: WS.WSId -> WSEvent -> WSLog +mkErrorLog wsId event = WSLog L.LevelError $ WSLogInfo wsId event + +sendMsg :: (MonadIO m) => WSConn -> ServerMessage -> m () +sendMsg wsConn = + liftIO . WS.sendMsg wsConn . encodeServerMessage diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Protocol.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Protocol.hs new file mode 100644 index 0000000000000..cf489e70c966d --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Protocol.hs @@ -0,0 +1,111 @@ +module Hasura.GraphQL.Transport.WebSocket.Transaction.Protocol where + +import Hasura.EncJSON +import Hasura.GraphQL.Transport.HTTP.Protocol +import Hasura.Prelude +import Hasura.Server.Utils + +import Data.Aeson +import Data.Aeson.Casing +import Data.Aeson.TH + +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS + +import qualified Data.ByteString.Lazy as BL + +data ExecutePayload + = ExecutePayload + { _epRequestId :: !(Maybe RequestId) + , _epQuery :: !GQLReqUnparsed + } deriving (Show, Eq) +$(deriveFromJSON (aesonDrop 3 snakeCase) ''ExecutePayload) + +data ClientMessage + = CMExecute !ExecutePayload + | CMAbort + | CMCommit + deriving (Show, Eq) + +instance FromJSON ClientMessage where + parseJSON = withObject "Object" $ \obj -> do + ty <- obj .: "type" + case ty of + "execute" -> CMExecute <$> obj .: "payload" + "abort" -> pure CMAbort + "commit" -> pure CMCommit + _ -> fail $ "unexpected type for ClientMessage: " <> ty + +data DataMessage + = DataMessage + { _dmId :: !RequestId + , _dmWsId :: !WS.WSId + , _dmPayload :: !EncJSON + } + +data ErrorMessage + = ErrorMessage + { _emId :: !(Maybe RequestId) + , _emWsId :: !WS.WSId + , _emPayload :: !Value + } + +data ServerMessage + = SMConnErr !Text + | SMExecMessage !Text + | SMData !DataMessage + | SMError !ErrorMessage + | SMClose !WS.WSId !Text + +data ServerMsgType + = SMT_GQL_TX_CONNECTION_ERROR + | SMT_GQL_TX_DATA + | SMT_GQL_TX_ERROR + | SMT_GQL_TX_CLOSE + deriving (Eq) + +instance Show ServerMsgType where + show = \case + SMT_GQL_TX_CONNECTION_ERROR -> "connection_error" + SMT_GQL_TX_DATA -> "data" + SMT_GQL_TX_ERROR -> "error" + SMT_GQL_TX_CLOSE -> "close" + +instance ToJSON ServerMsgType where + toJSON = toJSON . show + +encodeServerMessage :: ServerMessage -> BL.ByteString +encodeServerMessage msg = + encJToLBS $ encJFromAssocList $ case msg of + + SMConnErr connErr -> + [ encTy SMT_GQL_TX_CONNECTION_ERROR + , ("payload", encJFromJValue connErr) + ] + + SMExecMessage message -> + [ encTy SMT_GQL_TX_DATA + , ("payload", encJFromJValue message) + ] + + SMData (DataMessage reqId wsId payload) -> + [ encTy SMT_GQL_TX_DATA + , ("request_id", encJFromJValue reqId) + , ("id", encJFromJValue wsId) + , ("payload", payload) + ] + + SMError (ErrorMessage reqId wsId payload) -> + [ encTy SMT_GQL_TX_ERROR + , ("request_id", encJFromJValue reqId) + , ("id", encJFromJValue wsId) + , ("payload", encJFromJValue payload) + ] + + SMClose wsId message -> + [ encTy SMT_GQL_TX_CLOSE + , ("id", encJFromJValue wsId) + , ("payload", encJFromJValue message) + ] + + where + encTy ty = ("type", encJFromJValue ty) diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Types.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Types.hs new file mode 100644 index 0000000000000..be6e400021f63 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket/Transaction/Types.hs @@ -0,0 +1,85 @@ +module Hasura.GraphQL.Transport.WebSocket.Transaction.Types where + +import Hasura.GraphQL.Transport.HTTP.Protocol +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.Server.Utils + +import Data.Aeson +import Data.Aeson.Casing +import Data.Aeson.TH + +import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS +import qualified Hasura.Logging as L + +import qualified Control.Concurrent.STM as STM +import qualified Database.PG.Query as PG + +data PGConnCtx + = PGConnCtx + { _pccConn :: !PG.PGConn + , _pccLocalPool :: !PG.LocalPGPool + } + +data TxStatus + = TxBegin + | TxCommit + | TxAbort + deriving (Eq) + +data WSTxData + = WSTxData + { _wtdUserInfo :: !UserInfo + , _wtdErrorType :: !WS.ErrRespType + , _wtdPgConn :: !PGConnCtx + , _wtdTxStatus :: !(STM.TVar TxStatus) + } + +data ExecuteQuery + = ExecuteQuery + { _eqRequestId :: !RequestId + , _eqQuery :: !GQLReqUnparsed + } +$(deriveToJSON (aesonDrop 3 snakeCase) ''ExecuteQuery) + +data Operation + = OExecute !ExecuteQuery + | OCommit + | OAbort + +$(deriveToJSON + defaultOptions { constructorTagModifier = snakeCase . drop 1 + , sumEncoding = TaggedObject "type" "detail" + } + ''Operation) + +data WSEvent + = EAccepted + | ERejected !QErr + | EConnErr !Text + | EOperation !Operation + | EQueryError !QErr + | EClosed + +$(deriveToJSON + defaultOptions { constructorTagModifier = snakeCase . drop 1 + , sumEncoding = TaggedObject "type" "detail" + } + ''WSEvent) + +data WSLogInfo + = WSLogInfo + { _wsliWebsocketId :: !WS.WSId + , _wsliEvent :: !WSEvent + } +$(deriveToJSON (aesonDrop 5 snakeCase) ''WSLogInfo) + +data WSLog + = WSLog + { _wslLogLevel :: !L.LogLevel + , _wslInfo :: !WSLogInfo + } + +instance L.ToEngineLog WSLog where + toEngineLog (WSLog logLevel wsLog) = + (logLevel, L.ELTWebsocketTxLog, toJSON wsLog) diff --git a/server/src-lib/Hasura/Logging.hs b/server/src-lib/Hasura/Logging.hs index a50359c37b99c..12173b3959e9d 100644 --- a/server/src-lib/Hasura/Logging.hs +++ b/server/src-lib/Hasura/Logging.hs @@ -45,6 +45,7 @@ newtype FormattedTime data EngineLogType = ELTHttpLog | ELTWebsocketLog + | ELTWebsocketTxLog | ELTWebhookLog | ELTQueryLog | ELTStartup @@ -83,7 +84,7 @@ alwaysOnLogTypes = Set.fromList defaultEnabledLogTypes :: Set.HashSet EngineLogType defaultEnabledLogTypes = Set.union alwaysOnLogTypes $ - Set.fromList [ELTStartup, ELTHttpLog, ELTWebhookLog, ELTWebsocketLog] + Set.fromList [ELTStartup, ELTHttpLog, ELTWebhookLog, ELTWebsocketLog, ELTWebsocketTxLog] -- log types that can be set by the user userAllowedLogTypes :: [EngineLogType] diff --git a/server/stack.yaml b/server/stack.yaml index 675e3d69d79ff..8a8da65fa9030 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -16,8 +16,8 @@ rebuild-ghc-options: true # Packages to be pulled from upstream that are not in the resolver (e.g., acme-missiles-0.3) extra-deps: # use https URLs so that build systems can clone these repos -- git: https://github.com/hasura/pg-client-hs.git - commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 +- git: https://github.com/rakeshkky/pg-client-hs.git + commit: 8c26ce5b64f7b10b350642c5ed47eaa51cb23ea3 - git: https://github.com/0x777/graphql-parser-hs.git commit: 6eda2bf6bafe6d90bc4fe369f656a3cb979b041a - git: https://github.com/hasura/ci-info-hs.git diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index 370c2c25a7c2a..944395eccbd0e 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -10,14 +10,14 @@ packages: sha256: 0ef7cf19d08caa11c690a732f14e4b7159c46cdda1d9e66dceb6d4bedd9fd9c1 name: pg-client version: 0.1.0 - git: https://github.com/hasura/pg-client-hs.git + git: https://github.com/rakeshkky/pg-client-hs.git pantry-tree: size: 1107 - sha256: e008d56e5b0535223b856be94a8e71e31d7dabe10b2951a38447df5089de1876 - commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 + sha256: 50cf438195e8bf109c24b99328a804772fff5db07a7b7e1146afd2738af55ffc + commit: 8c26ce5b64f7b10b350642c5ed47eaa51cb23ea3 original: - git: https://github.com/hasura/pg-client-hs.git - commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 + git: https://github.com/rakeshkky/pg-client-hs.git + commit: 8c26ce5b64f7b10b350642c5ed47eaa51cb23ea3 - completed: cabal-file: size: 3364