graphql-engine/server/src-lib/Hasura/RQL/DDL/Headers.hs
Samir Talwar 342391f39d Upgrade Ormolu to v0.5.
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
2022-11-02 20:55:13 +00:00

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)))