{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} module Data.Morpheus.Server.Apollo ( ApolloSubscription(..) , apolloProtocol , toApolloResponse , parseApolloRequest ) where import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), eitherDecode, encode, pairs, withObject, (.:), (.:?), (.=)) import Data.ByteString.Lazy.Char8 (ByteString) import Data.Map (Map) import qualified Data.Morpheus.Types.Internal.Value as V (Value) import Data.Morpheus.Types.IO (GQLResponse) import Data.Semigroup ((<>)) import Data.Text (Text) import GHC.Generics (Generic) import Network.WebSockets (AcceptRequest (..)) data ApolloSubscription a = ApolloSubscription { apolloId :: Maybe Int , apolloType :: Text , apolloPayload :: Maybe a , apolloQuery :: Maybe Text , apolloOperationName :: Maybe Text , apolloVariables :: Maybe (Map Text V.Value) } deriving (Generic) instance FromJSON (ApolloSubscription Value) where parseJSON = withObject "ApolloSubscription" objectParser where objectParser o = ApolloSubscription <$> o .:? "id" <*> o .: "type" <*> o .:? "payload" <*> o .:? "query" <*> o .:? "operationName" <*> o .:? "variables" instance ToJSON (ApolloSubscription GQLResponse) where toEncoding (ApolloSubscription id' type' payload' query' operationName' variables') = pairs $ "id" .= id' <> "type" .= type' <> "payload" .= payload' <> "query" .= query' <> "operationName" .= operationName' <> "variables" .= variables' apolloProtocol :: AcceptRequest apolloProtocol = AcceptRequest (Just "graphql-subscriptions") [] toApolloResponse :: Int -> GQLResponse -> ByteString toApolloResponse sid' val' = encode $ ApolloSubscription (Just sid') "subscription_data" (Just val') Nothing Nothing Nothing parseApolloRequest :: ByteString -> Either String (ApolloSubscription Value) parseApolloRequest = eitherDecode