{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Wisdom.CreateKnowledgeBase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a knowledge base.
--
-- When using this API, you cannot reuse
-- <https://docs.aws.amazon.com/appintegrations/latest/APIReference/Welcome.html Amazon AppIntegrations>
-- DataIntegrations with external knowledge bases such as Salesforce and
-- ServiceNow. If you do, you\'ll get an @InvalidRequestException@ error.
--
-- >  <p>For example, you're programmatically managing your external knowledge base, and you want to add or remove one of the fields that is being ingested from Salesforce. Do the following:</p> <ol> <li> <p>Call <a href="https://docs.aws.amazon.com/wisdom/latest/APIReference/API_DeleteKnowledgeBase.html">DeleteKnowledgeBase</a>.</p> </li> <li> <p>Call <a href="https://docs.aws.amazon.com/appintegrations/latest/APIReference/API_DeleteDataIntegration.html">DeleteDataIntegration</a>.</p> </li> <li> <p>Call <a href="https://docs.aws.amazon.com/appintegrations/latest/APIReference/API_CreateDataIntegration.html">CreateDataIntegration</a> to recreate the DataIntegration or a create different one.</p> </li> <li> <p>Call CreateKnowledgeBase.</p> </li> </ol> </note>
module Amazonka.Wisdom.CreateKnowledgeBase
  ( -- * Creating a Request
    CreateKnowledgeBase (..),
    newCreateKnowledgeBase,

    -- * Request Lenses
    createKnowledgeBase_clientToken,
    createKnowledgeBase_description,
    createKnowledgeBase_renderingConfiguration,
    createKnowledgeBase_serverSideEncryptionConfiguration,
    createKnowledgeBase_sourceConfiguration,
    createKnowledgeBase_tags,
    createKnowledgeBase_knowledgeBaseType,
    createKnowledgeBase_name,

    -- * Destructuring the Response
    CreateKnowledgeBaseResponse (..),
    newCreateKnowledgeBaseResponse,

    -- * Response Lenses
    createKnowledgeBaseResponse_knowledgeBase,
    createKnowledgeBaseResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Wisdom.Types

-- | /See:/ 'newCreateKnowledgeBase' smart constructor.
data CreateKnowledgeBase = CreateKnowledgeBase'
  { -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateKnowledgeBase -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The description.
    CreateKnowledgeBase -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Information about how to render the content.
    CreateKnowledgeBase -> Maybe RenderingConfiguration
renderingConfiguration :: Prelude.Maybe RenderingConfiguration,
    -- | The KMS key used for encryption.
    CreateKnowledgeBase -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Prelude.Maybe ServerSideEncryptionConfiguration,
    -- | The source of the knowledge base content. Only set this argument for
    -- EXTERNAL knowledge bases.
    CreateKnowledgeBase -> Maybe SourceConfiguration
sourceConfiguration :: Prelude.Maybe SourceConfiguration,
    -- | The tags used to organize, track, or control access for this resource.
    CreateKnowledgeBase -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The type of knowledge base. Only CUSTOM knowledge bases allow you to
    -- upload your own content. EXTERNAL knowledge bases support integrations
    -- with third-party systems whose content is synchronized automatically.
    CreateKnowledgeBase -> KnowledgeBaseType
knowledgeBaseType :: KnowledgeBaseType,
    -- | The name of the knowledge base.
    CreateKnowledgeBase -> Text
name :: Prelude.Text
  }
  deriving (CreateKnowledgeBase -> CreateKnowledgeBase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKnowledgeBase -> CreateKnowledgeBase -> Bool
$c/= :: CreateKnowledgeBase -> CreateKnowledgeBase -> Bool
== :: CreateKnowledgeBase -> CreateKnowledgeBase -> Bool
$c== :: CreateKnowledgeBase -> CreateKnowledgeBase -> Bool
Prelude.Eq, ReadPrec [CreateKnowledgeBase]
ReadPrec CreateKnowledgeBase
Int -> ReadS CreateKnowledgeBase
ReadS [CreateKnowledgeBase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKnowledgeBase]
$creadListPrec :: ReadPrec [CreateKnowledgeBase]
readPrec :: ReadPrec CreateKnowledgeBase
$creadPrec :: ReadPrec CreateKnowledgeBase
readList :: ReadS [CreateKnowledgeBase]
$creadList :: ReadS [CreateKnowledgeBase]
readsPrec :: Int -> ReadS CreateKnowledgeBase
$creadsPrec :: Int -> ReadS CreateKnowledgeBase
Prelude.Read, Int -> CreateKnowledgeBase -> ShowS
[CreateKnowledgeBase] -> ShowS
CreateKnowledgeBase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKnowledgeBase] -> ShowS
$cshowList :: [CreateKnowledgeBase] -> ShowS
show :: CreateKnowledgeBase -> String
$cshow :: CreateKnowledgeBase -> String
showsPrec :: Int -> CreateKnowledgeBase -> ShowS
$cshowsPrec :: Int -> CreateKnowledgeBase -> ShowS
Prelude.Show, forall x. Rep CreateKnowledgeBase x -> CreateKnowledgeBase
forall x. CreateKnowledgeBase -> Rep CreateKnowledgeBase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateKnowledgeBase x -> CreateKnowledgeBase
$cfrom :: forall x. CreateKnowledgeBase -> Rep CreateKnowledgeBase x
Prelude.Generic)

-- |
-- Create a value of 'CreateKnowledgeBase' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clientToken', 'createKnowledgeBase_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'description', 'createKnowledgeBase_description' - The description.
--
-- 'renderingConfiguration', 'createKnowledgeBase_renderingConfiguration' - Information about how to render the content.
--
-- 'serverSideEncryptionConfiguration', 'createKnowledgeBase_serverSideEncryptionConfiguration' - The KMS key used for encryption.
--
-- 'sourceConfiguration', 'createKnowledgeBase_sourceConfiguration' - The source of the knowledge base content. Only set this argument for
-- EXTERNAL knowledge bases.
--
-- 'tags', 'createKnowledgeBase_tags' - The tags used to organize, track, or control access for this resource.
--
-- 'knowledgeBaseType', 'createKnowledgeBase_knowledgeBaseType' - The type of knowledge base. Only CUSTOM knowledge bases allow you to
-- upload your own content. EXTERNAL knowledge bases support integrations
-- with third-party systems whose content is synchronized automatically.
--
-- 'name', 'createKnowledgeBase_name' - The name of the knowledge base.
newCreateKnowledgeBase ::
  -- | 'knowledgeBaseType'
  KnowledgeBaseType ->
  -- | 'name'
  Prelude.Text ->
  CreateKnowledgeBase
newCreateKnowledgeBase :: KnowledgeBaseType -> Text -> CreateKnowledgeBase
newCreateKnowledgeBase KnowledgeBaseType
pKnowledgeBaseType_ Text
pName_ =
  CreateKnowledgeBase'
    { $sel:clientToken:CreateKnowledgeBase' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateKnowledgeBase' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:renderingConfiguration:CreateKnowledgeBase' :: Maybe RenderingConfiguration
renderingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceConfiguration:CreateKnowledgeBase' :: Maybe SourceConfiguration
sourceConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateKnowledgeBase' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:knowledgeBaseType:CreateKnowledgeBase' :: KnowledgeBaseType
knowledgeBaseType = KnowledgeBaseType
pKnowledgeBaseType_,
      $sel:name:CreateKnowledgeBase' :: Text
name = Text
pName_
    }

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createKnowledgeBase_clientToken :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe Prelude.Text)
createKnowledgeBase_clientToken :: Lens' CreateKnowledgeBase (Maybe Text)
createKnowledgeBase_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe Text
a -> CreateKnowledgeBase
s {$sel:clientToken:CreateKnowledgeBase' :: Maybe Text
clientToken = Maybe Text
a} :: CreateKnowledgeBase)

-- | The description.
createKnowledgeBase_description :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe Prelude.Text)
createKnowledgeBase_description :: Lens' CreateKnowledgeBase (Maybe Text)
createKnowledgeBase_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe Text
description :: Maybe Text
$sel:description:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe Text
a -> CreateKnowledgeBase
s {$sel:description:CreateKnowledgeBase' :: Maybe Text
description = Maybe Text
a} :: CreateKnowledgeBase)

-- | Information about how to render the content.
createKnowledgeBase_renderingConfiguration :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe RenderingConfiguration)
createKnowledgeBase_renderingConfiguration :: Lens' CreateKnowledgeBase (Maybe RenderingConfiguration)
createKnowledgeBase_renderingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe RenderingConfiguration
renderingConfiguration :: Maybe RenderingConfiguration
$sel:renderingConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe RenderingConfiguration
renderingConfiguration} -> Maybe RenderingConfiguration
renderingConfiguration) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe RenderingConfiguration
a -> CreateKnowledgeBase
s {$sel:renderingConfiguration:CreateKnowledgeBase' :: Maybe RenderingConfiguration
renderingConfiguration = Maybe RenderingConfiguration
a} :: CreateKnowledgeBase)

-- | The KMS key used for encryption.
createKnowledgeBase_serverSideEncryptionConfiguration :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe ServerSideEncryptionConfiguration)
createKnowledgeBase_serverSideEncryptionConfiguration :: Lens' CreateKnowledgeBase (Maybe ServerSideEncryptionConfiguration)
createKnowledgeBase_serverSideEncryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
$sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration} -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe ServerSideEncryptionConfiguration
a -> CreateKnowledgeBase
s {$sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = Maybe ServerSideEncryptionConfiguration
a} :: CreateKnowledgeBase)

-- | The source of the knowledge base content. Only set this argument for
-- EXTERNAL knowledge bases.
createKnowledgeBase_sourceConfiguration :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe SourceConfiguration)
createKnowledgeBase_sourceConfiguration :: Lens' CreateKnowledgeBase (Maybe SourceConfiguration)
createKnowledgeBase_sourceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe SourceConfiguration
sourceConfiguration :: Maybe SourceConfiguration
$sel:sourceConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe SourceConfiguration
sourceConfiguration} -> Maybe SourceConfiguration
sourceConfiguration) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe SourceConfiguration
a -> CreateKnowledgeBase
s {$sel:sourceConfiguration:CreateKnowledgeBase' :: Maybe SourceConfiguration
sourceConfiguration = Maybe SourceConfiguration
a} :: CreateKnowledgeBase)

-- | The tags used to organize, track, or control access for this resource.
createKnowledgeBase_tags :: Lens.Lens' CreateKnowledgeBase (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createKnowledgeBase_tags :: Lens' CreateKnowledgeBase (Maybe (HashMap Text Text))
createKnowledgeBase_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Maybe (HashMap Text Text)
a -> CreateKnowledgeBase
s {$sel:tags:CreateKnowledgeBase' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateKnowledgeBase) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The type of knowledge base. Only CUSTOM knowledge bases allow you to
-- upload your own content. EXTERNAL knowledge bases support integrations
-- with third-party systems whose content is synchronized automatically.
createKnowledgeBase_knowledgeBaseType :: Lens.Lens' CreateKnowledgeBase KnowledgeBaseType
createKnowledgeBase_knowledgeBaseType :: Lens' CreateKnowledgeBase KnowledgeBaseType
createKnowledgeBase_knowledgeBaseType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {KnowledgeBaseType
knowledgeBaseType :: KnowledgeBaseType
$sel:knowledgeBaseType:CreateKnowledgeBase' :: CreateKnowledgeBase -> KnowledgeBaseType
knowledgeBaseType} -> KnowledgeBaseType
knowledgeBaseType) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} KnowledgeBaseType
a -> CreateKnowledgeBase
s {$sel:knowledgeBaseType:CreateKnowledgeBase' :: KnowledgeBaseType
knowledgeBaseType = KnowledgeBaseType
a} :: CreateKnowledgeBase)

-- | The name of the knowledge base.
createKnowledgeBase_name :: Lens.Lens' CreateKnowledgeBase Prelude.Text
createKnowledgeBase_name :: Lens' CreateKnowledgeBase Text
createKnowledgeBase_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBase' {Text
name :: Text
$sel:name:CreateKnowledgeBase' :: CreateKnowledgeBase -> Text
name} -> Text
name) (\s :: CreateKnowledgeBase
s@CreateKnowledgeBase' {} Text
a -> CreateKnowledgeBase
s {$sel:name:CreateKnowledgeBase' :: Text
name = Text
a} :: CreateKnowledgeBase)

instance Core.AWSRequest CreateKnowledgeBase where
  type
    AWSResponse CreateKnowledgeBase =
      CreateKnowledgeBaseResponse
  request :: (Service -> Service)
-> CreateKnowledgeBase -> Request CreateKnowledgeBase
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateKnowledgeBase
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateKnowledgeBase)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe KnowledgeBaseData -> Int -> CreateKnowledgeBaseResponse
CreateKnowledgeBaseResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"knowledgeBase")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateKnowledgeBase where
  hashWithSalt :: Int -> CreateKnowledgeBase -> Int
hashWithSalt Int
_salt CreateKnowledgeBase' {Maybe Text
Maybe (HashMap Text Text)
Maybe RenderingConfiguration
Maybe ServerSideEncryptionConfiguration
Maybe SourceConfiguration
Text
KnowledgeBaseType
name :: Text
knowledgeBaseType :: KnowledgeBaseType
tags :: Maybe (HashMap Text Text)
sourceConfiguration :: Maybe SourceConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
renderingConfiguration :: Maybe RenderingConfiguration
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateKnowledgeBase' :: CreateKnowledgeBase -> Text
$sel:knowledgeBaseType:CreateKnowledgeBase' :: CreateKnowledgeBase -> KnowledgeBaseType
$sel:tags:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe (HashMap Text Text)
$sel:sourceConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe SourceConfiguration
$sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe ServerSideEncryptionConfiguration
$sel:renderingConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe RenderingConfiguration
$sel:description:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
$sel:clientToken:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RenderingConfiguration
renderingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourceConfiguration
sourceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KnowledgeBaseType
knowledgeBaseType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateKnowledgeBase where
  rnf :: CreateKnowledgeBase -> ()
rnf CreateKnowledgeBase' {Maybe Text
Maybe (HashMap Text Text)
Maybe RenderingConfiguration
Maybe ServerSideEncryptionConfiguration
Maybe SourceConfiguration
Text
KnowledgeBaseType
name :: Text
knowledgeBaseType :: KnowledgeBaseType
tags :: Maybe (HashMap Text Text)
sourceConfiguration :: Maybe SourceConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
renderingConfiguration :: Maybe RenderingConfiguration
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateKnowledgeBase' :: CreateKnowledgeBase -> Text
$sel:knowledgeBaseType:CreateKnowledgeBase' :: CreateKnowledgeBase -> KnowledgeBaseType
$sel:tags:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe (HashMap Text Text)
$sel:sourceConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe SourceConfiguration
$sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe ServerSideEncryptionConfiguration
$sel:renderingConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe RenderingConfiguration
$sel:description:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
$sel:clientToken:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RenderingConfiguration
renderingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceConfiguration
sourceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KnowledgeBaseType
knowledgeBaseType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders CreateKnowledgeBase where
  toHeaders :: CreateKnowledgeBase -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateKnowledgeBase where
  toJSON :: CreateKnowledgeBase -> Value
toJSON CreateKnowledgeBase' {Maybe Text
Maybe (HashMap Text Text)
Maybe RenderingConfiguration
Maybe ServerSideEncryptionConfiguration
Maybe SourceConfiguration
Text
KnowledgeBaseType
name :: Text
knowledgeBaseType :: KnowledgeBaseType
tags :: Maybe (HashMap Text Text)
sourceConfiguration :: Maybe SourceConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
renderingConfiguration :: Maybe RenderingConfiguration
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateKnowledgeBase' :: CreateKnowledgeBase -> Text
$sel:knowledgeBaseType:CreateKnowledgeBase' :: CreateKnowledgeBase -> KnowledgeBaseType
$sel:tags:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe (HashMap Text Text)
$sel:sourceConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe SourceConfiguration
$sel:serverSideEncryptionConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe ServerSideEncryptionConfiguration
$sel:renderingConfiguration:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe RenderingConfiguration
$sel:description:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
$sel:clientToken:CreateKnowledgeBase' :: CreateKnowledgeBase -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientToken,
            (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"renderingConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RenderingConfiguration
renderingConfiguration,
            (Key
"serverSideEncryptionConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration,
            (Key
"sourceConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SourceConfiguration
sourceConfiguration,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"knowledgeBaseType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KnowledgeBaseType
knowledgeBaseType),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateKnowledgeBase where
  toPath :: CreateKnowledgeBase -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/knowledgeBases"

instance Data.ToQuery CreateKnowledgeBase where
  toQuery :: CreateKnowledgeBase -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateKnowledgeBaseResponse' smart constructor.
data CreateKnowledgeBaseResponse = CreateKnowledgeBaseResponse'
  { -- | The knowledge base.
    CreateKnowledgeBaseResponse -> Maybe KnowledgeBaseData
knowledgeBase :: Prelude.Maybe KnowledgeBaseData,
    -- | The response's http status code.
    CreateKnowledgeBaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateKnowledgeBaseResponse -> CreateKnowledgeBaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateKnowledgeBaseResponse -> CreateKnowledgeBaseResponse -> Bool
$c/= :: CreateKnowledgeBaseResponse -> CreateKnowledgeBaseResponse -> Bool
== :: CreateKnowledgeBaseResponse -> CreateKnowledgeBaseResponse -> Bool
$c== :: CreateKnowledgeBaseResponse -> CreateKnowledgeBaseResponse -> Bool
Prelude.Eq, ReadPrec [CreateKnowledgeBaseResponse]
ReadPrec CreateKnowledgeBaseResponse
Int -> ReadS CreateKnowledgeBaseResponse
ReadS [CreateKnowledgeBaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateKnowledgeBaseResponse]
$creadListPrec :: ReadPrec [CreateKnowledgeBaseResponse]
readPrec :: ReadPrec CreateKnowledgeBaseResponse
$creadPrec :: ReadPrec CreateKnowledgeBaseResponse
readList :: ReadS [CreateKnowledgeBaseResponse]
$creadList :: ReadS [CreateKnowledgeBaseResponse]
readsPrec :: Int -> ReadS CreateKnowledgeBaseResponse
$creadsPrec :: Int -> ReadS CreateKnowledgeBaseResponse
Prelude.Read, Int -> CreateKnowledgeBaseResponse -> ShowS
[CreateKnowledgeBaseResponse] -> ShowS
CreateKnowledgeBaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateKnowledgeBaseResponse] -> ShowS
$cshowList :: [CreateKnowledgeBaseResponse] -> ShowS
show :: CreateKnowledgeBaseResponse -> String
$cshow :: CreateKnowledgeBaseResponse -> String
showsPrec :: Int -> CreateKnowledgeBaseResponse -> ShowS
$cshowsPrec :: Int -> CreateKnowledgeBaseResponse -> ShowS
Prelude.Show, forall x.
Rep CreateKnowledgeBaseResponse x -> CreateKnowledgeBaseResponse
forall x.
CreateKnowledgeBaseResponse -> Rep CreateKnowledgeBaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateKnowledgeBaseResponse x -> CreateKnowledgeBaseResponse
$cfrom :: forall x.
CreateKnowledgeBaseResponse -> Rep CreateKnowledgeBaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateKnowledgeBaseResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'knowledgeBase', 'createKnowledgeBaseResponse_knowledgeBase' - The knowledge base.
--
-- 'httpStatus', 'createKnowledgeBaseResponse_httpStatus' - The response's http status code.
newCreateKnowledgeBaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateKnowledgeBaseResponse
newCreateKnowledgeBaseResponse :: Int -> CreateKnowledgeBaseResponse
newCreateKnowledgeBaseResponse Int
pHttpStatus_ =
  CreateKnowledgeBaseResponse'
    { $sel:knowledgeBase:CreateKnowledgeBaseResponse' :: Maybe KnowledgeBaseData
knowledgeBase =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateKnowledgeBaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The knowledge base.
createKnowledgeBaseResponse_knowledgeBase :: Lens.Lens' CreateKnowledgeBaseResponse (Prelude.Maybe KnowledgeBaseData)
createKnowledgeBaseResponse_knowledgeBase :: Lens' CreateKnowledgeBaseResponse (Maybe KnowledgeBaseData)
createKnowledgeBaseResponse_knowledgeBase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBaseResponse' {Maybe KnowledgeBaseData
knowledgeBase :: Maybe KnowledgeBaseData
$sel:knowledgeBase:CreateKnowledgeBaseResponse' :: CreateKnowledgeBaseResponse -> Maybe KnowledgeBaseData
knowledgeBase} -> Maybe KnowledgeBaseData
knowledgeBase) (\s :: CreateKnowledgeBaseResponse
s@CreateKnowledgeBaseResponse' {} Maybe KnowledgeBaseData
a -> CreateKnowledgeBaseResponse
s {$sel:knowledgeBase:CreateKnowledgeBaseResponse' :: Maybe KnowledgeBaseData
knowledgeBase = Maybe KnowledgeBaseData
a} :: CreateKnowledgeBaseResponse)

-- | The response's http status code.
createKnowledgeBaseResponse_httpStatus :: Lens.Lens' CreateKnowledgeBaseResponse Prelude.Int
createKnowledgeBaseResponse_httpStatus :: Lens' CreateKnowledgeBaseResponse Int
createKnowledgeBaseResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateKnowledgeBaseResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateKnowledgeBaseResponse' :: CreateKnowledgeBaseResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateKnowledgeBaseResponse
s@CreateKnowledgeBaseResponse' {} Int
a -> CreateKnowledgeBaseResponse
s {$sel:httpStatus:CreateKnowledgeBaseResponse' :: Int
httpStatus = Int
a} :: CreateKnowledgeBaseResponse)

instance Prelude.NFData CreateKnowledgeBaseResponse where
  rnf :: CreateKnowledgeBaseResponse -> ()
rnf CreateKnowledgeBaseResponse' {Int
Maybe KnowledgeBaseData
httpStatus :: Int
knowledgeBase :: Maybe KnowledgeBaseData
$sel:httpStatus:CreateKnowledgeBaseResponse' :: CreateKnowledgeBaseResponse -> Int
$sel:knowledgeBase:CreateKnowledgeBaseResponse' :: CreateKnowledgeBaseResponse -> Maybe KnowledgeBaseData
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe KnowledgeBaseData
knowledgeBase
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus