{-|
Module      :  Data.GraphQL.Monad
Maintainer  :  Brandon Chinn <brandon@leapyear.io>
Stability   :  experimental
Portability :  portable

Defines the 'GraphQLQueryT' monad transformer, which implements
'MonadGraphQLQuery' to allow querying GraphQL APIs.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}

module Data.GraphQL.Monad
  ( module Data.GraphQL.Monad.Class
  , GraphQLQueryT
  , runGraphQLQueryT
  , GraphQLSettings(..)
  , defaultGraphQLSettings
  ) where

import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.IO.Unlift (MonadUnliftIO(..))
import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)
import Control.Monad.Trans.Class (MonadTrans)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Network.HTTP.Client
    ( Manager
    , ManagerSettings
    , Request(..)
    , RequestBody(..)
    , httpLbs
    , newManager
    , parseUrlThrow
    , responseBody
    )
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Network.HTTP.Types (hContentType)

import Data.GraphQL.Monad.Class
import Data.GraphQL.Query (GraphQLQuery(..))

-- | The state for running GraphQLQueryT.
data QueryState = QueryState
  { QueryState -> Manager
manager :: Manager
  , QueryState -> Request
baseReq :: Request
  }

-- | The monad transformer type that should be used to run GraphQL queries.
--
-- @
-- newtype MyMonad a = MyMonad { unMyMonad :: GraphQLQueryT IO a }
--
-- runMyMonad :: MyMonad a -> IO a
-- runMyMonad = runGraphQLQueryT graphQLSettings . unMyMonad
--   where
--     graphQLSettings = defaultGraphQLSettings
--       { url = "https://api.github.com/graphql"
--       , modifyReq = \\req -> req
--           { requestHeaders =
--               (hAuthorization, "bearer my_github_token") : requestHeaders req
--           }
--       }
-- @
newtype GraphQLQueryT m a = GraphQLQueryT { GraphQLQueryT m a -> ReaderT QueryState m a
unGraphQLQueryT :: ReaderT QueryState m a }
  deriving
    ( a -> GraphQLQueryT m b -> GraphQLQueryT m a
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
(forall a b. (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b)
-> (forall a b. a -> GraphQLQueryT m b -> GraphQLQueryT m a)
-> Functor (GraphQLQueryT m)
forall a b. a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall a b. (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Functor m =>
a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GraphQLQueryT m b -> GraphQLQueryT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> GraphQLQueryT m b -> GraphQLQueryT m a
fmap :: (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
Functor
    , Functor (GraphQLQueryT m)
a -> GraphQLQueryT m a
Functor (GraphQLQueryT m)
-> (forall a. a -> GraphQLQueryT m a)
-> (forall a b.
    GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b)
-> (forall a b c.
    (a -> b -> c)
    -> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c)
-> (forall a b.
    GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b)
-> (forall a b.
    GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a)
-> Applicative (GraphQLQueryT m)
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
forall a. a -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall a b.
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall a b c.
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (GraphQLQueryT m)
forall (m :: * -> *) a. Applicative m => a -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
<* :: GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
*> :: GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
liftA2 :: (a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
<*> :: GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
pure :: a -> GraphQLQueryT m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GraphQLQueryT m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (GraphQLQueryT m)
Applicative
    , Applicative (GraphQLQueryT m)
a -> GraphQLQueryT m a
Applicative (GraphQLQueryT m)
-> (forall a b.
    GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b)
-> (forall a b.
    GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b)
-> (forall a. a -> GraphQLQueryT m a)
-> Monad (GraphQLQueryT m)
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall a. a -> GraphQLQueryT m a
forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall a b.
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
forall (m :: * -> *). Monad m => Applicative (GraphQLQueryT m)
forall (m :: * -> *) a. Monad m => a -> GraphQLQueryT m a
forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> GraphQLQueryT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> GraphQLQueryT m a
>> :: GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
>>= :: GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (GraphQLQueryT m)
Monad
    , Monad (GraphQLQueryT m)
Monad (GraphQLQueryT m)
-> (forall a. IO a -> GraphQLQueryT m a)
-> MonadIO (GraphQLQueryT m)
IO a -> GraphQLQueryT m a
forall a. IO a -> GraphQLQueryT m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (GraphQLQueryT m)
forall (m :: * -> *) a. MonadIO m => IO a -> GraphQLQueryT m a
liftIO :: IO a -> GraphQLQueryT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GraphQLQueryT m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (GraphQLQueryT m)
MonadIO
    , MonadReader QueryState
    , m a -> GraphQLQueryT m a
(forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a)
-> MonadTrans GraphQLQueryT
forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> GraphQLQueryT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
MonadTrans
    )

instance MonadUnliftIO m => MonadUnliftIO (GraphQLQueryT m) where
  withRunInIO :: ((forall a. GraphQLQueryT m a -> IO a) -> IO b)
-> GraphQLQueryT m b
withRunInIO (forall a. GraphQLQueryT m a -> IO a) -> IO b
inner = ReaderT QueryState m b -> GraphQLQueryT m b
forall (m :: * -> *) a. ReaderT QueryState m a -> GraphQLQueryT m a
GraphQLQueryT (ReaderT QueryState m b -> GraphQLQueryT m b)
-> ReaderT QueryState m b -> GraphQLQueryT m b
forall a b. (a -> b) -> a -> b
$ ((forall a. ReaderT QueryState m a -> IO a) -> IO b)
-> ReaderT QueryState m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. ReaderT QueryState m a -> IO a) -> IO b)
 -> ReaderT QueryState m b)
-> ((forall a. ReaderT QueryState m a -> IO a) -> IO b)
-> ReaderT QueryState m b
forall a b. (a -> b) -> a -> b
$ \forall a. ReaderT QueryState m a -> IO a
run -> (forall a. GraphQLQueryT m a -> IO a) -> IO b
inner (ReaderT QueryState m a -> IO a
forall a. ReaderT QueryState m a -> IO a
run (ReaderT QueryState m a -> IO a)
-> (GraphQLQueryT m a -> ReaderT QueryState m a)
-> GraphQLQueryT m a
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLQueryT m a -> ReaderT QueryState m a
forall (m :: * -> *) a. GraphQLQueryT m a -> ReaderT QueryState m a
unGraphQLQueryT)

instance MonadIO m => MonadGraphQLQuery (GraphQLQueryT m) where
  runQuerySafe :: query -> GraphQLQueryT m (GraphQLResult (Object schema))
runQuerySafe query
query = do
    QueryState{Request
Manager
baseReq :: Request
manager :: Manager
baseReq :: QueryState -> Request
manager :: QueryState -> Manager
..} <- GraphQLQueryT m QueryState
forall r (m :: * -> *). MonadReader r m => m r
ask

    let request :: Request
request = Request
baseReq
          { requestBody :: RequestBody
requestBody = ByteString -> RequestBody
RequestBodyLBS (ByteString -> RequestBody) -> ByteString -> RequestBody
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object
              [ Text
"query" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= query -> Text
forall query. GraphQLQuery query => query -> Text
getQueryText query
query
              , Text
"variables" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= query -> Value
forall query. GraphQLQuery query => query -> Value
getArgs query
query
              ]
          }

    IO (GraphQLResult (Object schema))
-> GraphQLQueryT m (GraphQLResult (Object schema))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GraphQLResult (Object schema))
 -> GraphQLQueryT m (GraphQLResult (Object schema)))
