{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Subscriptions.Apollo
  ( ApolloAction (..),
    apolloFormat,
    acceptApolloRequest,
    toApolloResponse,
    Validation,
    ApolloSubscription (..),
    ApolloMessageType (..),
  )
where

import Control.Applicative (Applicative (..))
import Control.Monad.Fail (fail)
import Control.Monad.IO.Class (MonadIO (..))
import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    Value (..),
    eitherDecode,
    encode,
    pairs,
    withObject,
    withText,
    (.:),
    (.:?),
    (.=),
  )
import Data.ByteString.Lazy.Char8
  ( ByteString,
    pack,
  )
import Data.Either
  ( Either (..),
    either,
  )
import Data.Functor ((<$>))
import Data.Maybe
  ( Maybe (..),
    maybe,
  )
import Data.Morpheus.Types.IO
  ( GQLRequest (..),
    GQLResponse,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    Token,
  )
import Data.Semigroup ((<>))
import Data.Text
  ( Text,
    unpack,
  )
import GHC.Generics (Generic)
import Network.WebSockets
  ( AcceptRequest (..),
    Connection,
    PendingConnection,
    RequestHead,
    acceptRequestWith,
    getRequestSubprotocols,
    pendingRequest,
  )
import Prelude
  ( Eq,
    Show,
    String,
    mempty,
    return,
    ($),
    (.),
  )

type ID = Text

data ApolloSubscription payload = ApolloSubscription
  { forall payload. ApolloSubscription payload -> Maybe Text
apolloId :: Maybe ID,
    forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType :: ApolloMessageType,
    forall payload. ApolloSubscription payload -> Maybe payload
apolloPayload :: Maybe payload
  }
  deriving (Int -> ApolloSubscription payload -> ShowS
[ApolloSubscription payload] -> ShowS
ApolloSubscription payload -> String
(Int -> ApolloSubscription payload -> ShowS)
-> (ApolloSubscription payload -> String)
-> ([ApolloSubscription payload] -> ShowS)
-> Show (ApolloSubscription payload)
forall payload.
Show payload =>
Int -> ApolloSubscription payload -> ShowS
forall payload.
Show payload =>
[ApolloSubscription payload] -> ShowS
forall payload.
Show payload =>
ApolloSubscription payload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall payload.
Show payload =>
Int -> ApolloSubscription payload -> ShowS
showsPrec :: Int -> ApolloSubscription payload -> ShowS
$cshow :: forall payload.
Show payload =>
ApolloSubscription payload -> String
show :: ApolloSubscription payload -> String
$cshowList :: forall payload.
Show payload =>
[ApolloSubscription payload] -> ShowS
showList :: [ApolloSubscription payload] -> ShowS
Show, (forall x.
 ApolloSubscription payload -> Rep (ApolloSubscription payload) x)
-> (forall x.
    Rep (ApolloSubscription payload) x -> ApolloSubscription payload)
-> Generic (ApolloSubscription payload)
forall x.
Rep (ApolloSubscription payload) x -> ApolloSubscription payload
forall x.
ApolloSubscription payload -> Rep (ApolloSubscription payload) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall payload x.
Rep (ApolloSubscription payload) x -> ApolloSubscription payload
forall payload x.
ApolloSubscription payload -> Rep (ApolloSubscription payload) x
$cfrom :: forall payload x.
ApolloSubscription payload -> Rep (ApolloSubscription payload) x
from :: forall x.
ApolloSubscription payload -> Rep (ApolloSubscription payload) x
$cto :: forall payload x.
Rep (ApolloSubscription payload) x -> ApolloSubscription payload
to :: forall x.
Rep (ApolloSubscription payload) x -> ApolloSubscription payload
Generic)

instance (FromJSON a) => FromJSON (ApolloSubscription a) where
  parseJSON :: Value -> Parser (ApolloSubscription a)
parseJSON = String
-> (Object -> Parser (ApolloSubscription a))
-> Value
-> Parser (ApolloSubscription a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApolloSubscription" Object -> Parser (ApolloSubscription a)
forall {payload}.
FromJSON payload =>
Object -> Parser (ApolloSubscription payload)
objectParser
    where
      objectParser :: Object -> Parser (ApolloSubscription payload)
objectParser Object
o =
        Maybe Text
-> ApolloMessageType -> Maybe payload -> ApolloSubscription payload
forall payload.
Maybe Text
-> ApolloMessageType -> Maybe payload -> ApolloSubscription payload
ApolloSubscription
          (Maybe Text
 -> ApolloMessageType
 -> Maybe payload
 -> ApolloSubscription payload)
-> Parser (Maybe Text)
-> Parser
     (ApolloMessageType -> Maybe payload -> ApolloSubscription payload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
          Parser
  (ApolloMessageType -> Maybe payload -> ApolloSubscription payload)
-> Parser ApolloMessageType
-> Parser (Maybe payload -> ApolloSubscription payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser ApolloMessageType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
          Parser (Maybe payload -> ApolloSubscription payload)
-> Parser (Maybe payload) -> Parser (ApolloSubscription payload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe payload)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload"

data RequestPayload = RequestPayload
  { RequestPayload -> Maybe FieldName
payloadOperationName :: Maybe FieldName,
    RequestPayload -> Maybe Text
payloadQuery :: Maybe Token,
    RequestPayload -> Maybe Value
payloadVariables :: Maybe Value
  }
  deriving (Int -> RequestPayload -> ShowS
[RequestPayload] -> ShowS
RequestPayload -> String
(Int -> RequestPayload -> ShowS)
-> (RequestPayload -> String)
-> ([RequestPayload] -> ShowS)
-> Show RequestPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestPayload -> ShowS
showsPrec :: Int -> RequestPayload -> ShowS
$cshow :: RequestPayload -> String
show :: RequestPayload -> String
$cshowList :: [RequestPayload] -> ShowS
showList :: [RequestPayload] -> ShowS
Show, (forall x. RequestPayload -> Rep RequestPayload x)
-> (forall x. Rep RequestPayload x -> RequestPayload)
-> Generic RequestPayload
forall x. Rep RequestPayload x -> RequestPayload
forall x. RequestPayload -> Rep RequestPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestPayload -> Rep RequestPayload x
from :: forall x. RequestPayload -> Rep RequestPayload x
$cto :: forall x. Rep RequestPayload x -> RequestPayload
to :: forall x. Rep RequestPayload x -> RequestPayload
Generic)

instance FromJSON RequestPayload where
  parseJSON :: Value -> Parser RequestPayload
parseJSON = String
-> (Object -> Parser RequestPayload)
-> Value
-> Parser RequestPayload
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApolloPayload" Object -> Parser RequestPayload
objectParser
    where
      objectParser :: Object -> Parser RequestPayload
objectParser Object
o =
        Maybe FieldName -> Maybe Text -> Maybe Value -> RequestPayload
RequestPayload
          (Maybe FieldName -> Maybe Text -> Maybe Value -> RequestPayload)
-> Parser (Maybe FieldName)
-> Parser (Maybe Text -> Maybe Value -> RequestPayload)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe FieldName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"operationName"
          Parser (Maybe Text -> Maybe Value -> RequestPayload)
-> Parser (Maybe Text) -> Parser (Maybe Value -> RequestPayload)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"query"
          Parser (Maybe Value -> RequestPayload)
-> Parser (Maybe Value) -> Parser RequestPayload
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"variables"

instance (ToJSON a) => ToJSON (ApolloSubscription a) where
  toEncoding :: ApolloSubscription a -> Encoding
toEncoding (ApolloSubscription Maybe Text
id' ApolloMessageType
type' Maybe a
payload') =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      Key -> Maybe Text -> Series
forall {a} {e} {v}.
(Monoid a, KeyValue e a, ToJSON v) =>
Key -> Maybe v -> a
encodeMaybe Key
"id" Maybe Text
id'
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"type" Key -> ApolloMessageType -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ApolloMessageType
type'
        Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key -> Maybe a -> Series
forall {a} {e} {v}.
(Monoid a, KeyValue e a, ToJSON v) =>
Key -> Maybe v -> a
encodeMaybe Key
"payload" Maybe a
payload'
    where
      -- Messages should only include these fields when they have real values,
      -- for example the MessageAck response should only include the type and optionally
      -- extraneous data in the payload.
      -- Aeson < 2.0.0 has Keys as Text, >= 2.0.0 has Data.Aeson.Key.Key
      -- encodeMaybe :: ToJSON b => Text -> Maybe b -> Series
      encodeMaybe :: Key -> Maybe v -> a
encodeMaybe Key
_ Maybe v
Nothing = a
forall a. Monoid a => a
Prelude.mempty
      encodeMaybe Key
k (Just v
v) = Key
k Key -> v -> a
forall v. ToJSON v => Key -> v -> a
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
v

acceptApolloRequest ::
  (MonadIO m) =>
  PendingConnection ->
  m Connection
acceptApolloRequest :: forall (m :: * -> *).
MonadIO m =>
PendingConnection -> m Connection
acceptApolloRequest PendingConnection
pending =
  IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$
    PendingConnection -> AcceptRequest -> IO Connection
acceptRequestWith
      PendingConnection
pending
      (RequestHead -> AcceptRequest
acceptApolloSubProtocol (PendingConnection -> RequestHead
pendingRequest PendingConnection
pending))

acceptApolloSubProtocol :: RequestHead -> AcceptRequest
acceptApolloSubProtocol :: RequestHead -> AcceptRequest
acceptApolloSubProtocol RequestHead
reqHead =
  [ByteString] -> AcceptRequest
forall {a}. (Eq a, IsString a) => [a] -> AcceptRequest
apolloProtocol (RequestHead -> [ByteString]
getRequestSubprotocols RequestHead
reqHead)
  where
    apolloProtocol :: [a] -> AcceptRequest
apolloProtocol [a
"graphql-subscriptions"] =
      Maybe ByteString -> Headers -> AcceptRequest
AcceptRequest (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"graphql-subscriptions") []
    apolloProtocol [a
"graphql-ws"] =
      Maybe ByteString -> Headers -> AcceptRequest
AcceptRequest (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"graphql-ws") []
    apolloProtocol [a
"graphql-transport-ws"] =
      Maybe ByteString -> Headers -> AcceptRequest
AcceptRequest (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"graphql-transport-ws") []
    apolloProtocol [a]
_ = Maybe ByteString -> Headers -> AcceptRequest
AcceptRequest Maybe ByteString
forall a. Maybe a
Nothing []

toApolloResponse :: ApolloMessageType -> Maybe ID -> Maybe GQLResponse -> ByteString
toApolloResponse :: ApolloMessageType -> Maybe Text -> Maybe GQLResponse -> ByteString
toApolloResponse ApolloMessageType
responseType Maybe Text
sid_myb Maybe GQLResponse
val_myb =
  ApolloSubscription GQLResponse -> ByteString
forall a. ToJSON a => a -> ByteString
encode (ApolloSubscription GQLResponse -> ByteString)
-> ApolloSubscription GQLResponse -> ByteString
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> ApolloMessageType
-> Maybe GQLResponse
-> ApolloSubscription GQLResponse
forall payload.
Maybe Text
-> ApolloMessageType -> Maybe payload -> ApolloSubscription payload
ApolloSubscription Maybe Text
sid_myb ApolloMessageType
responseType Maybe GQLResponse
val_myb

data ApolloMessageType
  = GqlConnectionAck
  | GqlConnectionError
  | GqlData
  | GqlError
  | GqlComplete
  | GqlConnectionInit
  | GqlSubscribe
  | GqlPing
  | GqlPong
  deriving (ApolloMessageType -> ApolloMessageType -> Bool
(ApolloMessageType -> ApolloMessageType -> Bool)
-> (ApolloMessageType -> ApolloMessageType -> Bool)
-> Eq ApolloMessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApolloMessageType -> ApolloMessageType -> Bool
== :: ApolloMessageType -> ApolloMessageType -> Bool
$c/= :: ApolloMessageType -> ApolloMessageType -> Bool
/= :: ApolloMessageType -> ApolloMessageType -> Bool
Eq, Int -> ApolloMessageType -> ShowS
[ApolloMessageType] -> ShowS
ApolloMessageType -> String
(Int -> ApolloMessageType -> ShowS)
-> (ApolloMessageType -> String)
-> ([ApolloMessageType] -> ShowS)
-> Show ApolloMessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApolloMessageType -> ShowS
showsPrec :: Int -> ApolloMessageType -> ShowS
$cshow :: ApolloMessageType -> String
show :: ApolloMessageType -> String
$cshowList :: [ApolloMessageType] -> ShowS
showList :: [ApolloMessageType] -> ShowS
Show, (forall x. ApolloMessageType -> Rep ApolloMessageType x)
-> (forall x. Rep ApolloMessageType x -> ApolloMessageType)
-> Generic ApolloMessageType
forall x. Rep ApolloMessageType x -> ApolloMessageType
forall x. ApolloMessageType -> Rep ApolloMessageType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ApolloMessageType -> Rep ApolloMessageType x
from :: forall x. ApolloMessageType -> Rep ApolloMessageType x
$cto :: forall x. Rep ApolloMessageType x -> ApolloMessageType
to :: forall x. Rep ApolloMessageType x -> ApolloMessageType
Generic)

instance FromJSON ApolloMessageType where
  parseJSON :: Value -> Parser ApolloMessageType
parseJSON = String
-> (Text -> Parser ApolloMessageType)
-> Value
-> Parser ApolloMessageType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ApolloMessageType" Text -> Parser ApolloMessageType
forall {a} {m :: * -> *}.
(Eq a, IsString a, MonadFail m) =>
a -> m ApolloMessageType
txtParser
    where
      txtParser :: a -> m ApolloMessageType
txtParser a
"connection_ack" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlConnectionAck
      txtParser a
"connection_error" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlConnectionError
      txtParser a
"next" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlData
      txtParser a
"error" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlError
      txtParser a
"complete" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlComplete
      txtParser a
"connection_init" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlConnectionInit
      txtParser a
"subscribe" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlSubscribe
      txtParser a
"ping" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlPing
      txtParser a
"pong" = ApolloMessageType -> m ApolloMessageType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ApolloMessageType
GqlPong
      txtParser a
_ = String -> m ApolloMessageType
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid type encountered."

instance ToJSON ApolloMessageType where
  toEncoding :: ApolloMessageType -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding)
-> (ApolloMessageType -> Text) -> ApolloMessageType -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApolloMessageType -> Text
apolloResponseToProtocolMsgType

apolloResponseToProtocolMsgType :: ApolloMessageType -> Text
apolloResponseToProtocolMsgType :: ApolloMessageType -> Text
apolloResponseToProtocolMsgType ApolloMessageType
GqlConnectionAck = Text
"connection_ack"
apolloResponseToProtocolMsgType ApolloMessageType
GqlConnectionError = Text
"connection_error"
apolloResponseToProtocolMsgType ApolloMessageType
GqlConnectionInit = Text
"connection_init"
apolloResponseToProtocolMsgType ApolloMessageType
GqlData = Text
"next"
apolloResponseToProtocolMsgType ApolloMessageType
GqlError = Text
"error"
apolloResponseToProtocolMsgType ApolloMessageType
GqlComplete = Text
"complete"
apolloResponseToProtocolMsgType ApolloMessageType
GqlSubscribe = Text
"subscribe"
apolloResponseToProtocolMsgType ApolloMessageType
GqlPing = Text
"ping"
apolloResponseToProtocolMsgType ApolloMessageType
GqlPong = Text
"pong"

data ApolloAction
  = SessionStop ID
  | SessionStart ID GQLRequest
  | ConnectionInit
  | Ping

type Validation = Either ByteString

apolloFormat :: ByteString -> Validation ApolloAction
apolloFormat :: ByteString -> Validation ApolloAction
apolloFormat = Either String (ApolloSubscription RequestPayload)
-> Validation ApolloAction
validateReq (Either String (ApolloSubscription RequestPayload)
 -> Validation ApolloAction)
-> (ByteString
    -> Either String (ApolloSubscription RequestPayload))
-> ByteString
-> Validation ApolloAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (ApolloSubscription RequestPayload)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode
  where
    validateReq :: Either String (ApolloSubscription RequestPayload) -> Validation ApolloAction
    validateReq :: Either String (ApolloSubscription RequestPayload)
-> Validation ApolloAction
validateReq = (String -> Validation ApolloAction)
-> (ApolloSubscription RequestPayload -> Validation ApolloAction)
-> Either String (ApolloSubscription RequestPayload)
-> Validation ApolloAction
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> Validation ApolloAction
forall a b. a -> Either a b
Left (ByteString -> Validation ApolloAction)
-> (String -> ByteString) -> String -> Validation ApolloAction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
pack) ApolloSubscription RequestPayload -> Validation ApolloAction
validateSub
    -------------------------------------
    validateSub :: ApolloSubscription RequestPayload -> Validation ApolloAction
    validateSub :: ApolloSubscription RequestPayload -> Validation ApolloAction
validateSub ApolloSubscription {apolloType :: forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType = ApolloMessageType
GqlConnectionInit} =
      ApolloAction -> Validation ApolloAction
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApolloAction
ConnectionInit
    validateSub ApolloSubscription {apolloType :: forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType = ApolloMessageType
GqlPing} =
      ApolloAction -> Validation ApolloAction
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApolloAction
Ping
    validateSub ApolloSubscription {apolloType :: forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType = ApolloMessageType
GqlSubscribe, Maybe Text
apolloId :: forall payload. ApolloSubscription payload -> Maybe Text
apolloId :: Maybe Text
apolloId, Maybe RequestPayload
apolloPayload :: forall payload. ApolloSubscription payload -> Maybe payload
apolloPayload :: Maybe RequestPayload
apolloPayload} =
      do
        Text
sessionId <- Maybe Text -> Validation Text
validateSession Maybe Text
apolloId
        GQLRequest
payload <- Maybe RequestPayload -> Either ByteString GQLRequest
validatePayload Maybe RequestPayload
apolloPayload
        ApolloAction -> Validation ApolloAction
forall a. a -> Either ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ApolloAction -> Validation ApolloAction)
-> ApolloAction -> Validation ApolloAction
forall a b. (a -> b) -> a -> b
$ Text -> GQLRequest -> ApolloAction
SessionStart Text
sessionId GQLRequest
payload
    validateSub ApolloSubscription {apolloType :: forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType = ApolloMessageType
GqlComplete, Maybe Text
apolloId :: forall payload. ApolloSubscription payload -> Maybe Text
apolloId :: Maybe Text
apolloId} =
      Text -> ApolloAction
SessionStop (Text -> ApolloAction)
-> Validation Text -> Validation ApolloAction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Validation Text
validateSession Maybe Text
apolloId
    validateSub ApolloSubscription {ApolloMessageType
apolloType :: forall payload. ApolloSubscription payload -> ApolloMessageType
apolloType :: ApolloMessageType
apolloType} =
      ByteString -> Validation ApolloAction
forall a b. a -> Either a b
Left (ByteString -> Validation ApolloAction)
-> ByteString -> Validation ApolloAction
forall a b. (a -> b) -> a -> b
$
        ByteString
"Unknown Request type \""
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ApolloMessageType -> Text
apolloResponseToProtocolMsgType ApolloMessageType
apolloType)
          ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"."

    validateSession :: Maybe ID -> Validation ID
    validateSession :: Maybe Text -> Validation Text
