{-# 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.LexModels.PutBotAlias
-- 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 alias for the specified version of the bot or replaces an
-- alias for the specified bot. To change the version of the bot that the
-- alias points to, replace the alias. For more information about aliases,
-- see versioning-aliases.
--
-- This operation requires permissions for the @lex:PutBotAlias@ action.
module Amazonka.LexModels.PutBotAlias
  ( -- * Creating a Request
    PutBotAlias (..),
    newPutBotAlias,

    -- * Request Lenses
    putBotAlias_checksum,
    putBotAlias_conversationLogs,
    putBotAlias_description,
    putBotAlias_tags,
    putBotAlias_name,
    putBotAlias_botVersion,
    putBotAlias_botName,

    -- * Destructuring the Response
    PutBotAliasResponse (..),
    newPutBotAliasResponse,

    -- * Response Lenses
    putBotAliasResponse_botName,
    putBotAliasResponse_botVersion,
    putBotAliasResponse_checksum,
    putBotAliasResponse_conversationLogs,
    putBotAliasResponse_createdDate,
    putBotAliasResponse_description,
    putBotAliasResponse_lastUpdatedDate,
    putBotAliasResponse_name,
    putBotAliasResponse_tags,
    putBotAliasResponse_httpStatus,
  )
where

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

-- | /See:/ 'newPutBotAlias' smart constructor.
data PutBotAlias = PutBotAlias'
  { -- | Identifies a specific revision of the @$LATEST@ version.
    --
    -- When you create a new bot alias, leave the @checksum@ field blank. If
    -- you specify a checksum you get a @BadRequestException@ exception.
    --
    -- When you want to update a bot alias, set the @checksum@ field to the
    -- checksum of the most recent revision of the @$LATEST@ version. If you
    -- don\'t specify the @ checksum@ field, or if the checksum does not match
    -- the @$LATEST@ version, you get a @PreconditionFailedException@
    -- exception.
    PutBotAlias -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | Settings for conversation logs for the alias.
    PutBotAlias -> Maybe ConversationLogsRequest
conversationLogs :: Prelude.Maybe ConversationLogsRequest,
    -- | A description of the alias.
    PutBotAlias -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to add to the bot alias. You can only add tags when you
    -- create an alias, you can\'t use the @PutBotAlias@ operation to update
    -- the tags on a bot alias. To update tags, use the @TagResource@
    -- operation.
    PutBotAlias -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the alias. The name is /not/ case sensitive.
    PutBotAlias -> Text
name :: Prelude.Text,
    -- | The version of the bot.
    PutBotAlias -> Text
botVersion :: Prelude.Text,
    -- | The name of the bot.
    PutBotAlias -> Text
botName :: Prelude.Text
  }
  deriving (PutBotAlias -> PutBotAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutBotAlias -> PutBotAlias -> Bool
$c/= :: PutBotAlias -> PutBotAlias -> Bool
== :: PutBotAlias -> PutBotAlias -> Bool
$c== :: PutBotAlias -> PutBotAlias -> Bool
Prelude.Eq, ReadPrec [PutBotAlias]
ReadPrec PutBotAlias
Int -> ReadS PutBotAlias
ReadS [PutBotAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutBotAlias]
$creadListPrec :: ReadPrec [PutBotAlias]
readPrec :: ReadPrec PutBotAlias
$creadPrec :: ReadPrec PutBotAlias
readList :: ReadS [PutBotAlias]
$creadList :: ReadS [PutBotAlias]
readsPrec :: Int -> ReadS PutBotAlias
$creadsPrec :: Int -> ReadS PutBotAlias
Prelude.Read, Int -> PutBotAlias -> ShowS
[PutBotAlias] -> ShowS
PutBotAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutBotAlias] -> ShowS
$cshowList :: [PutBotAlias] -> ShowS
show :: PutBotAlias -> String
$cshow :: PutBotAlias -> String
showsPrec :: Int -> PutBotAlias -> ShowS
$cshowsPrec :: Int -> PutBotAlias -> ShowS
Prelude.Show, forall x. Rep PutBotAlias x -> PutBotAlias
forall x. PutBotAlias -> Rep PutBotAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutBotAlias x -> PutBotAlias
$cfrom :: forall x. PutBotAlias -> Rep PutBotAlias x
Prelude.Generic)

-- |
-- Create a value of 'PutBotAlias' 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:
--
-- 'checksum', 'putBotAlias_checksum' - Identifies a specific revision of the @$LATEST@ version.
--
-- When you create a new bot alias, leave the @checksum@ field blank. If
-- you specify a checksum you get a @BadRequestException@ exception.
--
-- When you want to update a bot alias, set the @checksum@ field to the
-- checksum of the most recent revision of the @$LATEST@ version. If you
-- don\'t specify the @ checksum@ field, or if the checksum does not match
-- the @$LATEST@ version, you get a @PreconditionFailedException@
-- exception.
--
-- 'conversationLogs', 'putBotAlias_conversationLogs' - Settings for conversation logs for the alias.
--
-- 'description', 'putBotAlias_description' - A description of the alias.
--
-- 'tags', 'putBotAlias_tags' - A list of tags to add to the bot alias. You can only add tags when you
-- create an alias, you can\'t use the @PutBotAlias@ operation to update
-- the tags on a bot alias. To update tags, use the @TagResource@
-- operation.
--
-- 'name', 'putBotAlias_name' - The name of the alias. The name is /not/ case sensitive.
--
-- 'botVersion', 'putBotAlias_botVersion' - The version of the bot.
--
-- 'botName', 'putBotAlias_botName' - The name of the bot.
newPutBotAlias ::
  -- | 'name'
  Prelude.Text ->
  -- | 'botVersion'
  Prelude.Text ->
  -- | 'botName'
  Prelude.Text ->
  PutBotAlias
newPutBotAlias :: Text -> Text -> Text -> PutBotAlias
newPutBotAlias Text
pName_ Text
pBotVersion_ Text
pBotName_ =
  PutBotAlias'
    { $sel:checksum:PutBotAlias' :: Maybe Text
checksum = forall a. Maybe a
Prelude.Nothing,
      $sel:conversationLogs:PutBotAlias' :: Maybe ConversationLogsRequest
conversationLogs = forall a. Maybe a
Prelude.Nothing,
      $sel:description:PutBotAlias' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:PutBotAlias' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:PutBotAlias' :: Text
name = Text
pName_,
      $sel:botVersion:PutBotAlias' :: Text
botVersion = Text
pBotVersion_,
      $sel:botName:PutBotAlias' :: Text
botName = Text
pBotName_
    }

-- | Identifies a specific revision of the @$LATEST@ version.
--
-- When you create a new bot alias, leave the @checksum@ field blank. If
-- you specify a checksum you get a @BadRequestException@ exception.
--
-- When you want to update a bot alias, set the @checksum@ field to the
-- checksum of the most recent revision of the @$LATEST@ version. If you
-- don\'t specify the @ checksum@ field, or if the checksum does not match
-- the @$LATEST@ version, you get a @PreconditionFailedException@
-- exception.
putBotAlias_checksum :: Lens.Lens' PutBotAlias (Prelude.Maybe Prelude.Text)
putBotAlias_checksum :: Lens' PutBotAlias (Maybe Text)
putBotAlias_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Maybe Text
checksum :: Maybe Text
$sel:checksum:PutBotAlias' :: PutBotAlias -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: PutBotAlias
s@PutBotAlias' {} Maybe Text
a -> PutBotAlias
s {$sel:checksum:PutBotAlias' :: Maybe Text
checksum = Maybe Text
a} :: PutBotAlias)

-- | Settings for conversation logs for the alias.
putBotAlias_conversationLogs :: Lens.Lens' PutBotAlias (Prelude.Maybe ConversationLogsRequest)
putBotAlias_conversationLogs :: Lens' PutBotAlias (Maybe ConversationLogsRequest)
putBotAlias_conversationLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Maybe ConversationLogsRequest
conversationLogs :: Maybe ConversationLogsRequest
$sel:conversationLogs:PutBotAlias' :: PutBotAlias -> Maybe ConversationLogsRequest
conversationLogs} -> Maybe ConversationLogsRequest
conversationLogs) (\s :: PutBotAlias
s@PutBotAlias' {} Maybe ConversationLogsRequest
a -> PutBotAlias
s {$sel:conversationLogs:PutBotAlias' :: Maybe ConversationLogsRequest
conversationLogs = Maybe ConversationLogsRequest
a} :: PutBotAlias)

-- | A description of the alias.
putBotAlias_description :: Lens.Lens' PutBotAlias (Prelude.Maybe Prelude.Text)
putBotAlias_description :: Lens' PutBotAlias (Maybe Text)
putBotAlias_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Maybe Text
description :: Maybe Text
$sel:description:PutBotAlias' :: PutBotAlias -> Maybe Text
description} -> Maybe Text
description) (\s :: PutBotAlias
s@PutBotAlias' {} Maybe Text
a -> PutBotAlias
s {$sel:description:PutBotAlias' :: Maybe Text
description = Maybe Text
a} :: PutBotAlias)

-- | A list of tags to add to the bot alias. You can only add tags when you
-- create an alias, you can\'t use the @PutBotAlias@ operation to update
-- the tags on a bot alias. To update tags, use the @TagResource@
-- operation.
putBotAlias_tags :: Lens.Lens' PutBotAlias (Prelude.Maybe [Tag])
putBotAlias_tags :: Lens' PutBotAlias (Maybe [Tag])
putBotAlias_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PutBotAlias' :: PutBotAlias -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PutBotAlias
s@PutBotAlias' {} Maybe [Tag]
a -> PutBotAlias
s {$sel:tags:PutBotAlias' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PutBotAlias) 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 alias. The name is /not/ case sensitive.
putBotAlias_name :: Lens.Lens' PutBotAlias Prelude.Text
putBotAlias_name :: Lens' PutBotAlias Text
putBotAlias_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Text
name :: Text
$sel:name:PutBotAlias' :: PutBotAlias -> Text
name} -> Text
name) (\s :: PutBotAlias
s@PutBotAlias' {} Text
a -> PutBotAlias
s {$sel:name:PutBotAlias' :: Text
name = Text
a} :: PutBotAlias)

-- | The version of the bot.
putBotAlias_botVersion :: Lens.Lens' PutBotAlias Prelude.Text
putBotAlias_botVersion :: Lens' PutBotAlias Text
putBotAlias_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Text
botVersion :: Text
$sel:botVersion:PutBotAlias' :: PutBotAlias -> Text
botVersion} -> Text
botVersion) (\s :: PutBotAlias
s@PutBotAlias' {} Text
a -> PutBotAlias
s {$sel:botVersion:PutBotAlias' :: Text
botVersion = Text
a} :: PutBotAlias)

-- | The name of the bot.
putBotAlias_botName :: Lens.Lens' PutBotAlias Prelude.Text
putBotAlias_botName :: Lens' PutBotAlias Text
putBotAlias_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAlias' {Text
botName :: Text
$sel:botName:PutBotAlias' :: PutBotAlias -> Text
botName} -> Text
botName) (\s :: PutBotAlias
s@PutBotAlias' {} Text
a -> PutBotAlias
s {$sel:botName:PutBotAlias' :: Text
botName = Text
a} :: PutBotAlias)

instance Core.AWSRequest PutBotAlias where
  type AWSResponse PutBotAlias = PutBotAliasResponse
  request :: (Service -> Service) -> PutBotAlias -> Request PutBotAlias
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 PutBotAlias
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutBotAlias)))
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 Text
-> Maybe ConversationLogsResponse
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe [Tag]
-> Int
-> PutBotAliasResponse
PutBotAliasResponse'
            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
