{-# 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.NetworkManager.UpdateDevice
-- 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 details for an existing device. To remove information for
-- any of the parameters, specify an empty string.
module Amazonka.NetworkManager.UpdateDevice
  ( -- * Creating a Request
    UpdateDevice (..),
    newUpdateDevice,

    -- * Request Lenses
    updateDevice_aWSLocation,
    updateDevice_description,
    updateDevice_location,
    updateDevice_model,
    updateDevice_serialNumber,
    updateDevice_siteId,
    updateDevice_type,
    updateDevice_vendor,
    updateDevice_globalNetworkId,
    updateDevice_deviceId,

    -- * Destructuring the Response
    UpdateDeviceResponse (..),
    newUpdateDeviceResponse,

    -- * Response Lenses
    updateDeviceResponse_device,
    updateDeviceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDevice' smart constructor.
data UpdateDevice = UpdateDevice'
  { -- | The Amazon Web Services location of the device, if applicable. For an
    -- on-premises device, you can omit this parameter.
    UpdateDevice -> Maybe AWSLocation
aWSLocation :: Prelude.Maybe AWSLocation,
    -- | A description of the device.
    --
    -- Constraints: Maximum length of 256 characters.
    UpdateDevice -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    UpdateDevice -> Maybe (Sensitive Location)
location :: Prelude.Maybe (Data.Sensitive Location),
    -- | The model of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    UpdateDevice -> Maybe Text
model :: Prelude.Maybe Prelude.Text,
    -- | The serial number of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    UpdateDevice -> Maybe Text
serialNumber :: Prelude.Maybe Prelude.Text,
    -- | The ID of the site.
    UpdateDevice -> Maybe Text
siteId :: Prelude.Maybe Prelude.Text,
    -- | The type of the device.
    UpdateDevice -> Maybe Text
type' :: Prelude.Maybe Prelude.Text,
    -- | The vendor of the device.
    --
    -- Constraints: Maximum length of 128 characters.
    UpdateDevice -> Maybe Text
vendor :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    UpdateDevice -> Text
globalNetworkId :: Prelude.Text,
    -- | The ID of the device.
    UpdateDevice -> Text
deviceId :: Prelude.Text
  }
  deriving (UpdateDevice -> UpdateDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDevice -> UpdateDevice -> Bool
$c/= :: UpdateDevice -> UpdateDevice -> Bool
== :: UpdateDevice -> UpdateDevice -> Bool
$c== :: UpdateDevice -> UpdateDevice -> Bool
Prelude.Eq, Int -> UpdateDevice -> ShowS
[UpdateDevice] -> ShowS
UpdateDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDevice] -> ShowS
$cshowList :: [UpdateDevice] -> ShowS
show :: UpdateDevice -> String
$cshow :: UpdateDevice -> String
showsPrec :: Int -> UpdateDevice -> ShowS
$cshowsPrec :: Int -> UpdateDevice -> ShowS
Prelude.Show, forall x. Rep UpdateDevice x -> UpdateDevice
forall x. UpdateDevice -> Rep UpdateDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDevice x -> UpdateDevice
$cfrom :: forall x. UpdateDevice -> Rep UpdateDevice x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDevice' 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:
--
-- 'aWSLocation', 'updateDevice_aWSLocation' - The Amazon Web Services location of the device, if applicable. For an
-- on-premises device, you can omit this parameter.
--
-- 'description', 'updateDevice_description' - A description of the device.
--
-- Constraints: Maximum length of 256 characters.
--
-- 'location', 'updateDevice_location' - Undocumented member.
--
-- 'model', 'updateDevice_model' - The model of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'serialNumber', 'updateDevice_serialNumber' - The serial number of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'siteId', 'updateDevice_siteId' - The ID of the site.
--
-- 'type'', 'updateDevice_type' - The type of the device.
--
-- 'vendor', 'updateDevice_vendor' - The vendor of the device.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'globalNetworkId', 'updateDevice_globalNetworkId' - The ID of the global network.
--
-- 'deviceId', 'updateDevice_deviceId' - The ID of the device.
newUpdateDevice ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'deviceId'
  Prelude.Text ->
  UpdateDevice
newUpdateDevice :: Text -> Text -> UpdateDevice
newUpdateDevice Text
pGlobalNetworkId_ Text
pDeviceId_ =
  UpdateDevice'
    { $sel:aWSLocation:UpdateDevice' :: Maybe AWSLocation
aWSLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateDevice' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:location:UpdateDevice' :: Maybe (Sensitive Location)
location = forall a. Maybe a
Prelude.Nothing,
      $sel:model:UpdateDevice' :: Maybe Text
model = forall a. Maybe a
Prelude.Nothing,
      $sel:serialNumber:UpdateDevice' :: Maybe Text
serialNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:siteId:UpdateDevice' :: Maybe Text
siteId = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateDevice' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vendor:UpdateDevice' :: Maybe Text
vendor = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:UpdateDevice' :: Text
globalNetworkId = Text
pGlobalNetworkId_,
      $sel:deviceId:UpdateDevice' :: Text
deviceId = Text
pDeviceId_
    }

-- | The Amazon Web Services location of the device, if applicable. For an
-- on-premises device, you can omit this parameter.
updateDevice_aWSLocation :: Lens.Lens' UpdateDevice (Prelude.Maybe AWSLocation)
updateDevice_aWSLocation :: Lens' UpdateDevice (Maybe AWSLocation)
updateDevice_aWSLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe AWSLocation
aWSLocation :: Maybe AWSLocation
$sel:aWSLocation:UpdateDevice' :: UpdateDevice -> Maybe AWSLocation
aWSLocation} -> Maybe AWSLocation
aWSLocation) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe AWSLocation
a -> UpdateDevice
s {$sel:aWSLocation:UpdateDevice' :: Maybe AWSLocation
aWSLocation = Maybe AWSLocation
a} :: UpdateDevice)

-- | A description of the device.
--
-- Constraints: Maximum length of 256 characters.
updateDevice_description :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_description :: Lens' UpdateDevice (Maybe Text)
updateDevice_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDevice' :: UpdateDevice -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:description:UpdateDevice' :: Maybe Text
description = Maybe Text
a} :: UpdateDevice)

-- | Undocumented member.
updateDevice_location :: Lens.Lens' UpdateDevice (Prelude.Maybe Location)
updateDevice_location :: Lens' UpdateDevice (Maybe Location)
updateDevice_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe (Sensitive Location)
location :: Maybe (Sensitive Location)
$sel:location:UpdateDevice' :: UpdateDevice -> Maybe (Sensitive Location)
location} -> Maybe (Sensitive Location)
location) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe (Sensitive Location)
a -> UpdateDevice
s {$sel:location:UpdateDevice' :: Maybe (Sensitive Location)
location = Maybe (Sensitive Location)
a} :: UpdateDevice) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | The model of the device.
--
-- Constraints: Maximum length of 128 characters.
updateDevice_model :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_model :: Lens' UpdateDevice (Maybe Text)
updateDevice_model = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
model :: Maybe Text
$sel:model:UpdateDevice' :: UpdateDevice -> Maybe Text
model} -> Maybe Text
model) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:model:UpdateDevice' :: Maybe Text
model = Maybe Text
a} :: UpdateDevice)

-- | The serial number of the device.
--
-- Constraints: Maximum length of 128 characters.
updateDevice_serialNumber :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_serialNumber :: Lens' UpdateDevice (Maybe Text)
updateDevice_serialNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
serialNumber :: Maybe Text
$sel:serialNumber:UpdateDevice' :: UpdateDevice -> Maybe Text
serialNumber} -> Maybe Text
serialNumber) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:serialNumber:UpdateDevice' :: Maybe Text
serialNumber = Maybe Text
a} :: UpdateDevice)

-- | The ID of the site.
updateDevice_siteId :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_siteId :: Lens' UpdateDevice (Maybe Text)
updateDevice_siteId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
siteId :: Maybe Text
$sel:siteId:UpdateDevice' :: UpdateDevice -> Maybe Text
siteId} -> Maybe Text
siteId) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:siteId:UpdateDevice' :: Maybe Text
siteId = Maybe Text
a} :: UpdateDevice)

-- | The type of the device.
updateDevice_type :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_type :: Lens' UpdateDevice (Maybe Text)
updateDevice_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
type' :: Maybe Text
$sel:type':UpdateDevice' :: UpdateDevice -> Maybe Text
type'} -> Maybe Text
type') (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:type':UpdateDevice' :: Maybe Text
type' = Maybe Text
a} :: UpdateDevice)

-- | The vendor of the device.
--
-- Constraints: Maximum length of 128 characters.
updateDevice_vendor :: Lens.Lens' UpdateDevice (Prelude.Maybe Prelude.Text)
updateDevice_vendor :: Lens' UpdateDevice (Maybe Text)
updateDevice_vendor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Maybe Text
vendor :: Maybe Text
$sel:vendor:UpdateDevice' :: UpdateDevice -> Maybe Text
vendor} -> Maybe Text
vendor) (\s :: UpdateDevice
s@UpdateDevice' {} Maybe Text
a -> UpdateDevice
s {$sel:vendor:UpdateDevice' :: Maybe Text
vendor = Maybe Text
a} :: UpdateDevice)

-- | The ID of the global network.
updateDevice_globalNetworkId :: Lens.Lens' UpdateDevice Prelude.Text
updateDevice_globalNetworkId :: Lens' UpdateDevice Text
updateDevice_globalNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Text
globalNetworkId :: Text
$sel:globalNetworkId:UpdateDevice' :: UpdateDevice -> Text
globalNetworkId} -> Text
globalNetworkId) (\s :: UpdateDevice
s@UpdateDevice' {} Text
a -> UpdateDevice
s {$sel:globalNetworkId:UpdateDevice' :: Text
globalNetworkId = Text
a} :: UpdateDevice)

-- | The ID of the device.
updateDevice_deviceId :: Lens.Lens' UpdateDevice Prelude.Text
updateDevice_deviceId :: Lens' UpdateDevice Text
updateDevice_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevice' {Text
deviceId :: Text
$sel:deviceId:UpdateDevice' :: UpdateDevice -> Text
deviceId} -> Text
deviceId) (\s :: UpdateDevice
s@UpdateDevice' {} Text
a -> UpdateDevice
s {$sel:deviceId:UpdateDevice' :: Text
deviceId = Text
a} :: UpdateDevice)

instance Core.AWSRequest UpdateDevice where
  type AWSResponse UpdateDevice = UpdateDeviceResponse
  request :: (Service -> Service) -> UpdateDevice -> Request UpdateDevice
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDevice)))
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 Device -> Int -> UpdateDeviceResponse
UpdateDeviceResponse'
            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
"Device")
            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 UpdateDevice where
  hashWithSalt :: Int -> UpdateDevice -> Int
hashWithSalt Int
_salt UpdateDevice' {Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
deviceId :: Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:deviceId:UpdateDevice' :: UpdateDevice -> Text
$sel:globalNetworkId:UpdateDevice' :: UpdateDevice -> Text
$sel:vendor:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:type':UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:siteId:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:serialNumber:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:model:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:location:UpdateDevice' :: UpdateDevice -> Maybe (Sensitive Location)
$sel:description:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:aWSLocation:UpdateDevice' :: UpdateDevice -> Maybe AWSLocation
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AWSLocation
aWSLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Location)
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
model
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serialNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
siteId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vendor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalNetworkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId

instance Prelude.NFData UpdateDevice where
  rnf :: UpdateDevice -> ()
rnf UpdateDevice' {Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
deviceId :: Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:deviceId:UpdateDevice' :: UpdateDevice -> Text
$sel:globalNetworkId:UpdateDevice' :: UpdateDevice -> Text
$sel:vendor:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:type':UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:siteId:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:serialNumber:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:model:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:location:UpdateDevice' :: UpdateDevice -> Maybe (Sensitive Location)
$sel:description:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:aWSLocation:UpdateDevice' :: UpdateDevice -> Maybe AWSLocation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AWSLocation
aWSLocation
      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 (Sensitive Location)
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
model
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serialNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
siteId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vendor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
globalNetworkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId

instance Data.ToHeaders UpdateDevice where
  toHeaders :: UpdateDevice -> 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 UpdateDevice where
  toJSON :: UpdateDevice -> Value
toJSON UpdateDevice' {Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
deviceId :: Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:deviceId:UpdateDevice' :: UpdateDevice -> Text
$sel:globalNetworkId:UpdateDevice' :: UpdateDevice -> Text
$sel:vendor:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:type':UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:siteId:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:serialNumber:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:model:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:location:UpdateDevice' :: UpdateDevice -> Maybe (Sensitive Location)
$sel:description:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:aWSLocation:UpdateDevice' :: UpdateDevice -> Maybe AWSLocation
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AWSLocation" 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 AWSLocation
aWSLocation,
            (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
"Location" 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 (Sensitive Location)
location,
            (Key
"Model" 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
model,
            (Key
"SerialNumber" 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
serialNumber,
            (Key
"SiteId" 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
siteId,
            (Key
"Type" 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
type',
            (Key
"Vendor" 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
vendor
          ]
      )

instance Data.ToPath UpdateDevice where
  toPath :: UpdateDevice -> ByteString
toPath UpdateDevice' {Maybe Text
Maybe (Sensitive Location)
Maybe AWSLocation
Text
deviceId :: Text
globalNetworkId :: Text
vendor :: Maybe Text
type' :: Maybe Text
siteId :: Maybe Text
serialNumber :: Maybe Text
model :: Maybe Text
location :: Maybe (Sensitive Location)
description :: Maybe Text
aWSLocation :: Maybe AWSLocation
$sel:deviceId:UpdateDevice' :: UpdateDevice -> Text
$sel:globalNetworkId:UpdateDevice' :: UpdateDevice -> Text
$sel:vendor:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:type':UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:siteId:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:serialNumber:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:model:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:location:UpdateDevice' :: UpdateDevice -> Maybe (Sensitive Location)
$sel:description:UpdateDevice' :: UpdateDevice -> Maybe Text
$sel:aWSLocation:UpdateDevice' :: UpdateDevice -> Maybe AWSLocation
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/devices/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceId
      ]

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

-- | /See:/ 'newUpdateDeviceResponse' smart constructor.
data UpdateDeviceResponse = UpdateDeviceResponse'
  { -- | Information about the device.
    UpdateDeviceResponse -> Maybe Device
device :: Prelude.Maybe Device,
    -- | The response's http status code.
    UpdateDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateDeviceResponse -> UpdateDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDeviceResponse -> UpdateDeviceResponse -> Bool
$c/= :: UpdateDeviceResponse -> UpdateDeviceResponse -> Bool
== :: UpdateDeviceResponse -> UpdateDeviceResponse -> Bool
$c== :: UpdateDeviceResponse -> UpdateDeviceResponse -> Bool
Prelude.Eq, Int -> UpdateDeviceResponse -> ShowS
[UpdateDeviceResponse] -> ShowS
UpdateDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDeviceResponse] -> ShowS
$cshowList :: [UpdateDeviceResponse] -> ShowS
show :: UpdateDeviceResponse -> String
$cshow :: UpdateDeviceResponse -> String
showsPrec :: Int -> UpdateDeviceResponse -> ShowS
$cshowsPrec :: Int -> UpdateDeviceResponse -> ShowS
Prelude.Show, forall x. Rep UpdateDeviceResponse x -> UpdateDeviceResponse
forall x. UpdateDeviceResponse -> Rep UpdateDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDeviceResponse x -> UpdateDeviceResponse
$cfrom :: forall x. UpdateDeviceResponse -> Rep UpdateDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDeviceResponse' 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:
--
-- 'device', 'updateDeviceResponse_device' - Information about the device.
--
-- 'httpStatus', 'updateDeviceResponse_httpStatus' - The response's http status code.
newUpdateDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDeviceResponse
newUpdateDeviceResponse :: Int -> UpdateDeviceResponse
newUpdateDeviceResponse Int
pHttpStatus_ =
  UpdateDeviceResponse'
    { $sel:device:UpdateDeviceResponse' :: Maybe Device
device = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the device.
updateDeviceResponse_device :: Lens.Lens' UpdateDeviceResponse (Prelude.Maybe Device)
updateDeviceResponse_device :: Lens' UpdateDeviceResponse (Maybe Device)
updateDeviceResponse_device = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDeviceResponse' {Maybe Device
device :: Maybe Device
$sel:device:UpdateDeviceResponse' :: UpdateDeviceResponse -> Maybe Device
device} -> Maybe Device
device) (\s :: UpdateDeviceResponse
s@UpdateDeviceResponse' {} Maybe Device
a -> UpdateDeviceResponse
s {$sel:device:UpdateDeviceResponse' :: Maybe Device
device = Maybe Device
a} :: UpdateDeviceResponse)

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

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