Fix GraphQL subscriptions (#254)

graphql/src/Mu/GraphQL/Server.hs

@@ -186,8 +186,13 @@ wsGraphQLAppTrans
     -> WS.ServerApp
 wsGraphQLAppTrans f server q m s conn
   = do let headers = WS.requestHeaders $ WS.pendingRequest conn
-       conn' <- WS.acceptRequest conn
-       flip protocol conn' $ runSubscriptionPipeline f headers server q m s
+       case lookup "Sec-WebSocket-Protocol" headers of
+         Just v
+           | v == "graphql-ws" || v == "graphql-transport-ws"
+           -> do conn' <- WS.acceptRequestWith conn (WS.AcceptRequest (Just v) [])
+                 flip protocol conn' $
+                   runSubscriptionPipeline f headers server q m s
+         _ -> WS.rejectRequest conn "unsupported protocol"
 
 -- | Run a Mu 'graphQLApp' using the given 'Settings'.
 --

graphql/src/Mu/GraphQL/Subscription/Protocol.hs

@@ -119,6 +119,9 @@ data ServerMessage
   | GQLKeepAlive
   deriving Show
 
+-- NOTE: using https://github.com/apollographql/subscriptions-transport-ws/blob/master/src/message-types.ts
+-- as source of truth for the message types
+
 instance A.FromJSON ClientMessage where
   parseJSON = A.withObject "ClientMessage" $ \v -> do
      ty :: String <- v .: "type"
@@ -147,7 +150,7 @@ instance A.ToJSON ServerMessage where
   toJSON (GQLConnectionError e)
     = A.object [theType "connection_error", "payload" .= e]
   toJSON GQLConnectionAck
-    = A.object [theType "connection_acl"]
+    = A.object [theType "connection_ack"]
   toJSON (GQLData i p)
     = A.object [theType "data", "id" .= i, "payload" .= p]
   toJSON (GQLError i p)
@@ -155,4 +158,4 @@ instance A.ToJSON ServerMessage where
   toJSON (GQLComplete i)
     = A.object [theType "complete", "id" .= i]
   toJSON GQLKeepAlive
-    = A.object [theType "connection_keep_alive"]
+    = A.object [theType "ka"]