graphql-engine/server/src-lib/Hasura/RQL/DDL/ConnectionTemplate.hs
Tom Harding e0c0043e76 Upgrade Ormolu to 0.7.0.0
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9284
GitOrigin-RevId: 2f2cf2ad01900a54e4bdb970205ac0ef313c7e00
2023-05-24 13:53:53 +00:00

73 lines
2.8 KiB
Haskell

-- | ConnectionTemplate
--
-- This module defines the needed types/functions for implementing the metadata
-- API `<backend>_test_connection_template`.
module Hasura.RQL.DDL.ConnectionTemplate
( runTestConnectionTemplate,
TestConnectionTemplate (..),
BackendResolvedConnectionTemplate (..),
ResolvedConnectionTemplateWrapper (..),
)
where
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON))
import Data.Aeson qualified as J
import Hasura.Backends.Postgres.Connection.Settings (ConnectionTemplate (..))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata (MetadataM)
import Hasura.RQL.Types.SchemaCache (CacheRM, askSourceConfig)
import Hasura.SQL.AnyBackend qualified as AB
-- | The input type for the metadata API `<backend>_test_connection_template`
data TestConnectionTemplate b = TestConnectionTemplate
{ _tctSourceName :: SourceName,
_tctRequestContext :: ConnectionTemplateRequestContext b,
_tctConnectionTemplate :: (Maybe ConnectionTemplate)
}
instance (Backend b) => FromJSON (TestConnectionTemplate b) where
parseJSON v =
flip (J.withObject "TestConnectionTemplate") v $ \o ->
TestConnectionTemplate
<$> o
J..:? "source_name"
J..!= defaultSource
<*> o
J..: "request_context"
<*> o
J..:? "connection_template"
-- | Resolver for the metadata API `<backend>_test_connection_template`
runTestConnectionTemplate ::
forall b m.
(MonadError QErr m, CacheRM m, Backend b, MetadataM m) =>
TestConnectionTemplate b ->
m EncJSON
runTestConnectionTemplate (TestConnectionTemplate sourceName requestContext connectionTemplateMaybe) = do
sourceConfig <- askSourceConfig @b sourceName
liftEither $ resolveConnectionTemplate @b sourceConfig requestContext connectionTemplateMaybe
-- A wrapper around the `ResolvedConnectionTemplate` for adding this to `query-log`
newtype ResolvedConnectionTemplateWrapper b = ResolvedConnectionTemplateWrapper
{ getResolvedConnectionTemplateWrapper :: ResolvedConnectionTemplate b
}
-- An AnyBackend wrapper around `ResolvedConnectionTemplateWrapper` for logging as query-log
newtype BackendResolvedConnectionTemplate = BackendResolvedConnectionTemplate
{ getBackendResolvedConnectionTemplate :: AB.AnyBackend ResolvedConnectionTemplateWrapper
}
instance ToJSON BackendResolvedConnectionTemplate where
toJSON resolvedConnectionTemplate =
AB.dispatchAnyBackend
@Backend
(getBackendResolvedConnectionTemplate resolvedConnectionTemplate)
$ \(resolvedConnectionTemplate' :: ResolvedConnectionTemplateWrapper b) ->
J.object
[ "result" J..= getResolvedConnectionTemplateWrapper resolvedConnectionTemplate'
]