-- | 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 Data.Aeson (FromJSON, ToJSON, (.:), (.=))
import Data.Aeson qualified as Aeson
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Text.NonEmpty (NonEmptyText)
import Data.Text.NonEmpty qualified as Text.NE
import Hasura.Backends.DataConnector.Adapter.Types qualified as DC.Types
import Hasura.Base.Error qualified as Error
import Hasura.EncJSON (EncJSON)
import Hasura.Prelude
import Hasura.RQL.Types.Common qualified as Common
import Hasura.RQL.Types.Metadata (MetadataM (putMetadata))
import Hasura.RQL.Types.Metadata qualified as Metadata
import Hasura.SQL.Backend qualified as Backend
import Hasura.SQL.BackendMap qualified as BackendMap
import Servant.Client qualified as Servant

--------------------------------------------------------------------------------

data DCAddAgent = DCAddAgent
  { DCAddAgent -> NonEmptyText
_gdcaName :: NonEmptyText,
    DCAddAgent -> BaseUrl
_gdcaUrl :: Servant.BaseUrl
  }

instance FromJSON DCAddAgent where
  parseJSON :: Value -> Parser DCAddAgent
parseJSON = String
-> (Object -> Parser DCAddAgent) -> Value -> Parser DCAddAgent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"DCAddAgent" \Object
o -> do
    NonEmptyText
_gdcaName <- Object
o Object -> Key -> Parser NonEmptyText
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    Maybe BaseUrl
mUri <- Object
o Object -> Key -> Parser (Maybe BaseUrl)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
    case Maybe BaseUrl
mUri of
      Just BaseUrl
_gdcaUrl -> DCAddAgent -> Parser DCAddAgent
forall (f :: * -> *) a. Applicative f => a -> f a
pure DCAddAgent :: NonEmptyText -> BaseUrl -> DCAddAgent
DCAddAgent {NonEmptyText
BaseUrl
_gdcaUrl :: BaseUrl
_gdcaName :: NonEmptyText
_gdcaUrl :: BaseUrl
_gdcaName :: NonEmptyText
..}
      Maybe BaseUrl
Nothing -> String -> Parser DCAddAgent
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse Agent URL"

instance ToJSON DCAddAgent where
  toJSON :: DCAddAgent -> Value
toJSON DCAddAgent {NonEmptyText
BaseUrl
_gdcaUrl :: BaseUrl
_gdcaName :: NonEmptyText
_gdcaUrl :: DCAddAgent -> BaseUrl
_gdcaName :: DCAddAgent -> NonEmptyText
..} = [Pair] -> Value
Aeson.object [Key
"name" Key -> NonEmptyText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmptyText
_gdcaName, Key
"url" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BaseUrl -> String
forall a. Show a => a -> String
show BaseUrl
_gdcaUrl]

-- | Insert a new Data Connector Agent into Metadata.
runAddDataConnectorAgent :: (Metadata.MetadataM m) => DCAddAgent -> m EncJSON
runAddDataConnectorAgent :: DCAddAgent -> m EncJSON
runAddDataConnectorAgent DCAddAgent {NonEmptyText
BaseUrl
_gdcaUrl :: BaseUrl
_gdcaName :: NonEmptyText
_gdcaUrl :: DCAddAgent -> BaseUrl
_gdcaName :: DCAddAgent -> NonEmptyText
..} = do
  let kind :: DataConnectorName
kind = NonEmptyText -> DataConnectorName
DC.Types.DataConnectorName NonEmptyText
_gdcaName
      agent :: DataConnectorOptions
agent = BaseUrl -> DataConnectorOptions
DC.Types.DataConnectorOptions BaseUrl
_gdcaUrl

  Metadata
oldMetadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
Metadata.getMetadata

  let modifiedMetadata :: Metadata
modifiedMetadata =
        Metadata
oldMetadata Metadata -> (Metadata -> Metadata) -> Metadata
forall a b. a -> (a -> b) -> b
& (BackendMap BackendConfigWrapper
 -> Identity (BackendMap BackendConfigWrapper))
-> Metadata -> Identity Metadata
Lens' Metadata (BackendMap BackendConfigWrapper)
Metadata.metaBackendConfigs ((BackendMap BackendConfigWrapper
  -> Identity (BackendMap BackendConfigWrapper))
 -> Metadata -> Identity Metadata)
-> (BackendMap BackendConfigWrapper
    -> BackendMap BackendConfigWrapper)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (BackendConfigWrapper 'DataConnector
 -> BackendConfigWrapper 'DataConnector)
-> BackendMap BackendConfigWrapper
-> BackendMap BackendConfigWrapper
forall (b :: BackendType) (i :: BackendType -> *).
(HasTag b, Monoid (i b)) =>
(i b -> i b) -> BackendMap i -> BackendMap i
BackendMap.modify @'Backend.DataConnector \BackendConfigWrapper 'DataConnector
oldMap ->
          BackendConfig 'DataConnector -> BackendConfigWrapper 'DataConnector
forall (b :: BackendType).
BackendConfig b -> BackendConfigWrapper b
Metadata.BackendConfigWrapper (BackendConfig 'DataConnector
 -> BackendConfigWrapper 'DataConnector)
-> BackendConfig 'DataConnector
-> BackendConfigWrapper 'DataConnector
forall a b. (a -> b) -> a -> b
$ DataConnectorName
-> DataConnectorOptions
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> InsOrdHashMap DataConnectorName DataConnectorOptions
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert DataConnectorName
kind DataConnectorOptions
agent (BackendConfigWrapper 'DataConnector
-> InsOrdHashMap DataConnectorName DataConnectorOptions
coerce BackendConfigWrapper 'DataConnector
oldMap)

  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
modifiedMetadata
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
Common.successMsg

--------------------------------------------------------------------------------

data DCDeleteAgent = DCDeleteAgent {DCDeleteAgent -> NonEmptyText
_gdcrName :: NonEmptyText}

instance FromJSON DCDeleteAgent where
  parseJSON :: Value -> Parser DCDeleteAgent
parseJSON = String
-> (Object -> Parser DCDeleteAgent)
-> Value
-> Parser DCDeleteAgent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"DCDeleteAgent" \Object
o -> do
    NonEmptyText
_gdcrName <- Object
o Object -> Key -> Parser NonEmptyText
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    DCDeleteAgent -> Parser DCDeleteAgent
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DCDeleteAgent -> Parser DCDeleteAgent)
-> DCDeleteAgent -> Parser DCDeleteAgent
forall a b. (a -> b) -> a -> b
$ DCDeleteAgent :: NonEmptyText -> DCDeleteAgent
DCDeleteAgent {NonEmptyText
_gdcrName :: NonEmptyText
_gdcrName :: NonEmptyText
..}

instance ToJSON DCDeleteAgent where
  toJSON :: DCDeleteAgent -> Value
toJSON DCDeleteAgent {NonEmptyText
_gdcrName :: NonEmptyText
_gdcrName :: DCDeleteAgent -> NonEmptyText
..} = [Pair] -> Value
Aeson.object [Key
"name" Key -> NonEmptyText -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= NonEmptyText
_gdcrName]

runDeleteDataConnectorAgent :: (Metadata.MetadataM m, MonadError Error.QErr m) => DCDeleteAgent -> m EncJSON
runDeleteDataConnectorAgent :: DCDeleteAgent -> m EncJSON
runDeleteDataConnectorAgent DCDeleteAgent {NonEmptyText
_gdcrName :: NonEmptyText
_gdcrName :: DCDeleteAgent -> NonEmptyText
..} = do
  let kind :: DataConnectorName
kind = NonEmptyText -> DataConnectorName
DC.Types.DataConnectorName NonEmptyText
_gdcrName

  Metadata
oldMetadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
Metadata.getMetadata

  let kindExists :: Maybe DataConnectorOptions
kindExists = do
        BackendConfigWrapper 'DataConnector
agentMap <- forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
BackendMap i -> Maybe (i b)
forall (i :: BackendType -> *).
HasTag 'DataConnector =>
BackendMap i -> Maybe (i 'DataConnector)
BackendMap.lookup @'Backend.DataConnector (BackendMap BackendConfigWrapper
 -> Maybe (BackendConfigWrapper 'DataConnector))
-> BackendMap BackendConfigWrapper
-> Maybe (BackendConfigWrapper 'DataConnector)
forall a b. (a -> b) -> a -> b
$ Metadata -> BackendMap BackendConfigWrapper
Metadata._metaBackendConfigs Metadata
oldMetadata
        DataConnectorName
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> Maybe DataConnectorOptions
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup DataConnectorName
kind (InsOrdHashMap DataConnectorName DataConnectorOptions
 -> Maybe DataConnectorOptions)
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> Maybe DataConnectorOptions
forall a b. (a -> b) -> a -> b
$ BackendConfigWrapper 'DataConnector -> BackendConfig 'DataConnector
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
Metadata.unBackendConfigWrapper BackendConfigWrapper 'DataConnector
agentMap
  case Maybe DataConnectorOptions
kindExists of
    Maybe DataConnectorOptions
Nothing -> Code -> Text -> m EncJSON
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
Error.throw400 Code
Error.NotFound (Text -> m EncJSON) -> Text -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Text
"DC Agent '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmptyText -> Text
Text.NE.unNonEmptyText NonEmptyText
_gdcrName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' not found"
    Just DataConnectorOptions
_ -> do
      let modifiedMetadata :: Metadata
modifiedMetadata =
            Metadata
oldMetadata Metadata -> (Metadata -> Metadata) -> Metadata
forall a b. a -> (a -> b) -> b
& (BackendMap BackendConfigWrapper
 -> Identity (BackendMap BackendConfigWrapper))
-> Metadata -> Identity Metadata
Lens' Metadata (BackendMap BackendConfigWrapper)
Metadata.metaBackendConfigs
              ((BackendMap BackendConfigWrapper
  -> Identity (BackendMap BackendConfigWrapper))
 -> Metadata -> Identity Metadata)
-> (BackendMap BackendConfigWrapper
    -> BackendMap BackendConfigWrapper)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Maybe (BackendConfigWrapper 'DataConnector)
 -> Maybe (BackendConfigWrapper 'DataConnector))
-> BackendMap BackendConfigWrapper
-> BackendMap BackendConfigWrapper
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
(Maybe (i b) -> Maybe (i b)) -> BackendMap i -> BackendMap i
BackendMap.alter @'Backend.DataConnector
                ((BackendConfigWrapper 'DataConnector
 -> BackendConfigWrapper 'DataConnector)
-> Maybe (BackendConfigWrapper 'DataConnector)
-> Maybe (BackendConfigWrapper 'DataConnector)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InsOrdHashMap DataConnectorName DataConnectorOptions
-> BackendConfigWrapper 'DataConnector
coerce (InsOrdHashMap DataConnectorName DataConnectorOptions
 -> BackendConfigWrapper 'DataConnector)
-> (BackendConfigWrapper 'DataConnector
    -> InsOrdHashMap DataConnectorName DataConnectorOptions)
-> BackendConfigWrapper 'DataConnector
-> BackendConfigWrapper 'DataConnector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConnectorName
-> InsOrdHashMap DataConnectorName DataConnectorOptions
-> InsOrdHashMap DataConnectorName DataConnectorOptions
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete DataConnectorName
kind (InsOrdHashMap DataConnectorName DataConnectorOptions
 -> InsOrdHashMap DataConnectorName DataConnectorOptions)
-> (BackendConfigWrapper 'DataConnector
    -> InsOrdHashMap DataConnectorName DataConnectorOptions)
-> BackendConfigWrapper 'DataConnector
-> InsOrdHashMap DataConnectorName DataConnectorOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendConfigWrapper 'DataConnector
-> InsOrdHashMap DataConnectorName DataConnectorOptions
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
Metadata.unBackendConfigWrapper))

      Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
modifiedMetadata
      EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
Common.successMsg