Only output deprecated enum values when requested

Author: Auke Booij

server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs

@@ -10,6 +10,8 @@ module Hasura.GraphQL.Resolve.InputValue
   , asPGColumnValueM
   , asPGColumnValue
 
+  , asScalarValM
+  , asScalarVal
   , asEnumVal
   , asEnumValM
   , withObject
@@ -26,6 +28,8 @@ module Hasura.GraphQL.Resolve.InputValue
 
 import           Hasura.Prelude
 
+import qualified Text.Builder                  as TB
+
 import qualified Language.GraphQL.Draft.Syntax  as G
 
 import qualified Hasura.RQL.Types               as RQL
@@ -120,6 +124,19 @@ asPGColumnValue v = do
 openInputValue :: (MonadReusability m) => AnnInpVal -> m AnnGValue
 openInputValue v = when (isJust $ _aivVariable v) markNotReusable $> _aivValue v
 
+asScalarValM :: (MonadReusability m, MonadError QErr m) => AnnInpVal -> PGScalarType -> m (Maybe PGScalarValue)
+asScalarValM v tp = openInputValue v >>= \case
+  AGScalar tp' vM ->
+    if tp == tp'
+    then pure vM
+    else tyMismatch "scalar" v
+  _ -> tyMismatch "scalar" v
+
+asScalarVal :: (MonadReusability m, MonadError QErr m) => AnnInpVal -> PGScalarType -> m PGScalarValue
+asScalarVal v tp = asScalarValM v tp >>= \case
+  Just val -> pure val
+  Nothing -> throw500 $ "unexpected null for ty " <> TB.run (toSQL tp)
+
 -- | Note: only handles “synthetic” enums (see 'EnumValuesInfo'). Enum table references are handled
 -- by 'asPGColumnType' and its variants.
 asEnumVal :: (MonadReusability m, MonadError QErr m) => AnnInpVal -> m (G.NamedType, G.EnumValue)

server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs

@@ -11,6 +11,8 @@ import qualified Data.HashMap.Strict                as Map
 import qualified Data.HashSet                       as Set
 import qualified Data.Text                          as T
 import qualified Language.GraphQL.Draft.Syntax      as G
+import qualified Hasura.SQL.Value                   as S
+import qualified Hasura.SQL.Types                   as S
 
 import           Hasura.GraphQL.Context
 import           Hasura.GraphQL.Resolve.Context
@@ -156,7 +158,7 @@ ifaceR' i@(IFaceTyInfo descM n flds) fld =
 
 -- 4.5.2.5
 enumTypeR
-  :: ( Monad m )
+  :: ( Monad m, MonadReusability m, MonadError QErr m )
   => EnumTyInfo
   -> Field
   -> m J.Object
@@ -167,9 +169,20 @@ enumTypeR (EnumTyInfo descM n vals _) fld =
     "kind"        -> retJ TKENUM
     "name"        -> retJ $ namedTyToTxt n
     "description" -> retJ $ fmap G.unDescription descM
-    "enumValues"  -> fmap J.toJSON $ mapM (enumValueR subFld) $
-                     sortOn _eviVal $ Map.elems (normalizeEnumValues vals)
+    "enumValues"  -> do
+      includeDeprecated <- readIncludeDeprecated subFld
+      fmap J.toJSON $ mapM (enumValueR subFld) $
+        filter (\val -> includeDeprecated || _eviIsDeprecated val) $
+        sortOn _eviVal $ Map.elems (normalizeEnumValues vals)
     _             -> return J.Null
+  where
+    readIncludeDeprecated subFld = do
+      let argM = Map.lookup "includeDeprecated" (_fArguments subFld)
+      case argM of
+        Nothing -> pure False
+        Just arg -> asScalarVal arg S.PGBoolean >>= \case
+          S.PGValBoolean b -> pure b
+          _ -> throw500 "unexpected non-Boolean argument for includeDeprecated"
 
 -- 4.5.2.6
 inputObjR