{-# 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.ModifyClientProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the properties of the specified Amazon WorkSpaces clients.
module Amazonka.WorkSpaces.ModifyClientProperties
  ( -- * Creating a Request
    ModifyClientProperties (..),
    newModifyClientProperties,

    -- * Request Lenses
    modifyClientProperties_resourceId,
    modifyClientProperties_clientProperties,

    -- * Destructuring the Response
    ModifyClientPropertiesResponse (..),
    newModifyClientPropertiesResponse,

    -- * Response Lenses
    modifyClientPropertiesResponse_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:/ 'newModifyClientProperties' smart constructor.
data ModifyClientProperties = ModifyClientProperties'
  { -- | The resource identifiers, in the form of directory IDs.
    ModifyClientProperties -> Text
resourceId :: Prelude.Text,
    -- | Information about the Amazon WorkSpaces client.
    ModifyClientProperties -> ClientProperties
clientProperties :: ClientProperties
  }
  deriving (ModifyClientProperties -> ModifyClientProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyClientProperties -> ModifyClientProperties -> Bool
$c/= :: ModifyClientProperties -> ModifyClientProperties -> Bool
== :: ModifyClientProperties -> ModifyClientProperties -> Bool
$c== :: ModifyClientProperties -> ModifyClientProperties -> Bool
Prelude.Eq, ReadPrec [ModifyClientProperties]
ReadPrec ModifyClientProperties
Int -> ReadS ModifyClientProperties
ReadS [ModifyClientProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyClientProperties]
$creadListPrec :: ReadPrec [ModifyClientProperties]
readPrec :: ReadPrec ModifyClientProperties
$creadPrec :: ReadPrec ModifyClientProperties
readList :: ReadS [ModifyClientProperties]
$creadList :: ReadS [ModifyClientProperties]
readsPrec :: Int -> ReadS ModifyClientProperties
$creadsPrec :: Int -> ReadS ModifyClientProperties
Prelude.Read, Int -> ModifyClientProperties -> ShowS
[ModifyClientProperties] -> ShowS
ModifyClientProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyClientProperties] -> ShowS
$cshowList :: [ModifyClientProperties] -> ShowS
show :: ModifyClientProperties -> String
$cshow :: ModifyClientProperties -> String
showsPrec :: Int -> ModifyClientProperties -> ShowS
$cshowsPrec :: Int -> ModifyClientProperties -> ShowS
Prelude.Show, forall x. Rep ModifyClientProperties x -> ModifyClientProperties
forall x. ModifyClientProperties -> Rep ModifyClientProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyClientProperties x -> ModifyClientProperties
$cfrom :: forall x. ModifyClientProperties -> Rep ModifyClientProperties x
Prelude.Generic)

-- |
-- Create a value of 'ModifyClientProperties' 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:
--
-- 'resourceId', 'modifyClientProperties_resourceId' - The resource identifiers, in the form of directory IDs.
--
-- 'clientProperties', 'modifyClientProperties_clientProperties' - Information about the Amazon WorkSpaces client.
newModifyClientProperties ::
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'clientProperties'
  ClientProperties ->
  ModifyClientProperties
newModifyClientProperties :: Text -> ClientProperties -> ModifyClientProperties
newModifyClientProperties
  Text
pResourceId_
  ClientProperties
pClientProperties_ =
    ModifyClientProperties'
      { $sel:resourceId:ModifyClientProperties' :: Text
resourceId = Text
pResourceId_,
        $sel:clientProperties:ModifyClientProperties' :: ClientProperties
clientProperties = ClientProperties
pClientProperties_
      }

-- | The resource identifiers, in the form of directory IDs.
modifyClientProperties_resourceId :: Lens.Lens' ModifyClientProperties Prelude.Text
modifyClientProperties_resourceId :: Lens' ModifyClientProperties Text
modifyClientProperties_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClientProperties' {Text
resourceId :: Text
$sel:resourceId:ModifyClientProperties' :: ModifyClientProperties -> Text
resourceId} -> Text
resourceId) (\s :: ModifyClientProperties
s@ModifyClientProperties' {} Text
a -> ModifyClientProperties
s {$sel:resourceId:ModifyClientProperties' :: Text
resourceId = Text
a} :: ModifyClientProperties)

-- | Information about the Amazon WorkSpaces client.
modifyClientProperties_clientProperties :: Lens.Lens' ModifyClientProperties ClientProperties
modifyClientProperties_clientProperties :: Lens' ModifyClientProperties ClientProperties
modifyClientProperties_clientProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyClientProperties' {ClientProperties
clientProperties :: ClientProperties
$sel:clientProperties:ModifyClientProperties' :: ModifyClientProperties -> ClientProperties
clientProperties} -> ClientProperties
clientProperties) (\s :: ModifyClientProperties
s@ModifyClientProperties' {} ClientProperties
a -> ModifyClientProperties
s {$sel:clientProperties:ModifyClientProperties' :: ClientProperties
clientProperties = ClientProperties
a} :: ModifyClientProperties)

instance Core.AWSRequest ModifyClientProperties where
  type
    AWSResponse ModifyClientProperties =
      ModifyClientPropertiesResponse
  request :: (Service -> Service)
-> ModifyClientProperties -> Request ModifyClientProperties
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 ModifyClientProperties
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyClientProperties)))
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 -> ModifyClientPropertiesResponse
ModifyClientPropertiesResponse'
            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 ModifyClientProperties where
  hashWithSalt :: Int -> ModifyClientProperties -> Int
hashWithSalt Int
_salt ModifyClientProperties' {Text
ClientProperties
clientProperties :: ClientProperties
resourceId :: Text
$sel:clientProperties:ModifyClientProperties' :: ModifyClientProperties -> ClientProperties
$sel:resourceId:ModifyClientProperties' :: ModifyClientProperties -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ClientProperties
clientProperties

instance Prelude.NFData ModifyClientProperties where
  rnf :: ModifyClientProperties -> ()
rnf ModifyClientProperties' {Text
ClientProperties
clientProperties :: ClientProperties
resourceId :: Text
$sel:clientProperties:ModifyClientProperties' :: ModifyClientProperties -> ClientProperties
$sel:resourceId:ModifyClientProperties' :: ModifyClientProperties -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ClientProperties
clientProperties

instance Data.ToHeaders ModifyClientProperties where
  toHeaders :: ModifyClientProperties -> 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.ModifyClientProperties" ::
                          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 ModifyClientProperties where
  toJSON :: ModifyClientProperties -> Value
toJSON ModifyClientProperties' {Text
ClientProperties
clientProperties :: ClientProperties
resourceId :: Text
$sel:clientProperties:ModifyClientProperties' :: ModifyClientProperties -> ClientProperties
$sel:resourceId:ModifyClientProperties' :: ModifyClientProperties -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientProperties" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ClientProperties
clientProperties)
          ]
      )

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

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

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

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

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

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