{-# LANGUAGE OverloadedStrings #-}
module Data.Morpheus.Server
( gqlSocketApp
, initGQLState
, GQLState
, GQLAPI
) where
import Control.Exception (finally)
import Control.Monad (forever)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Morpheus.Server.Apollo (ApolloSubscription (..), apolloProtocol, parseApolloRequest)
import Data.Morpheus.Server.ClientRegister (GQLState, addClientSubscription, connectClient,
disconnectClient, initGQLState, publishUpdates,
removeClientSubscription)
import Data.Morpheus.Types (GQLRequest (..))
import Data.Morpheus.Types.Internal.WebSocket (GQLClient (..), OutputAction (..))
import Network.WebSockets (ServerApp, acceptRequestWith, forkPingThread, receiveData,
sendTextData)
type GQLAPI = GQLRequest -> IO (OutputAction IO ByteString)
handleGQLResponse :: GQLClient -> GQLState -> Int -> OutputAction IO ByteString -> IO ()
handleGQLResponse GQLClient {clientConnection = connection', clientID = clientId'} state sessionId' msg =
case msg of
PublishMutation { mutationChannels = channels'
, currentSubscriptionStateResolver = resolver'
, mutationResponse = response'
} -> sendTextData connection' response' >> publishUpdates channels' resolver' state
InitSubscription {subscriptionQuery = selection', subscriptionChannels = channels'} ->
addClientSubscription clientId' selection' channels' sessionId' state
NoEffect response' -> sendTextData connection' response'
queryHandler :: GQLAPI -> GQLClient -> GQLState -> IO ()
queryHandler interpreter' client'@GQLClient {clientConnection = connection', clientID = id'} state =
forever handleRequest
where
handleRequest = do
msg <- receiveData connection'
case parseApolloRequest msg of
Left x -> print x
Right ApolloSubscription {apolloType = "subscription_end", apolloId = Just sid'} ->
removeClientSubscription id' sid' state
Right ApolloSubscription { apolloType = "subscription_start"
, apolloId = Just sid'
, apolloQuery = Just query'
, apolloOperationName = name'
, apolloVariables = variables'
} -> interpreter' request >>= handleGQLResponse client' state sid'
where request = GQLRequest {query = query', operationName = name', variables = variables'}
Right _ -> return ()
gqlSocketApp :: GQLAPI -> GQLState -> ServerApp
gqlSocketApp interpreter' state pending = do
connection' <- acceptRequestWith pending apolloProtocol
forkPingThread connection' 30
client' <- connectClient connection' state
finally (queryHandler interpreter' client' state) (disconnectClient client' state)