{-# 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.LexV2Models.CreateBot
-- 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 an Amazon Lex conversational bot.
module Amazonka.LexV2Models.CreateBot
  ( -- * Creating a Request
    CreateBot (..),
    newCreateBot,

    -- * Request Lenses
    createBot_botTags,
    createBot_description,
    createBot_testBotAliasTags,
    createBot_botName,
    createBot_roleArn,
    createBot_dataPrivacy,
    createBot_idleSessionTTLInSeconds,

    -- * Destructuring the Response
    CreateBotResponse (..),
    newCreateBotResponse,

    -- * Response Lenses
    createBotResponse_botId,
    createBotResponse_botName,
    createBotResponse_botStatus,
    createBotResponse_botTags,
    createBotResponse_creationDateTime,
    createBotResponse_dataPrivacy,
    createBotResponse_description,
    createBotResponse_idleSessionTTLInSeconds,
    createBotResponse_roleArn,
    createBotResponse_testBotAliasTags,
    createBotResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateBot' smart constructor.
data CreateBot = CreateBot'
  { -- | A list of tags to add to the bot. You can only add tags when you create
    -- a bot. You can\'t use the @UpdateBot@ operation to update tags. To
    -- update tags, use the @TagResource@ operation.
    CreateBot -> Maybe (HashMap Text Text)
botTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A description of the bot. It appears in lists to help you identify a
    -- particular bot.
    CreateBot -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to add to the test alias for a bot. You can only add tags
    -- when you create a bot. You can\'t use the @UpdateAlias@ operation to
    -- update tags. To update tags on the test alias, use the @TagResource@
    -- operation.
    CreateBot -> Maybe (HashMap Text Text)
testBotAliasTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the bot. The bot name must be unique in the account that
    -- creates the bot.
    CreateBot -> Text
botName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of an IAM role that has permission to
    -- access the bot.
    CreateBot -> Text
roleArn :: Prelude.Text,
    -- | Provides information on additional privacy protections Amazon Lex should
    -- use with the bot\'s data.
    CreateBot -> DataPrivacy
dataPrivacy :: DataPrivacy,
    -- | The time, in seconds, that Amazon Lex should keep information about a
    -- user\'s conversation with the bot.
    --
    -- A user interaction remains active for the amount of time specified. If
    -- no conversation occurs during this time, the session expires and Amazon
    -- Lex deletes any data provided before the timeout.
    --
    -- You can specify between 60 (1 minute) and 86,400 (24 hours) seconds.
    CreateBot -> Natural
idleSessionTTLInSeconds :: Prelude.Natural
  }
  deriving (CreateBot -> CreateBot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBot -> CreateBot -> Bool
$c/= :: CreateBot -> CreateBot -> Bool
== :: CreateBot -> CreateBot -> Bool
$c== :: CreateBot -> CreateBot -> Bool
Prelude.Eq, ReadPrec [CreateBot]
ReadPrec CreateBot
Int -> ReadS CreateBot
ReadS [CreateBot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBot]
$creadListPrec :: ReadPrec [CreateBot]
readPrec :: ReadPrec CreateBot
$creadPrec :: ReadPrec CreateBot
readList :: ReadS [CreateBot]
$creadList :: ReadS [CreateBot]
readsPrec :: Int -> ReadS CreateBot
$creadsPrec :: Int -> ReadS CreateBot
Prelude.Read, Int -> CreateBot -> ShowS
[CreateBot] -> ShowS
CreateBot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBot] -> ShowS
$cshowList :: [CreateBot] -> ShowS
show :: CreateBot -> String
$cshow :: CreateBot -> String
showsPrec :: Int -> CreateBot -> ShowS
$cshowsPrec :: Int -> CreateBot -> ShowS
Prelude.Show, forall x. Rep CreateBot x -> CreateBot
forall x. CreateBot -> Rep CreateBot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBot x -> CreateBot
$cfrom :: forall x. CreateBot -> Rep CreateBot x
Prelude.Generic)

-- |
-- Create a value of 'CreateBot' 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:
--
-- 'botTags', 'createBot_botTags' - A list of tags to add to the bot. You can only add tags when you create
-- a bot. You can\'t use the @UpdateBot@ operation to update tags. To
-- update tags, use the @TagResource@ operation.
--
-- 'description', 'createBot_description' - A description of the bot. It appears in lists to help you identify a
-- particular bot.
--
-- 'testBotAliasTags', 'createBot_testBotAliasTags' - A list of tags to add to the test alias for a bot. You can only add tags
-- when you create a bot. You can\'t use the @UpdateAlias@ operation to
-- update tags. To update tags on the test alias, use the @TagResource@
-- operation.
--
-- 'botName', 'createBot_botName' - The name of the bot. The bot name must be unique in the account that
-- creates the bot.
--
-- 'roleArn', 'createBot_roleArn' - The Amazon Resource Name (ARN) of an IAM role that has permission to
-- access the bot.
--
-- 'dataPrivacy', 'createBot_dataPrivacy' - Provides information on additional privacy protections Amazon Lex should
-- use with the bot\'s data.
--
-- 'idleSessionTTLInSeconds', 'createBot_idleSessionTTLInSeconds' - The time, in seconds, that Amazon Lex should keep information about a
-- user\'s conversation with the bot.
--
-- A user interaction remains active for the amount of time specified. If
-- no conversation occurs during this time, the session expires and Amazon
-- Lex deletes any data provided before the timeout.
--
-- You can specify between 60 (1 minute) and 86,400 (24 hours) seconds.
newCreateBot ::
  -- | 'botName'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'dataPrivacy'
  DataPrivacy ->
  -- | 'idleSessionTTLInSeconds'
  Prelude.Natural ->
  CreateBot
newCreateBot :: Text -> Text -> DataPrivacy -> Natural -> CreateBot
newCreateBot
  Text
pBotName_
  Text
pRoleArn_
  DataPrivacy
pDataPrivacy_
  Natural
pIdleSessionTTLInSeconds_ =
    CreateBot'
      { $sel:botTags:CreateBot' :: Maybe (HashMap Text Text)
botTags = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateBot' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:testBotAliasTags:CreateBot' :: Maybe (HashMap Text Text)
testBotAliasTags = forall a. Maybe a
Prelude.Nothing,
        $sel:botName:CreateBot' :: Text
botName = Text
pBotName_,
        $sel:roleArn:CreateBot' :: Text
roleArn = Text
pRoleArn_,
        $sel:dataPrivacy:CreateBot' :: DataPrivacy
dataPrivacy = DataPrivacy
pDataPrivacy_,
        $sel:idleSessionTTLInSeconds:CreateBot' :: Natural
idleSessionTTLInSeconds = Natural
pIdleSessionTTLInSeconds_
      }

-- | A list of tags to add to the bot. You can only add tags when you create
-- a bot. You can\'t use the @UpdateBot@ operation to update tags. To
-- update tags, use the @TagResource@ operation.
createBot_botTags :: Lens.Lens' CreateBot (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBot_botTags :: Lens' CreateBot (Maybe (HashMap Text Text))
createBot_botTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Maybe (HashMap Text Text)
botTags :: Maybe (HashMap Text Text)
$sel:botTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
botTags} -> Maybe (HashMap Text Text)
botTags) (\s :: CreateBot
s@CreateBot' {} Maybe (HashMap Text Text)
a -> CreateBot
s {$sel:botTags:CreateBot' :: Maybe (HashMap Text Text)
botTags = Maybe (HashMap Text Text)
a} :: CreateBot) 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

-- | A description of the bot. It appears in lists to help you identify a
-- particular bot.
createBot_description :: Lens.Lens' CreateBot (Prelude.Maybe Prelude.Text)
createBot_description :: Lens' CreateBot (Maybe Text)
createBot_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Maybe Text
description :: Maybe Text
$sel:description:CreateBot' :: CreateBot -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateBot
s@CreateBot' {} Maybe Text
a -> CreateBot
s {$sel:description:CreateBot' :: Maybe Text
description = Maybe Text
a} :: CreateBot)

-- | A list of tags to add to the test alias for a bot. You can only add tags
-- when you create a bot. You can\'t use the @UpdateAlias@ operation to
-- update tags. To update tags on the test alias, use the @TagResource@
-- operation.
createBot_testBotAliasTags :: Lens.Lens' CreateBot (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBot_testBotAliasTags :: Lens' CreateBot (Maybe (HashMap Text Text))
createBot_testBotAliasTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Maybe (HashMap Text Text)
testBotAliasTags :: Maybe (HashMap Text Text)
$sel:testBotAliasTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
testBotAliasTags} -> Maybe (HashMap Text Text)
testBotAliasTags) (\s :: CreateBot
s@CreateBot' {} Maybe (HashMap Text Text)
a -> CreateBot
s {$sel:testBotAliasTags:CreateBot' :: Maybe (HashMap Text Text)
testBotAliasTags = Maybe (HashMap Text Text)
a} :: CreateBot) 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 name of the bot. The bot name must be unique in the account that
-- creates the bot.
createBot_botName :: Lens.Lens' CreateBot Prelude.Text
createBot_botName :: Lens' CreateBot Text
createBot_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Text
botName :: Text
$sel:botName:CreateBot' :: CreateBot -> Text
botName} -> Text
botName) (\s :: CreateBot
s@CreateBot' {} Text
a -> CreateBot
s {$sel:botName:CreateBot' :: Text
botName = Text
a} :: CreateBot)

-- | The Amazon Resource Name (ARN) of an IAM role that has permission to
-- access the bot.
createBot_roleArn :: Lens.Lens' CreateBot Prelude.Text
createBot_roleArn :: Lens' CreateBot Text
createBot_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Text
roleArn :: Text
$sel:roleArn:CreateBot' :: CreateBot -> Text
roleArn} -> Text
roleArn) (\s :: CreateBot
s@CreateBot' {} Text
a -> CreateBot
s {$sel:roleArn:CreateBot' :: Text
roleArn = Text
a} :: CreateBot)

-- | Provides information on additional privacy protections Amazon Lex should
-- use with the bot\'s data.
createBot_dataPrivacy :: Lens.Lens' CreateBot DataPrivacy
createBot_dataPrivacy :: Lens' CreateBot DataPrivacy
createBot_dataPrivacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {DataPrivacy
dataPrivacy :: DataPrivacy
$sel:dataPrivacy:CreateBot' :: CreateBot -> DataPrivacy
dataPrivacy} -> DataPrivacy
dataPrivacy) (\s :: CreateBot
s@CreateBot' {} DataPrivacy
a -> CreateBot
s {$sel:dataPrivacy:CreateBot' :: DataPrivacy
dataPrivacy = DataPrivacy
a} :: CreateBot)

-- | The time, in seconds, that Amazon Lex should keep information about a
-- user\'s conversation with the bot.
--
-- A user interaction remains active for the amount of time specified. If
-- no conversation occurs during this time, the session expires and Amazon
-- Lex deletes any data provided before the timeout.
--
-- You can specify between 60 (1 minute) and 86,400 (24 hours) seconds.
createBot_idleSessionTTLInSeconds :: Lens.Lens' CreateBot Prelude.Natural
createBot_idleSessionTTLInSeconds :: Lens' CreateBot Natural
createBot_idleSessionTTLInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBot' {Natural
idleSessionTTLInSeconds :: Natural
$sel:idleSessionTTLInSeconds:CreateBot' :: CreateBot -> Natural
idleSessionTTLInSeconds} -> Natural
idleSessionTTLInSeconds) (\s :: CreateBot
s@CreateBot' {} Natural
a -> CreateBot
s {$sel:idleSessionTTLInSeconds:CreateBot' :: Natural
idleSessionTTLInSeconds = Natural
a} :: CreateBot)

instance Core.AWSRequest CreateBot where
  type AWSResponse CreateBot = CreateBotResponse
  request :: (Service -> Service) -> CreateBot -> Request CreateBot
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateBot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateBot)))
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 Text
-> Maybe Text
-> Maybe BotStatus
-> Maybe (HashMap Text Text)
-> Maybe POSIX
-> Maybe DataPrivacy
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> CreateBotResponse
CreateBotResponse'
            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
"botId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botTags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"creationDateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"dataPrivacy")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"idleSessionTTLInSeconds")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"roleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"testBotAliasTags"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 CreateBot where
  hashWithSalt :: Int -> CreateBot -> Int
hashWithSalt Int
_salt CreateBot' {Natural
Maybe Text
Maybe (HashMap Text Text)
Text
DataPrivacy
idleSessionTTLInSeconds :: Natural
dataPrivacy :: DataPrivacy
roleArn :: Text
botName :: Text
testBotAliasTags :: Maybe (HashMap Text Text)
description :: Maybe Text
botTags :: Maybe (HashMap Text Text)
$sel:idleSessionTTLInSeconds:CreateBot' :: CreateBot -> Natural
$sel:dataPrivacy:CreateBot' :: CreateBot -> DataPrivacy
$sel:roleArn:CreateBot' :: CreateBot -> Text
$sel:botName:CreateBot' :: CreateBot -> Text
$sel:testBotAliasTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
$sel:description:CreateBot' :: CreateBot -> Maybe Text
$sel:botTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
botTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
testBotAliasTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataPrivacy
dataPrivacy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
idleSessionTTLInSeconds

instance Prelude.NFData CreateBot where
  rnf :: CreateBot -> ()
rnf CreateBot' {Natural
Maybe Text
Maybe (HashMap Text Text)
Text
DataPrivacy
idleSessionTTLInSeconds :: Natural
dataPrivacy :: DataPrivacy
roleArn :: Text
botName :: Text
testBotAliasTags :: Maybe (HashMap Text Text)
description :: Maybe Text
botTags :: Maybe (HashMap Text Text)
$sel:idleSessionTTLInSeconds:CreateBot' :: CreateBot -> Natural
$sel:dataPrivacy:CreateBot' :: CreateBot -> DataPrivacy
$sel:roleArn:CreateBot' :: CreateBot -> Text
$sel:botName:CreateBot' :: CreateBot -> Text
$sel:testBotAliasTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
$sel:description:CreateBot' :: CreateBot -> Maybe Text
$sel:botTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
botTags
      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 (HashMap Text Text)
testBotAliasTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataPrivacy
dataPrivacy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
idleSessionTTLInSeconds

instance Data.ToHeaders CreateBot where
  toHeaders :: CreateBot -> 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 CreateBot where
  toJSON :: CreateBot -> Value
toJSON CreateBot' {Natural
Maybe Text
Maybe (HashMap Text Text)
Text
DataPrivacy
idleSessionTTLInSeconds :: Natural
dataPrivacy :: DataPrivacy
roleArn :: Text
botName :: Text
testBotAliasTags :: Maybe (HashMap Text Text)
description :: Maybe Text
botTags :: Maybe (HashMap Text Text)
$sel:idleSessionTTLInSeconds:CreateBot' :: CreateBot -> Natural
$sel:dataPrivacy:CreateBot' :: CreateBot -> DataPrivacy
$sel:roleArn:CreateBot' :: CreateBot -> Text
$sel:botName:CreateBot' :: CreateBot -> Text
$sel:testBotAliasTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
$sel:description:CreateBot' :: CreateBot -> Maybe Text
$sel:botTags:CreateBot' :: CreateBot -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"botTags" 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)
botTags,
            (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
"testBotAliasTags" 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)
testBotAliasTags,
            forall a. a -> Maybe a
Prelude.Just (Key
"botName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
botName),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"dataPrivacy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataPrivacy
dataPrivacy),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"idleSessionTTLInSeconds"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
idleSessionTTLInSeconds
              )
          ]
      )

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

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

-- | /See:/ 'newCreateBotResponse' smart constructor.
data CreateBotResponse = CreateBotResponse'
  { -- | A unique identifier for a particular bot. You use this to identify the
    -- bot when you call other Amazon Lex API operations.
    CreateBotResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The name specified for the bot.
    CreateBotResponse -> Maybe Text
botName :: Prelude.Maybe Prelude.Text,
    -- | Shows the current status of the bot. The bot is first in the @Creating@
    -- status. Once the bot is read for use, it changes to the @Available@
    -- status. After the bot is created, you can use the @Draft@ version of the
    -- bot.
    CreateBotResponse -> Maybe BotStatus
botStatus :: Prelude.Maybe BotStatus,
    -- | A list of tags associated with the bot.
    CreateBotResponse -> Maybe (HashMap Text Text)
botTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A timestamp indicating the date and time that the bot was created.
    CreateBotResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The data privacy settings specified for the bot.
    CreateBotResponse -> Maybe DataPrivacy
dataPrivacy :: Prelude.Maybe DataPrivacy,
    -- | The description specified for the bot.
    CreateBotResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The session idle time specified for the bot.
    CreateBotResponse -> Maybe Natural
idleSessionTTLInSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The IAM role specified for the bot.
    CreateBotResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | A list of tags associated with the test alias for the bot.
    CreateBotResponse -> Maybe (HashMap Text Text)
testBotAliasTags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateBotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateBotResponse -> CreateBotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBotResponse -> CreateBotResponse -> Bool
$c/= :: CreateBotResponse -> CreateBotResponse -> Bool
== :: CreateBotResponse -> CreateBotResponse -> Bool
$c== :: CreateBotResponse -> CreateBotResponse -> Bool
Prelude.Eq, ReadPrec [CreateBotResponse]
ReadPrec CreateBotResponse
Int -> ReadS CreateBotResponse
ReadS [CreateBotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBotResponse]
$creadListPrec :: ReadPrec [CreateBotResponse]
readPrec :: ReadPrec CreateBotResponse
$creadPrec :: ReadPrec CreateBotResponse
readList :: ReadS [CreateBotResponse]
$creadList :: ReadS [CreateBotResponse]
readsPrec :: Int -> ReadS CreateBotResponse
$creadsPrec :: Int -> ReadS CreateBotResponse
Prelude.Read, Int -> CreateBotResponse -> ShowS
[CreateBotResponse] -> ShowS
CreateBotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBotResponse] -> ShowS
$cshowList :: [CreateBotResponse] -> ShowS
show :: CreateBotResponse -> String
$cshow :: CreateBotResponse -> String
showsPrec :: Int -> CreateBotResponse -> ShowS
$cshowsPrec :: Int -> CreateBotResponse -> ShowS
Prelude.Show, forall x. Rep CreateBotResponse x -> CreateBotResponse
forall x. CreateBotResponse -> Rep CreateBotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBotResponse x -> CreateBotResponse
$cfrom :: forall x. CreateBotResponse -> Rep CreateBotResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBotResponse' 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:
--
-- 'botId', 'createBotResponse_botId' - A unique identifier for a particular bot. You use this to identify the
-- bot when you call other Amazon Lex API operations.
--
-- 'botName', 'createBotResponse_botName' - The name specified for the bot.
--
-- 'botStatus', 'createBotResponse_botStatus' - Shows the current status of the bot. The bot is first in the @Creating@
-- status. Once the bot is read for use, it changes to the @Available@
-- status. After the bot is created, you can use the @Draft@ version of the
-- bot.
--
-- 'botTags', 'createBotResponse_botTags' - A list of tags associated with the bot.
--
-- 'creationDateTime', 'createBotResponse_creationDateTime' - A timestamp indicating the date and time that the bot was created.
--
-- 'dataPrivacy', 'createBotResponse_dataPrivacy' - The data privacy settings specified for the bot.
--
-- 'description', 'createBotResponse_description' - The description specified for the bot.
--
-- 'idleSessionTTLInSeconds', 'createBotResponse_idleSessionTTLInSeconds' - The session idle time specified for the bot.
--
-- 'roleArn', 'createBotResponse_roleArn' - The IAM role specified for the bot.
--
-- 'testBotAliasTags', 'createBotResponse_testBotAliasTags' - A list of tags associated with the test alias for the bot.
--
-- 'httpStatus', 'createBotResponse_httpStatus' - The response's http status code.
newCreateBotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBotResponse
newCreateBotResponse :: Int -> CreateBotResponse
newCreateBotResponse Int
pHttpStatus_ =
  CreateBotResponse'
    { $sel:botId:CreateBotResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botName:CreateBotResponse' :: Maybe Text
botName = forall a. Maybe a
Prelude.Nothing,
      $sel:botStatus:CreateBotResponse' :: Maybe BotStatus
botStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:botTags:CreateBotResponse' :: Maybe (HashMap Text Text)
botTags = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:CreateBotResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:dataPrivacy:CreateBotResponse' :: Maybe DataPrivacy
dataPrivacy = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateBotResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:idleSessionTTLInSeconds:CreateBotResponse' :: Maybe Natural
idleSessionTTLInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:CreateBotResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:testBotAliasTags:CreateBotResponse' :: Maybe (HashMap Text Text)
testBotAliasTags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier for a particular bot. You use this to identify the
-- bot when you call other Amazon Lex API operations.
createBotResponse_botId :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.Text)
createBotResponse_botId :: Lens' CreateBotResponse (Maybe Text)
createBotResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:CreateBotResponse' :: CreateBotResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe Text
a -> CreateBotResponse
s {$sel:botId:CreateBotResponse' :: Maybe Text
botId = Maybe Text
a} :: CreateBotResponse)

-- | The name specified for the bot.
createBotResponse_botName :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.Text)
createBotResponse_botName :: Lens' CreateBotResponse (Maybe Text)
createBotResponse_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe Text
botName :: Maybe Text
$sel:botName:CreateBotResponse' :: CreateBotResponse -> Maybe Text
botName} -> Maybe Text
botName) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe Text
a -> CreateBotResponse
s {$sel:botName:CreateBotResponse' :: Maybe Text
botName = Maybe Text
a} :: CreateBotResponse)

-- | Shows the current status of the bot. The bot is first in the @Creating@
-- status. Once the bot is read for use, it changes to the @Available@
-- status. After the bot is created, you can use the @Draft@ version of the
-- bot.
createBotResponse_botStatus :: Lens.Lens' CreateBotResponse (Prelude.Maybe BotStatus)
createBotResponse_botStatus :: Lens' CreateBotResponse (Maybe BotStatus)
createBotResponse_botStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe BotStatus
botStatus :: Maybe BotStatus
$sel:botStatus:CreateBotResponse' :: CreateBotResponse -> Maybe BotStatus
botStatus} -> Maybe BotStatus
botStatus) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe BotStatus
a -> CreateBotResponse
s {$sel:botStatus:CreateBotResponse' :: Maybe BotStatus
botStatus = Maybe BotStatus
a} :: CreateBotResponse)

-- | A list of tags associated with the bot.
createBotResponse_botTags :: Lens.Lens' CreateBotResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBotResponse_botTags :: Lens' CreateBotResponse (Maybe (HashMap Text Text))
createBotResponse_botTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe (HashMap Text Text)
botTags :: Maybe (HashMap Text Text)
$sel:botTags:CreateBotResponse' :: CreateBotResponse -> Maybe (HashMap Text Text)
botTags} -> Maybe (HashMap Text Text)
botTags) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe (HashMap Text Text)
a -> CreateBotResponse
s {$sel:botTags:CreateBotResponse' :: Maybe (HashMap Text Text)
botTags = Maybe (HashMap Text Text)
a} :: CreateBotResponse) 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

-- | A timestamp indicating the date and time that the bot was created.
createBotResponse_creationDateTime :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.UTCTime)
createBotResponse_creationDateTime :: Lens' CreateBotResponse (Maybe UTCTime)
createBotResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:CreateBotResponse' :: CreateBotResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe POSIX
a -> CreateBotResponse
s {$sel:creationDateTime:CreateBotResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: CreateBotResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The data privacy settings specified for the bot.
createBotResponse_dataPrivacy :: Lens.Lens' CreateBotResponse (Prelude.Maybe DataPrivacy)
createBotResponse_dataPrivacy :: Lens' CreateBotResponse (Maybe DataPrivacy)
createBotResponse_dataPrivacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe DataPrivacy
dataPrivacy :: Maybe DataPrivacy
$sel:dataPrivacy:CreateBotResponse' :: CreateBotResponse -> Maybe DataPrivacy
dataPrivacy} -> Maybe DataPrivacy
dataPrivacy) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe DataPrivacy
a -> CreateBotResponse
s {$sel:dataPrivacy:CreateBotResponse' :: Maybe DataPrivacy
dataPrivacy = Maybe DataPrivacy
a} :: CreateBotResponse)

-- | The description specified for the bot.
createBotResponse_description :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.Text)
createBotResponse_description :: Lens' CreateBotResponse (Maybe Text)
createBotResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateBotResponse' :: CreateBotResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe Text
a -> CreateBotResponse
s {$sel:description:CreateBotResponse' :: Maybe Text
description = Maybe Text
a} :: CreateBotResponse)

-- | The session idle time specified for the bot.
createBotResponse_idleSessionTTLInSeconds :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.Natural)
createBotResponse_idleSessionTTLInSeconds :: Lens' CreateBotResponse (Maybe Natural)
createBotResponse_idleSessionTTLInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe Natural
idleSessionTTLInSeconds :: Maybe Natural
$sel:idleSessionTTLInSeconds:CreateBotResponse' :: CreateBotResponse -> Maybe Natural
idleSessionTTLInSeconds} -> Maybe Natural
idleSessionTTLInSeconds) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe Natural
a -> CreateBotResponse
s {$sel:idleSessionTTLInSeconds:CreateBotResponse' :: Maybe Natural
idleSessionTTLInSeconds = Maybe Natural
a} :: CreateBotResponse)

-- | The IAM role specified for the bot.
createBotResponse_roleArn :: Lens.Lens' CreateBotResponse (Prelude.Maybe Prelude.Text)
createBotResponse_roleArn :: Lens' CreateBotResponse (Maybe Text)
createBotResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:CreateBotResponse' :: CreateBotResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe Text
a -> CreateBotResponse
s {$sel:roleArn:CreateBotResponse' :: Maybe Text
roleArn = Maybe Text
a} :: CreateBotResponse)

-- | A list of tags associated with the test alias for the bot.
createBotResponse_testBotAliasTags :: Lens.Lens' CreateBotResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBotResponse_testBotAliasTags :: Lens' CreateBotResponse (Maybe (HashMap Text Text))
createBotResponse_testBotAliasTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Maybe (HashMap Text Text)
testBotAliasTags :: Maybe (HashMap Text Text)
$sel:testBotAliasTags:CreateBotResponse' :: CreateBotResponse -> Maybe (HashMap Text Text)
testBotAliasTags} -> Maybe (HashMap Text Text)
testBotAliasTags) (\s :: CreateBotResponse
s@CreateBotResponse' {} Maybe (HashMap Text Text)
a -> CreateBotResponse
s {$sel:testBotAliasTags:CreateBotResponse' :: Maybe (HashMap Text Text)
testBotAliasTags = Maybe (HashMap Text Text)
a} :: CreateBotResponse) 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 response's http status code.
createBotResponse_httpStatus :: Lens.Lens' CreateBotResponse Prelude.Int
createBotResponse_httpStatus :: Lens' CreateBotResponse Int
createBotResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateBotResponse' :: CreateBotResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateBotResponse
s@CreateBotResponse' {} Int
a -> CreateBotResponse
s {$sel:httpStatus:CreateBotResponse' :: Int
httpStatus = Int
a} :: CreateBotResponse)

instance Prelude.NFData CreateBotResponse where
  rnf :: CreateBotResponse -> ()
rnf CreateBotResponse' {Int
Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe BotStatus
Maybe DataPrivacy
httpStatus :: Int
testBotAliasTags :: Maybe (HashMap Text Text)
roleArn :: Maybe Text
idleSessionTTLInSeconds :: Maybe Natural
description :: Maybe Text
dataPrivacy :: Maybe DataPrivacy
creationDateTime :: Maybe POSIX
botTags :: Maybe (HashMap Text Text)
botStatus :: Maybe BotStatus
botName :: Maybe Text
botId :: Maybe Text
$sel:httpStatus:CreateBotResponse' :: CreateBotResponse -> Int
$sel:testBotAliasTags:CreateBotResponse' :: CreateBotResponse -> Maybe (HashMap Text Text)
$sel:roleArn:CreateBotResponse' :: CreateBotResponse -> Maybe Text
$sel:idleSessionTTLInSeconds:CreateBotResponse' :: CreateBotResponse -> Maybe Natural
$sel:description:CreateBotResponse' :: CreateBotResponse -> Maybe Text
$sel:dataPrivacy:CreateBotResponse' :: CreateBotResponse -> Maybe DataPrivacy
$sel:creationDateTime:CreateBotResponse' :: CreateBotResponse -> Maybe POSIX
$sel:botTags:CreateBotResponse' :: CreateBotResponse -> Maybe (HashMap Text Text)
$sel:botStatus:CreateBotResponse' :: CreateBotResponse -> Maybe BotStatus
$sel:botName:CreateBotResponse' :: CreateBotResponse -> Maybe Text
$sel:botId:CreateBotResponse' :: CreateBotResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BotStatus
botStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
botTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataPrivacy
dataPrivacy
      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 Natural
idleSessionTTLInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
testBotAliasTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus