hasura · shahidhk · Mar 20, 2019 · Mar 19, 2019
@@ -14,15 +14,13 @@ import           Hasura.GraphQL.Resolve.Context
 import           Hasura.GraphQL.Resolve.InputValue
 import           Hasura.GraphQL.Validate.Types
 import           Hasura.RQL.Types
-
-import           Hasura.SQL.Types
 import           Hasura.SQL.Value
 
-type OpExp = OpExpG (PGColType, PGColValue)
+type OpExp = OpExpG AnnPGVal
 
 parseOpExps
   :: (MonadError QErr m)
-  => AnnGValue -> m [OpExp]
+  => AnnInpVal -> m [OpExp]
 parseOpExps annVal = do
   opExpsM <- flip withObjectM annVal $ \nt objM -> forM objM $ \obj ->
     forM (OMap.toList obj) $ \(k, v) -> case k of
@@ -73,7 +71,7 @@ parseOpExps annVal = do
           <> showName k
   return $ catMaybes $ fromMaybe [] opExpsM
   where
-    resolveIsNull v = case v of
+    resolveIsNull v = case _aivValue v of
       AGScalar _ Nothing -> return Nothing
       AGScalar _ (Just (PGValBoolean b)) ->
         return $ Just $ bool ANISNOTNULL ANISNULL b
@@ -91,14 +89,14 @@ parseOpExps annVal = do
 
 parseAsEqOp
   :: (MonadError QErr m)
-  => AnnGValue -> m [OpExp]
+  => AnnInpVal -> m [OpExp]
 parseAsEqOp annVal = do
   annValOpExp <- AEQ True <$> asPGColVal annVal
   return [annValOpExp]
 
 parseColExp
   :: (MonadError QErr m, MonadReader r m, Has FieldMap r)
-  => PrepFn m -> G.NamedType -> G.Name -> AnnGValue
+  => PrepFn m -> G.NamedType -> G.Name -> AnnInpVal
   -> m AnnBoolExpFldSQL
 parseColExp f nt n val = do
   fldInfo <- getFldInfo nt n
@@ -112,7 +110,7 @@ parseColExp f nt n val = do
 
 parseBoolExp
   :: (MonadError QErr m, MonadReader r m, Has FieldMap r)
-  => PrepFn m -> AnnGValue -> m AnnBoolExpSQL
+  => PrepFn m -> AnnInpVal -> m AnnBoolExpSQL
 parseBoolExp f annGVal = do
   boolExpsM <-
     flip withObjectM annGVal
@@ -125,7 +123,7 @@ parseBoolExp f annGVal = do
           | otherwise   -> BoolFld <$> parseColExp f nt k v
   return $ BoolAnd $ fromMaybe [] boolExpsM
 
-type PGColValMap = Map.HashMap G.Name AnnGValue
+type PGColValMap = Map.HashMap G.Name AnnInpVal
 
 pgColValToBoolExp
   :: (MonadError QErr m)

@@ -12,6 +12,7 @@ module Hasura.GraphQL.Resolve.Context
   , InsCtxMap
   , RespTx
   , LazyRespTx
+  , AnnPGVal(..)
   , PrepFn
   , InsertTxConflictCtx(..)
   , getFldInfo
@@ -24,6 +25,7 @@ module Hasura.GraphQL.Resolve.Context
   , Convert
   , runConvert
   , prepare
+  , prepareColVal
   , txtConverter
   , module Hasura.GraphQL.Utils
   ) where
@@ -61,7 +63,16 @@ $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''InsResp)
 type RespTx = Q.TxE QErr EncJSON
 
 type LazyRespTx = LazyTx QErr EncJSON
-type PrepFn m = (PGColType, PGColValue) -> m S.SQLExp
+
+type PrepFn m = AnnPGVal -> m S.SQLExp
+
+data AnnPGVal
+  = AnnPGVal
+  { _apvVariable   :: !(Maybe G.Variable)
+  , _apvIsNullable :: !Bool
+  , _apvType       :: !PGColType
+  , _apvValue      :: !PGColValue
+  } deriving (Show, Eq)
 
 getFldInfo
   :: (MonadError QErr m, MonadReader r m, Has FieldMap r)
@@ -88,7 +99,7 @@ getArg
   :: (MonadError QErr m)
   => ArgsMap
   -> G.Name
-  -> m AnnGValue
+  -> m AnnInpVal
 getArg args arg =
   onNothing (Map.lookup arg args) $
   throw500 $ "missing argument: " <> showName arg
@@ -107,7 +118,7 @@ withArg
   :: (MonadError QErr m)
   => ArgsMap
   -> G.Name
-  -> (AnnGValue -> m a)
+  -> (AnnInpVal -> m a)
   -> m a
 withArg args arg f = prependArgsInPath $ nameAsPath arg $
   getArg args arg >>= f
@@ -116,12 +127,13 @@ withArgM
   :: (MonadError QErr m)
   => ArgsMap
   -> G.Name
-  -> (AnnGValue -> m a)
+  -> (AnnInpVal -> m a)
   -> m (Maybe a)
 withArgM args arg f = prependArgsInPath $ nameAsPath arg $
   mapM f $ handleNull =<< Map.lookup arg args
   where
-    handleNull v = bool (Just v) Nothing $ hasNullVal v
+    handleNull v = bool (Just v) Nothing $
+                   hasNullVal $ _aivValue v
 
 type PrepArgs = Seq.Seq Q.PrepArg
 
@@ -135,13 +147,21 @@ type Convert =
 
 prepare
   :: (MonadState PrepArgs m) => PrepFn m
-prepare (colTy, colVal) = do
+prepare (AnnPGVal _ _ colTy colVal) =
+  prepareColVal colTy colVal
+
+prepareColVal
+  :: (MonadState PrepArgs m)
+  => PGColType -> PGColValue -> m S.SQLExp
+prepareColVal colTy colVal = do
   preparedArgs <- get
   put (preparedArgs Seq.|> binEncoder colVal)
   return $ toPrepParam (Seq.length preparedArgs + 1) colTy
 
+
 txtConverter :: Monad m => PrepFn m
-txtConverter = return . uncurry toTxtValue
+txtConverter (AnnPGVal _ _ a b) =
+  return $ toTxtValue a b
 
 runConvert
   :: (MonadError QErr m)

@@ -13,17 +13,17 @@ module Hasura.GraphQL.Resolve.InputValue
   , withArrayM
   , parseMany
   , asPGColText
+  , AnnPGVal
   ) where
 
 import           Hasura.Prelude
 
-import qualified Data.Text                     as T
-import qualified Language.GraphQL.Draft.Syntax as G
+import qualified Data.Text                      as T
+import qualified Language.GraphQL.Draft.Syntax  as G
 
-import           Hasura.GraphQL.Utils
+import           Hasura.GraphQL.Resolve.Context
 import           Hasura.GraphQL.Validate.Types
 import           Hasura.RQL.Types
-import           Hasura.SQL.Types
 import           Hasura.SQL.Value
 
 withNotNull
@@ -34,98 +34,103 @@ withNotNull nt v =
   "unexpected null for a value of type " <> showNamedTy nt
 
 tyMismatch
-  :: (MonadError QErr m) => Text -> AnnGValue -> m a
+  :: (MonadError QErr m) => Text -> AnnInpVal -> m a
 tyMismatch expectedTy v =
   throw500 $ "expected " <> expectedTy <> ", found " <>
-  getAnnInpValKind v <> " for value of type " <>
-  G.showGT (getAnnInpValTy v)
+  getAnnInpValKind (_aivValue v) <> " for value of type " <>
+  G.showGT (_aivType v)
 
 asPGColValM
   :: (MonadError QErr m)
-  => AnnGValue -> m (Maybe (PGColType, PGColValue))
-asPGColValM = \case
-  AGScalar colTy valM -> return $ fmap (colTy,) valM
-  v            -> tyMismatch "pgvalue" v
+  => AnnInpVal -> m (Maybe AnnPGVal)
+asPGColValM annInpVal = case val of
+  AGScalar colTy valM ->
+    return $ fmap (AnnPGVal varM (G.isNullable ty) colTy) valM
+  _                   ->
+    tyMismatch "pgvalue" annInpVal
+  where
+    AnnInpVal ty varM val = annInpVal
 
 asPGColVal
   :: (MonadError QErr m)
-  => AnnGValue -> m (PGColType, PGColValue)
-asPGColVal = \case
-  AGScalar colTy (Just val) -> return (colTy, val)
-  AGScalar colTy Nothing ->
+  => AnnInpVal -> m AnnPGVal
+asPGColVal v = case _aivValue v of
+  AGScalar colTy (Just val) ->
+    return $ AnnPGVal (_aivVariable v) (G.isNullable (_aivType v)) colTy val
+  AGScalar colTy Nothing    ->
     throw500 $ "unexpected null for ty "
     <> T.pack (show colTy)
-  v            -> tyMismatch "pgvalue" v
+  _            -> tyMismatch "pgvalue" v
 
 asEnumVal
   :: (MonadError QErr m)
-  => AnnGValue -> m (G.NamedType, G.EnumValue)
-asEnumVal = \case
+  => AnnInpVal -> m (G.NamedType, G.EnumValue)
+asEnumVal v = case _aivValue v of
   AGEnum ty (Just val) -> return (ty, val)
   AGEnum ty Nothing ->
     throw500 $ "unexpected null for ty " <> showNamedTy ty
-  v              -> tyMismatch "enum" v
+  _              -> tyMismatch "enum" v
 
 withObject
   :: (MonadError QErr m)
-  => (G.NamedType -> AnnGObject -> m a) -> AnnGValue -> m a
-withObject fn v = case v of
+  => (G.NamedType -> AnnGObject -> m a) -> AnnInpVal -> m a
+withObject fn v = case _aivValue v of
   AGObject nt (Just obj) -> fn nt obj
-  AGObject nt Nothing  ->
+  AGObject _ Nothing     ->
     throw500 $ "unexpected null for ty"
-    <> G.showGT (G.TypeNamed (G.Nullability True) nt)
-  _               -> tyMismatch "object" v
+    <> G.showGT (_aivType v)
+  _                      -> tyMismatch "object" v
 
 asObject
   :: (MonadError QErr m)
-  => AnnGValue -> m AnnGObject
+  => AnnInpVal -> m AnnGObject
 asObject = withObject (\_ o -> return o)
 
 withObjectM
   :: (MonadError QErr m)
-  => (G.NamedType -> Maybe AnnGObject -> m a) -> AnnGValue -> m a
-withObjectM fn v = case v of
+  => (G.NamedType -> Maybe AnnGObject -> m a) -> AnnInpVal -> m a
+withObjectM fn v = case _aivValue v of
   AGObject nt objM -> fn nt objM
   _                -> tyMismatch "object" v
 
 asObjectM
   :: (MonadError QErr m)
-  => AnnGValue -> m (Maybe AnnGObject)
+  => AnnInpVal -> m (Maybe AnnGObject)
 asObjectM = withObjectM (\_ o -> return o)
 
 withArrayM
   :: (MonadError QErr m)
-  => (G.ListType -> Maybe [AnnGValue] -> m a) -> AnnGValue -> m a
-withArrayM fn v = case v of
+  => (G.ListType -> Maybe [AnnInpVal] -> m a) -> AnnInpVal -> m a
+withArrayM fn v = case _aivValue v of
   AGArray lt listM -> fn lt listM
   _                -> tyMismatch "array" v
 
 withArray
   :: (MonadError QErr m)
-  => (G.ListType -> [AnnGValue] -> m a) -> AnnGValue -> m a
-withArray fn v = case v of
+  => (G.ListType -> [AnnInpVal] -> m a) -> AnnInpVal -> m a
+withArray fn v = case _aivValue v of
   AGArray lt (Just l) -> fn lt l
-  AGArray lt Nothing  -> throw500 $ "unexpected null for ty"
-                         <> G.showGT (G.TypeList (G.Nullability True) lt)
+  AGArray _ Nothing   -> throw500 $ "unexpected null for ty"
+                         <> G.showGT (_aivType v)
   _                   -> tyMismatch "array" v
 
 asArray
   :: (MonadError QErr m)
-  => AnnGValue -> m [AnnGValue]
+  => AnnInpVal -> m [AnnInpVal]
 asArray = withArray (\_ vals -> return vals)
 
 parseMany
   :: (MonadError QErr m)
-  => (AnnGValue -> m a) -> AnnGValue -> m (Maybe [a])
-parseMany fn v = case v of
+  => (AnnInpVal -> m a) -> AnnInpVal -> m (Maybe [a])
+parseMany fn v = case _aivValue v of
   AGArray _ arrM -> mapM (mapM fn) arrM
   _              -> tyMismatch "array" v
 
 asPGColText
   :: (MonadError QErr m)
-  => AnnGValue -> m Text
+  => AnnInpVal -> m Text
 asPGColText val = do
-  (_, pgColVal) <- asPGColVal val
+  pgColVal <- _apvValue <$> asPGColVal val
   case pgColVal of
     PGValText t -> return t
     _           -> throw500 "expecting text for asPGColText"