mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-19 05:21:47 +03:00
d1ba271c3d
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3475 GitOrigin-RevId: bc847b18d491fe4957a190f5d0fe2ae6e6719791
102 lines
3.7 KiB
Haskell
102 lines
3.7 KiB
Haskell
module Hasura.RQL.WebhookTransformsSpec (spec) where
|
|
|
|
import Data.Aeson
|
|
import Data.CaseInsensitive qualified as CI
|
|
import Data.List (nubBy)
|
|
import Data.Set qualified as S
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.WebhookTransforms
|
|
import Hedgehog.Gen qualified as Gen
|
|
import Hedgehog.Range qualified as Range
|
|
import Test.Hspec
|
|
import Test.Hspec.Hedgehog
|
|
|
|
spec :: Spec
|
|
spec = do
|
|
it "StringTemplateText RoundTrip" $
|
|
hedgehog $ forAll genStringTemplateText >>= trippingJSON
|
|
|
|
it "TemplateEngine RoundTrip" $
|
|
hedgehog $ forAll genTemplatingEngine >>= trippingJSON
|
|
|
|
it "TemplateText RoundTrip" $
|
|
hedgehog $ forAll genTemplateText >>= trippingJSON
|
|
|
|
it "TransformHeaders" $
|
|
hedgehog $ do
|
|
headers <- forAll genTransformHeaders
|
|
let sortH TransformHeaders {..} = TransformHeaders (sort addHeaders) (sort removeHeaders)
|
|
headersMaybe = eitherDecode $ encode headers
|
|
Right (sortH headers) === fmap sortH headersMaybe
|
|
|
|
it "MetadataRequestTransform RoundTrip" $
|
|
hedgehog $ do
|
|
transform <- forAll genMetadataRequestTransform
|
|
let sortH TransformHeaders {..} = TransformHeaders (sort addHeaders) (sort removeHeaders)
|
|
let sortMT mt@MetadataRequestTransform {mtRequestHeaders, mtQueryParams} = mt {mtRequestHeaders = sortH <$> mtRequestHeaders, mtQueryParams = sort <$> mtQueryParams}
|
|
transformMaybe = eitherDecode $ encode transform
|
|
Right (sortMT transform) === fmap sortMT transformMaybe
|
|
|
|
trippingJSON :: (Show a, Eq a, ToJSON a, FromJSON a, MonadTest m) => a -> m ()
|
|
trippingJSON val = tripping val (toJSON) (fromJSON)
|
|
|
|
genTemplatingEngine :: Gen TemplatingEngine
|
|
genTemplatingEngine = Gen.enumBounded @_ @TemplatingEngine
|
|
|
|
-- NOTE: This generator is strictly useful for roundtrip aeson testing
|
|
-- and does not produce valid template snippets.
|
|
genTemplateText :: Gen TemplateText
|
|
genTemplateText = TemplateText . wrap <$> Gen.text (Range.constant 3 20) Gen.alphaNum
|
|
where
|
|
wrap txt = "\"" <> txt <> "\""
|
|
|
|
genStringTemplateText :: Gen StringTemplateText
|
|
genStringTemplateText = StringTemplateText <$> Gen.text (Range.constant 3 20) Gen.alphaNum
|
|
|
|
genTransformHeaders :: Gen TransformHeaders
|
|
genTransformHeaders = do
|
|
numHeaders <- Gen.integral $ Range.constant 1 20
|
|
|
|
let genHeaderKey = CI.mk <$> Gen.text (Range.constant 1 20) Gen.alphaNum
|
|
genHeaderValue = genStringTemplateText
|
|
|
|
genKeys = S.toList <$> Gen.set (Range.singleton numHeaders) genHeaderKey
|
|
genValues = S.toList <$> Gen.set (Range.singleton numHeaders) genHeaderValue
|
|
|
|
removeHeaders <- Gen.list (Range.constant 1 10) genHeaderKey
|
|
addHeaders <- liftA2 zip genKeys genValues
|
|
pure $ TransformHeaders addHeaders removeHeaders
|
|
|
|
genQueryParams :: Gen [(StringTemplateText, Maybe StringTemplateText)]
|
|
genQueryParams = do
|
|
numParams <- Gen.integral $ Range.constant 1 20
|
|
let keyGen = genStringTemplateText
|
|
valueGen = Gen.maybe $ genStringTemplateText
|
|
keys <- Gen.list (Range.singleton numParams) keyGen
|
|
values <- Gen.list (Range.singleton numParams) valueGen
|
|
pure $ nubBy (\a b -> fst a == fst b) $ zip keys values
|
|
|
|
genUrl :: Gen StringTemplateText
|
|
genUrl = do
|
|
host <- Gen.text (Range.constant 3 20) Gen.alphaNum
|
|
|
|
pure $ StringTemplateText $ "http://www." <> host <> ".com"
|
|
|
|
genMetadataRequestTransform :: Gen MetadataRequestTransform
|
|
genMetadataRequestTransform = do
|
|
method <- Gen.maybe genStringTemplateText
|
|
-- NOTE: At the moment no need to generate valid urls or templates
|
|
-- but such instances maybe useful in the future.
|
|
url <- Gen.maybe $ genUrl
|
|
bodyTransform <- Gen.maybe $ fmap Transform $ genTemplateText
|
|
queryParams <- Gen.maybe $ genQueryParams
|
|
reqHeaders <- Gen.maybe $ genTransformHeaders
|
|
MetadataRequestTransform
|
|
V2
|
|
method
|
|
url
|
|
bodyTransform
|
|
queryParams
|
|
reqHeaders
|
|
<$> genTemplatingEngine
|