mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 01:44:03 +03:00
bd9f93eaef
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/8269 GitOrigin-RevId: 34330f383ca82fb159842a171a763c178b462788
184 lines
6.7 KiB
Haskell
184 lines
6.7 KiB
Haskell
-- | This module provides operations to load and modify metadata
|
|
-- relating to GraphQL Data Connectors.
|
|
module Hasura.RQL.DDL.DataConnector
|
|
( -- * DC Add Agent
|
|
DCAddAgent (..),
|
|
runAddDataConnectorAgent,
|
|
|
|
-- * DC Delete Agent
|
|
DCDeleteAgent (..),
|
|
runDeleteDataConnectorAgent,
|
|
)
|
|
where
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
import Control.Monad.Except
|
|
import Control.Monad.Trans.Control
|
|
import Data.Aeson (FromJSON, ToJSON, (.!=), (.:), (.:?), (.=))
|
|
import Data.Aeson qualified as Aeson
|
|
import Data.Has
|
|
import Data.Map.Strict qualified as Map
|
|
import Data.Monoid
|
|
import Data.Text.Extended (ToTxt (..))
|
|
import Hasura.Backends.DataConnector.API (ErrorResponse (_crDetails))
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC.Types
|
|
import Hasura.Backends.DataConnector.Agent.Client (AgentClientContext (..), runAgentClientT)
|
|
import Hasura.Base.Error qualified as Error
|
|
import Hasura.EncJSON (EncJSON)
|
|
import Hasura.EncJSON qualified as EncJSON
|
|
import Hasura.Logging qualified as L
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.SourceKinds
|
|
import Hasura.RQL.Types.Common qualified as Common
|
|
import Hasura.RQL.Types.Metadata qualified as Metadata
|
|
import Hasura.RQL.Types.SchemaCache.Build qualified as SC.Build
|
|
import Hasura.SQL.Backend qualified as Backend
|
|
import Hasura.SQL.BackendMap qualified as BackendMap
|
|
import Hasura.Services.Network
|
|
import Hasura.Tracing (ignoreTraceT)
|
|
import Servant.Client qualified as Servant
|
|
import Servant.Client.Core.HasClient ((//))
|
|
import Servant.Client.Generic (genericClient)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
data DCAddAgent = DCAddAgent
|
|
{ -- | Source kind, ie., the backend type.
|
|
_gdcaName :: DC.Types.DataConnectorName,
|
|
-- | The Agent URL.
|
|
_gdcaUrl :: Servant.BaseUrl,
|
|
-- | Override the display name provided by the Agent.
|
|
_gdcaDisplayName :: Maybe Text,
|
|
-- | Optionally skip the Agent Validation step.
|
|
_gdcaSkipCheck :: SkipCheck
|
|
}
|
|
|
|
newtype SkipCheck = SkipCheck Bool
|
|
deriving newtype (FromJSON, ToJSON, Eq)
|
|
deriving (Semigroup, Monoid) via Any
|
|
|
|
instance FromJSON DCAddAgent where
|
|
parseJSON = Aeson.withObject "DCAddAgent" \o -> do
|
|
_gdcaName <- o .: "name"
|
|
mUri <- o .: "url"
|
|
_gdcaDisplayName <- o .:? "display_name"
|
|
_gdcaSkipCheck <- o .:? "skip_check" .!= SkipCheck False
|
|
case mUri of
|
|
Just _gdcaUrl -> pure DCAddAgent {..}
|
|
Nothing -> fail "Failed to parse Agent URL"
|
|
|
|
instance ToJSON DCAddAgent where
|
|
toJSON DCAddAgent {..} =
|
|
Aeson.object $
|
|
[ "name" .= _gdcaName,
|
|
"url" .= show _gdcaUrl,
|
|
"skip_check" .= _gdcaSkipCheck
|
|
]
|
|
++ ["display_name" .= _gdcaDisplayName | isJust _gdcaDisplayName]
|
|
|
|
-- | Insert a new Data Connector Agent into Metadata.
|
|
runAddDataConnectorAgent ::
|
|
( Metadata.MetadataM m,
|
|
ProvidesNetwork m,
|
|
SC.Build.CacheRWM m,
|
|
Has (L.Logger L.Hasura) r,
|
|
MonadReader r m,
|
|
MonadError Error.QErr m,
|
|
MonadIO m,
|
|
MonadBaseControl IO m
|
|
) =>
|
|
DCAddAgent ->
|
|
m EncJSON
|
|
runAddDataConnectorAgent DCAddAgent {..} = do
|
|
let agent :: DC.Types.DataConnectorOptions
|
|
agent = DC.Types.DataConnectorOptions _gdcaUrl _gdcaDisplayName
|
|
sourceKinds <- (:) "postgres" . fmap _skiSourceKind . unSourceKinds <$> agentSourceKinds
|
|
if
|
|
| toTxt _gdcaName `elem` sourceKinds -> Error.throw400 Error.AlreadyExists $ "SourceKind '" <> toTxt _gdcaName <> "' already exists."
|
|
| _gdcaSkipCheck == SkipCheck True -> addAgent _gdcaName agent
|
|
| otherwise ->
|
|
checkAgentAvailability _gdcaUrl >>= \case
|
|
NotAvailable err ->
|
|
pure $
|
|
EncJSON.encJFromJValue $
|
|
Aeson.object
|
|
[ ("message" .= Aeson.String "Agent is not available"),
|
|
("details" .= err)
|
|
]
|
|
_ -> addAgent _gdcaName agent
|
|
|
|
addAgent :: (MonadError Error.QErr m, SC.Build.MetadataM m, SC.Build.CacheRWM m) => DC.Types.DataConnectorName -> DC.Types.DataConnectorOptions -> m EncJSON
|
|
addAgent agentName agent = do
|
|
let modifier' =
|
|
Metadata.MetadataModifier $
|
|
Metadata.metaBackendConfigs %~ BackendMap.modify @'Backend.DataConnector \oldMap ->
|
|
Metadata.BackendConfigWrapper $ Map.insert agentName agent (coerce oldMap)
|
|
SC.Build.withNewInconsistentObjsCheck $ SC.Build.buildSchemaCache modifier'
|
|
|
|
pure Common.successMsg
|
|
|
|
data Availability = Available | NotAvailable Error.QErr
|
|
|
|
-- | Check DC Agent availability by checking its Capabilities endpoint.
|
|
checkAgentAvailability ::
|
|
( ProvidesNetwork m,
|
|
Has (L.Logger L.Hasura) r,
|
|
MonadReader r m,
|
|
MonadIO m,
|
|
MonadBaseControl IO m
|
|
) =>
|
|
Servant.BaseUrl ->
|
|
m Availability
|
|
checkAgentAvailability url = do
|
|
manager <- askHTTPManager
|
|
logger <- asks getter
|
|
res <- runExceptT $ do
|
|
capabilitiesU <- (ignoreTraceT . flip runAgentClientT (AgentClientContext logger url manager Nothing) $ genericClient @API.Routes // API._capabilities)
|
|
API.capabilitiesCase
|
|
(Error.throw500 "Capabilities request failed unexpectedly")
|
|
pure
|
|
(\e -> Error.throw500WithDetail (API.errorResponseSummary e) (_crDetails e))
|
|
capabilitiesU
|
|
-- NOTE: 'capabilitiesCase' does not handle the 'no connection to host' scenario so we must handle it explicitly here:
|
|
pure (either NotAvailable (const Available) res)
|
|
|
|
--------------------------------------------------------------------------------
|
|
|
|
newtype DCDeleteAgent = DCDeleteAgent {_dcdaName :: DC.Types.DataConnectorName}
|
|
|
|
instance FromJSON DCDeleteAgent where
|
|
parseJSON = Aeson.withObject "DCDeleteAgent" \o -> do
|
|
_dcdaName <- o .: "name"
|
|
pure $ DCDeleteAgent {..}
|
|
|
|
instance ToJSON DCDeleteAgent where
|
|
toJSON DCDeleteAgent {..} = Aeson.object ["name" .= _dcdaName]
|
|
|
|
-- | Delete a Data Connector Agent from the Metadata.
|
|
runDeleteDataConnectorAgent ::
|
|
( SC.Build.CacheRWM m,
|
|
Metadata.MetadataM m,
|
|
MonadError Error.QErr m
|
|
) =>
|
|
DCDeleteAgent ->
|
|
m EncJSON
|
|
runDeleteDataConnectorAgent DCDeleteAgent {..} = do
|
|
oldMetadata <- Metadata.getMetadata
|
|
|
|
let kindExists = do
|
|
agentMap <- BackendMap.lookup @'Backend.DataConnector $ Metadata._metaBackendConfigs oldMetadata
|
|
Map.lookup _dcdaName $ Metadata.unBackendConfigWrapper agentMap
|
|
case kindExists of
|
|
Nothing -> Error.throw400 Error.NotFound $ "DC Agent '" <> toTxt _dcdaName <> "' not found"
|
|
Just _ -> do
|
|
let modifier' =
|
|
Metadata.MetadataModifier $
|
|
Metadata.metaBackendConfigs
|
|
%~ BackendMap.alter @'Backend.DataConnector
|
|
(fmap (coerce . Map.delete _dcdaName . Metadata.unBackendConfigWrapper))
|
|
|
|
SC.Build.withNewInconsistentObjsCheck $ SC.Build.buildSchemaCache modifier'
|
|
pure Common.successMsg
|