validateSession = Validation Text
-> (Text -> Validation Text) -> Maybe Text -> Validation Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Validation Text
forall a b. a -> Either a b
Left ByteString
"\"id\" was not provided") Text -> Validation Text
forall a b. b -> Either a b
Right
    -------------------------------------
    validatePayload :: Maybe RequestPayload -> Either ByteString GQLRequest
validatePayload = Either ByteString GQLRequest
-> (RequestPayload -> Either ByteString GQLRequest)
-> Maybe RequestPayload
-> Either ByteString GQLRequest
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either ByteString GQLRequest
forall a b. a -> Either a b
Left ByteString
"\"payload\" was not provided") RequestPayload -> Either ByteString GQLRequest
forall {a}. IsString a => RequestPayload -> Either a GQLRequest
validatePayloadContent
    -------------------------------------
    validatePayloadContent :: RequestPayload -> Either a GQLRequest
validatePayloadContent
      RequestPayload
        { Maybe Text
payloadQuery :: RequestPayload -> Maybe Text
payloadQuery :: Maybe Text
payloadQuery,
          payloadOperationName :: RequestPayload -> Maybe FieldName
payloadOperationName = Maybe FieldName
operationName,
          payloadVariables :: RequestPayload -> Maybe Value
payloadVariables = Maybe Value
variables
        } = do
        Text
query <- Either a Text
-> (Text -> Either a Text) -> Maybe Text -> Either a Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> Either a Text
forall a b. a -> Either a b
Left a
"\"payload.query\" was not provided") Text -> Either a Text
forall a b. b -> Either a b
Right Maybe Text
payloadQuery
        GQLRequest -> Either a GQLRequest
forall a. a -> Either a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GQLRequest -> Either a GQLRequest)
-> GQLRequest -> Either a GQLRequest
forall a b. (a -> b) -> a -> b
$ GQLRequest {Text
query :: Text
query :: Text
query, Maybe FieldName
operationName :: Maybe FieldName
operationName :: Maybe FieldName
operationName, Maybe Value
variables :: Maybe Value
variables :: Maybe Value
variables}