mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 04:51:35 +03:00
d432eb4d3d
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9040 GitOrigin-RevId: f577f34fd773cbc886546d7866e5a77603087a37
105 lines
3.2 KiB
Haskell
105 lines
3.2 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
|
|
-- | Feature Flags are /temporary/ toggles.
|
|
module Hasura.Server.Init.FeatureFlag
|
|
( FeatureFlag (..),
|
|
CheckFeatureFlag (..),
|
|
checkFeatureFlag,
|
|
Identifier (..),
|
|
FeatureFlags (..),
|
|
HasFeatureFlagChecker (..),
|
|
featureFlags,
|
|
nativeQueryInterface,
|
|
storedProceduresFlag,
|
|
)
|
|
where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import Data.Environment qualified as Env
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Hasura.Prelude
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
newtype Identifier = Identifier {getIdentifier :: Text}
|
|
deriving stock (Generic)
|
|
deriving newtype (Eq, FromJSON, ToJSON)
|
|
deriving anyclass (Hashable)
|
|
|
|
data FeatureFlag = FeatureFlag
|
|
{ ffIdentifier :: Identifier,
|
|
ffDefaultValue :: Bool,
|
|
ffDescription :: Text,
|
|
ffEnvVar :: String
|
|
}
|
|
deriving stock (Eq, Generic)
|
|
deriving anyclass (Hashable, FromJSON, ToJSON)
|
|
|
|
-- | In OSS we look for a environment variable or fall back to the default
|
|
-- value
|
|
checkFeatureFlag :: Env.Environment -> FeatureFlag -> IO Bool
|
|
checkFeatureFlag env (FeatureFlag {ffEnvVar = envVar, ffDefaultValue = defaultValue}) =
|
|
case Env.lookupEnv env envVar of
|
|
Just found -> pure $ fromMaybe defaultValue (readMaybe found)
|
|
Nothing -> pure $ defaultValue
|
|
|
|
newtype CheckFeatureFlag = CheckFeatureFlag {runCheckFeatureFlag :: FeatureFlag -> IO Bool}
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
newtype FeatureFlags = FeatureFlags {getFeatureFlags :: HashMap Text FeatureFlag}
|
|
|
|
featureFlags :: FeatureFlags
|
|
featureFlags =
|
|
FeatureFlags $
|
|
HashMap.fromList
|
|
[ ("test-flag", testFlag),
|
|
("native-query-interface", nativeQueryInterface),
|
|
("stored-procedures", storedProceduresFlag)
|
|
]
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
class Monad m => HasFeatureFlagChecker m where
|
|
checkFlag :: FeatureFlag -> m Bool
|
|
|
|
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (ReaderT r m) where
|
|
checkFlag = lift . checkFlag
|
|
|
|
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (ExceptT e m) where
|
|
checkFlag = lift . checkFlag
|
|
|
|
instance HasFeatureFlagChecker m => HasFeatureFlagChecker (StateT s m) where
|
|
checkFlag = lift . checkFlag
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
testFlag :: FeatureFlag
|
|
testFlag =
|
|
FeatureFlag
|
|
{ ffIdentifier = Identifier "test-flag",
|
|
ffDefaultValue = False,
|
|
ffDescription = "Testing feature flag integration",
|
|
ffEnvVar = "HASURA_FF_TEST_FLAG"
|
|
}
|
|
|
|
nativeQueryInterface :: FeatureFlag
|
|
nativeQueryInterface =
|
|
FeatureFlag
|
|
{ ffIdentifier = Identifier "native-query-interface",
|
|
ffDefaultValue = False,
|
|
ffDescription = "Expose custom views, permissions and advanced SQL functionality via custom queries",
|
|
ffEnvVar = "HASURA_FF_NATIVE_QUERY_INTERFACE"
|
|
}
|
|
|
|
storedProceduresFlag :: FeatureFlag
|
|
storedProceduresFlag =
|
|
FeatureFlag
|
|
{ ffIdentifier = Identifier "stored-procedures",
|
|
ffDefaultValue = False,
|
|
ffDescription = "Expose stored procedures support",
|
|
ffEnvVar = "HASURA_FF_STORED_PROCEDURES"
|
|
}
|