"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
"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
"checksum")
            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
"conversationLogs")
            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
"createdDate")
            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
"lastUpdatedDate")
            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
"name")
            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
"tags" 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 PutBotAlias where
  hashWithSalt :: Int -> PutBotAlias -> Int
hashWithSalt Int
_salt PutBotAlias' {Maybe [Tag]
Maybe Text
Maybe ConversationLogsRequest
Text
botName :: Text
botVersion :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
conversationLogs :: Maybe ConversationLogsRequest
checksum :: Maybe Text
$sel:botName:PutBotAlias' :: PutBotAlias -> Text
$sel:botVersion:PutBotAlias' :: PutBotAlias -> Text
$sel:name:PutBotAlias' :: PutBotAlias -> Text
$sel:tags:PutBotAlias' :: PutBotAlias -> Maybe [Tag]
$sel:description:PutBotAlias' :: PutBotAlias -> Maybe Text
$sel:conversationLogs:PutBotAlias' :: PutBotAlias -> Maybe ConversationLogsRequest
$sel:checksum:PutBotAlias' :: PutBotAlias -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
checksum
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConversationLogsRequest
conversationLogs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botName

instance Prelude.NFData PutBotAlias where
  rnf :: PutBotAlias -> ()
rnf PutBotAlias' {Maybe [Tag]
Maybe Text
Maybe ConversationLogsRequest
Text
botName :: Text
botVersion :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
conversationLogs :: Maybe ConversationLogsRequest
checksum :: Maybe Text
$sel:botName:PutBotAlias' :: PutBotAlias -> Text
$sel:botVersion:PutBotAlias' :: PutBotAlias -> Text
$sel:name:PutBotAlias' :: PutBotAlias -> Text
$sel:tags:PutBotAlias' :: PutBotAlias -> Maybe [Tag]
$sel:description:PutBotAlias' :: PutBotAlias -> Maybe Text
$sel:conversationLogs:PutBotAlias' :: PutBotAlias -> Maybe ConversationLogsRequest
$sel:checksum:PutBotAlias' :: PutBotAlias -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
checksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConversationLogsRequest
conversationLogs
      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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botName

instance Data.ToHeaders PutBotAlias where
  toHeaders :: PutBotAlias -> 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 PutBotAlias where
  toJSON :: PutBotAlias -> Value
toJSON PutBotAlias' {Maybe [Tag]
Maybe Text
Maybe ConversationLogsRequest
Text
botName :: Text
botVersion :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
conversationLogs :: Maybe ConversationLogsRequest
checksum :: Maybe Text
$sel:botName:PutBotAlias' :: PutBotAlias -> Text
$sel:botVersion:PutBotAlias' :: PutBotAlias -> Text
$sel:name:PutBotAlias' :: PutBotAlias -> Text
$sel:tags:PutBotAlias' :: PutBotAlias -> Maybe [Tag]
$sel:description:PutBotAlias' :: PutBotAlias -> Maybe Text
$sel:conversationLogs:PutBotAlias' :: PutBotAlias -> Maybe ConversationLogsRequest
$sel:checksum:PutBotAlias' :: PutBotAlias -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"checksum" 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
checksum,
            (Key
"conversationLogs" 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 ConversationLogsRequest
conversationLogs,
            (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
"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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"botVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
botVersion)
          ]
      )

instance Data.ToPath PutBotAlias where
  toPath :: PutBotAlias -> ByteString
toPath PutBotAlias' {Maybe [Tag]
Maybe Text
Maybe ConversationLogsRequest
Text
botName :: Text
botVersion :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
conversationLogs :: Maybe ConversationLogsRequest
checksum :: Maybe Text
$sel:botName:PutBotAlias' :: PutBotAlias -> Text
$sel:botVersion:PutBotAlias' :: PutBotAlias -> Text
$sel:name:PutBotAlias' :: PutBotAlias -> Text
$sel:tags:PutBotAlias' :: PutBotAlias -> Maybe [Tag]
$sel:description:PutBotAlias' :: PutBotAlias -> Maybe Text
$sel:conversationLogs:PutBotAlias' :: PutBotAlias -> Maybe ConversationLogsRequest
$sel:checksum:PutBotAlias' :: PutBotAlias -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botName,
        ByteString
"/aliases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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

-- | /See:/ 'newPutBotAliasResponse' smart constructor.
data PutBotAliasResponse = PutBotAliasResponse'
  { -- | The name of the bot that the alias points to.
    PutBotAliasResponse -> Maybe Text
botName :: Prelude.Maybe Prelude.Text,
    -- | The version of the bot that the alias points to.
    PutBotAliasResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | The checksum for the current version of the alias.
    PutBotAliasResponse -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | The settings that determine how Amazon Lex uses conversation logs for
    -- the alias.
    PutBotAliasResponse -> Maybe ConversationLogsResponse
conversationLogs :: Prelude.Maybe ConversationLogsResponse,
    -- | The date that the bot alias was created.
    PutBotAliasResponse -> Maybe POSIX
createdDate :: Prelude.Maybe Data.POSIX,
    -- | A description of the alias.
    PutBotAliasResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The date that the bot alias was updated. When you create a resource, the
    -- creation date and the last updated date are the same.
    PutBotAliasResponse -> Maybe POSIX
lastUpdatedDate :: Prelude.Maybe Data.POSIX,
    -- | The name of the alias.
    PutBotAliasResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | A list of tags associated with a bot.
    PutBotAliasResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    PutBotAliasResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutBotAliasResponse -> PutBotAliasResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutBotAliasResponse -> PutBotAliasResponse -> Bool
$c/= :: PutBotAliasResponse -> PutBotAliasResponse -> Bool
== :: PutBotAliasResponse -> PutBotAliasResponse -> Bool
$c== :: PutBotAliasResponse -> PutBotAliasResponse -> Bool
Prelude.Eq, ReadPrec [PutBotAliasResponse]
ReadPrec PutBotAliasResponse
Int -> ReadS PutBotAliasResponse
ReadS [PutBotAliasResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutBotAliasResponse]
$creadListPrec :: ReadPrec [PutBotAliasResponse]
readPrec :: ReadPrec PutBotAliasResponse
$creadPrec :: ReadPrec PutBotAliasResponse
readList :: ReadS [PutBotAliasResponse]
$creadList :: ReadS [PutBotAliasResponse]
readsPrec :: Int -> ReadS PutBotAliasResponse
$creadsPrec :: Int -> ReadS PutBotAliasResponse
Prelude.Read, Int -> PutBotAliasResponse -> ShowS
[PutBotAliasResponse] -> ShowS
PutBotAliasResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutBotAliasResponse] -> ShowS
$cshowList :: [PutBotAliasResponse] -> ShowS
show :: PutBotAliasResponse -> String
$cshow :: PutBotAliasResponse -> String
showsPrec :: Int -> PutBotAliasResponse -> ShowS
$cshowsPrec :: Int -> PutBotAliasResponse -> ShowS
Prelude.Show, forall x. Rep PutBotAliasResponse x -> PutBotAliasResponse
forall x. PutBotAliasResponse -> Rep PutBotAliasResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutBotAliasResponse x -> PutBotAliasResponse
$cfrom :: forall x. PutBotAliasResponse -> Rep PutBotAliasResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutBotAliasResponse' 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:
--
-- 'botName', 'putBotAliasResponse_botName' - The name of the bot that the alias points to.
--
-- 'botVersion', 'putBotAliasResponse_botVersion' - The version of the bot that the alias points to.
--
-- 'checksum', 'putBotAliasResponse_checksum' - The checksum for the current version of the alias.
--
-- 'conversationLogs', 'putBotAliasResponse_conversationLogs' - The settings that determine how Amazon Lex uses conversation logs for
-- the alias.
--
-- 'createdDate', 'putBotAliasResponse_createdDate' - The date that the bot alias was created.
--
-- 'description', 'putBotAliasResponse_description' - A description of the alias.
--
-- 'lastUpdatedDate', 'putBotAliasResponse_lastUpdatedDate' - The date that the bot alias was updated. When you create a resource, the
-- creation date and the last updated date are the same.
--
-- 'name', 'putBotAliasResponse_name' - The name of the alias.
--
-- 'tags', 'putBotAliasResponse_tags' - A list of tags associated with a bot.
--
-- 'httpStatus', 'putBotAliasResponse_httpStatus' - The response's http status code.
newPutBotAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutBotAliasResponse
newPutBotAliasResponse :: Int -> PutBotAliasResponse
newPutBotAliasResponse Int
pHttpStatus_ =
  PutBotAliasResponse'
    { $sel:botName:PutBotAliasResponse' :: Maybe Text
botName = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:PutBotAliasResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:checksum:PutBotAliasResponse' :: Maybe Text
checksum = forall a. Maybe a
Prelude.Nothing,
      $sel:conversationLogs:PutBotAliasResponse' :: Maybe ConversationLogsResponse
conversationLogs = forall a. Maybe a
Prelude.Nothing,
      $sel:createdDate:PutBotAliasResponse' :: Maybe POSIX
createdDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:PutBotAliasResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedDate:PutBotAliasResponse' :: Maybe POSIX
lastUpdatedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:name:PutBotAliasResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:PutBotAliasResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutBotAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the bot that the alias points to.
putBotAliasResponse_botName :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.Text)
putBotAliasResponse_botName :: Lens' PutBotAliasResponse (Maybe Text)
putBotAliasResponse_botName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe Text
botName :: Maybe Text
$sel:botName:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
botName} -> Maybe Text
botName) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe Text
a -> PutBotAliasResponse
s {$sel:botName:PutBotAliasResponse' :: Maybe Text
botName = Maybe Text
a} :: PutBotAliasResponse)

-- | The version of the bot that the alias points to.
putBotAliasResponse_botVersion :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.Text)
putBotAliasResponse_botVersion :: Lens' PutBotAliasResponse (Maybe Text)
putBotAliasResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe Text
a -> PutBotAliasResponse
s {$sel:botVersion:PutBotAliasResponse' :: Maybe Text
botVersion = Maybe Text
a} :: PutBotAliasResponse)

-- | The checksum for the current version of the alias.
putBotAliasResponse_checksum :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.Text)
putBotAliasResponse_checksum :: Lens' PutBotAliasResponse (Maybe Text)
putBotAliasResponse_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe Text
checksum :: Maybe Text
$sel:checksum:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe Text
a -> PutBotAliasResponse
s {$sel:checksum:PutBotAliasResponse' :: Maybe Text
checksum = Maybe Text
a} :: PutBotAliasResponse)

-- | The settings that determine how Amazon Lex uses conversation logs for
-- the alias.
putBotAliasResponse_conversationLogs :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe ConversationLogsResponse)
putBotAliasResponse_conversationLogs :: Lens' PutBotAliasResponse (Maybe ConversationLogsResponse)
putBotAliasResponse_conversationLogs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe ConversationLogsResponse
conversationLogs :: Maybe ConversationLogsResponse
$sel:conversationLogs:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe ConversationLogsResponse
conversationLogs} -> Maybe ConversationLogsResponse
conversationLogs) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe ConversationLogsResponse
a -> PutBotAliasResponse
s {$sel:conversationLogs:PutBotAliasResponse' :: Maybe ConversationLogsResponse
conversationLogs = Maybe ConversationLogsResponse
a} :: PutBotAliasResponse)

-- | The date that the bot alias was created.
putBotAliasResponse_createdDate :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.UTCTime)
putBotAliasResponse_createdDate :: Lens' PutBotAliasResponse (Maybe UTCTime)
putBotAliasResponse_createdDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe POSIX
createdDate :: Maybe POSIX
$sel:createdDate:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe POSIX
createdDate} -> Maybe POSIX
createdDate) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe POSIX
a -> PutBotAliasResponse
s {$sel:createdDate:PutBotAliasResponse' :: Maybe POSIX
createdDate = Maybe POSIX
a} :: PutBotAliasResponse) 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

-- | A description of the alias.
putBotAliasResponse_description :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.Text)
putBotAliasResponse_description :: Lens' PutBotAliasResponse (Maybe Text)
putBotAliasResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe Text
description :: Maybe Text
$sel:description:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe Text
a -> PutBotAliasResponse
s {$sel:description:PutBotAliasResponse' :: Maybe Text
description = Maybe Text
a} :: PutBotAliasResponse)

-- | The date that the bot alias was updated. When you create a resource, the
-- creation date and the last updated date are the same.
putBotAliasResponse_lastUpdatedDate :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.UTCTime)
putBotAliasResponse_lastUpdatedDate :: Lens' PutBotAliasResponse (Maybe UTCTime)
putBotAliasResponse_lastUpdatedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe POSIX
lastUpdatedDate :: Maybe POSIX
$sel:lastUpdatedDate:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe POSIX
lastUpdatedDate} -> Maybe POSIX
lastUpdatedDate) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe POSIX
a -> PutBotAliasResponse
s {$sel:lastUpdatedDate:PutBotAliasResponse' :: Maybe POSIX
lastUpdatedDate = Maybe POSIX
a} :: PutBotAliasResponse) 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 name of the alias.
putBotAliasResponse_name :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe Prelude.Text)
putBotAliasResponse_name :: Lens' PutBotAliasResponse (Maybe Text)
putBotAliasResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe Text
name :: Maybe Text
$sel:name:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe Text
a -> PutBotAliasResponse
s {$sel:name:PutBotAliasResponse' :: Maybe Text
name = Maybe Text
a} :: PutBotAliasResponse)

-- | A list of tags associated with a bot.
putBotAliasResponse_tags :: Lens.Lens' PutBotAliasResponse (Prelude.Maybe [Tag])
putBotAliasResponse_tags :: Lens' PutBotAliasResponse (Maybe [Tag])
putBotAliasResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Maybe [Tag]
a -> PutBotAliasResponse
s {$sel:tags:PutBotAliasResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: PutBotAliasResponse) 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.
putBotAliasResponse_httpStatus :: Lens.Lens' PutBotAliasResponse Prelude.Int
putBotAliasResponse_httpStatus :: Lens' PutBotAliasResponse Int
putBotAliasResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutBotAliasResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutBotAliasResponse' :: PutBotAliasResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutBotAliasResponse
s@PutBotAliasResponse' {} Int
a -> PutBotAliasResponse
s {$sel:httpStatus:PutBotAliasResponse' :: Int
httpStatus = Int
a} :: PutBotAliasResponse)

instance Prelude.NFData PutBotAliasResponse where
  rnf :: PutBotAliasResponse -> ()
rnf PutBotAliasResponse' {Int
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ConversationLogsResponse
httpStatus :: Int
tags :: Maybe [Tag]
name :: Maybe Text
lastUpdatedDate :: Maybe POSIX
description :: Maybe Text
createdDate :: Maybe POSIX
conversationLogs :: Maybe ConversationLogsResponse
checksum :: Maybe Text
botVersion :: Maybe Text
botName :: Maybe Text
$sel:httpStatus:PutBotAliasResponse' :: PutBotAliasResponse -> Int
$sel:tags:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe [Tag]
$sel:name:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
$sel:lastUpdatedDate:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe POSIX
$sel:description:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
$sel:createdDate:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe POSIX
$sel:conversationLogs:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe ConversationLogsResponse
$sel:checksum:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
$sel:botVersion:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
$sel:botName:PutBotAliasResponse' :: PutBotAliasResponse -> Maybe Text
..} =
    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 Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
checksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConversationLogsResponse
conversationLogs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdDate
      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 POSIX
lastUpdatedDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus