mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-09-11 10:46:25 +03:00
server: add support for header resolution from env vars
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9509 GitOrigin-RevId: 818f747422c5444fcb55419729ad58d74b890d52
This commit is contained in:
parent
3af0d49dd7
commit
f2fe9cfe3b
@ -1167,6 +1167,11 @@ Template example: `https://{{ACTION_API_DOMAIN}}/create-user`
|
||||
| name | true | String | Name of the header |
|
||||
| value | true | String | Value of the header |
|
||||
|
||||
The `value` field supports templating environment variables enclosed in
|
||||
`{{` and `}}`.
|
||||
|
||||
Template example: `header-{{HEADER_FROM_ENV}}`
|
||||
|
||||
## HeaderFromEnv {#headerfromenv}
|
||||
|
||||
| Key | required | Schema | Description |
|
||||
|
@ -1154,7 +1154,7 @@ test-suite graphql-engine-tests
|
||||
Data.Parser.CacheControlSpec
|
||||
Data.Parser.JSONPathSpec
|
||||
Data.Parser.RemoteRelationshipSpec
|
||||
Data.Parser.URLTemplateSpec
|
||||
Data.Parser.TemplateSpec
|
||||
Data.Text.RawString
|
||||
Data.TimeSpec
|
||||
Data.TrieSpec
|
||||
|
@ -43,7 +43,7 @@ instance NFData UT.Variable
|
||||
|
||||
instance NFData UT.TemplateItem
|
||||
|
||||
instance NFData UT.URLTemplate
|
||||
instance NFData UT.Template
|
||||
|
||||
instance NFData C.StepField
|
||||
|
||||
|
@ -1,15 +1,18 @@
|
||||
-- | A simple URL templating that enables interpolating environment variables
|
||||
module Data.URL.Template
|
||||
( URLTemplate,
|
||||
( Template (..),
|
||||
TemplateItem,
|
||||
Variable,
|
||||
printURLTemplate,
|
||||
mkPlainURLTemplate,
|
||||
parseURLTemplate,
|
||||
renderURLTemplate,
|
||||
printTemplate,
|
||||
mkPlainTemplate,
|
||||
parseTemplate,
|
||||
renderTemplate,
|
||||
)
|
||||
where
|
||||
|
||||
import Autodocodec (HasCodec)
|
||||
import Autodocodec qualified as AC
|
||||
import Data.Aeson
|
||||
import Data.Attoparsec.Combinator (lookAhead)
|
||||
import Data.Attoparsec.Text
|
||||
import Data.Environment qualified as Env
|
||||
@ -38,24 +41,40 @@ printTemplateItem = \case
|
||||
|
||||
-- | A String with environment variables enclosed in '{{' and '}}'
|
||||
-- http://{{APP_HOST}}:{{APP_PORT}}/v1/api
|
||||
newtype URLTemplate = URLTemplate {unURLTemplate :: [TemplateItem]}
|
||||
newtype Template = Template {unTemplate :: [TemplateItem]}
|
||||
deriving (Show, Eq, Generic, Hashable)
|
||||
|
||||
printURLTemplate :: URLTemplate -> Text
|
||||
printURLTemplate = T.concat . map printTemplateItem . unURLTemplate
|
||||
instance ToJSON Template where
|
||||
toJSON = String . printTemplate
|
||||
|
||||
mkPlainURLTemplate :: Text -> URLTemplate
|
||||
mkPlainURLTemplate =
|
||||
URLTemplate . pure . TIText
|
||||
instance FromJSON Template where
|
||||
parseJSON = withText "Template" $ \t ->
|
||||
onLeft
|
||||
(parseTemplate t)
|
||||
(\err -> fail $ "Parsing URL template failed: " ++ err)
|
||||
|
||||
parseURLTemplate :: Text -> Either String URLTemplate
|
||||
parseURLTemplate t = parseOnly parseTemplate t
|
||||
instance HasCodec Template where
|
||||
codec =
|
||||
AC.bimapCodec
|
||||
(mapLeft ("Parsing URL template failed: " ++) . parseTemplate)
|
||||
printTemplate
|
||||
AC.codec
|
||||
|
||||
printTemplate :: Template -> Text
|
||||
printTemplate = T.concat . map printTemplateItem . unTemplate
|
||||
|
||||
mkPlainTemplate :: Text -> Template
|
||||
mkPlainTemplate =
|
||||
Template . pure . TIText
|
||||
|
||||
parseTemplate :: Text -> Either String Template
|
||||
parseTemplate t = parseOnly parseTemplate' t
|
||||
where
|
||||
parseTemplate :: Parser URLTemplate
|
||||
parseTemplate = do
|
||||
parseTemplate' :: Parser Template
|
||||
parseTemplate' = do
|
||||
items <- many parseTemplateItem
|
||||
lastItem <- TIText <$> takeText
|
||||
pure $ URLTemplate $ items <> [lastItem]
|
||||
pure $ Template $ items <> [lastItem]
|
||||
|
||||
parseTemplateItem :: Parser TemplateItem
|
||||
parseTemplateItem =
|
||||
@ -66,13 +85,13 @@ parseURLTemplate t = parseOnly parseTemplate t
|
||||
parseVariable =
|
||||
string "{{" *> (Variable . T.pack <$> manyTill anyChar (string "}}"))
|
||||
|
||||
renderURLTemplate :: Env.Environment -> URLTemplate -> Either Text Text
|
||||
renderURLTemplate env template =
|
||||
renderTemplate :: Env.Environment -> Template -> Either Text Text
|
||||
renderTemplate env template =
|
||||
case errorVariables of
|
||||
[] -> Right $ T.concat $ rights eitherResults
|
||||
_ -> Left (commaSeparated errorVariables)
|
||||
where
|
||||
eitherResults = map renderTemplateItem $ unURLTemplate template
|
||||
eitherResults = map renderTemplateItem $ unTemplate template
|
||||
errorVariables = lefts eitherResults
|
||||
renderTemplateItem = \case
|
||||
TIText t -> Right t
|
||||
@ -86,8 +105,8 @@ renderURLTemplate env template =
|
||||
instance Arbitrary Variable where
|
||||
arbitrary = Variable . T.pack <$> listOf1 (elements $ alphaNumerics <> " -_")
|
||||
|
||||
instance Arbitrary URLTemplate where
|
||||
arbitrary = URLTemplate <$> listOf (oneof [genText, genVariable])
|
||||
instance Arbitrary Template where
|
||||
arbitrary = Template <$> listOf (oneof [genText, genVariable])
|
||||
where
|
||||
genText = TIText . T.pack <$> listOf1 (elements $ alphaNumerics <> " ://")
|
||||
genVariable = TIVariable <$> arbitrary
|
||||
|
@ -59,6 +59,7 @@ import Data.SerializableBlob qualified as SB
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Encoding qualified as TE
|
||||
import Data.Text.Encoding.Error qualified as TE
|
||||
import Data.URL.Template (mkPlainTemplate, printTemplate)
|
||||
import Hasura.HTTP
|
||||
import Hasura.Logging
|
||||
import Hasura.Prelude
|
||||
@ -142,7 +143,7 @@ mkHTTPResp resp =
|
||||
respBody = HTTP.responseBody resp
|
||||
decodeBS = TE.decodeUtf8With TE.lenientDecode
|
||||
decodeHeader' (hdrName, hdrVal) =
|
||||
HeaderConf (decodeBS $ CI.original hdrName) (HVValue (decodeBS hdrVal))
|
||||
HeaderConf (decodeBS $ CI.original hdrName) (HVValue $ mkPlainTemplate (decodeBS hdrVal))
|
||||
|
||||
data RequestDetails = RequestDetails
|
||||
{ _rdOriginalRequest :: HTTP.Request,
|
||||
@ -191,7 +192,7 @@ instance J.ToJSON (HTTPRespExtra a) where
|
||||
Just name -> ["event_name" J..= name]
|
||||
Nothing -> []
|
||||
getValue val = case val of
|
||||
HVValue txt -> J.String txt
|
||||
HVValue txt -> J.String (printTemplate txt)
|
||||
HVEnv txt -> J.String txt
|
||||
getRedactedHeaders =
|
||||
J.Object
|
||||
@ -410,7 +411,7 @@ decodeHeader headerInfos (hdrName, hdrVal) =
|
||||
in name'
|
||||
mehi = find (\hi -> getName hi == name) headerInfos
|
||||
in case mehi of
|
||||
Nothing -> HeaderConf name (HVValue (decodeBS hdrVal))
|
||||
Nothing -> HeaderConf name (HVValue $ mkPlainTemplate (decodeBS hdrVal))
|
||||
Just ehi -> ehiHeaderConf ehi
|
||||
where
|
||||
decodeBS = TE.decodeUtf8With TE.lenientDecode
|
||||
@ -437,7 +438,7 @@ getRetryAfterHeaderFromResp resp =
|
||||
(\(HeaderConf name _) -> CI.mk name == retryAfterHeader)
|
||||
(hrsHeaders resp)
|
||||
in case mHeader of
|
||||
Just (HeaderConf _ (HVValue value)) -> Just value
|
||||
Just (HeaderConf _ (HVValue value)) -> Just $ printTemplate value
|
||||
_ -> Nothing
|
||||
|
||||
parseRetryHeaderValue :: Text -> Maybe Int
|
||||
|
@ -138,7 +138,7 @@ import Data.Text qualified as T
|
||||
import Data.Text.Extended (ToTxt (..), (<<>))
|
||||
import Data.These
|
||||
import Data.Time.Clock
|
||||
import Data.URL.Template (printURLTemplate)
|
||||
import Data.URL.Template (printTemplate)
|
||||
import Database.PG.Query qualified as PG
|
||||
import Hasura.Backends.Postgres.Execute.Types
|
||||
import Hasura.Backends.Postgres.SQL.DML qualified as S
|
||||
@ -385,7 +385,7 @@ processOneOffScheduledEvents
|
||||
scheduledTriggerMetrics
|
||||
where
|
||||
logInternalError err = liftIO . L.unLogger logger $ ScheduledTriggerInternalErr err
|
||||
getTemplateFromUrl url = printURLTemplate $ unInputWebhook url
|
||||
getTemplateFromUrl url = printTemplate $ unInputWebhook url
|
||||
mkInvalidEnvVarErrMsg envVarErrorValues = "The value for environment variables not found: " <> (getInvalidEnvVarText envVarErrorValues)
|
||||
mkErrorObject :: Text -> J.Value
|
||||
mkErrorObject errorMessage =
|
||||
|
@ -22,7 +22,7 @@ import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
||||
import Data.List.NonEmpty qualified as NEList
|
||||
import Data.Text.Extended
|
||||
import Data.URL.Template (printURLTemplate)
|
||||
import Data.URL.Template (printTemplate)
|
||||
import Hasura.Base.Error
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Metadata.Class
|
||||
@ -195,7 +195,7 @@ resolveAction env AnnotatedCustomTypes {..} ActionDefinition {..} allScalars = d
|
||||
<> commaSeparated (dquote . _ofdName <$> nestedObjects)
|
||||
pure aot
|
||||
resolvedWebhook <- resolveWebhook env _adHandler
|
||||
let webhookEnvRecord = EnvRecord (printURLTemplate $ unInputWebhook _adHandler) resolvedWebhook
|
||||
let webhookEnvRecord = EnvRecord (printTemplate $ unInputWebhook _adHandler) resolvedWebhook
|
||||
pure
|
||||
( ActionDefinition
|
||||
resolvedArguments
|
||||
|
@ -59,7 +59,7 @@ import Data.HashSet qualified as Set
|
||||
import Data.Sequence qualified as Seq
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Extended
|
||||
import Data.URL.Template (printURLTemplate)
|
||||
import Data.URL.Template (printTemplate, renderTemplate)
|
||||
import Hasura.Base.Error
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Eventing.Backend
|
||||
@ -503,7 +503,9 @@ getHeaderInfosFromConf env = mapM getHeader
|
||||
where
|
||||
getHeader :: (QErrM m) => HeaderConf -> m EventHeaderInfo
|
||||
getHeader hconf = case hconf of
|
||||
(HeaderConf _ (HVValue val)) -> return $ EventHeaderInfo hconf val
|
||||
(HeaderConf _ (HVValue val)) -> case renderTemplate env val of
|
||||
Left err -> throw400 NotFound $ "template cannot be resolved: " <> err
|
||||
Right resolvedVal -> return $ EventHeaderInfo hconf resolvedVal
|
||||
(HeaderConf _ (HVEnv val)) -> do
|
||||
envVal <- getEnv env val
|
||||
return $ EventHeaderInfo hconf envVal
|
||||
@ -522,7 +524,9 @@ getHeaderInfosFromConfEither env hConfList =
|
||||
headerInfoList = map getHeader hConfList
|
||||
getHeader :: HeaderConf -> Either Text EventHeaderInfo
|
||||
getHeader hconf = case hconf of
|
||||
(HeaderConf _ (HVValue val)) -> Right $ EventHeaderInfo hconf val
|
||||
(HeaderConf _ (HVValue val)) -> case renderTemplate env val of
|
||||
Left err -> Left $ "template cannot be resolved: " <> tshow err
|
||||
Right resolvedVal -> Right $ EventHeaderInfo hconf resolvedVal
|
||||
(HeaderConf _ (HVEnv val)) ->
|
||||
(Right . EventHeaderInfo hconf) =<< getEnvEither env val
|
||||
|
||||
@ -534,7 +538,7 @@ getWebhookInfoFromConf ::
|
||||
getWebhookInfoFromConf env webhookConf = case webhookConf of
|
||||
WCValue w -> do
|
||||
resolvedWebhook <- resolveWebhook env w
|
||||
let urlTemplate = printURLTemplate $ unInputWebhook w
|
||||
let urlTemplate = printTemplate $ unInputWebhook w
|
||||
-- `urlTemplate` can either be the template value({{TEST}}) or a plain text.
|
||||
-- When `urlTemplate` is a template value then '_envVarName' of the 'EnvRecord'
|
||||
-- will be the template value i.e '{{TEST}}'
|
||||
|
@ -7,6 +7,7 @@ where
|
||||
import Data.CaseInsensitive qualified as CI
|
||||
import Data.Environment qualified as Env
|
||||
import Data.Text qualified as T
|
||||
import Data.URL.Template (mkPlainTemplate, renderTemplate)
|
||||
import Hasura.Base.Error
|
||||
import Hasura.Base.Instances ()
|
||||
import Hasura.Prelude
|
||||
@ -21,7 +22,11 @@ makeHeadersFromConf env = mapM getHeader
|
||||
getHeader hconf =
|
||||
((CI.mk . txtToBs) *** txtToBs)
|
||||
<$> case hconf of
|
||||
(HeaderConf name (HVValue val)) -> return (name, val)
|
||||
(HeaderConf name (HVValue template)) -> do
|
||||
let renderedTemplate = renderTemplate env template
|
||||
case renderedTemplate of
|
||||
Left e -> throw400 NotFound $ "template cannot be resolved: " <> e
|
||||
Right v -> return (name, v)
|
||||
(HeaderConf name (HVEnv val)) -> do
|
||||
let mEnv = Env.lookupEnv env (T.unpack val)
|
||||
case mEnv of
|
||||
@ -31,4 +36,4 @@ makeHeadersFromConf env = mapM getHeader
|
||||
-- | Encode headers to HeaderConf
|
||||
toHeadersConf :: [HTTP.Header] -> [HeaderConf]
|
||||
toHeadersConf =
|
||||
map (uncurry HeaderConf . ((bsToTxt . CI.original) *** (HVValue . bsToTxt)))
|
||||
map (uncurry HeaderConf . ((bsToTxt . CI.original) *** (HVValue . mkPlainTemplate . bsToTxt)))
|
||||
|
@ -17,7 +17,7 @@ import Data.Environment qualified as Env
|
||||
import Data.HashMap.Strict qualified as HashMap
|
||||
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
|
||||
import Data.Time.Clock qualified as C
|
||||
import Data.URL.Template (printURLTemplate)
|
||||
import Data.URL.Template (printTemplate)
|
||||
import Hasura.Base.Error
|
||||
import Hasura.EncJSON
|
||||
import Hasura.Eventing.ScheduledTrigger
|
||||
@ -111,7 +111,7 @@ resolveCronTrigger ::
|
||||
resolveCronTrigger env CronTriggerMetadata {..} = do
|
||||
webhookInfo <- resolveWebhook env ctWebhook
|
||||
headerInfo <- getHeaderInfosFromConf env ctHeaders
|
||||
let urlTemplate = printURLTemplate $ unInputWebhook ctWebhook
|
||||
let urlTemplate = printTemplate $ unInputWebhook ctWebhook
|
||||
pure
|
||||
$ CronTriggerInfo
|
||||
ctName
|
||||
|
@ -73,7 +73,7 @@ import Hasura.Prelude
|
||||
import Hasura.RQL.Types.Common
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
import Hasura.RQL.Types.Eventing (EventId (..))
|
||||
import Hasura.RQL.Types.Headers (HeaderConf)
|
||||
import Hasura.RQL.Types.Headers
|
||||
import Hasura.RQL.Types.Roles (RoleName)
|
||||
import Hasura.RQL.Types.Session (SessionVariables)
|
||||
import Hasura.RQL.Types.Webhook.Transform (MetadataResponseTransform, RequestTransform)
|
||||
|
@ -315,7 +315,7 @@ newtype ResolvedWebhook = ResolvedWebhook {unResolvedWebhook :: Text}
|
||||
|
||||
instance NFData ResolvedWebhook
|
||||
|
||||
newtype InputWebhook = InputWebhook {unInputWebhook :: URLTemplate}
|
||||
newtype InputWebhook = InputWebhook {unInputWebhook :: Template}
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance NFData InputWebhook
|
||||
@ -327,22 +327,22 @@ instance HasCodec InputWebhook where
|
||||
where
|
||||
urlTemplateCodec =
|
||||
bimapCodec
|
||||
(mapLeft ("Parsing URL template failed: " ++) . parseURLTemplate)
|
||||
printURLTemplate
|
||||
(mapLeft ("Parsing URL template failed: " ++) . parseTemplate)
|
||||
printTemplate
|
||||
codec
|
||||
|
||||
instance ToJSON InputWebhook where
|
||||
toJSON = String . printURLTemplate . unInputWebhook
|
||||
toJSON = String . printTemplate . unInputWebhook
|
||||
|
||||
instance FromJSON InputWebhook where
|
||||
parseJSON = withText "String" $ \t ->
|
||||
case parseURLTemplate t of
|
||||
case parseTemplate t of
|
||||
Left e -> fail $ "Parsing URL template failed: " ++ e
|
||||
Right v -> pure $ InputWebhook v
|
||||
|
||||
instance PG.FromCol InputWebhook where
|
||||
fromCol bs = do
|
||||
urlTemplate <- parseURLTemplate <$> PG.fromCol bs
|
||||
urlTemplate <- parseTemplate <$> PG.fromCol bs
|
||||
bimap (\e -> "Parsing URL template failed: " <> T.pack e) InputWebhook urlTemplate
|
||||
|
||||
-- Consists of the environment variable name with missing/invalid value
|
||||
@ -358,7 +358,7 @@ resolveWebhook env inputWebhook = do
|
||||
-- This is similar to `resolveWebhook` but it doesn't fail when an env var is invalid
|
||||
resolveWebhookEither :: Env.Environment -> InputWebhook -> Either ResolveWebhookError ResolvedWebhook
|
||||
resolveWebhookEither env (InputWebhook urlTemplate) =
|
||||
bimap ResolveWebhookError ResolvedWebhook (renderURLTemplate env urlTemplate)
|
||||
bimap ResolveWebhookError ResolvedWebhook (renderTemplate env urlTemplate)
|
||||
|
||||
newtype Timeout = Timeout {unTimeout :: Int}
|
||||
deriving (Show, Eq, ToJSON, Generic, NFData)
|
||||
|
@ -8,6 +8,8 @@ import Autodocodec (HasCodec (codec), bimapCodec, disjointEitherCodec, requiredF
|
||||
import Autodocodec qualified as AC
|
||||
import Data.Aeson
|
||||
import Data.Text qualified as T
|
||||
import Data.URL.Template
|
||||
import Hasura.Base.Instances ()
|
||||
import Hasura.Prelude
|
||||
|
||||
data HeaderConf = HeaderConf HeaderName HeaderValue
|
||||
@ -19,7 +21,7 @@ instance Hashable HeaderConf
|
||||
|
||||
type HeaderName = Text
|
||||
|
||||
data HeaderValue = HVValue Text | HVEnv Text
|
||||
data HeaderValue = HVValue Template | HVEnv Text
|
||||
deriving (Show, Eq, Generic)
|
||||
|
||||
instance NFData HeaderValue
|
||||
@ -61,7 +63,9 @@ instance FromJSON HeaderConf where
|
||||
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)
|
||||
(Just val, Nothing) -> do
|
||||
template <- parseJSON val
|
||||
return $ HeaderConf name (HVValue template)
|
||||
(Nothing, Just val) -> do
|
||||
when (T.isPrefixOf "HASURA_GRAPHQL_" val)
|
||||
$ fail
|
||||
@ -72,5 +76,5 @@ instance FromJSON HeaderConf where
|
||||
parseJSON _ = fail "expecting object for headers"
|
||||
|
||||
instance ToJSON HeaderConf where
|
||||
toJSON (HeaderConf name (HVValue val)) = object ["name" .= name, "value" .= val]
|
||||
toJSON (HeaderConf name (HVValue val)) = object ["name" .= name, "value" .= toJSON val]
|
||||
toJSON (HeaderConf name (HVEnv val)) = object ["name" .= name, "value_from_env" .= val]
|
||||
|
@ -58,7 +58,7 @@ import Data.HashSet qualified as Set
|
||||
import Data.Monoid
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Extended
|
||||
import Data.URL.Template (printURLTemplate)
|
||||
import Data.URL.Template (printTemplate)
|
||||
import Hasura.Base.Error
|
||||
import Hasura.GraphQL.Parser.Variable
|
||||
import Hasura.GraphQL.Schema.Typename
|
||||
@ -234,7 +234,7 @@ validateRemoteSchemaDef env (RemoteSchemaDef mUrl mUrlEnv hdrC fwdHdrs mTimeout
|
||||
where
|
||||
hdrs = fromMaybe [] hdrC
|
||||
timeout = fromMaybe 60 mTimeout
|
||||
getTemplateFromUrl url = printURLTemplate $ unInputWebhook url
|
||||
getTemplateFromUrl url = printTemplate $ unInputWebhook url
|
||||
|
||||
-- | See `resolveRemoteVariable` function. This data type is used
|
||||
-- for validation of the session variable value
|
||||
|
@ -104,7 +104,7 @@ retriesNumOption =
|
||||
Config._helpMessage = "No.of retries if Postgres connection error occurs (default: 1)"
|
||||
}
|
||||
|
||||
parseDatabaseUrl :: Opt.Parser (Maybe Template.URLTemplate)
|
||||
parseDatabaseUrl :: Opt.Parser (Maybe Template.Template)
|
||||
parseDatabaseUrl =
|
||||
Opt.optional
|
||||
$ Opt.option
|
||||
|
@ -177,14 +177,14 @@ pciRetries = Lens.lens _pciRetries $ \pci mi -> pci {_pciRetries = mi}
|
||||
-- | Postgres Connection info in the form of a templated URI string or
|
||||
-- structured data.
|
||||
data PostgresConnInfoRaw
|
||||
= PGConnDatabaseUrl Template.URLTemplate
|
||||
= PGConnDatabaseUrl Template.Template
|
||||
| PGConnDetails PostgresConnDetailsRaw
|
||||
deriving (Show, Eq)
|
||||
|
||||
mkUrlConnInfo :: String -> PostgresConnInfoRaw
|
||||
mkUrlConnInfo = PGConnDatabaseUrl . Template.mkPlainURLTemplate . Text.pack
|
||||
mkUrlConnInfo = PGConnDatabaseUrl . Template.mkPlainTemplate . Text.pack
|
||||
|
||||
_PGConnDatabaseUrl :: Prism' PostgresConnInfoRaw Template.URLTemplate
|
||||
_PGConnDatabaseUrl :: Prism' PostgresConnInfoRaw Template.Template
|
||||
_PGConnDatabaseUrl = Lens.prism' PGConnDatabaseUrl $ \case
|
||||
PGConnDatabaseUrl template -> Just template
|
||||
PGConnDetails _ -> Nothing
|
||||
@ -194,9 +194,9 @@ _PGConnDetails = Lens.prism' PGConnDetails $ \case
|
||||
PGConnDatabaseUrl _ -> Nothing
|
||||
PGConnDetails prcd -> Just prcd
|
||||
|
||||
rawConnDetailsToUrl :: PostgresConnDetailsRaw -> Template.URLTemplate
|
||||
rawConnDetailsToUrl :: PostgresConnDetailsRaw -> Template.Template
|
||||
rawConnDetailsToUrl =
|
||||
Template.mkPlainURLTemplate . rawConnDetailsToUrlText
|
||||
Template.mkPlainTemplate . rawConnDetailsToUrlText
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
|
@ -346,8 +346,8 @@ instance FromEnv Logging.LogLevel where
|
||||
"error" -> Right Logging.LevelError
|
||||
_ -> Left "Valid log levels: debug, info, warn or error"
|
||||
|
||||
instance FromEnv Template.URLTemplate where
|
||||
fromEnv = Template.parseURLTemplate . Text.pack
|
||||
instance FromEnv Template.Template where
|
||||
fromEnv = Template.parseTemplate . Text.pack
|
||||
|
||||
instance (Num a, Ord a, FromEnv a) => FromEnv (Refined NonNegative a) where
|
||||
fromEnv s =
|
||||
|
17
server/src-test/Data/Parser/TemplateSpec.hs
Normal file
17
server/src-test/Data/Parser/TemplateSpec.hs
Normal file
@ -0,0 +1,17 @@
|
||||
module Data.Parser.TemplateSpec (spec) where
|
||||
|
||||
import Data.URL.Template
|
||||
import Hasura.Prelude
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "parseTemplate"
|
||||
$ it "template parser and printer"
|
||||
$ withMaxSuccess 1000
|
||||
$ forAll (arbitrary :: Gen Template)
|
||||
$ \template -> do
|
||||
let templateString = printTemplate template
|
||||
case parseTemplate templateString of
|
||||
Left e -> counterexample e False
|
||||
Right r -> property $ printTemplate r == templateString
|
@ -1,17 +0,0 @@
|
||||
module Data.Parser.URLTemplateSpec (spec) where
|
||||
|
||||
import Data.URL.Template
|
||||
import Hasura.Prelude
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "parseURLTemplate"
|
||||
$ it "URL template parser and printer"
|
||||
$ withMaxSuccess 1000
|
||||
$ forAll (arbitrary :: Gen URLTemplate)
|
||||
$ \urlTemplate -> do
|
||||
let templateString = printURLTemplate urlTemplate
|
||||
case parseURLTemplate templateString of
|
||||
Left e -> counterexample e False
|
||||
Right r -> property $ printURLTemplate r == templateString
|
@ -73,7 +73,7 @@ mainParserSpec =
|
||||
Opt.Failure _pf -> pure ()
|
||||
Opt.CompletionInvoked cr -> Hspec.expectationFailure $ show cr
|
||||
|
||||
Hspec.it "Accepts '--database-url' with a valid URLTemplate argument" $ do
|
||||
Hspec.it "Accepts '--database-url' with a valid Template argument" $ do
|
||||
let -- Given
|
||||
parserInfo = Opt.info (UUT.parseHgeOpts @Logging.Hasura Opt.<**> Opt.helper) Opt.fullDesc
|
||||
-- When
|
||||
@ -82,7 +82,7 @@ mainParserSpec =
|
||||
result = Opt.execParserPure Opt.defaultPrefs parserInfo argInput
|
||||
|
||||
fmap (preview (UUT.horDatabaseUrl . UUT.pciDatabaseConn . _Just . UUT._PGConnDatabaseUrl)) result `Hspec.shouldSatisfy` \case
|
||||
Opt.Success template -> template == eitherToMaybe (Template.parseURLTemplate "https://hasura.io/{{foo}}")
|
||||
Opt.Success template -> template == eitherToMaybe (Template.parseTemplate "https://hasura.io/{{foo}}")
|
||||
Opt.Failure _pf -> False
|
||||
Opt.CompletionInvoked _cr -> False
|
||||
|
||||
|
@ -70,7 +70,7 @@ main = do
|
||||
<> envVar
|
||||
|
||||
let pgConnInfo = PG.ConnInfo 1 $ PG.CDDatabaseURI $ txtToBs pgUrlText
|
||||
urlConf = UrlValue $ InputWebhook $ mkPlainURLTemplate pgUrlText
|
||||
urlConf = UrlValue $ InputWebhook $ mkPlainTemplate pgUrlText
|
||||
sourceConnInfo =
|
||||
PostgresSourceConnInfo urlConf (Just setPostgresPoolSettings) True PG.ReadCommitted Nothing
|
||||
sourceConfig = PostgresConnConfiguration sourceConnInfo Nothing defaultPostgresExtensionsSchema Nothing mempty
|
||||
|
Loading…
Reference in New Issue
Block a user