{-# 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.WorkSpaces.UpdateConnectClientAddIn
-- 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 a Amazon Connect client add-in. Use this action to update the
-- name and endpoint URL of a Amazon Connect client add-in.
module Amazonka.WorkSpaces.UpdateConnectClientAddIn
  ( -- * Creating a Request
    UpdateConnectClientAddIn (..),
    newUpdateConnectClientAddIn,

    -- * Request Lenses
    updateConnectClientAddIn_name,
    updateConnectClientAddIn_url,
    updateConnectClientAddIn_addInId,
    updateConnectClientAddIn_resourceId,

    -- * Destructuring the Response
    UpdateConnectClientAddInResponse (..),
    newUpdateConnectClientAddInResponse,

    -- * Response Lenses
    updateConnectClientAddInResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateConnectClientAddIn' smart constructor.
data UpdateConnectClientAddIn = UpdateConnectClientAddIn'
  { -- | The name of the client add-in.
    UpdateConnectClientAddIn -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The endpoint URL of the Amazon Connect client add-in.
    UpdateConnectClientAddIn -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the client add-in to update.
    UpdateConnectClientAddIn -> Text
addInId :: Prelude.Text,
    -- | The directory identifier for which the client add-in is configured.
    UpdateConnectClientAddIn -> Text
resourceId :: Prelude.Text
  }
  deriving (UpdateConnectClientAddIn -> UpdateConnectClientAddIn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateConnectClientAddIn -> UpdateConnectClientAddIn -> Bool
$c/= :: UpdateConnectClientAddIn -> UpdateConnectClientAddIn -> Bool
== :: UpdateConnectClientAddIn -> UpdateConnectClientAddIn -> Bool
$c== :: UpdateConnectClientAddIn -> UpdateConnectClientAddIn -> Bool
Prelude.Eq, ReadPrec [UpdateConnectClientAddIn]
ReadPrec UpdateConnectClientAddIn
Int -> ReadS UpdateConnectClientAddIn
ReadS [UpdateConnectClientAddIn]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateConnectClientAddIn]
$creadListPrec :: ReadPrec [UpdateConnectClientAddIn]
readPrec :: ReadPrec UpdateConnectClientAddIn
$creadPrec :: ReadPrec UpdateConnectClientAddIn
readList :: ReadS [UpdateConnectClientAddIn]
$creadList :: ReadS [UpdateConnectClientAddIn]
readsPrec :: Int -> ReadS UpdateConnectClientAddIn
$creadsPrec :: Int -> ReadS UpdateConnectClientAddIn
Prelude.Read, Int -> UpdateConnectClientAddIn -> ShowS
[UpdateConnectClientAddIn] -> ShowS
UpdateConnectClientAddIn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateConnectClientAddIn] -> ShowS
$cshowList :: [UpdateConnectClientAddIn] -> ShowS
show :: UpdateConnectClientAddIn -> String
$cshow :: UpdateConnectClientAddIn -> String
showsPrec :: Int -> UpdateConnectClientAddIn -> ShowS
$cshowsPrec :: Int -> UpdateConnectClientAddIn -> ShowS
Prelude.Show, forall x.
Rep UpdateConnectClientAddIn x -> UpdateConnectClientAddIn
forall x.
UpdateConnectClientAddIn -> Rep UpdateConnectClientAddIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateConnectClientAddIn x -> UpdateConnectClientAddIn
$cfrom :: forall x.
UpdateConnectClientAddIn -> Rep UpdateConnectClientAddIn x
Prelude.Generic)

-- |
-- Create a value of 'UpdateConnectClientAddIn' 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:
--
-- 'name', 'updateConnectClientAddIn_name' - The name of the client add-in.
--
-- 'url', 'updateConnectClientAddIn_url' - The endpoint URL of the Amazon Connect client add-in.
--
-- 'addInId', 'updateConnectClientAddIn_addInId' - The identifier of the client add-in to update.
--
-- 'resourceId', 'updateConnectClientAddIn_resourceId' - The directory identifier for which the client add-in is configured.
newUpdateConnectClientAddIn ::
  -- | 'addInId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  UpdateConnectClientAddIn
newUpdateConnectClientAddIn :: Text -> Text -> UpdateConnectClientAddIn
newUpdateConnectClientAddIn Text
pAddInId_ Text
pResourceId_ =
  UpdateConnectClientAddIn'
    { $sel:name:UpdateConnectClientAddIn' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:url:UpdateConnectClientAddIn' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:addInId:UpdateConnectClientAddIn' :: Text
addInId = Text
pAddInId_,
      $sel:resourceId:UpdateConnectClientAddIn' :: Text
resourceId = Text
pResourceId_
    }

-- | The name of the client add-in.
updateConnectClientAddIn_name :: Lens.Lens' UpdateConnectClientAddIn (Prelude.Maybe Prelude.Text)
updateConnectClientAddIn_name :: Lens' UpdateConnectClientAddIn (Maybe Text)
updateConnectClientAddIn_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectClientAddIn' {Maybe Text
name :: Maybe Text
$sel:name:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateConnectClientAddIn
s@UpdateConnectClientAddIn' {} Maybe Text
a -> UpdateConnectClientAddIn
s {$sel:name:UpdateConnectClientAddIn' :: Maybe Text
name = Maybe Text
a} :: UpdateConnectClientAddIn)

-- | The endpoint URL of the Amazon Connect client add-in.
updateConnectClientAddIn_url :: Lens.Lens' UpdateConnectClientAddIn (Prelude.Maybe Prelude.Text)
updateConnectClientAddIn_url :: Lens' UpdateConnectClientAddIn (Maybe Text)
updateConnectClientAddIn_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectClientAddIn' {Maybe Text
url :: Maybe Text
$sel:url:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
url} -> Maybe Text
url) (\s :: UpdateConnectClientAddIn
s@UpdateConnectClientAddIn' {} Maybe Text
a -> UpdateConnectClientAddIn
s {$sel:url:UpdateConnectClientAddIn' :: Maybe Text
url = Maybe Text
a} :: UpdateConnectClientAddIn)

-- | The identifier of the client add-in to update.
updateConnectClientAddIn_addInId :: Lens.Lens' UpdateConnectClientAddIn Prelude.Text
updateConnectClientAddIn_addInId :: Lens' UpdateConnectClientAddIn Text
updateConnectClientAddIn_addInId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectClientAddIn' {Text
addInId :: Text
$sel:addInId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
addInId} -> Text
addInId) (\s :: UpdateConnectClientAddIn
s@UpdateConnectClientAddIn' {} Text
a -> UpdateConnectClientAddIn
s {$sel:addInId:UpdateConnectClientAddIn' :: Text
addInId = Text
a} :: UpdateConnectClientAddIn)

-- | The directory identifier for which the client add-in is configured.
updateConnectClientAddIn_resourceId :: Lens.Lens' UpdateConnectClientAddIn Prelude.Text
updateConnectClientAddIn_resourceId :: Lens' UpdateConnectClientAddIn Text
updateConnectClientAddIn_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateConnectClientAddIn' {Text
resourceId :: Text
$sel:resourceId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
resourceId} -> Text
resourceId) (\s :: UpdateConnectClientAddIn
s@UpdateConnectClientAddIn' {} Text
a -> UpdateConnectClientAddIn
s {$sel:resourceId:UpdateConnectClientAddIn' :: Text
resourceId = Text
a} :: UpdateConnectClientAddIn)

instance Core.AWSRequest UpdateConnectClientAddIn where
  type
    AWSResponse UpdateConnectClientAddIn =
      UpdateConnectClientAddInResponse
  request :: (Service -> Service)
-> UpdateConnectClientAddIn -> Request UpdateConnectClientAddIn
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 UpdateConnectClientAddIn
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateConnectClientAddIn)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateConnectClientAddInResponse
UpdateConnectClientAddInResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateConnectClientAddIn where
  hashWithSalt :: Int -> UpdateConnectClientAddIn -> Int
hashWithSalt Int
_salt UpdateConnectClientAddIn' {Maybe Text
Text
resourceId :: Text
addInId :: Text
url :: Maybe Text
name :: Maybe Text
$sel:resourceId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:addInId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:url:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
$sel:name:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
url
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
addInId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData UpdateConnectClientAddIn where
  rnf :: UpdateConnectClientAddIn -> ()
rnf UpdateConnectClientAddIn' {Maybe Text
Text
resourceId :: Text
addInId :: Text
url :: Maybe Text
name :: Maybe Text
$sel:resourceId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:addInId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:url:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
$sel:name:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
..} =
    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 Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
addInId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

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

instance Data.ToJSON UpdateConnectClientAddIn where
  toJSON :: UpdateConnectClientAddIn -> Value
toJSON UpdateConnectClientAddIn' {Maybe Text
Text
resourceId :: Text
addInId :: Text
url :: Maybe Text
name :: Maybe Text
$sel:resourceId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:addInId:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Text
$sel:url:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
$sel:name:UpdateConnectClientAddIn' :: UpdateConnectClientAddIn -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Name" 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
name,
            (Key
"URL" 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
url,
            forall a. a -> Maybe a
Prelude.Just (Key
"AddInId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
addInId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateConnectClientAddInResponse' 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:
--
-- 'httpStatus', 'updateConnectClientAddInResponse_httpStatus' - The response's http status code.
newUpdateConnectClientAddInResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateConnectClientAddInResponse
newUpdateConnectClientAddInResponse :: Int -> UpdateConnectClientAddInResponse
newUpdateConnectClientAddInResponse Int
pHttpStatus_ =
  UpdateConnectClientAddInResponse'
    { $sel:httpStatus:UpdateConnectClientAddInResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    UpdateConnectClientAddInResponse
  where
  rnf :: UpdateConnectClientAddInResponse -> ()
rnf UpdateConnectClientAddInResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateConnectClientAddInResponse' :: UpdateConnectClientAddInResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus