{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module PGIP.GraphQL (isGraphQL, processGraphQL) where

import PGIP.GraphQL.Resolver

import PGIP.Shared

import Driver.Options

import Data.Aeson as Aeson
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy.Encoding as LEncoding
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Text.Lazy as LText
import Data.Text as Text
import Network.Wai
import GHC.Generics
import qualified Control.Monad.Fail as Fail

isGraphQL :: String -> [String] -> Bool
isGraphQL :: String -> [String] -> Bool
isGraphQL httpVerb :: String
httpVerb pathComponents :: [String]
pathComponents =
  String
httpVerb String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "POST" Bool -> Bool -> Bool
&& [String]
pathComponents [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== ["graphql"]

processGraphQL :: HetcatsOpts -> Cache -> Request -> IO String
processGraphQL :: HetcatsOpts -> Cache -> Request -> IO String
processGraphQL opts :: HetcatsOpts
opts sessionReference :: Cache
sessionReference request :: Request
request = do
  ByteString
body <- Request -> RsrcIO ByteString
receivedRequestBody Request
request
  let bodyQueryE :: Either String QueryBodyAux
bodyQueryE = ByteString -> Either String QueryBodyAux
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (ByteString -> Either String QueryBodyAux)
-> ByteString -> Either String QueryBodyAux
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
body :: Either String QueryBodyAux
  QueryBody
queryBody <- case Either String QueryBodyAux
bodyQueryE of
    Left message :: String
message -> String -> IO QueryBody
forall (m :: * -> *) a. MonadFail m => String -> m a
Fail.fail ("bad request body: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
message)
    Right b :: QueryBodyAux
b -> QueryBody -> IO QueryBody
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryBody -> IO QueryBody) -> QueryBody -> IO QueryBody
forall a b. (a -> b) -> a -> b
$ QueryBodyAux -> QueryBody
toGraphQLQueryBody QueryBodyAux
b
  HetcatsOpts -> Cache -> Text -> Map Text Text -> IO String
resolve HetcatsOpts
opts Cache
sessionReference (QueryBody -> Text
graphQLQuery QueryBody
queryBody) (QueryBody -> Map Text Text
graphQLVariables QueryBody
queryBody)

-- This structure contains the data that is passed to the GraphQL API
data QueryBody = QueryBody { QueryBody -> Text
graphQLQuery :: Text
                           , QueryBody -> Map Text Text
graphQLVariables :: Map Text Text
                           } deriving (Int -> QueryBody -> String -> String
[QueryBody] -> String -> String
QueryBody -> String
(Int -> QueryBody -> String -> String)
-> (QueryBody -> String)
-> ([QueryBody] -> String -> String)
-> Show QueryBody
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QueryBody] -> String -> String
$cshowList :: [QueryBody] -> String -> String
show :: QueryBody -> String
$cshow :: QueryBody -> String
showsPrec :: Int -> QueryBody -> String -> String
$cshowsPrec :: Int -> QueryBody -> String -> String
Show, (forall x. QueryBody -> Rep QueryBody x)
-> (forall x. Rep QueryBody x -> QueryBody) -> Generic QueryBody
forall x. Rep QueryBody x -> QueryBody
forall x. QueryBody -> Rep QueryBody x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryBody x -> QueryBody
$cfrom :: forall x. QueryBody -> Rep QueryBody x
Generic)

-- This is an auxiliary strucutre that helps to parse the request body.
-- It is then converted to QueryBody.
data QueryBodyAux = QueryBodyAux { QueryBodyAux -> Text
query :: Text
                                 , QueryBodyAux -> Maybe (Map Text Value)
variables :: Maybe (Map Text Aeson.Value)
                                 } deriving (Int -> QueryBodyAux -> String -> String
[QueryBodyAux] -> String -> String
QueryBodyAux -> String
(Int -> QueryBodyAux -> String -> String)
-> (QueryBodyAux -> String)
-> ([QueryBodyAux] -> String -> String)
-> Show QueryBodyAux
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [QueryBodyAux] -> String -> String
$cshowList :: [QueryBodyAux] -> String -> String
show :: QueryBodyAux -> String
$cshow :: QueryBodyAux -> String
showsPrec :: Int -> QueryBodyAux -> String -> String
$cshowsPrec :: Int -> QueryBodyAux -> String -> String
Show, (forall x. QueryBodyAux -> Rep QueryBodyAux x)
-> (forall x. Rep QueryBodyAux x -> QueryBodyAux)
-> Generic QueryBodyAux
forall x. Rep QueryBodyAux x -> QueryBodyAux
forall x. QueryBodyAux -> Rep QueryBodyAux x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryBodyAux x -> QueryBodyAux
$cfrom :: forall x. QueryBodyAux -> Rep QueryBodyAux x
Generic)
instance FromJSON QueryBodyAux


-- For an unknown reason, GraphQL-API requires the query to be enclosed in {}
toGraphQLQueryBody :: QueryBodyAux -> QueryBody
toGraphQLQueryBody :: QueryBodyAux -> QueryBody
toGraphQLQueryBody QueryBodyAux { query :: QueryBodyAux -> Text
query = Text
q, variables :: QueryBodyAux -> Maybe (Map Text Value)
variables = Maybe (Map Text Value)
aesonVariables } =
  QueryBody :: Text -> Map Text Text -> QueryBody
QueryBody { graphQLQuery :: Text
graphQLQuery = Text
q
            , graphQLVariables :: Map Text Text
graphQLVariables = (Value -> Text) -> Map Text Value -> Map Text Text
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Value -> Text
convert (Map Text Value -> Map Text Text)
-> Map Text Value -> Map Text Text
forall a b. (a -> b) -> a -> b
$
                                           Map Text Value -> Maybe (Map Text Value) -> Map Text Value
forall a. a -> Maybe a -> a
fromMaybe Map Text Value
forall k a. Map k a
Map.empty Maybe (Map Text Value)
aesonVariables
            }
  where
    convert :: Value -> Text
convert = Text -> Text
LText.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
LEncoding.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode