Make the lexer and parser safe

1 files changed, 10 insertions, 11 deletions

diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 265e94f..f959f64 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -189,6 +189,8 @@ data QueryError
     | CoercionError Full.VariableDefinition
     | UnknownInputType Full.VariableDefinition
 
+type ExecuteHandler m a e = e -> ExecutorT m a
+
 tell :: Monad m => Seq Error -> ExecutorT m ()
 tell = ExecutorT . lift . Writer.tell
 
@@ -313,8 +315,7 @@ executeQuery topSelections schema = do
     pure $ Response data' errors
 
 handleException :: (MonadCatch m, Serialize a)
-    => FieldException
-    -> ExecutorT m a
+    => ExecuteHandler m a FieldException
 handleException (FieldException fieldLocation errorPath next) =
     let newError = constructError next fieldLocation errorPath
      in tell (Seq.singleton newError) >> pure null
@@ -390,30 +391,28 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath =
     fieldErrorPath = fieldsSegment fields : errorPath
     inputCoercionHandler :: (MonadCatch m, Serialize a)
         => Full.Location
-        -> InputCoercionException
-        -> ExecutorT m a
+        -> ExecuteHandler m a InputCoercionException
     inputCoercionHandler _ e@(InputCoercionException _ _ (Just valueNode)) =
         let argumentLocation = getField @"location" valueNode
          in exceptionHandler argumentLocation e
     inputCoercionHandler fieldLocation e = exceptionHandler fieldLocation e
     resultHandler :: (MonadCatch m, Serialize a)
         => Full.Location
-        -> ResultException
-        -> ExecutorT m a
+        -> ExecuteHandler m a ResultException
     resultHandler = exceptionHandler
     resolverHandler :: (MonadCatch m, Serialize a)
         => Full.Location
-        -> ResolverException
-        -> ExecutorT m a
+        -> ExecuteHandler m a ResolverException
     resolverHandler = exceptionHandler
-    nullResultHandler :: (MonadCatch m, Serialize a)
-        => FieldException
-        -> ExecutorT m a
+    nullResultHandler :: (MonadCatch m, Serialize a) => ExecuteHandler m a FieldException
     nullResultHandler e@(FieldException fieldLocation errorPath' next) =
         let newError = constructError next fieldLocation errorPath'
          in if Out.isNonNullType fieldType
              then throwM e
              else returnError newError
+    exceptionHandler :: (Exception e, MonadCatch m, Serialize a)
+        => Full.Location
+        -> ExecuteHandler m a e
     exceptionHandler errorLocation e =
         let newError = constructError e errorLocation fieldErrorPath
          in if Out.isNonNullType fieldType