mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
c52bfc540d
This is the result of a general audit of how we fork threads, with a detour into how we're using mutable state especially in websocket codepaths, making more robust to async exceptions and exceptions resulting from bugs. Some highlights: - use a wrapper around 'immortal' so threads that die due to bugs are restarted, and log the error - use 'withAsync' some places - use bracket a few places where we might break invariants - log some codepaths that represent bugs - export UnstructuredLog for ad hoc logging (the alternative is we continue not logging useful stuff) I had to timebox this. There are a few TODOs I didn't want to address. And we'll wait until this is merged to attempt #3705 for Control.Concurrent.Extended
151 lines
3.9 KiB
Haskell
151 lines
3.9 KiB
Haskell
-- | See: https://github.com/apollographql/subscriptions-transport-ws/blob/master/PROTOCOL.md
|
|
module Hasura.GraphQL.Transport.WebSocket.Protocol
|
|
( OperationId(..)
|
|
, ConnParams(..)
|
|
, StartMsg(..)
|
|
, StopMsg(..)
|
|
, ClientMsg(..)
|
|
, ServerMsg(..)
|
|
, encodeServerMsg
|
|
, DataMsg(..)
|
|
, ErrorMsg(..)
|
|
, ConnErrMsg(..)
|
|
, CompletionMsg(..)
|
|
) where
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Casing as J
|
|
import qualified Data.Aeson.TH as J
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import qualified Data.HashMap.Strict as Map
|
|
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
|
import Hasura.Prelude
|
|
|
|
-- | These come from the client and are websocket connection-local.
|
|
newtype OperationId
|
|
= OperationId { unOperationId :: Text }
|
|
deriving (Show, Eq, J.ToJSON, J.FromJSON, Hashable)
|
|
|
|
data StartMsg
|
|
= StartMsg
|
|
{ _smId :: !OperationId
|
|
, _smPayload :: !GQLReqUnparsed
|
|
} deriving (Show, Eq)
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''StartMsg)
|
|
|
|
data StopMsg
|
|
= StopMsg
|
|
{ _stId :: OperationId
|
|
} deriving (Show, Eq)
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''StopMsg)
|
|
|
|
data ClientMsg
|
|
= CMConnInit !(Maybe ConnParams)
|
|
| CMStart !StartMsg
|
|
| CMStop !StopMsg
|
|
| CMConnTerm
|
|
deriving (Show, Eq)
|
|
|
|
data ConnParams
|
|
= ConnParams
|
|
{ _cpHeaders :: Maybe (Map.HashMap Text Text)
|
|
} deriving (Show, Eq)
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ConnParams)
|
|
|
|
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_terminate" -> return CMConnTerm
|
|
_ -> fail $ "unexpected type for ClientMessage: " <> t
|
|
|
|
-- server to client messages
|
|
data DataMsg
|
|
= DataMsg
|
|
{ _dmId :: !OperationId
|
|
, _dmPayload :: !GraphqlResponse
|
|
}
|
|
|
|
data ErrorMsg
|
|
= ErrorMsg
|
|
{ _emId :: !OperationId
|
|
, _emPayload :: !J.Value
|
|
} deriving (Show, Eq)
|
|
|
|
newtype CompletionMsg
|
|
= CompletionMsg { unCompletionMsg :: OperationId }
|
|
deriving (Show, Eq)
|
|
|
|
newtype ConnErrMsg
|
|
= ConnErrMsg { unConnErrMsg :: Text }
|
|
deriving (Show, Eq, J.ToJSON, J.FromJSON, IsString)
|
|
|
|
data ServerMsg
|
|
= SMConnAck
|
|
| SMConnKeepAlive
|
|
| SMConnErr !ConnErrMsg
|
|
| SMData !DataMsg
|
|
| SMErr !ErrorMsg
|
|
| SMComplete !CompletionMsg
|
|
|
|
data ServerMsgType
|
|
= SMT_GQL_CONNECTION_ACK
|
|
| SMT_GQL_CONNECTION_KEEP_ALIVE
|
|
| SMT_GQL_CONNECTION_ERROR
|
|
| SMT_GQL_DATA
|
|
| SMT_GQL_ERROR
|
|
| SMT_GQL_COMPLETE
|
|
deriving (Eq)
|
|
|
|
instance Show ServerMsgType where
|
|
show = \case
|
|
SMT_GQL_CONNECTION_ACK -> "connection_ack"
|
|
SMT_GQL_CONNECTION_KEEP_ALIVE -> "ka"
|
|
SMT_GQL_CONNECTION_ERROR -> "connection_error"
|
|
SMT_GQL_DATA -> "data"
|
|
SMT_GQL_ERROR -> "error"
|
|
SMT_GQL_COMPLETE -> "complete"
|
|
|
|
instance J.ToJSON ServerMsgType where
|
|
toJSON = J.toJSON . show
|
|
|
|
encodeServerMsg :: ServerMsg -> BL.ByteString
|
|
encodeServerMsg msg =
|
|
encJToLBS $ encJFromAssocList $ case msg of
|
|
|
|
SMConnAck ->
|
|
[encTy SMT_GQL_CONNECTION_ACK]
|
|
|
|
SMConnKeepAlive ->
|
|
[encTy SMT_GQL_CONNECTION_KEEP_ALIVE]
|
|
|
|
SMConnErr connErr ->
|
|
[ encTy SMT_GQL_CONNECTION_ERROR
|
|
, ("payload", encJFromJValue connErr)
|
|
]
|
|
|
|
SMData (DataMsg opId payload) ->
|
|
[ encTy SMT_GQL_DATA
|
|
, ("id", encJFromJValue opId)
|
|
, ("payload", encodeGraphqlResponse payload)
|
|
]
|
|
|
|
SMErr (ErrorMsg opId payload) ->
|
|
[ encTy SMT_GQL_ERROR
|
|
, ("id", encJFromJValue opId)
|
|
, ("payload", encJFromJValue payload)
|
|
]
|
|
|
|
SMComplete compMsg ->
|
|
[ encTy SMT_GQL_COMPLETE
|
|
, ("id", encJFromJValue $ unCompletionMsg compMsg)
|
|
]
|
|
|
|
where
|
|
encTy ty = ("type", encJFromJValue ty)
|