{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

{-|
Module      :  Data.GraphQL.Monad
Maintainer  :  Brandon Chinn <brandonchinn178@gmail.com>
Stability   :  experimental
Portability :  portable

Defines the 'MonadGraphQLQuery' type class to query GraphQL APIs.
Also provides the 'GraphQLQueryT' monad transformer that can be
added to a transformer stack to implement the type class, and the
'runQuerySafeIO' function to manually implement it yourself.
-}
module Data.GraphQL.Monad (
  -- * MonadGraphQLQuery API
  MonadGraphQLQuery (..),
  runQuery,
  runQuerySafeIO,

  -- * GraphQLSettings
  GraphQLSettings (..),
  defaultGraphQLSettings,

  -- * GraphQLManager
  GraphQLManager,
  initGraphQLManager,

  -- * GraphQLQueryT
  GraphQLQueryT,
  runGraphQLQueryT,
) where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.IO.Unlift (MonadUnliftIO (..))
import Control.Monad.Reader (ReaderT, ask, runReaderT)
import Control.Monad.Trans.Class (MonadTrans)
import Data.Aeson ((.=))
import qualified Data.Aeson as Aeson
import Data.Aeson.Schema (Object)
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 (..))
import Data.GraphQL.Result (GraphQLResult)

{- GraphQLSettings -}

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

-- | Default settings for 'GraphQLSettings'. Requires 'url' field to be overridden.
--
--  Example usage:
--
--  >>> defaultGraphQLSettings
--  ...   { url = "https://api.github.com/graphql"
--  ...   , modifyReq = \\req -> req
--  ...       { requestHeaders =
--  ...           (hAuthorization, "bearer my_github_token") : requestHeaders req
--  ...       }
--  ...   }
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings :: GraphQLSettings
defaultGraphQLSettings =
  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
    }

{- The base runQuerySafeIO implementation -}

-- | The manager for running GraphQL queries.
data GraphQLManager = GraphQLManager
  { GraphQLManager -> Manager
manager :: Manager
  , GraphQLManager -> Request
baseReq :: Request
  }

initGraphQLManager :: GraphQLSettings -> IO GraphQLManager
initGraphQLManager :: GraphQLSettings -> IO GraphQLManager
initGraphQLManager GraphQLSettings{String
ManagerSettings
Request -> Request
managerSettings :: GraphQLSettings -> ManagerSettings
url :: GraphQLSettings -> String
modifyReq :: GraphQLSettings -> Request -> Request
managerSettings :: ManagerSettings
url :: String
modifyReq :: Request -> Request
..} = 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
  GraphQLManager -> IO GraphQLManager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return GraphQLManager{Manager
Request
manager :: Manager
baseReq :: Request
manager :: Manager
baseReq :: Request
..}
  where
    modifyReq' :: Request -> Request
modifyReq' Request
req =
      Request
req
        { method = "POST"
        , requestHeaders = (hContentType, "application/json") : requestHeaders req
        }

-- | Execute a GraphQL query with the given 'GraphQLManager'.
runQuerySafeIO ::
  (GraphQLQuery query, schema ~ ResultSchema query) =>
  GraphQLManager
  -> query
  -> IO (GraphQLResult (Object schema))
runQuerySafeIO :: forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
GraphQLManager -> query -> IO (GraphQLResult (Object schema))
runQuerySafeIO GraphQLManager{Manager
Request
manager :: GraphQLManager -> Manager
baseReq :: GraphQLManager -> Request
manager :: Manager
baseReq :: Request
..} query
query = Request -> Manager -> IO (Response ByteString)
httpLbs Request
request Manager
manager IO (Response ByteString)
-> (Response ByteString -> IO (GraphQLResult (Object schema)))
-> IO (GraphQLResult (Object schema))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response ByteString -> IO (GraphQLResult (Object schema))
decodeBody
  where
    request :: Request
request =
      Request
baseReq
        { requestBody =
            RequestBodyLBS $
              Aeson.encode $
                Aeson.object
                  [ "query" .= getQueryText query
                  , "variables" .= getArgs query
                  ]
        }

    decodeBody :: Response ByteString -> IO (GraphQLResult (Object schema))
decodeBody = (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 a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail GraphQLResult (Object schema) -> IO (GraphQLResult (Object schema))
forall a. a -> IO a
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

{- GraphQLQueryT monad transformer -}

-- | The monad transformer type that can 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"}
--  @
newtype GraphQLQueryT m a = GraphQLQueryT {forall (m :: * -> *) a.
GraphQLQueryT m a -> ReaderT GraphQLManager m a
unGraphQLQueryT :: ReaderT GraphQLManager m a}
  deriving
    ( (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
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
fmap :: forall a b. (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> GraphQLQueryT m b -> GraphQLQueryT m a
<$ :: forall a b. a -> GraphQLQueryT m b -> GraphQLQueryT m a
Functor
    , Functor (GraphQLQueryT m)
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)
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
$cpure :: forall (m :: * -> *) a. Applicative m => a -> GraphQLQueryT m a
pure :: forall a. a -> GraphQLQueryT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
<*> :: forall a b.
GraphQLQueryT m (a -> b) -> GraphQLQueryT m a -> GraphQLQueryT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
*> :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
<* :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m a
Applicative
    , Applicative (GraphQLQueryT m)
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)
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
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
>>= :: forall a b.
GraphQLQueryT m a -> (a -> GraphQLQueryT m b) -> GraphQLQueryT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
>> :: forall a b.
GraphQLQueryT m a -> GraphQLQueryT m b -> GraphQLQueryT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> GraphQLQueryT m a
return :: forall a. a -> GraphQLQueryT m a
Monad
    , Monad (GraphQLQueryT m)
Monad (GraphQLQueryT m) =>
(forall a. IO a -> GraphQLQueryT m a) -> MonadIO (GraphQLQueryT m)
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
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> GraphQLQueryT m a
liftIO :: forall a. IO a -> GraphQLQueryT m a
MonadIO
    , (forall (m :: * -> *). Monad m => Monad (GraphQLQueryT m)) =>
(forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a)
-> MonadTrans GraphQLQueryT
forall (m :: * -> *). Monad m => Monad (GraphQLQueryT m)
forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *). Monad m => Monad (t m)) =>
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> GraphQLQueryT m a
MonadTrans
    )

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

instance (MonadIO m) => MonadGraphQLQuery (GraphQLQueryT m) where
  runQuerySafe :: forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
query -> GraphQLQueryT m (GraphQLResult (Object schema))
runQuerySafe query
query = do
    GraphQLManager
manager <- ReaderT GraphQLManager m GraphQLManager
-> GraphQLQueryT m GraphQLManager
forall (m :: * -> *) a.
ReaderT GraphQLManager m a -> GraphQLQueryT m a
GraphQLQueryT ReaderT GraphQLManager m GraphQLManager
forall r (m :: * -> *). MonadReader r m => m r
ask
    IO (GraphQLResult (Object schema))
-> GraphQLQueryT m (GraphQLResult (Object schema))
forall a. IO a -> GraphQLQueryT m a
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
$ GraphQLManager -> query -> IO (GraphQLResult (Object schema))
forall query (schema :: Schema).
(GraphQLQuery query, schema ~ ResultSchema query) =>
GraphQLManager -> query -> IO (GraphQLResult (Object schema))
runQuerySafeIO GraphQLManager
manager query
query

-- | Run the GraphQLQueryT monad transformer.
runGraphQLQueryT :: (MonadIO m) => GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT :: forall (m :: * -> *) a.
MonadIO m =>
GraphQLSettings -> GraphQLQueryT m a -> m a
runGraphQLQueryT GraphQLSettings
settings GraphQLQueryT m a
m = do
  GraphQLManager
manager <- IO GraphQLManager -> m GraphQLManager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GraphQLManager -> m GraphQLManager)
-> IO GraphQLManager -> m GraphQLManager
forall a b. (a -> b) -> a -> b
$ GraphQLSettings -> IO GraphQLManager
initGraphQLManager GraphQLSettings
settings
  (ReaderT GraphQLManager m a -> GraphQLManager -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` GraphQLManager
manager) (ReaderT GraphQLManager m a -> m a)
-> (GraphQLQueryT m a -> ReaderT GraphQLManager m a)
-> GraphQLQueryT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLQueryT m a -> ReaderT GraphQLManager m a
forall (m :: * -> *) a.
GraphQLQueryT m a -> ReaderT GraphQLManager m a
unGraphQLQueryT (GraphQLQueryT m a -> m a) -> GraphQLQueryT m a -> m a
forall a b. (a -> b) -> a -> b
$ GraphQLQueryT m a
m