{-# language DataKinds           #-}
{-# language FlexibleContexts    #-}
{-# language GADTs               #-}
{-# language OverloadedLists     #-}
{-# language OverloadedStrings   #-}
{-# language RankNTypes          #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications    #-}
{-|
Description : Execute a Mu 'Server' using GraphQL

This module allows you to server a Mu 'Server'
as a WAI 'Application' using GraphQL.

The simples way is to use 'runGraphQLAppQuery'
(if you only provide GraphQL queries) or
'runGraphQLApp' (if you also have mutations
or subscriptions). All other variants provide
more control over the settings.
-}
module Mu.GraphQL.Server (
    GraphQLApp
  -- * Run an GraphQL resolver directly
  , runGraphQLApp
  , runGraphQLAppSettings
  , runGraphQLAppQuery
  , runGraphQLAppTrans
  -- * Build a WAI 'Application'
  , graphQLApp
  , graphQLAppQuery
  , graphQLAppTrans
  , graphQLAppTransQuery
  -- * Lifting of 'Conduit's
  , liftServerConduit
) where

import           Control.Applicative              ((<|>))
import           Control.Exception                (throw)
import           Control.Monad.Except
import qualified Data.Aeson                       as A
import           Data.Aeson.Text                  (encodeToLazyText)
import           Data.ByteString.Lazy             (fromStrict, toStrict)
import           Data.Conduit
import qualified Data.HashMap.Strict              as HM
import           Data.Proxy
import qualified Data.Text                        as T
import           Data.Text.Encoding               (decodeUtf8)
import qualified Data.Text.Lazy.Encoding          as T
import           Language.GraphQL.Draft.Parser    (parseExecutableDoc)
import qualified Language.GraphQL.Draft.Syntax    as GQL
import           Mu.Adapter.Json                  ()
import           Network.HTTP.Types.Header        (hContentType)
import           Network.HTTP.Types.Method        (StdMethod (..), parseMethod)
import           Network.HTTP.Types.Status        (ok200)
import           Network.Wai
import           Network.Wai.Handler.Warp         (Port, Settings, run, runSettings)
import qualified Network.Wai.Handler.WebSockets   as WS
import qualified Network.WebSockets               as WS

import           Mu.GraphQL.Query.Parse
import           Mu.GraphQL.Query.Run
import           Mu.GraphQL.Subscription.Protocol
import           Mu.Server

data GraphQLInput = GraphQLInput T.Text VariableMapC (Maybe T.Text)

instance A.FromJSON GraphQLInput where
  parseJSON :: Value -> Parser GraphQLInput
parseJSON = String
-> (Object -> Parser GraphQLInput) -> Value -> Parser GraphQLInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"GraphQLInput" ((Object -> Parser GraphQLInput) -> Value -> Parser GraphQLInput)
-> (Object -> Parser GraphQLInput) -> Value -> Parser GraphQLInput
forall a b. (a -> b) -> a -> b
$
     \Object
v -> Text -> VariableMapC -> Maybe Text -> GraphQLInput
GraphQLInput
      (Text -> VariableMapC -> Maybe Text -> GraphQLInput)
-> Parser Text
-> Parser (VariableMapC -> Maybe Text -> GraphQLInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"query"
      Parser (VariableMapC -> Maybe Text -> GraphQLInput)
-> Parser VariableMapC -> Parser (Maybe Text -> GraphQLInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser VariableMapC
forall a. FromJSON a => Object -> Text -> Parser a
A..: Text
"variables" Parser VariableMapC -> Parser VariableMapC -> Parser VariableMapC
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VariableMapC -> Parser VariableMapC
forall (f :: * -> *) a. Applicative f => a -> f a
pure VariableMapC
forall k v. HashMap k v
HM.empty)
      Parser (Maybe Text -> GraphQLInput)
-> Parser (Maybe Text) -> Parser GraphQLInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
A..:? Text
"operationName"

-- | Turn a Mu GraphQL 'Server' into a WAI 'Application'.
--   Use this version when your server has not only
--   queries, but also mutations or subscriptions.
graphQLApp ::
    ( GraphQLApp p qr mut sub ServerErrorIO chn hs )
    => ServerT chn GQL.Field p ServerErrorIO hs
    -> Proxy qr
    -> Proxy mut
    -> Proxy sub
    -> Application
graphQLApp :: ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
graphQLApp = (forall a. ServerErrorIO a -> ServerErrorIO a)
-> ServerT chn Field p ServerErrorIO hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
graphQLAppTrans forall a. a -> a
forall a. ServerErrorIO a -> ServerErrorIO a
id

-- | Turn a Mu GraphQL 'Server' into a WAI 'Application'.
--   Use this version when your server has only queries.
graphQLAppQuery ::
    forall qr p chn hs.
    ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs )
    => ServerT chn GQL.Field p ServerErrorIO hs
    -> Proxy qr
    -> Application
graphQLAppQuery :: ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application
graphQLAppQuery ServerT chn Field p ServerErrorIO hs
svr Proxy qr
_
  = ServerT chn Field p ServerErrorIO hs
-> Proxy ('Just qr)
-> Proxy 'Nothing
-> Proxy 'Nothing
-> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (chn :: ServiceChain Symbol) (hs :: [[*]]).
GraphQLApp p qr mut sub ServerErrorIO chn hs =>
ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
graphQLApp ServerT chn Field p ServerErrorIO hs
svr (Proxy ('Just qr)
forall k (t :: k). Proxy t
Proxy @('Just qr)) (Proxy 'Nothing
forall k (t :: k). Proxy t
Proxy @'Nothing) (Proxy 'Nothing
forall k (t :: k). Proxy t
Proxy @'Nothing)

-- | Turn a Mu GraphQL 'Server' into a WAI 'Application'
--   using a combined transformer stack.
--   See also documentation for 'graphQLAppQuery'.
graphQLAppTransQuery ::
    forall qr m p chn hs.
    ( GraphQLApp p ('Just qr) 'Nothing 'Nothing m chn hs )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn GQL.Field p m hs
    -> Proxy qr
    -> Application
graphQLAppTransQuery :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs -> Proxy qr -> Application
graphQLAppTransQuery forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
svr Proxy qr
_
  = (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy ('Just qr)
-> Proxy 'Nothing
-> Proxy 'Nothing
-> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
graphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
svr (Proxy ('Just qr)
forall k (t :: k). Proxy t
Proxy @('Just qr)) (Proxy 'Nothing
forall k (t :: k). Proxy t
Proxy @'Nothing) (Proxy 'Nothing
forall k (t :: k). Proxy t
Proxy @'Nothing)

-- | Turn a Mu GraphQL 'Server' into a WAI 'Application'
--   using a combined transformer stack.
--   See also documentation for 'graphQLApp'.
graphQLAppTrans ::
    ( GraphQLApp p qr mut sub m chn hs )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn GQL.Field p m hs
    -> Proxy qr
    -> Proxy mut
    -> Proxy sub
    -> Application
graphQLAppTrans :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
graphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s
  = ConnectionOptions -> ServerApp -> Application -> Application
WS.websocketsOr ConnectionOptions
WS.defaultConnectionOptions
                    ((forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> ServerApp
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> ServerApp
wsGraphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s)
                    ((forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
httpGraphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s)

httpGraphQLAppTrans ::
    ( GraphQLApp p qr mut sub m chn hs )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn GQL.Field p m hs
    -> Proxy qr
    -> Proxy mut
    -> Proxy sub
    -> Application
httpGraphQLAppTrans :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
httpGraphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s Request
req Response -> IO ResponseReceived
res =
  case Method -> Either Method StdMethod
parseMethod (Request -> Method
requestMethod Request
req) of
    Left Method
err   -> Text -> IO ResponseReceived
toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Method -> Text
decodeUtf8 Method
err
    Right StdMethod
GET  -> do
      let qst :: Query
qst = Request -> Query
queryString Request
req
          opN :: Maybe Text
opN = Method -> Text
decodeUtf8 (Method -> Text) -> Maybe Method -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Method) -> Maybe Method
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Method -> Query -> Maybe (Maybe Method)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Method
"operationName" Query
qst)
      case ((Method -> Text) -> Maybe Method -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Method -> Text
decodeUtf8 (Maybe Method -> Maybe Text)
-> Maybe (Maybe Method) -> Maybe (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Method -> Query -> Maybe (Maybe Method)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Method
"query" Query
qst, Method -> Query -> Maybe (Maybe Method)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Method
"variables" Query
qst) of
        (Just (Just Text
qry), Just (Just Method
vars)) ->
          case ByteString -> Either String VariableMapC
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (ByteString -> Either String VariableMapC)
-> ByteString -> Either String VariableMapC
forall a b. (a -> b) -> a -> b
$ Method -> ByteString
fromStrict Method
vars of
            Left String
err  -> Text -> IO ResponseReceived
toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
            Right VariableMapC
vrs -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived
execQuery Maybe Text
opN VariableMapC
vrs Text
qry
        (Just (Just Text
qry), Maybe (Maybe Method)
_)                -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived
execQuery Maybe Text
opN VariableMapC
forall k v. HashMap k v
HM.empty Text
qry
        (Maybe (Maybe Text), Maybe (Maybe Method))
_                                   -> Text -> IO ResponseReceived
toError Text
"Error parsing query"
    Right StdMethod
POST -> do
      ByteString
body <- Request -> IO ByteString
strictRequestBody Request
req
      case HeaderName -> [(HeaderName, Method)] -> Maybe Method
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
hContentType ([(HeaderName, Method)] -> Maybe Method)
-> [(HeaderName, Method)] -> Maybe Method
forall a b. (a -> b) -> a -> b
$ Request -> [(HeaderName, Method)]
requestHeaders Request
req of
        Just Method
"application/json"    ->
          case ByteString -> Either String GraphQLInput
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
body of
            Left String
err                             -> Text -> IO ResponseReceived
toError (Text -> IO ResponseReceived) -> Text -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
            Right (GraphQLInput Text
qry VariableMapC
vars Maybe Text
opName) -> Maybe Text -> VariableMapC -> Text -> IO ResponseReceived
execQuery Maybe Text
opName VariableMapC
vars Text
qry
        Just Method
"application/graphql" ->
          Maybe Text -> VariableMapC -> Text -> IO ResponseReceived
execQuery Maybe Text
forall a. Maybe a
Nothing VariableMapC
forall k v. HashMap k v
HM.empty (Method -> Text
decodeUtf8 (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Method
toStrict ByteString
body)
        Maybe Method
_                          -> Text -> IO ResponseReceived
toError Text
"No `Content-Type` header found!"
    Either Method StdMethod
_          -> Text -> IO ResponseReceived
toError Text
"Unsupported method"
  where
    execQuery :: Maybe T.Text -> VariableMapC -> T.Text -> IO ResponseReceived
    execQuery :: Maybe Text -> VariableMapC -> Text -> IO ResponseReceived
execQuery Maybe Text
opn VariableMapC
vals Text
qry =
      case Text -> Either Text ExecutableDocument
parseExecutableDoc Text
qry of
        Left Text
err  -> Text -> IO ResponseReceived
toError Text
err
        Right ExecutableDocument
doc -> (forall a. m a -> ServerErrorIO a)
-> [(HeaderName, Method)]
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> IO Value
forall (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (p :: Package') (m :: * -> *)
       (chn :: ServiceChain Symbol) (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> [(HeaderName, Method)]
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> IO Value
runPipeline forall a. m a -> ServerErrorIO a
f (Request -> [(HeaderName, Method)]
requestHeaders Request
req) ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s Maybe Text
opn VariableMapC
vals ExecutableDocument
doc
                       IO Value -> (Value -> IO ResponseReceived) -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> IO ResponseReceived
toResponse
    toError :: T.Text -> IO ResponseReceived
    toError :: Text -> IO ResponseReceived
toError Text
err = Value -> IO ResponseReceived
toResponse (Value -> IO ResponseReceived) -> Value -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
A.object [ (Text
"errors", Array -> Value
A.Array [ [Pair] -> Value
A.object [ (Text
"message", Text -> Value
A.String Text
err) ] ])]
    toResponse :: A.Value -> IO ResponseReceived
    toResponse :: Value -> IO ResponseReceived
toResponse = Response -> IO ResponseReceived
res (Response -> IO ResponseReceived)
-> (Value -> Response) -> Value -> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> [(HeaderName, Method)] -> Builder -> Response
responseBuilder Status
ok200 [] (Builder -> Response) -> (Value -> Builder) -> Value -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
T.encodeUtf8Builder (Text -> Builder) -> (Value -> Text) -> Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
encodeToLazyText

wsGraphQLAppTrans
    :: ( GraphQLApp p qr mut sub m chn hs )
    => (forall a. m a -> ServerErrorIO a)
    -> ServerT chn GQL.Field p m hs
    -> Proxy qr
    -> Proxy mut
    -> Proxy sub
    -> WS.ServerApp
wsGraphQLAppTrans :: (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> ServerApp
wsGraphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s PendingConnection
conn
  = do let headers :: [(HeaderName, Method)]
headers = RequestHead -> [(HeaderName, Method)]
WS.requestHeaders (RequestHead -> [(HeaderName, Method)])
-> RequestHead -> [(HeaderName, Method)]
forall a b. (a -> b) -> a -> b
$ PendingConnection -> RequestHead
WS.pendingRequest PendingConnection
conn
       Connection
conn' <- PendingConnection -> IO Connection
WS.acceptRequest PendingConnection
conn
       ((Maybe Text
  -> VariableMapC
  -> ExecutableDocument
  -> ConduitT Value Void IO ()
  -> IO ())
 -> Connection -> IO ())
-> Connection
-> (Maybe Text
    -> VariableMapC
    -> ExecutableDocument
    -> ConduitT Value Void IO ()
    -> IO ())
-> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe Text
 -> VariableMapC
 -> ExecutableDocument
 -> ConduitT Value Void IO ()
 -> IO ())
-> Connection -> IO ()
protocol Connection
conn' ((Maybe Text
  -> VariableMapC
  -> ExecutableDocument
  -> ConduitT Value Void IO ()
  -> IO ())
 -> IO ())
-> (Maybe Text
    -> VariableMapC
    -> ExecutableDocument
    -> ConduitT Value Void IO ()
    -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ (forall a. m a -> ServerErrorIO a)
-> [(HeaderName, Method)]
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> ConduitT Value Void IO ()
-> IO ()
forall (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (p :: Package') (m :: * -> *)
       (chn :: ServiceChain Symbol) (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> [(HeaderName, Method)]
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Maybe Text
-> VariableMapC
-> ExecutableDocument
-> ConduitT Value Void IO ()
-> IO ()
runSubscriptionPipeline forall a. m a -> ServerErrorIO a
f [(HeaderName, Method)]
headers ServerT chn Field p m hs
server Proxy qr
q Proxy mut
m Proxy sub
s

-- | Run a Mu 'graphQLApp' using the given 'Settings'.
--
--   Go to 'Network.Wai.Handler.Warp' to declare 'Settings'.
runGraphQLAppSettings ::
  ( GraphQLApp p qr mut sub ServerErrorIO chn hs )
  => Settings
  -> ServerT chn GQL.Field p ServerErrorIO hs
  -> Proxy qr
  -> Proxy mut
  -> Proxy sub
  -> IO ()
runGraphQLAppSettings :: Settings
-> ServerT chn Field p ServerErrorIO hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> IO ()
runGraphQLAppSettings Settings
st ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q Proxy mut
m Proxy sub
s = Settings -> Application -> IO ()
runSettings Settings
st (ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (chn :: ServiceChain Symbol) (hs :: [[*]]).
GraphQLApp p qr mut sub ServerErrorIO chn hs =>
ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
graphQLApp ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q Proxy mut
m Proxy sub
s)

-- | Run a Mu 'graphQLApp' on the given port.
runGraphQLApp ::
  ( GraphQLApp p qr mut sub ServerErrorIO chn hs )
  => Port
  -> ServerT chn GQL.Field p ServerErrorIO hs
  -> Proxy qr
  -> Proxy mut
  -> Proxy sub
  -> IO ()
runGraphQLApp :: Port
-> ServerT chn Field p ServerErrorIO hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> IO ()
runGraphQLApp Port
port ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q Proxy mut
m Proxy sub
s = Port -> Application -> IO ()
run Port
port (ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (chn :: ServiceChain Symbol) (hs :: [[*]]).
GraphQLApp p qr mut sub ServerErrorIO chn hs =>
ServerT chn Field p ServerErrorIO hs
-> Proxy qr -> Proxy mut -> Proxy sub -> Application
graphQLApp ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q Proxy mut
m Proxy sub
s)

-- | Run a Mu 'graphQLApp' on a transformer stack on the given port.
runGraphQLAppTrans ::
  ( GraphQLApp p qr mut sub m chn hs )
  => Port
  -> (forall a. m a -> ServerErrorIO a)
  -> ServerT chn GQL.Field p m hs
  -> Proxy qr
  -> Proxy mut
  -> Proxy sub
  -> IO ()
runGraphQLAppTrans :: Port
-> (forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> IO ()
runGraphQLAppTrans Port
port forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
svr Proxy qr
q Proxy mut
m Proxy sub
s = Port -> Application -> IO ()
run Port
port ((forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
forall (p :: Package') (qr :: Maybe Symbol) (mut :: Maybe Symbol)
       (sub :: Maybe Symbol) (m :: * -> *) (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p qr mut sub m chn hs =>
(forall a. m a -> ServerErrorIO a)
-> ServerT chn Field p m hs
-> Proxy qr
-> Proxy mut
-> Proxy sub
-> Application
graphQLAppTrans forall a. m a -> ServerErrorIO a
f ServerT chn Field p m hs
svr Proxy qr
q Proxy mut
m Proxy sub
s)

-- | Run a query-only Mu 'graphQLApp' on the given port.
runGraphQLAppQuery ::
  ( GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs )
  => Port
  -> ServerT chn GQL.Field p ServerErrorIO hs
  -> Proxy qr
  -> IO ()
runGraphQLAppQuery :: Port -> ServerT chn Field p ServerErrorIO hs -> Proxy qr -> IO ()
runGraphQLAppQuery Port
port ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q = Port -> Application -> IO ()
run Port
port (ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application
forall (qr :: Symbol) (p :: Package') (chn :: ServiceChain Symbol)
       (hs :: [[*]]).
GraphQLApp p ('Just qr) 'Nothing 'Nothing ServerErrorIO chn hs =>
ServerT chn Field p ServerErrorIO hs -> Proxy qr -> Application
graphQLAppQuery ServerT chn Field p ServerErrorIO hs
svr Proxy qr
q)

-- | Turns a 'Conduit' working on 'ServerErrorIO'
--   into any other base monad which supports 'IO',
--   by raising any error as an exception.
--
--   This function is useful to interoperate with
--   libraries which generate 'Conduit's with other
--   base monads, such as @persistent@.
liftServerConduit
  :: MonadIO m
  => ConduitT i o ServerErrorIO r -> ConduitT i o m r
liftServerConduit :: ConduitT i o ServerErrorIO r -> ConduitT i o m r
liftServerConduit = (forall a. ServerErrorIO a -> m a)
-> ConduitT i o ServerErrorIO r -> ConduitT i o m r
forall (m :: * -> *) (n :: * -> *) i o r.
Monad m =>
(forall a. m a -> n a) -> ConduitT i o m r -> ConduitT i o n r
transPipe forall a. ServerErrorIO a -> m a
forall (m :: * -> *) a. MonadIO m => ServerErrorIO a -> m a
raiseErrors
  where raiseErrors :: forall m a. MonadIO m => ServerErrorIO a -> m a
        raiseErrors :: ServerErrorIO a -> m a
raiseErrors ServerErrorIO a
h
          = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
              Either ServerError a
h' <- ServerErrorIO a -> IO (Either ServerError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ServerErrorIO a
h
              case Either ServerError a
h' of
                Right a
r -> a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
                Left  ServerError
e -> ServerError -> IO a
forall a e. Exception e => e -> a
throw ServerError
e