{-# 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.DeviceFarm.UpdateDevicePool
-- 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 name, description, and rules in a device pool given the
-- attributes and the pool ARN. Rule updates are all-or-nothing, meaning
-- they can only be updated as a whole (or not at all).
module Amazonka.DeviceFarm.UpdateDevicePool
  ( -- * Creating a Request
    UpdateDevicePool (..),
    newUpdateDevicePool,

    -- * Request Lenses
    updateDevicePool_clearMaxDevices,
    updateDevicePool_description,
    updateDevicePool_maxDevices,
    updateDevicePool_name,
    updateDevicePool_rules,
    updateDevicePool_arn,

    -- * Destructuring the Response
    UpdateDevicePoolResponse (..),
    newUpdateDevicePoolResponse,

    -- * Response Lenses
    updateDevicePoolResponse_devicePool,
    updateDevicePoolResponse_httpStatus,
  )
where

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

-- | Represents a request to the update device pool operation.
--
-- /See:/ 'newUpdateDevicePool' smart constructor.
data UpdateDevicePool = UpdateDevicePool'
  { -- | Sets whether the @maxDevices@ parameter applies to your device pool. If
    -- you set this parameter to @true@, the @maxDevices@ parameter does not
    -- apply, and Device Farm does not limit the number of devices that it adds
    -- to your device pool. In this case, Device Farm adds all available
    -- devices that meet the criteria specified in the @rules@ parameter.
    --
    -- If you use this parameter in your request, you cannot use the
    -- @maxDevices@ parameter in the same request.
    UpdateDevicePool -> Maybe Bool
clearMaxDevices :: Prelude.Maybe Prelude.Bool,
    -- | A description of the device pool to update.
    UpdateDevicePool -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The number of devices that Device Farm can add to your device pool.
    -- Device Farm adds devices that are available and that meet the criteria
    -- that you assign for the @rules@ parameter. Depending on how many devices
    -- meet these constraints, your device pool might contain fewer devices
    -- than the value for this parameter.
    --
    -- By specifying the maximum number of devices, you can control the costs
    -- that you incur by running tests.
    --
    -- If you use this parameter in your request, you cannot use the
    -- @clearMaxDevices@ parameter in the same request.
    UpdateDevicePool -> Maybe Int
maxDevices :: Prelude.Maybe Prelude.Int,
    -- | A string that represents the name of the device pool to update.
    UpdateDevicePool -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Represents the rules to modify for the device pool. Updating rules is
    -- optional. If you update rules for your request, the update replaces the
    -- existing rules.
    UpdateDevicePool -> Maybe [Rule]
rules :: Prelude.Maybe [Rule],
    -- | The Amazon Resource Name (ARN) of the Device Farm device pool to update.
    UpdateDevicePool -> Text
arn :: Prelude.Text
  }
  deriving (UpdateDevicePool -> UpdateDevicePool -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDevicePool -> UpdateDevicePool -> Bool
$c/= :: UpdateDevicePool -> UpdateDevicePool -> Bool
== :: UpdateDevicePool -> UpdateDevicePool -> Bool
$c== :: UpdateDevicePool -> UpdateDevicePool -> Bool
Prelude.Eq, ReadPrec [UpdateDevicePool]
ReadPrec UpdateDevicePool
Int -> ReadS UpdateDevicePool
ReadS [UpdateDevicePool]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDevicePool]
$creadListPrec :: ReadPrec [UpdateDevicePool]
readPrec :: ReadPrec UpdateDevicePool
$creadPrec :: ReadPrec UpdateDevicePool
readList :: ReadS [UpdateDevicePool]
$creadList :: ReadS [UpdateDevicePool]
readsPrec :: Int -> ReadS UpdateDevicePool
$creadsPrec :: Int -> ReadS UpdateDevicePool
Prelude.Read, Int -> UpdateDevicePool -> ShowS
[UpdateDevicePool] -> ShowS
UpdateDevicePool -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDevicePool] -> ShowS
$cshowList :: [UpdateDevicePool] -> ShowS
show :: UpdateDevicePool -> String
$cshow :: UpdateDevicePool -> String
showsPrec :: Int -> UpdateDevicePool -> ShowS
$cshowsPrec :: Int -> UpdateDevicePool -> ShowS
Prelude.Show, forall x. Rep UpdateDevicePool x -> UpdateDevicePool
forall x. UpdateDevicePool -> Rep UpdateDevicePool x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDevicePool x -> UpdateDevicePool
$cfrom :: forall x. UpdateDevicePool -> Rep UpdateDevicePool x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDevicePool' 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:
--
-- 'clearMaxDevices', 'updateDevicePool_clearMaxDevices' - Sets whether the @maxDevices@ parameter applies to your device pool. If
-- you set this parameter to @true@, the @maxDevices@ parameter does not
-- apply, and Device Farm does not limit the number of devices that it adds
-- to your device pool. In this case, Device Farm adds all available
-- devices that meet the criteria specified in the @rules@ parameter.
--
-- If you use this parameter in your request, you cannot use the
-- @maxDevices@ parameter in the same request.
--
-- 'description', 'updateDevicePool_description' - A description of the device pool to update.
--
-- 'maxDevices', 'updateDevicePool_maxDevices' - The number of devices that Device Farm can add to your device pool.
-- Device Farm adds devices that are available and that meet the criteria
-- that you assign for the @rules@ parameter. Depending on how many devices
-- meet these constraints, your device pool might contain fewer devices
-- than the value for this parameter.
--
-- By specifying the maximum number of devices, you can control the costs
-- that you incur by running tests.
--
-- If you use this parameter in your request, you cannot use the
-- @clearMaxDevices@ parameter in the same request.
--
-- 'name', 'updateDevicePool_name' - A string that represents the name of the device pool to update.
--
-- 'rules', 'updateDevicePool_rules' - Represents the rules to modify for the device pool. Updating rules is
-- optional. If you update rules for your request, the update replaces the
-- existing rules.
--
-- 'arn', 'updateDevicePool_arn' - The Amazon Resource Name (ARN) of the Device Farm device pool to update.
newUpdateDevicePool ::
  -- | 'arn'
  Prelude.Text ->
  UpdateDevicePool
