Repository: hasura/graphql-engine
File: server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs (Haskell)

Code before:
        []  -> pure ()
        [_] -> pure ()
        _   -> Failure (pure UnsupportedMultipleElementLists)
      (assertListType expectedGType)
      (flip
         traverse_
         values
         (\val ->
            validateType permittedVariables val (unwrapTy expectedGType) types))
      pure ()
    G.VObject (G.unObjectValue -> values) ->
      flip
        traverse_
        values
        (\(G.ObjectFieldG name val) ->
           let expectedNamedType = getBaseTy expectedGType
           in
           case HM.lookup expectedNamedType types of
             Nothing -> Failure (pure $ TypeNotFound expectedNamedType)
             Just typeInfo ->
               case typeInfo of
                 TIInpObj inpObjTypeInfo ->
                   case HM.lookup name (_iotiFields inpObjTypeInfo) of
                     Nothing -> Failure (pure $ NoSuchArgumentForRemote name)
                     Just (_iviType -> expectedType) ->
                       validateType permittedVariables val expectedType types
                 _ ->
                   Failure
                     (pure $
                      InvalidType
                        (G.toGT $ G.NamedType name)
                        "not an input object type"))

isTypeCoercible :: G.GType -> G.GType -> Validation (NonEmpty ValidationError) ()
isTypeCoercible actualType expectedType =
  -- The GraphQL spec says that, a singleton type can be coerced into  an array
  -- type. Which means that if the 'actualType' is a singleton type, like
  -- 'Int' we should be able to join this with a remote node, which expects an
  -- input argument of type '[Int]'
  -- http://spec.graphql.org/June2018/#sec-Type-System.List
  let (actualBaseType, actualNestingLevel) = getBaseTyWithNestedLevelsCount actualType
      (expectedBaseType, expectedNestingLevel) = getBaseTyWithNestedLevelsCount expectedType
  in
  if actualBaseType == expectedBaseType
  then if (actualNestingLevel == expectedNestingLevel || actualNestingLevel == 0)
  -- The check of 'actualNestedCount == 0' is the case of coercing a singleton type
  -- into an array type
       then pure ()
       else Failure (pure $ ExpectedTypeButGot expectedType actualType)
       --  we cannot coerce two types with different nesting levels,
       -- for example, we cannot coerce [Int] to [[Int]]

Review comment (suggestion):
I think technically "singleton" type is called `named` type but we can fix this comment later.

Code after:
                   let objectTypeDefnsMap =
                         mapFromL G._ivdName $ (G._iotdValueDefinitions inpObjTypeInfo)
                   in
                   case HM.lookup name objectTypeDefnsMap of
                     Nothing -> throwError $ NoSuchArgumentForRemote name
                     Just (G._ivdType -> expectedType) ->
                       validateType permittedVariables val expectedType schemaDocument
                 _ -> do
                   throwError $ InvalidType (mkGraphQLType name) "not an input object type")
  where
    mkGraphQLType =
      G.TypeNamed (G.Nullability False)

    mkScalarTy scalarType = do
      eitherScalar <- runExceptT $ mkScalarTypeName scalarType
      case eitherScalar of
        Left _ -> throwError $ InvalidGraphQLName $ toSQLTxt scalarType
        Right s -> pure s

isTypeCoercible
  :: (MonadError ValidationError m)
  => G.GType
  -> G.GType
  -> m ()
isTypeCoercible actualType expectedType =
  -- The GraphQL spec says that, a singleton type can be coerced into  an array
  -- type. Which means that if the 'actualType' is a singleton type, like
  -- 'Int' we should be able to join this with a remote node, which expects an
  -- input argument of type '[Int]'
  -- http://spec.graphql.org/June2018/#sec-Type-System.List
  let (actualBaseType, actualNestingLevel) = getBaseTyWithNestedLevelsCount actualType
      (expectedBaseType, expectedNestingLevel) = getBaseTyWithNestedLevelsCount expectedType
  in
  if | actualBaseType /= expectedBaseType -> raiseValidationError
       -- we cannot coerce two types with different nesting levels,
       -- for example, we cannot coerce [Int] to [[Int]]
     | (actualNestingLevel == expectedNestingLevel || actualNestingLevel == 0) -> pure ()
     | otherwise -> raiseValidationError
     where
       raiseValidationError = throwError $ ExpectedTypeButGot expectedType actualType

assertListType :: (MonadError ValidationError m) => G.GType -> m ()
assertListType actualType =
  (when (not $ G.isListType actualType)
    (throwError $ InvalidType actualType "is not a list type"))

-- | Convert a field info to a named type, if possible.
columnInfoToNamedType
  :: (MonadError ValidationError m)
  => PGColumnInfo
  -> m G.Name