mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-24 07:52:14 +03:00
342391f39d
This upgrades the version of Ormolu required by the HGE repository to v0.5.0.1, and reformats all code accordingly. Ormolu v0.5 reformats code that uses infix operators. This is mostly useful, adding newlines and indentation to make it clear which operators are applied first, but in some cases, it's unpleasant. To make this easier on the eyes, I had to do the following: * Add a few fixity declarations (search for `infix`) * Add parentheses to make precedence clear, allowing Ormolu to keep everything on one line * Rename `relevantEq` to `(==~)` in #6651 and set it to `infix 4` * Add a few _.ormolu_ files (thanks to @hallettj for helping me get started), mostly for Autodocodec operators that don't have explicit fixity declarations In general, I think these changes are quite reasonable. They mostly affect indentation. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6675 GitOrigin-RevId: cd47d87f1d089fb0bc9dcbbe7798dbceedcd7d83
78 lines
2.5 KiB
Haskell
78 lines
2.5 KiB
Haskell
module Hasura.RQL.DDL.Headers
|
|
( HeaderConf (..),
|
|
HeaderValue (HVEnv, HVValue),
|
|
makeHeadersFromConf,
|
|
toHeadersConf,
|
|
)
|
|
where
|
|
|
|
import Data.Aeson
|
|
import Data.CaseInsensitive qualified as CI
|
|
import Data.Environment qualified as Env
|
|
import Data.Text qualified as T
|
|
import Hasura.Base.Error
|
|
import Hasura.Base.Instances ()
|
|
import Hasura.Incremental (Cacheable)
|
|
import Hasura.Prelude
|
|
import Network.HTTP.Types qualified as HTTP
|
|
|
|
data HeaderConf = HeaderConf HeaderName HeaderValue
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance NFData HeaderConf
|
|
|
|
instance Hashable HeaderConf
|
|
|
|
instance Cacheable HeaderConf
|
|
|
|
type HeaderName = Text
|
|
|
|
data HeaderValue = HVValue Text | HVEnv Text
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance NFData HeaderValue
|
|
|
|
instance Hashable HeaderValue
|
|
|
|
instance Cacheable HeaderValue
|
|
|
|
instance FromJSON HeaderConf where
|
|
parseJSON (Object o) = do
|
|
name <- o .: "name"
|
|
value <- o .:? "value"
|
|
valueFromEnv <- o .:? "value_from_env"
|
|
case (value, valueFromEnv) of
|
|
(Nothing, Nothing) -> fail "expecting value or value_from_env keys"
|
|
(Just val, Nothing) -> return $ HeaderConf name (HVValue val)
|
|
(Nothing, Just val) -> do
|
|
when (T.isPrefixOf "HASURA_GRAPHQL_" val) $
|
|
fail $
|
|
"env variables starting with \"HASURA_GRAPHQL_\" are not allowed in value_from_env: " <> T.unpack val
|
|
return $ HeaderConf name (HVEnv val)
|
|
(Just _, Just _) -> fail "expecting only one of value or value_from_env keys"
|
|
parseJSON _ = fail "expecting object for headers"
|
|
|
|
instance ToJSON HeaderConf where
|
|
toJSON (HeaderConf name (HVValue val)) = object ["name" .= name, "value" .= val]
|
|
toJSON (HeaderConf name (HVEnv val)) = object ["name" .= name, "value_from_env" .= val]
|
|
|
|
-- | Resolve configuration headers
|
|
makeHeadersFromConf ::
|
|
MonadError QErr m => Env.Environment -> [HeaderConf] -> m [HTTP.Header]
|
|
makeHeadersFromConf env = mapM getHeader
|
|
where
|
|
getHeader hconf =
|
|
((CI.mk . txtToBs) *** txtToBs)
|
|
<$> case hconf of
|
|
(HeaderConf name (HVValue val)) -> return (name, val)
|
|
(HeaderConf name (HVEnv val)) -> do
|
|
let mEnv = Env.lookupEnv env (T.unpack val)
|
|
case mEnv of
|
|
Nothing -> throw400 NotFound $ "environment variable '" <> val <> "' not set"
|
|
Just envval -> pure (name, T.pack envval)
|
|
|
|
-- | Encode headers to HeaderConf
|
|
toHeadersConf :: [HTTP.Header] -> [HeaderConf]
|
|
toHeadersConf =
|
|
map (uncurry HeaderConf . ((bsToTxt . CI.original) *** (HVValue . bsToTxt)))
|