-> IO (GraphQLResult (Object schema))
-> GraphQLQueryT m (GraphQLResult (Object schema))
forall a b. (a -> b) -> a -> b
$ (String -> IO (GraphQLResult (Object schema)))
-> (GraphQLResult (Object schema)
    -> IO (GraphQLResult (Object schema)))
-> Either String (GraphQLResult (Object schema))
-> IO (GraphQLResult (Object schema))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO (GraphQLResult (Object schema))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail GraphQLResult (Object schema) -> IO (GraphQLResult (Object schema))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String (GraphQLResult (Object schema))
 -> IO (GraphQLResult (Object schema)))
-> (Response ByteString
    -> Either String (GraphQLResult (Object schema)))
-> Response ByteString
-> IO (GraphQLResult (Object schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (GraphQLResult (Object schema))
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String (GraphQLResult (Object schema)))
-> (Response ByteString -> ByteString)
-> Response ByteString
-> Either String (GraphQLResult (Object schema))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> IO (GraphQLResult (Object schema)))
-> IO (Response ByteString) -> IO (GraphQLResult (Object schema))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager

-- | Run a GraphQLQueryT stack.
runGraphQLQueryT :: MonadIO m => GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT :: GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT GraphQLSettings{String
ManagerSettings
Request -> Request
modifyReq :: GraphQLSettings -> Request -> Request
url :: GraphQLSettings -> String
managerSettings :: GraphQLSettings -> ManagerSettings
modifyReq :: Request -> Request
url :: String
managerSettings :: ManagerSettings
..} GraphQLQueryT m a
m = do
  QueryState
state <- IO QueryState -> m QueryState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO QueryState -> m QueryState) -> IO QueryState -> m QueryState
forall a b. (a -> b) -> a -> b
$ do
    Manager
manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
managerSettings
    Request
baseReq <- Request -> Request
modifyReq (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
modifyReq' (Request -> Request) -> IO Request -> IO Request
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url
    QueryState -> IO QueryState
forall (m :: * -> *) a. Monad m => a -> m a
return QueryState :: Manager -> Request -> QueryState
QueryState{Request
Manager
baseReq :: Request
manager :: Manager
baseReq :: Request
manager :: Manager
..}

  (ReaderT QueryState m a -> QueryState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` QueryState
state)
    (ReaderT QueryState m a -> m a)
-> (GraphQLQueryT m a -> ReaderT QueryState m a)
-> GraphQLQueryT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLQueryT m a -> ReaderT QueryState m a
forall (m :: * -> *) a. GraphQLQueryT m a -> ReaderT QueryState m a
unGraphQLQueryT
    (GraphQLQueryT m a -> m a) -> GraphQLQueryT m a -> m a
forall a b. (a -> b) -> a -> b
$ GraphQLQueryT m a
m
  where
    modifyReq' :: Request -> Request
modifyReq' Request
req = Request
req
      { method :: Method
method = Method
"POST"
      , requestHeaders :: RequestHeaders
requestHeaders = (HeaderName
hContentType, Method
"application/json") (HeaderName, Method) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req
      }

-- | The settings for running GraphQLQueryT.
data GraphQLSettings = GraphQLSettings
  { GraphQLSettings -> ManagerSettings
managerSettings :: ManagerSettings
    -- ^ Uses TLS by default
  , GraphQLSettings -> String
url             :: String
  , GraphQLSettings -> Request -> Request
modifyReq       :: Request -> Request
  }

-- | Default query settings.
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings = GraphQLSettings :: ManagerSettings
-> String -> (Request -> Request) -> GraphQLSettings
GraphQLSettings
  { managerSettings :: ManagerSettings
managerSettings = ManagerSettings
tlsManagerSettings
  , url :: String
url = String -> String
forall a. HasCallStack => String -> a
error String
"No URL is provided"
  , modifyReq :: Request -> Request
modifyReq = Request -> Request
forall a. a -> a
id
  }