{-# 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.Chime.UpdateBot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the status of the specified bot, such as starting or stopping
-- the bot from running in your Amazon Chime Enterprise account.
module Amazonka.Chime.UpdateBot
  ( -- * Creating a Request
    UpdateBot (..),
    newUpdateBot,

    -- * Request Lenses
    updateBot_disabled,
    updateBot_accountId,
    updateBot_botId,

    -- * Destructuring the Response
    UpdateBotResponse (..),
    newUpdateBotResponse,

    -- * Response Lenses
    updateBotResponse_bot,
    updateBotResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateBot' smart constructor.
data UpdateBot = UpdateBot'
  { -- | When true, stops the specified bot from running in your account.
    UpdateBot -> Maybe Bool
disabled :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Chime account ID.
    UpdateBot -> Text
accountId :: Prelude.Text,
    -- | The bot ID.
    UpdateBot -> Text
botId :: Prelude.Text
  }
  deriving (UpdateBot -> UpdateBot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBot -> UpdateBot -> Bool
$c/= :: UpdateBot -> UpdateBot -> Bool
== :: UpdateBot -> UpdateBot -> Bool
$c== :: UpdateBot -> UpdateBot -> Bool
Prelude.Eq, ReadPrec [UpdateBot]
ReadPrec UpdateBot
Int -> ReadS UpdateBot
ReadS [UpdateBot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBot]
$creadListPrec :: ReadPrec [UpdateBot]
readPrec :: ReadPrec UpdateBot
$creadPrec :: ReadPrec UpdateBot
readList :: ReadS [UpdateBot]
$creadList :: ReadS [UpdateBot]
readsPrec :: Int -> ReadS UpdateBot
$creadsPrec :: Int -> ReadS UpdateBot
Prelude.Read, Int -> UpdateBot -> ShowS
[UpdateBot] -> ShowS
UpdateBot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBot] -> ShowS
$cshowList :: [UpdateBot] -> ShowS
show :: UpdateBot -> String
$cshow :: UpdateBot -> String
showsPrec :: Int -> UpdateBot -> ShowS
$cshowsPrec :: Int -> UpdateBot -> ShowS
Prelude.Show, forall x. Rep UpdateBot x -> UpdateBot
forall x. UpdateBot -> Rep UpdateBot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBot x -> UpdateBot
$cfrom :: forall x. UpdateBot -> Rep UpdateBot x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBot' 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:
--
-- 'disabled', 'updateBot_disabled' - When true, stops the specified bot from running in your account.
--
-- 'accountId', 'updateBot_accountId' - The Amazon Chime account ID.
--
-- 'botId', 'updateBot_botId' - The bot ID.
newUpdateBot ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'botId'
  Prelude.Text ->
  UpdateBot
newUpdateBot :: Text -> Text -> UpdateBot
newUpdateBot Text
pAccountId_ Text
pBotId_ =
  UpdateBot'
    { $sel:disabled:UpdateBot' :: Maybe Bool
disabled = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:UpdateBot' :: Text
accountId = Text
pAccountId_,
      $sel:botId:UpdateBot' :: Text
botId = Text
pBotId_
    }

-- | When true, stops the specified bot from running in your account.
updateBot_disabled :: Lens.Lens' UpdateBot (Prelude.Maybe Prelude.Bool)
updateBot_disabled :: Lens' UpdateBot (Maybe Bool)
updateBot_disabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBot' {Maybe Bool
disabled :: Maybe Bool
$sel:disabled:UpdateBot' :: UpdateBot -> Maybe Bool
disabled} -> Maybe Bool
disabled) (\s :: UpdateBot
s@UpdateBot' {} Maybe Bool
a -> UpdateBot
s {$sel:disabled:UpdateBot' :: Maybe Bool
disabled = Maybe Bool
a} :: UpdateBot)

-- | The Amazon Chime account ID.
updateBot_accountId :: Lens.Lens' UpdateBot Prelude.Text
updateBot_accountId :: Lens' UpdateBot Text
updateBot_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBot' {Text
accountId :: Text
$sel:accountId:UpdateBot' :: UpdateBot -> Text
accountId} -> Text
accountId) (\s :: UpdateBot
s@UpdateBot' {} Text
a -> UpdateBot
s {$sel:accountId:UpdateBot' :: Text
accountId = Text
a} :: UpdateBot)

-- | The bot ID.
updateBot_botId :: Lens.Lens' UpdateBot Prelude.Text
updateBot_botId :: Lens' UpdateBot Text
updateBot_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBot' {Text
botId :: Text
$sel:botId:UpdateBot' :: UpdateBot -> Text
botId} -> Text
botId) (\s :: UpdateBot
s@UpdateBot' {} Text
a -> UpdateBot
s {$sel:botId:UpdateBot' :: Text
botId = Text
a} :: UpdateBot)

instance Core.AWSRequest UpdateBot where
  type AWSResponse UpdateBot = UpdateBotResponse
  request :: (Service -> Service) -> UpdateBot -> Request UpdateBot
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBot)))
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 Bot -> Int -> UpdateBotResponse
UpdateBotResponse'
            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
"Bot")
            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 UpdateBot where
  hashWithSalt :: Int -> UpdateBot -> Int
hashWithSalt Int
_salt UpdateBot' {Maybe Bool
Text
botId :: Text
accountId :: Text
disabled :: Maybe Bool
$sel:botId:UpdateBot' :: UpdateBot -> Text
$sel:accountId:UpdateBot' :: UpdateBot -> Text
$sel:disabled:UpdateBot' :: UpdateBot -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
disabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
botId

instance Prelude.NFData UpdateBot where
  rnf :: UpdateBot -> ()
rnf UpdateBot' {Maybe Bool
Text
botId :: Text
accountId :: Text
disabled :: Maybe Bool
$sel:botId:UpdateBot' :: UpdateBot -> Text
$sel:accountId:UpdateBot' :: UpdateBot -> Text
$sel:disabled:UpdateBot' :: UpdateBot -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
disabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
botId

instance Data.ToHeaders UpdateBot where
  toHeaders :: UpdateBot -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateBot where
  toJSON :: UpdateBot -> Value
toJSON UpdateBot' {Maybe Bool
Text
botId :: Text
accountId :: Text
disabled :: Maybe Bool
$sel:botId:UpdateBot' :: UpdateBot -> Text
$sel:accountId:UpdateBot' :: UpdateBot -> Text
$sel:disabled:UpdateBot' :: UpdateBot -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"Disabled" 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 Bool
disabled]
      )

instance Data.ToPath UpdateBot where
  toPath :: UpdateBot -> ByteString
toPath UpdateBot' {Maybe Bool
Text
botId :: Text
accountId :: Text
disabled :: Maybe Bool
$sel:botId:UpdateBot' :: UpdateBot -> Text
$sel:accountId:UpdateBot' :: UpdateBot -> Text
$sel:disabled:UpdateBot' :: UpdateBot -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/bots/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
botId
      ]

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

-- | /See:/ 'newUpdateBotResponse' smart constructor.
data UpdateBotResponse = UpdateBotResponse'
  { -- | The updated bot details.
    UpdateBotResponse -> Maybe Bot
bot :: Prelude.Maybe Bot,
    -- | The response's http status code.
    UpdateBotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateBotResponse -> UpdateBotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBotResponse -> UpdateBotResponse -> Bool
$c/= :: UpdateBotResponse -> UpdateBotResponse -> Bool
== :: UpdateBotResponse -> UpdateBotResponse -> Bool
$c== :: UpdateBotResponse -> UpdateBotResponse -> Bool
Prelude.Eq, Int -> UpdateBotResponse -> ShowS
[UpdateBotResponse] -> ShowS
UpdateBotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBotResponse] -> ShowS
$cshowList :: [UpdateBotResponse] -> ShowS
show :: UpdateBotResponse -> String
$cshow :: UpdateBotResponse -> String
showsPrec :: Int -> UpdateBotResponse -> ShowS
$cshowsPrec :: Int -> UpdateBotResponse -> ShowS
Prelude.Show, forall x. Rep UpdateBotResponse x -> UpdateBotResponse
forall x. UpdateBotResponse -> Rep UpdateBotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBotResponse x -> UpdateBotResponse
$cfrom :: forall x. UpdateBotResponse -> Rep UpdateBotResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBotResponse' 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:
--
-- 'bot', 'updateBotResponse_bot' - The updated bot details.
--
-- 'httpStatus', 'updateBotResponse_httpStatus' - The response's http status code.
newUpdateBotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBotResponse
newUpdateBotResponse :: Int -> UpdateBotResponse
newUpdateBotResponse Int
pHttpStatus_ =
  UpdateBotResponse'
    { $sel:bot:UpdateBotResponse' :: Maybe Bot
bot = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated bot details.
updateBotResponse_bot :: Lens.Lens' UpdateBotResponse (Prelude.Maybe Bot)
updateBotResponse_bot :: Lens' UpdateBotResponse (Maybe Bot)
updateBotResponse_bot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBotResponse' {Maybe Bot
bot :: Maybe Bot
$sel:bot:UpdateBotResponse' :: UpdateBotResponse -> Maybe Bot
bot} -> Maybe Bot
bot) (\s :: UpdateBotResponse
s@UpdateBotResponse' {} Maybe Bot
a -> UpdateBotResponse
s {$sel:bot:UpdateBotResponse' :: Maybe Bot
bot = Maybe Bot
a} :: UpdateBotResponse)

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

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