newUpdateDevicePool :: Text -> UpdateDevicePool
newUpdateDevicePool Text
pArn_ =
  UpdateDevicePool'
    { $sel:clearMaxDevices:UpdateDevicePool' :: Maybe Bool
clearMaxDevices =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateDevicePool' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:maxDevices:UpdateDevicePool' :: Maybe Int
maxDevices = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateDevicePool' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:rules:UpdateDevicePool' :: Maybe [Rule]
rules = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateDevicePool' :: Text
arn = Text
pArn_
    }

-- | Sets whether the @maxDevices@ parameter applies to your device pool. If
-- you set this parameter to @true@, the @maxDevices@ parameter does not
-- apply, and Device Farm does not limit the number of devices that it adds
-- to your device pool. In this case, Device Farm adds all available
-- devices that meet the criteria specified in the @rules@ parameter.
--
-- If you use this parameter in your request, you cannot use the
-- @maxDevices@ parameter in the same request.
updateDevicePool_clearMaxDevices :: Lens.Lens' UpdateDevicePool (Prelude.Maybe Prelude.Bool)
updateDevicePool_clearMaxDevices :: Lens' UpdateDevicePool (Maybe Bool)
updateDevicePool_clearMaxDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Maybe Bool
clearMaxDevices :: Maybe Bool
$sel:clearMaxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Bool
clearMaxDevices} -> Maybe Bool
clearMaxDevices) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Maybe Bool
a -> UpdateDevicePool
s {$sel:clearMaxDevices:UpdateDevicePool' :: Maybe Bool
clearMaxDevices = Maybe Bool
a} :: UpdateDevicePool)

-- | A description of the device pool to update.
updateDevicePool_description :: Lens.Lens' UpdateDevicePool (Prelude.Maybe Prelude.Text)
updateDevicePool_description :: Lens' UpdateDevicePool (Maybe Text)
updateDevicePool_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Maybe Text
a -> UpdateDevicePool
s {$sel:description:UpdateDevicePool' :: Maybe Text
description = Maybe Text
a} :: UpdateDevicePool)

-- | The number of devices that Device Farm can add to your device pool.
-- Device Farm adds devices that are available and that meet the criteria
-- that you assign for the @rules@ parameter. Depending on how many devices
-- meet these constraints, your device pool might contain fewer devices
-- than the value for this parameter.
--
-- By specifying the maximum number of devices, you can control the costs
-- that you incur by running tests.
--
-- If you use this parameter in your request, you cannot use the
-- @clearMaxDevices@ parameter in the same request.
updateDevicePool_maxDevices :: Lens.Lens' UpdateDevicePool (Prelude.Maybe Prelude.Int)
updateDevicePool_maxDevices :: Lens' UpdateDevicePool (Maybe Int)
updateDevicePool_maxDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Maybe Int
maxDevices :: Maybe Int
$sel:maxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Int
maxDevices} -> Maybe Int
maxDevices) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Maybe Int
a -> UpdateDevicePool
s {$sel:maxDevices:UpdateDevicePool' :: Maybe Int
maxDevices = Maybe Int
a} :: UpdateDevicePool)

-- | A string that represents the name of the device pool to update.
updateDevicePool_name :: Lens.Lens' UpdateDevicePool (Prelude.Maybe Prelude.Text)
updateDevicePool_name :: Lens' UpdateDevicePool (Maybe Text)
updateDevicePool_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Maybe Text
name :: Maybe Text
$sel:name:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Maybe Text
a -> UpdateDevicePool
s {$sel:name:UpdateDevicePool' :: Maybe Text
name = Maybe Text
a} :: UpdateDevicePool)

-- | Represents the rules to modify for the device pool. Updating rules is
-- optional. If you update rules for your request, the update replaces the
-- existing rules.
updateDevicePool_rules :: Lens.Lens' UpdateDevicePool (Prelude.Maybe [Rule])
updateDevicePool_rules :: Lens' UpdateDevicePool (Maybe [Rule])
updateDevicePool_rules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Maybe [Rule]
rules :: Maybe [Rule]
$sel:rules:UpdateDevicePool' :: UpdateDevicePool -> Maybe [Rule]
rules} -> Maybe [Rule]
rules) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Maybe [Rule]
a -> UpdateDevicePool
s {$sel:rules:UpdateDevicePool' :: Maybe [Rule]
rules = Maybe [Rule]
a} :: UpdateDevicePool) 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 Amazon Resource Name (ARN) of the Device Farm device pool to update.
updateDevicePool_arn :: Lens.Lens' UpdateDevicePool Prelude.Text
updateDevicePool_arn :: Lens' UpdateDevicePool Text
updateDevicePool_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePool' {Text
arn :: Text
$sel:arn:UpdateDevicePool' :: UpdateDevicePool -> Text
arn} -> Text
arn) (\s :: UpdateDevicePool
s@UpdateDevicePool' {} Text
a -> UpdateDevicePool
s {$sel:arn:UpdateDevicePool' :: Text
arn = Text
a} :: UpdateDevicePool)

instance Core.AWSRequest UpdateDevicePool where
  type
    AWSResponse UpdateDevicePool =
      UpdateDevicePoolResponse
  request :: (Service -> Service)
-> UpdateDevicePool -> Request UpdateDevicePool
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 UpdateDevicePool
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDevicePool)))
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 DevicePool -> Int -> UpdateDevicePoolResponse
UpdateDevicePoolResponse'
            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
"devicePool")
            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 UpdateDevicePool where
  hashWithSalt :: Int -> UpdateDevicePool -> Int
hashWithSalt Int
_salt UpdateDevicePool' {Maybe Bool
Maybe Int
Maybe [Rule]
Maybe Text
Text
arn :: Text
rules :: Maybe [Rule]
name :: Maybe Text
maxDevices :: Maybe Int
description :: Maybe Text
clearMaxDevices :: Maybe Bool
$sel:arn:UpdateDevicePool' :: UpdateDevicePool -> Text
$sel:rules:UpdateDevicePool' :: UpdateDevicePool -> Maybe [Rule]
$sel:name:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:maxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Int
$sel:description:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:clearMaxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
clearMaxDevices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxDevices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Rule]
rules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateDevicePool where
  rnf :: UpdateDevicePool -> ()
rnf UpdateDevicePool' {Maybe Bool
Maybe Int
Maybe [Rule]
Maybe Text
Text
arn :: Text
rules :: Maybe [Rule]
name :: Maybe Text
maxDevices :: Maybe Int
description :: Maybe Text
clearMaxDevices :: Maybe Bool
$sel:arn:UpdateDevicePool' :: UpdateDevicePool -> Text
$sel:rules:UpdateDevicePool' :: UpdateDevicePool -> Maybe [Rule]
$sel:name:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:maxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Int
$sel:description:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:clearMaxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
clearMaxDevices
      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 Int
maxDevices
      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 [Rule]
rules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders UpdateDevicePool where
  toHeaders :: UpdateDevicePool -> 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
"DeviceFarm_20150623.UpdateDevicePool" ::
                          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 UpdateDevicePool where
  toJSON :: UpdateDevicePool -> Value
toJSON UpdateDevicePool' {Maybe Bool
Maybe Int
Maybe [Rule]
Maybe Text
Text
arn :: Text
rules :: Maybe [Rule]
name :: Maybe Text
maxDevices :: Maybe Int
description :: Maybe Text
clearMaxDevices :: Maybe Bool
$sel:arn:UpdateDevicePool' :: UpdateDevicePool -> Text
$sel:rules:UpdateDevicePool' :: UpdateDevicePool -> Maybe [Rule]
$sel:name:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:maxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Int
$sel:description:UpdateDevicePool' :: UpdateDevicePool -> Maybe Text
$sel:clearMaxDevices:UpdateDevicePool' :: UpdateDevicePool -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clearMaxDevices" 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
clearMaxDevices,
            (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
"maxDevices" 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 Int
maxDevices,
            (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
"rules" 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 [Rule]
rules,
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

-- | Represents the result of an update device pool request.
--
-- /See:/ 'newUpdateDevicePoolResponse' smart constructor.
data UpdateDevicePoolResponse = UpdateDevicePoolResponse'
  { -- | The device pool you just updated.
    UpdateDevicePoolResponse -> Maybe DevicePool
devicePool :: Prelude.Maybe DevicePool,
    -- | The response's http status code.
    UpdateDevicePoolResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDevicePoolResponse -> UpdateDevicePoolResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDevicePoolResponse -> UpdateDevicePoolResponse -> Bool
$c/= :: UpdateDevicePoolResponse -> UpdateDevicePoolResponse -> Bool
== :: UpdateDevicePoolResponse -> UpdateDevicePoolResponse -> Bool
$c== :: UpdateDevicePoolResponse -> UpdateDevicePoolResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDevicePoolResponse]
ReadPrec UpdateDevicePoolResponse
Int -> ReadS UpdateDevicePoolResponse
ReadS [UpdateDevicePoolResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDevicePoolResponse]
$creadListPrec :: ReadPrec [UpdateDevicePoolResponse]
readPrec :: ReadPrec UpdateDevicePoolResponse
$creadPrec :: ReadPrec UpdateDevicePoolResponse
readList :: ReadS [UpdateDevicePoolResponse]
$creadList :: ReadS [UpdateDevicePoolResponse]
readsPrec :: Int -> ReadS UpdateDevicePoolResponse
$creadsPrec :: Int -> ReadS UpdateDevicePoolResponse
Prelude.Read, Int -> UpdateDevicePoolResponse -> ShowS
[UpdateDevicePoolResponse] -> ShowS
UpdateDevicePoolResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDevicePoolResponse] -> ShowS
$cshowList :: [UpdateDevicePoolResponse] -> ShowS
show :: UpdateDevicePoolResponse -> String
$cshow :: UpdateDevicePoolResponse -> String
showsPrec :: Int -> UpdateDevicePoolResponse -> ShowS
$cshowsPrec :: Int -> UpdateDevicePoolResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDevicePoolResponse x -> UpdateDevicePoolResponse
forall x.
UpdateDevicePoolResponse -> Rep UpdateDevicePoolResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDevicePoolResponse x -> UpdateDevicePoolResponse
$cfrom :: forall x.
UpdateDevicePoolResponse -> Rep UpdateDevicePoolResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDevicePoolResponse' 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:
--
-- 'devicePool', 'updateDevicePoolResponse_devicePool' - The device pool you just updated.
--
-- 'httpStatus', 'updateDevicePoolResponse_httpStatus' - The response's http status code.
newUpdateDevicePoolResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDevicePoolResponse
newUpdateDevicePoolResponse :: Int -> UpdateDevicePoolResponse
newUpdateDevicePoolResponse Int
pHttpStatus_ =
  UpdateDevicePoolResponse'
    { $sel:devicePool:UpdateDevicePoolResponse' :: Maybe DevicePool
devicePool =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDevicePoolResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The device pool you just updated.
updateDevicePoolResponse_devicePool :: Lens.Lens' UpdateDevicePoolResponse (Prelude.Maybe DevicePool)
updateDevicePoolResponse_devicePool :: Lens' UpdateDevicePoolResponse (Maybe DevicePool)
updateDevicePoolResponse_devicePool = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevicePoolResponse' {Maybe DevicePool
devicePool :: Maybe DevicePool
$sel:devicePool:UpdateDevicePoolResponse' :: UpdateDevicePoolResponse -> Maybe DevicePool
devicePool} -> Maybe DevicePool
devicePool) (\s :: UpdateDevicePoolResponse
s@UpdateDevicePoolResponse' {} Maybe DevicePool
a -> UpdateDevicePoolResponse
s {$sel:devicePool:UpdateDevicePoolResponse' :: Maybe DevicePool
devicePool = Maybe DevicePool
a} :: UpdateDevicePoolResponse)

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

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