Merge pull request #8 from dandoh/upgrade_morpheus

[ graphql ] update morpheus

Author: dandoh

package.yaml

@@ -30,6 +30,7 @@ default-extensions:
   - QuasiQuotes
   - ScopedTypeVariables
   - DuplicateRecordFields
+  - RankNTypes
   - LambdaCase
   - NamedFieldPuns
 
@@ -53,6 +54,7 @@ dependencies:
   - opaleye
   - unordered-containers
   - morpheus-graphql
+  - morpheus-graphql-core
   - scotty
   - envy
   - load-env

src/Graphql.hs

@@ -1,5 +1,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module Graphql where
@@ -64,18 +66,10 @@ importGQLDocument "schema.graphql"
 -------------------------------------------------------------------------------
 
 -- | Resolve single value
-type Value (o :: OperationType) a = Resolver o () Web a
+type Value (o :: OperationType) (a :: k) = ResolverO o () Web a
 
--- | Resolve object (which includes other fields that need their own resolvers)
-type Object (o :: OperationType) a = Resolver o () Web (a (Resolver o () Web))
-
--- | Resolve (Maybe object)
-type MaybeObject (o :: OperationType) a =
-  Resolver o () Web (Maybe (a (Resolver o () Web)))
-
--- | Resolve [object]
-type ArrayObject (o :: OperationType) a =
-  Resolver o () Web [a (Resolver o () Web)]
+-- | Resolve (f value)
+type Composed (o :: OperationType) f (a :: k) = ComposedResolver o () Web f a
 
 type GraphQL o =
   ( MonadIO (Resolver o () Web),
@@ -112,7 +106,7 @@ runSelectOne select errorMsg = do
       $ \connection -> Opaleye.runSelect connection select
   case xs of
     [x] -> return x
-    _ -> failRes errorMsg
+    _ -> fail errorMsg
 
 -------------------------------------------------------------------------------
 

src/Graphql/Resolver/Root.hs

@@ -4,9 +4,9 @@ import Data.Morpheus.Types
 import Graphql
 import Graphql.Resolver.User
 
-rootResolver :: GQLRootResolver Web () Query Mutation Undefined
+rootResolver :: RootResolver Web () Query Mutation Undefined
 rootResolver =
-  GQLRootResolver {queryResolver, mutationResolver, subscriptionResolver}
+  RootResolver {queryResolver, mutationResolver, subscriptionResolver}
   where
     queryResolver = Query {login = loginResolver, myUserInfo = myUserInfoResolver}
     mutationResolver = Mutation {register = registerResolver, changePassword = changePasswordResolver}

src/Graphql/Resolver/User.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE RankNTypes #-}
+
 module Graphql.Resolver.User where
 
 import Authentication.JWT
@@ -22,7 +24,7 @@ import GHC.Int (Int64)
 import Graphql
 
 -------------------------------------------------------------------------------
-userResolver :: GraphQL o => DB.User -> Object o User
+userResolver :: GraphQL o => DB.User -> Value o User
 userResolver user =
   let DB.User {userId, userEmail, userName} = record user
    in return
@@ -35,7 +37,7 @@ userResolver user =
           }
 
 -------------------------------------------------------------------------------
-loginResolver :: GraphQL o => LoginArgs -> Object o Session
+loginResolver :: GraphQL o => LoginArgs -> Value o Session
 loginResolver LoginArgs {email, password} = do
   res :: [DB.User] <- runSelect $ findUserByEmail email
   case res of
@@ -44,21 +46,21 @@ loginResolver LoginArgs {email, password} = do
       secret <- lift $ asks (jwtSecret . config)
       let jwt = makeJWT time secret (DB.userId . record $ user)
       return Session {token = pure jwt, user = userResolver user}
-    _ -> failRes "Wrong email or password"
+    _ -> fail "Wrong email or password"
 
 -------------------------------------------------------------------------------
-registerResolver :: RegisterArgs -> Object MUTATION Session
+registerResolver :: RegisterArgs -> Value MUTATION Session
 registerResolver RegisterArgs {email, password, name} = do
   res :: [DB.User] <- runSelect $ findUserByEmail email
   case res of
-    _ : _ -> failRes "This email is already taken"
+    _ : _ -> fail "This email is already taken"
     [] -> do
       ph <- liftIO $ hashPassword password
       runInsert $ insertUser (email, ph, name)
       loginResolver LoginArgs {email, password}
 
 -------------------------------------------------------------------------------
-myUserInfoResolver :: Object QUERY User
+myUserInfoResolver :: Value QUERY User
 myUserInfoResolver = do
   myUserId <- requireAuthorized
   runSelectOne (findUserByID myUserId) "Invalid user" >>= userResolver
@@ -73,4 +75,4 @@ changePasswordResolver ChangePasswordArgs {oldPassword, newPassword} = do
       ph <- liftIO $ hashPassword newPassword
       runUpdate $ updateUserPassword myUserId ph
       return True
-    else failRes "Wrong old password"
+    else fail "Wrong old password"

stack.yaml

@@ -36,7 +36,8 @@ packages:
 # forks / in-progress versions pinned to a git hash. For example:
 #
 extra-deps:
-  - morpheus-graphql-0.10.0
+  - morpheus-graphql-core-0.13.0
+  - morpheus-graphql-0.13.0
   - postgresql-simple-url-0.2.1.0
 
 # Override default flag values for local packages and extra-deps

stack.yaml.lock

@@ -5,12 +5,19 @@
 
 packages:
 - completed:
-    hackage: morpheus-graphql-0.10.0@sha256:02d06672f508d0c199932f81fdab1337e967375d57d91cec00fa02b7bfc70abb,24229
+    hackage: morpheus-graphql-core-0.13.0@sha256:af4c0cc0f5c84cbcb85486329574f2ced98326be4fedd8a7fa116bf783d5a8b6,6774
     pantry-tree:
-      size: 35491
-      sha256: bab034192a83daee625055d762eb988fb139cbed12c549ba8939c1fcade2d25f
+      size: 8516
+      sha256: f0155c18930d61ebb6b1f5d81321bdf49f41dffbab3f9b07a6cc3785c540ac9b
   original:
-    hackage: morpheus-graphql-0.10.0
+    hackage: morpheus-graphql-core-0.13.0
+- completed:
+    hackage: morpheus-graphql-0.13.0@sha256:d8173116f630ecf264747bf31a823126452f144e1802d236b64efcf8677289cb,28007
+    pantry-tree:
+      size: 40014
+      sha256: 5b390bba65d00644b0c99d7cbda308d1ff0706a33c90523d6cfcdd5005cab90d
+  original:
+    hackage: morpheus-graphql-0.13.0
 - completed:
     hackage: postgresql-simple-url-0.2.1.0@sha256:25aa9dca3c05b2c66b9336907d9300f1312fbdfa54e0d395b52d1a1e6579810a,1837
     pantry-tree: