{-# 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.CreateBotVersion
-- 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 new version of the bot based on the @DRAFT@ version. If the
-- @DRAFT@ version of this resource hasn\'t changed since you created the
-- last version, Amazon Lex doesn\'t create a new version, it returns the
-- last created version.
--
-- When you create the first version of a bot, Amazon Lex sets the version
-- to 1. Subsequent versions increment by 1.
module Amazonka.LexV2Models.CreateBotVersion
  ( -- * Creating a Request
    CreateBotVersion (..),
    newCreateBotVersion,

    -- * Request Lenses
    createBotVersion_description,
    createBotVersion_botId,
    createBotVersion_botVersionLocaleSpecification,

    -- * Destructuring the Response
    CreateBotVersionResponse (..),
    newCreateBotVersionResponse,

    -- * Response Lenses
    createBotVersionResponse_botId,
    createBotVersionResponse_botStatus,
    createBotVersionResponse_botVersion,
    createBotVersionResponse_botVersionLocaleSpecification,
    createBotVersionResponse_creationDateTime,
    createBotVersionResponse_description,
    createBotVersionResponse_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:/ 'newCreateBotVersion' smart constructor.
data CreateBotVersion = CreateBotVersion'
  { -- | A description of the version. Use the description to help identify the
    -- version in lists.
    CreateBotVersion -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the bot to create the version for.
    CreateBotVersion -> Text
botId :: Prelude.Text,
    -- | Specifies the locales that Amazon Lex adds to this version. You can
    -- choose the @Draft@ version or any other previously published version for
    -- each locale. When you specify a source version, the locale data is
    -- copied from the source version to the new version.
    CreateBotVersion -> HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: Prelude.HashMap Prelude.Text BotVersionLocaleDetails
  }
  deriving (CreateBotVersion -> CreateBotVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBotVersion -> CreateBotVersion -> Bool
$c/= :: CreateBotVersion -> CreateBotVersion -> Bool
== :: CreateBotVersion -> CreateBotVersion -> Bool
$c== :: CreateBotVersion -> CreateBotVersion -> Bool
Prelude.Eq, ReadPrec [CreateBotVersion]
ReadPrec CreateBotVersion
Int -> ReadS CreateBotVersion
ReadS [CreateBotVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBotVersion]
$creadListPrec :: ReadPrec [CreateBotVersion]
readPrec :: ReadPrec CreateBotVersion
$creadPrec :: ReadPrec CreateBotVersion
readList :: ReadS [CreateBotVersion]
$creadList :: ReadS [CreateBotVersion]
readsPrec :: Int -> ReadS CreateBotVersion
$creadsPrec :: Int -> ReadS CreateBotVersion
Prelude.Read, Int -> CreateBotVersion -> ShowS
[CreateBotVersion] -> ShowS
CreateBotVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBotVersion] -> ShowS
$cshowList :: [CreateBotVersion] -> ShowS
show :: CreateBotVersion -> String
$cshow :: CreateBotVersion -> String
showsPrec :: Int -> CreateBotVersion -> ShowS
$cshowsPrec :: Int -> CreateBotVersion -> ShowS
Prelude.Show, forall x. Rep CreateBotVersion x -> CreateBotVersion
forall x. CreateBotVersion -> Rep CreateBotVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBotVersion x -> CreateBotVersion
$cfrom :: forall x. CreateBotVersion -> Rep CreateBotVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreateBotVersion' 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:
--
-- 'description', 'createBotVersion_description' - A description of the version. Use the description to help identify the
-- version in lists.
--
-- 'botId', 'createBotVersion_botId' - The identifier of the bot to create the version for.
--
-- 'botVersionLocaleSpecification', 'createBotVersion_botVersionLocaleSpecification' - Specifies the locales that Amazon Lex adds to this version. You can
-- choose the @Draft@ version or any other previously published version for
-- each locale. When you specify a source version, the locale data is
-- copied from the source version to the new version.
newCreateBotVersion ::
  -- | 'botId'
  Prelude.Text ->
  CreateBotVersion
newCreateBotVersion :: Text -> CreateBotVersion
newCreateBotVersion Text
pBotId_ =
  CreateBotVersion'
    { $sel:description:CreateBotVersion' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:botId:CreateBotVersion' :: Text
botId = Text
pBotId_,
      $sel:botVersionLocaleSpecification:CreateBotVersion' :: HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification = forall a. Monoid a => a
Prelude.mempty
    }

-- | A description of the version. Use the description to help identify the
-- version in lists.
createBotVersion_description :: Lens.Lens' CreateBotVersion (Prelude.Maybe Prelude.Text)
createBotVersion_description :: Lens' CreateBotVersion (Maybe Text)
createBotVersion_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersion' {Maybe Text
description :: Maybe Text
$sel:description:CreateBotVersion' :: CreateBotVersion -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateBotVersion
s@CreateBotVersion' {} Maybe Text
a -> CreateBotVersion
s {$sel:description:CreateBotVersion' :: Maybe Text
description = Maybe Text
a} :: CreateBotVersion)

-- | The identifier of the bot to create the version for.
createBotVersion_botId :: Lens.Lens' CreateBotVersion Prelude.Text
createBotVersion_botId :: Lens' CreateBotVersion Text
createBotVersion_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersion' {Text
botId :: Text
$sel:botId:CreateBotVersion' :: CreateBotVersion -> Text
botId} -> Text
botId) (\s :: CreateBotVersion
s@CreateBotVersion' {} Text
a -> CreateBotVersion
s {$sel:botId:CreateBotVersion' :: Text
botId = Text
a} :: CreateBotVersion)

-- | Specifies the locales that Amazon Lex adds to this version. You can
-- choose the @Draft@ version or any other previously published version for
-- each locale. When you specify a source version, the locale data is
-- copied from the source version to the new version.
createBotVersion_botVersionLocaleSpecification :: Lens.Lens' CreateBotVersion (Prelude.HashMap Prelude.Text BotVersionLocaleDetails)
createBotVersion_botVersionLocaleSpecification :: Lens' CreateBotVersion (HashMap Text BotVersionLocaleDetails)
createBotVersion_botVersionLocaleSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersion' {HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: HashMap Text BotVersionLocaleDetails
$sel:botVersionLocaleSpecification:CreateBotVersion' :: CreateBotVersion -> HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification} -> HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification) (\s :: CreateBotVersion
s@CreateBotVersion' {} HashMap Text BotVersionLocaleDetails
a -> CreateBotVersion
s {$sel:botVersionLocaleSpecification:CreateBotVersion' :: HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification = HashMap Text BotVersionLocaleDetails
a} :: CreateBotVersion) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateBotVersion where
  type
    AWSResponse CreateBotVersion =
      CreateBotVersionResponse
  request :: (Service -> Service)
-> CreateBotVersion -> Request CreateBotVersion
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 CreateBotVersion
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateBotVersion)))
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 BotStatus
-> Maybe Text
-> Maybe (HashMap Text BotVersionLocaleDetails)
-> Maybe POSIX
-> Maybe Text
-> Int
-> CreateBotVersionResponse
CreateBotVersionResponse'
            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
"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
"botVersion")
            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
"botVersionLocaleSpecification"
                            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
"description")
            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 CreateBotVersion where
  hashWithSalt :: Int -> CreateBotVersion -> Int
hashWithSalt Int
_salt CreateBotVersion' {Maybe Text
Text
HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: HashMap Text BotVersionLocaleDetails
botId :: Text
description :: Maybe Text
$sel:botVersionLocaleSpecification:CreateBotVersion' :: CreateBotVersion -> HashMap Text BotVersionLocaleDetails
$sel:botId:CreateBotVersion' :: CreateBotVersion -> Text
$sel:description:CreateBotVersion' :: CreateBotVersion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification

instance Prelude.NFData CreateBotVersion where
  rnf :: CreateBotVersion -> ()
rnf CreateBotVersion' {Maybe Text
Text
HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: HashMap Text BotVersionLocaleDetails
botId :: Text
description :: Maybe Text
$sel:botVersionLocaleSpecification:CreateBotVersion' :: CreateBotVersion -> HashMap Text BotVersionLocaleDetails
$sel:botId:CreateBotVersion' :: CreateBotVersion -> Text
$sel:description:CreateBotVersion' :: CreateBotVersion -> Maybe Text
..} =
    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 Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification

instance Data.ToHeaders CreateBotVersion where
  toHeaders :: CreateBotVersion -> 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 CreateBotVersion where
  toJSON :: CreateBotVersion -> Value
toJSON CreateBotVersion' {Maybe Text
Text
HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: HashMap Text BotVersionLocaleDetails
botId :: Text
description :: Maybe Text
$sel:botVersionLocaleSpecification:CreateBotVersion' :: CreateBotVersion -> HashMap Text BotVersionLocaleDetails
$sel:botId:CreateBotVersion' :: CreateBotVersion -> Text
$sel:description:CreateBotVersion' :: CreateBotVersion -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"botVersionLocaleSpecification"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification
              )
          ]
      )

instance Data.ToPath CreateBotVersion where
  toPath :: CreateBotVersion -> ByteString
toPath CreateBotVersion' {Maybe Text
Text
HashMap Text BotVersionLocaleDetails
botVersionLocaleSpecification :: HashMap Text BotVersionLocaleDetails
botId :: Text
description :: Maybe Text
$sel:botVersionLocaleSpecification:CreateBotVersion' :: CreateBotVersion -> HashMap Text BotVersionLocaleDetails
$sel:botId:CreateBotVersion' :: CreateBotVersion -> Text
$sel:description:CreateBotVersion' :: CreateBotVersion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/bots/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId, ByteString
"/botversions/"]

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

-- | /See:/ 'newCreateBotVersionResponse' smart constructor.
data CreateBotVersionResponse = CreateBotVersionResponse'
  { -- | The bot identifier specified in the request.
    CreateBotVersionResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | When you send a request to create or update a bot, Amazon Lex sets the
    -- status response element to @Creating@. After Amazon Lex builds the bot,
    -- it sets status to @Available@. If Amazon Lex can\'t build the bot, it
    -- sets status to @Failed@.
    CreateBotVersionResponse -> Maybe BotStatus
botStatus :: Prelude.Maybe BotStatus,
    -- | The version number assigned to the version.
    CreateBotVersionResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | The source versions used for each locale in the new version.
    CreateBotVersionResponse
-> Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification :: Prelude.Maybe (Prelude.HashMap Prelude.Text BotVersionLocaleDetails),
    -- | A timestamp of the date and time that the version was created.
    CreateBotVersionResponse -> Maybe POSIX
creationDateTime :: Prelude.Maybe Data.POSIX,
    -- | The description of the version specified in the request.
    CreateBotVersionResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateBotVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateBotVersionResponse -> CreateBotVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBotVersionResponse -> CreateBotVersionResponse -> Bool
$c/= :: CreateBotVersionResponse -> CreateBotVersionResponse -> Bool
== :: CreateBotVersionResponse -> CreateBotVersionResponse -> Bool
$c== :: CreateBotVersionResponse -> CreateBotVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreateBotVersionResponse]
ReadPrec CreateBotVersionResponse
Int -> ReadS CreateBotVersionResponse
ReadS [CreateBotVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBotVersionResponse]
$creadListPrec :: ReadPrec [CreateBotVersionResponse]
readPrec :: ReadPrec CreateBotVersionResponse
$creadPrec :: ReadPrec CreateBotVersionResponse
readList :: ReadS [CreateBotVersionResponse]
$creadList :: ReadS [CreateBotVersionResponse]
readsPrec :: Int -> ReadS CreateBotVersionResponse
$creadsPrec :: Int -> ReadS CreateBotVersionResponse
Prelude.Read, Int -> CreateBotVersionResponse -> ShowS
[CreateBotVersionResponse] -> ShowS
CreateBotVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBotVersionResponse] -> ShowS
$cshowList :: [CreateBotVersionResponse] -> ShowS
show :: CreateBotVersionResponse -> String
$cshow :: CreateBotVersionResponse -> String
showsPrec :: Int -> CreateBotVersionResponse -> ShowS
$cshowsPrec :: Int -> CreateBotVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateBotVersionResponse x -> CreateBotVersionResponse
forall x.
CreateBotVersionResponse -> Rep CreateBotVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateBotVersionResponse x -> CreateBotVersionResponse
$cfrom :: forall x.
CreateBotVersionResponse -> Rep CreateBotVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBotVersionResponse' 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', 'createBotVersionResponse_botId' - The bot identifier specified in the request.
--
-- 'botStatus', 'createBotVersionResponse_botStatus' - When you send a request to create or update a bot, Amazon Lex sets the
-- status response element to @Creating@. After Amazon Lex builds the bot,
-- it sets status to @Available@. If Amazon Lex can\'t build the bot, it
-- sets status to @Failed@.
--
-- 'botVersion', 'createBotVersionResponse_botVersion' - The version number assigned to the version.
--
-- 'botVersionLocaleSpecification', 'createBotVersionResponse_botVersionLocaleSpecification' - The source versions used for each locale in the new version.
--
-- 'creationDateTime', 'createBotVersionResponse_creationDateTime' - A timestamp of the date and time that the version was created.
--
-- 'description', 'createBotVersionResponse_description' - The description of the version specified in the request.
--
-- 'httpStatus', 'createBotVersionResponse_httpStatus' - The response's http status code.
newCreateBotVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBotVersionResponse
newCreateBotVersionResponse :: Int -> CreateBotVersionResponse
newCreateBotVersionResponse Int
pHttpStatus_ =
  CreateBotVersionResponse'
    { $sel:botId:CreateBotVersionResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botStatus:CreateBotVersionResponse' :: Maybe BotStatus
botStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:CreateBotVersionResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersionLocaleSpecification:CreateBotVersionResponse' :: Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDateTime:CreateBotVersionResponse' :: Maybe POSIX
creationDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateBotVersionResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBotVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The bot identifier specified in the request.
createBotVersionResponse_botId :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe Prelude.Text)
createBotVersionResponse_botId :: Lens' CreateBotVersionResponse (Maybe Text)
createBotVersionResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe Text
a -> CreateBotVersionResponse
s {$sel:botId:CreateBotVersionResponse' :: Maybe Text
botId = Maybe Text
a} :: CreateBotVersionResponse)

-- | When you send a request to create or update a bot, Amazon Lex sets the
-- status response element to @Creating@. After Amazon Lex builds the bot,
-- it sets status to @Available@. If Amazon Lex can\'t build the bot, it
-- sets status to @Failed@.
createBotVersionResponse_botStatus :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe BotStatus)
createBotVersionResponse_botStatus :: Lens' CreateBotVersionResponse (Maybe BotStatus)
createBotVersionResponse_botStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe BotStatus
botStatus :: Maybe BotStatus
$sel:botStatus:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe BotStatus
botStatus} -> Maybe BotStatus
botStatus) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe BotStatus
a -> CreateBotVersionResponse
s {$sel:botStatus:CreateBotVersionResponse' :: Maybe BotStatus
botStatus = Maybe BotStatus
a} :: CreateBotVersionResponse)

-- | The version number assigned to the version.
createBotVersionResponse_botVersion :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe Prelude.Text)
createBotVersionResponse_botVersion :: Lens' CreateBotVersionResponse (Maybe Text)
createBotVersionResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe Text
a -> CreateBotVersionResponse
s {$sel:botVersion:CreateBotVersionResponse' :: Maybe Text
botVersion = Maybe Text
a} :: CreateBotVersionResponse)

-- | The source versions used for each locale in the new version.
createBotVersionResponse_botVersionLocaleSpecification :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text BotVersionLocaleDetails))
createBotVersionResponse_botVersionLocaleSpecification :: Lens'
  CreateBotVersionResponse
  (Maybe (HashMap Text BotVersionLocaleDetails))
createBotVersionResponse_botVersionLocaleSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification :: Maybe (HashMap Text BotVersionLocaleDetails)
$sel:botVersionLocaleSpecification:CreateBotVersionResponse' :: CreateBotVersionResponse
-> Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification} -> Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe (HashMap Text BotVersionLocaleDetails)
a -> CreateBotVersionResponse
s {$sel:botVersionLocaleSpecification:CreateBotVersionResponse' :: Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification = Maybe (HashMap Text BotVersionLocaleDetails)
a} :: CreateBotVersionResponse) 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 of the date and time that the version was created.
createBotVersionResponse_creationDateTime :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe Prelude.UTCTime)
createBotVersionResponse_creationDateTime :: Lens' CreateBotVersionResponse (Maybe UTCTime)
createBotVersionResponse_creationDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe POSIX
creationDateTime :: Maybe POSIX
$sel:creationDateTime:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe POSIX
creationDateTime} -> Maybe POSIX
creationDateTime) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe POSIX
a -> CreateBotVersionResponse
s {$sel:creationDateTime:CreateBotVersionResponse' :: Maybe POSIX
creationDateTime = Maybe POSIX
a} :: CreateBotVersionResponse) 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 description of the version specified in the request.
createBotVersionResponse_description :: Lens.Lens' CreateBotVersionResponse (Prelude.Maybe Prelude.Text)
createBotVersionResponse_description :: Lens' CreateBotVersionResponse (Maybe Text)
createBotVersionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBotVersionResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateBotVersionResponse
s@CreateBotVersionResponse' {} Maybe Text
a -> CreateBotVersionResponse
s {$sel:description:CreateBotVersionResponse' :: Maybe Text
description = Maybe Text
a} :: CreateBotVersionResponse)

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

instance Prelude.NFData CreateBotVersionResponse where
  rnf :: CreateBotVersionResponse -> ()
rnf CreateBotVersionResponse' {Int
Maybe Text
Maybe (HashMap Text BotVersionLocaleDetails)
Maybe POSIX
Maybe BotStatus
httpStatus :: Int
description :: Maybe Text
creationDateTime :: Maybe POSIX
botVersionLocaleSpecification :: Maybe (HashMap Text BotVersionLocaleDetails)
botVersion :: Maybe Text
botStatus :: Maybe BotStatus
botId :: Maybe Text
$sel:httpStatus:CreateBotVersionResponse' :: CreateBotVersionResponse -> Int
$sel:description:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe Text
$sel:creationDateTime:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe POSIX
$sel:botVersionLocaleSpecification:CreateBotVersionResponse' :: CreateBotVersionResponse
-> Maybe (HashMap Text BotVersionLocaleDetails)
$sel:botVersion:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe Text
$sel:botStatus:CreateBotVersionResponse' :: CreateBotVersionResponse -> Maybe BotStatus
$sel:botId:CreateBotVersionResponse' :: CreateBotVersionResponse -> 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 BotStatus
botStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text BotVersionLocaleDetails)
botVersionLocaleSpecification
      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 Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus