-- | This module exports an OpenAPI specification for the GraphQL Engine
-- metadata API.
--
-- The OpenAPI specification for metadata is experimental and incomplete. Please
-- do not incorporate it into essential workflows at this time.
module Hasura.Server.MetadataOpenAPI (metadataOpenAPI) where

import Autodocodec.OpenAPI (declareNamedSchemaViaCodec)
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.OpenApi (Components (..), NamedSchema (..), OpenApi (..))
import Data.OpenApi.Declare (MonadDeclare (declare), runDeclare)
import Data.Proxy (Proxy (..))
import Hasura.Metadata.DTO.Metadata (MetadataDTO)
import Hasura.Prelude

-- | An OpenApi document includes \"schemas\" that describe the data that may be
-- produced or consumed by an API. It can also include \"paths\" which describe
-- REST endpoints, and the document can include other API metadata. This example
-- only includes schemas.
--
-- The OpenAPI specification for metadata is experimental and incomplete. Please
-- do not incorporate it into essential workflows at this time.
metadataOpenAPI :: OpenApi
metadataOpenAPI :: OpenApi
metadataOpenAPI =
  OpenApi
forall a. Monoid a => a
mempty {_openApiComponents :: Components
_openApiComponents = Components
forall a. Monoid a => a
mempty {_componentsSchemas :: Definitions Schema
_componentsSchemas = Definitions Schema
definitions}}
  where
    definitions :: Definitions Schema
definitions = (Definitions Schema, Schema) -> Definitions Schema
forall a b. (a, b) -> a
fst
      ((Definitions Schema, Schema) -> Definitions Schema)
-> (Definitions Schema, Schema) -> Definitions Schema
forall a b. (a -> b) -> a -> b
$ (Declare (Definitions Schema) Schema
 -> Definitions Schema -> (Definitions Schema, Schema))
-> Definitions Schema
-> Declare (Definitions Schema) Schema
-> (Definitions Schema, Schema)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Declare (Definitions Schema) Schema
-> Definitions Schema -> (Definitions Schema, Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare Definitions Schema
forall a. Monoid a => a
mempty
      (Declare (Definitions Schema) Schema
 -> (Definitions Schema, Schema))
-> Declare (Definitions Schema) Schema
-> (Definitions Schema, Schema)
forall a b. (a -> b) -> a -> b
$ do
        NamedSchema Maybe Text
mName Schema
codecSchema <- Proxy MetadataDTO -> Declare (Definitions Schema) NamedSchema
forall value.
HasCodec value =>
Proxy value -> Declare (Definitions Schema) NamedSchema
declareNamedSchemaViaCodec (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @MetadataDTO)
        Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare (Definitions Schema -> DeclareT (Definitions Schema) Identity ())
-> Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ [(Text, Schema)] -> Definitions Schema
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdHashMap.fromList [(Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"MetadataDTO" Maybe Text
mName, Schema
codecSchema)]
        Schema -> Declare (Definitions Schema) Schema
forall a. a -> DeclareT (Definitions Schema) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Schema
codecSchema