diff --git a/mu-graphql.cabal b/mu-graphql.cabal --- a/mu-graphql.cabal +++ b/mu-graphql.cabal @@ -1,5 +1,5 @@ name: mu-graphql -version: 0.5.0.3 +version: 0.5.0.4 synopsis: GraphQL support for Mu description: GraphQL servers and clients for Mu-Haskell cabal-version: >=1.10 @@ -29,13 +29,13 @@ Mu.GraphQL.Subscription.Protocol build-depends: - aeson >=1.4 && <2 + aeson >=1.4 && <2.1 , async >=2.2 && <3 , base >=4.12 && <5 - , bytestring >=0.10 && <0.11 + , bytestring >=0.10 && <0.12 , conduit >=1.3.2 && <2 , foldl >=1.4 && <2 - , graphql >=1.0 + , graphql >=1 , http-types >=0.12 && <0.13 , list-t >=1.0 && <2 , megaparsec >=8 && <10 @@ -49,7 +49,7 @@ , stm-chans >=3 && <4 , stm-conduit >=4 && <5 , stm-containers >=1.1 && <2 - , template-haskell >=2.14 && <2.17 + , template-haskell >=2.14 && <2.19 , text >=1.2 && <1.3 , unordered-containers >=0.2 && <0.3 , uuid >=1.3 && <2 @@ -70,7 +70,7 @@ ghc-options: -Wall -threaded build-depends: base >=4.12 && <5 - , aeson >=1.4 && <2 + , aeson >=1.4 && <2.1 , conduit >=1.3.2 && <1.4 , mu-graphql , mu-rpc >=0.5 && <0.6 diff --git a/src/Mu/GraphQL/Annotations.hs b/src/Mu/GraphQL/Annotations.hs --- a/src/Mu/GraphQL/Annotations.hs +++ b/src/Mu/GraphQL/Annotations.hs @@ -94,19 +94,19 @@ instance KnownSymbol e => ReflectValueConst ('VCEnum e) where reflectValueConst _ = GQL.ConstString $ T.pack $ symbolVal (Proxy @e) instance ReflectValueConstList xs => ReflectValueConst ('VCList xs) where - reflectValueConst _ = GQL.ConstList $ - map (`GQL.Node` GQL.Location 0 0) $ reflectValueConstList (Proxy @xs) + reflectValueConst _ = GQL.ConstList $ reflectValueConstList (Proxy @xs) instance ReflectValueConstObject xs => ReflectValueConst ('VCObject xs) where reflectValueConst _ = GQL.ConstObject $ reflectValueConstObject (Proxy @xs) class ReflectValueConstList xs where - reflectValueConstList :: proxy xs -> [GQL.ConstValue] + reflectValueConstList :: proxy xs -> [GQL.Node GQL.ConstValue] instance ReflectValueConstList '[] where reflectValueConstList _ = [] instance (ReflectValueConst x, ReflectValueConstList xs) => ReflectValueConstList (x ': xs) where reflectValueConstList _ - = reflectValueConst (Proxy @x) : reflectValueConstList (Proxy @xs) + = GQL.Node (reflectValueConst (Proxy @x)) zl : reflectValueConstList (Proxy @xs) + where zl = GQL.Location 0 0 class ReflectValueConstObject xs where reflectValueConstObject :: proxy xs -> [GQL.ObjectField GQL.ConstValue] diff --git a/src/Mu/GraphQL/Query/Introspection.hs b/src/Mu/GraphQL/Query/Introspection.hs --- a/src/Mu/GraphQL/Query/Introspection.hs +++ b/src/Mu/GraphQL/Query/Introspection.hs @@ -18,6 +18,7 @@ import Data.Maybe (catMaybes, fromMaybe) import Data.Proxy import qualified Data.Text as T +import Data.UUID (UUID) import GHC.TypeLits import Mu.Rpc import qualified Mu.Schema as Mu @@ -67,7 +68,7 @@ = SCALAR | OBJECT | INTERFACE - | UNION + | UNION | ENUM | INPUT_OBJECT | LIST @@ -75,13 +76,13 @@ deriving Show tSimple :: T.Text -> Type -tSimple t = Type SCALAR (Just t) [] [] [] Nothing +tSimple t = Type SCALAR (Just t) [] [] [] Nothing tList :: Type -> Type tList = Type LIST Nothing [] [] [] . Just tNonNull :: Type -> Type -tNonNull = Type NON_NULL Nothing [] [] [] . Just +tNonNull = Type NON_NULL Nothing [] [] [] . Just unwrapNonNull :: Type -> Maybe Type unwrapNonNull (Type NON_NULL _ _ _ _ x) = x @@ -188,7 +189,7 @@ introspectServices _ psub = do let name = T.pack $ symbolVal (Proxy @sname) tys = map tSimple (symbolsVal (Proxy @elts)) - t = Type UNION (Just name) [] [] tys Nothing + t = Type UNION (Just name) [] [] tys Nothing -- add this one to the mix tell (HM.singleton name t) -- continue with the rest @@ -281,6 +282,8 @@ introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSON" instance IntrospectTypeRef ('PrimitiveRef JSON.Object) where introspectTypeRef _ _ = pure $ tNonNull $ tSimple "JSONObject" +instance IntrospectTypeRef ('PrimitiveRef UUID) where + introspectTypeRef _ _ = pure $ tNonNull $ tSimple "UUID" instance (IntrospectTypeRef r) => IntrospectTypeRef ('ListRef r) where diff --git a/src/Mu/GraphQL/Query/Parse.hs b/src/Mu/GraphQL/Query/Parse.hs --- a/src/Mu/GraphQL/Query/Parse.hs +++ b/src/Mu/GraphQL/Query/Parse.hs @@ -45,8 +45,9 @@ parseJSON (A.Number n) = case floatingOrInteger n :: Either Double Int32 of Right i -> pure $ GQL.ConstInt i Left m -> pure $ GQL.ConstFloat m - parseJSON (A.Array xs) = GQL.ConstList . map (`GQL.Node` GQL.Location 0 0) . F.toList - <$> traverse A.parseJSON xs + parseJSON (A.Array xs) = GQL.ConstList . F.toList . fmap (`GQL.Node` zl) <$> traverse A.parseJSON xs + where + zl = GQL.Location 0 0 parseJSON (A.Object o) = GQL.ConstObject . fmap toObjFld . HM.toList <$> traverse A.parseJSON o where toObjFld :: (T.Text, GQL.ConstValue) -> GQL.ObjectField GQL.ConstValue @@ -263,7 +264,7 @@ constToValue GQL.ConstNull = GQL.Null constToValue (GQL.ConstEnum n) = GQL.Enum n constToValue (GQL.ConstList n) - = GQL.List $ flip map n $ \(GQL.Node x loc) -> GQL.Node (constToValue x) loc + = GQL.List [ GQL.Node (constToValue v) l | GQL.Node v l <- n ] constToValue (GQL.ConstObject n) = GQL.Object [ GQL.ObjectField a (GQL.Node (constToValue v) m) l diff --git a/src/Mu/GraphQL/Server.hs b/src/Mu/GraphQL/Server.hs --- a/src/Mu/GraphQL/Server.hs +++ b/src/Mu/GraphQL/Server.hs @@ -39,7 +39,6 @@ import Control.Monad.Except (MonadIO (..), join, runExceptT) import qualified Data.Aeson as A import Data.Aeson.Text (encodeToLazyText) -import Data.ByteString.Char8 (split) import Data.ByteString.Lazy (fromStrict, toStrict) import Data.Conduit (ConduitT, transPipe) import qualified Data.HashMap.Strict as HM @@ -152,12 +151,12 @@ _ -> toError "Error parsing query" Right POST -> do body <- strictRequestBody req - case split ';' <$> lookup hContentType (requestHeaders req) of - Just ("application/json" : _) -> + case lookup hContentType $ requestHeaders req of + Just "application/json" -> case A.eitherDecode body of Left err -> toError $ T.pack err Right (GraphQLInput qry vars opName) -> execQuery opName vars qry - Just ("application/graphql" : _) -> + Just "application/graphql" -> case decodeUtf8' $ toStrict body of Left err -> toError $ "Could not decode utf8 from body: " <> unpackUnicodeException err Right msg -> execQuery Nothing HM.empty msg