{-# 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.IoTWireless.UpdateWirelessDevice
-- 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 properties of a wireless device.
module Amazonka.IoTWireless.UpdateWirelessDevice
  ( -- * Creating a Request
    UpdateWirelessDevice (..),
    newUpdateWirelessDevice,

    -- * Request Lenses
    updateWirelessDevice_description,
    updateWirelessDevice_destinationName,
    updateWirelessDevice_loRaWAN,
    updateWirelessDevice_name,
    updateWirelessDevice_positioning,
    updateWirelessDevice_id,

    -- * Destructuring the Response
    UpdateWirelessDeviceResponse (..),
    newUpdateWirelessDeviceResponse,

    -- * Response Lenses
    updateWirelessDeviceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateWirelessDevice' smart constructor.
data UpdateWirelessDevice = UpdateWirelessDevice'
  { -- | A new description of the resource.
    UpdateWirelessDevice -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the new destination for the device.
    UpdateWirelessDevice -> Maybe Text
destinationName :: Prelude.Maybe Prelude.Text,
    -- | The updated wireless device\'s configuration.
    UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
loRaWAN :: Prelude.Maybe LoRaWANUpdateDevice,
    -- | The new name of the resource.
    UpdateWirelessDevice -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | FPort values for the GNSS, stream, and ClockSync functions of the
    -- positioning information.
    UpdateWirelessDevice -> Maybe PositioningConfigStatus
positioning :: Prelude.Maybe PositioningConfigStatus,
    -- | The ID of the resource to update.
    UpdateWirelessDevice -> Text
id :: Prelude.Text
  }
  deriving (UpdateWirelessDevice -> UpdateWirelessDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWirelessDevice -> UpdateWirelessDevice -> Bool
$c/= :: UpdateWirelessDevice -> UpdateWirelessDevice -> Bool
== :: UpdateWirelessDevice -> UpdateWirelessDevice -> Bool
$c== :: UpdateWirelessDevice -> UpdateWirelessDevice -> Bool
Prelude.Eq, ReadPrec [UpdateWirelessDevice]
ReadPrec UpdateWirelessDevice
Int -> ReadS UpdateWirelessDevice
ReadS [UpdateWirelessDevice]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWirelessDevice]
$creadListPrec :: ReadPrec [UpdateWirelessDevice]
readPrec :: ReadPrec UpdateWirelessDevice
$creadPrec :: ReadPrec UpdateWirelessDevice
readList :: ReadS [UpdateWirelessDevice]
$creadList :: ReadS [UpdateWirelessDevice]
readsPrec :: Int -> ReadS UpdateWirelessDevice
$creadsPrec :: Int -> ReadS UpdateWirelessDevice
Prelude.Read, Int -> UpdateWirelessDevice -> ShowS
[UpdateWirelessDevice] -> ShowS
UpdateWirelessDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWirelessDevice] -> ShowS
$cshowList :: [UpdateWirelessDevice] -> ShowS
show :: UpdateWirelessDevice -> String
$cshow :: UpdateWirelessDevice -> String
showsPrec :: Int -> UpdateWirelessDevice -> ShowS
$cshowsPrec :: Int -> UpdateWirelessDevice -> ShowS
Prelude.Show, forall x. Rep UpdateWirelessDevice x -> UpdateWirelessDevice
forall x. UpdateWirelessDevice -> Rep UpdateWirelessDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWirelessDevice x -> UpdateWirelessDevice
$cfrom :: forall x. UpdateWirelessDevice -> Rep UpdateWirelessDevice x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWirelessDevice' 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:
--
-- 'description', 'updateWirelessDevice_description' - A new description of the resource.
--
-- 'destinationName', 'updateWirelessDevice_destinationName' - The name of the new destination for the device.
--
-- 'loRaWAN', 'updateWirelessDevice_loRaWAN' - The updated wireless device\'s configuration.
--
-- 'name', 'updateWirelessDevice_name' - The new name of the resource.
--
-- 'positioning', 'updateWirelessDevice_positioning' - FPort values for the GNSS, stream, and ClockSync functions of the
-- positioning information.
--
-- 'id', 'updateWirelessDevice_id' - The ID of the resource to update.
newUpdateWirelessDevice ::
  -- | 'id'
  Prelude.Text ->
  UpdateWirelessDevice
newUpdateWirelessDevice :: Text -> UpdateWirelessDevice
newUpdateWirelessDevice Text
pId_ =
  UpdateWirelessDevice'
    { $sel:description:UpdateWirelessDevice' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinationName:UpdateWirelessDevice' :: Maybe Text
destinationName = forall a. Maybe a
Prelude.Nothing,
      $sel:loRaWAN:UpdateWirelessDevice' :: Maybe LoRaWANUpdateDevice
loRaWAN = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateWirelessDevice' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:positioning:UpdateWirelessDevice' :: Maybe PositioningConfigStatus
positioning = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateWirelessDevice' :: Text
id = Text
pId_
    }

-- | A new description of the resource.
updateWirelessDevice_description :: Lens.Lens' UpdateWirelessDevice (Prelude.Maybe Prelude.Text)
updateWirelessDevice_description :: Lens' UpdateWirelessDevice (Maybe Text)
updateWirelessDevice_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Maybe Text
description :: Maybe Text
$sel:description:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Maybe Text
a -> UpdateWirelessDevice
s {$sel:description:UpdateWirelessDevice' :: Maybe Text
description = Maybe Text
a} :: UpdateWirelessDevice)

-- | The name of the new destination for the device.
updateWirelessDevice_destinationName :: Lens.Lens' UpdateWirelessDevice (Prelude.Maybe Prelude.Text)
updateWirelessDevice_destinationName :: Lens' UpdateWirelessDevice (Maybe Text)
updateWirelessDevice_destinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Maybe Text
destinationName :: Maybe Text
$sel:destinationName:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
destinationName} -> Maybe Text
destinationName) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Maybe Text
a -> UpdateWirelessDevice
s {$sel:destinationName:UpdateWirelessDevice' :: Maybe Text
destinationName = Maybe Text
a} :: UpdateWirelessDevice)

-- | The updated wireless device\'s configuration.
updateWirelessDevice_loRaWAN :: Lens.Lens' UpdateWirelessDevice (Prelude.Maybe LoRaWANUpdateDevice)
updateWirelessDevice_loRaWAN :: Lens' UpdateWirelessDevice (Maybe LoRaWANUpdateDevice)
updateWirelessDevice_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Maybe LoRaWANUpdateDevice
loRaWAN :: Maybe LoRaWANUpdateDevice
$sel:loRaWAN:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
loRaWAN} -> Maybe LoRaWANUpdateDevice
loRaWAN) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Maybe LoRaWANUpdateDevice
a -> UpdateWirelessDevice
s {$sel:loRaWAN:UpdateWirelessDevice' :: Maybe LoRaWANUpdateDevice
loRaWAN = Maybe LoRaWANUpdateDevice
a} :: UpdateWirelessDevice)

-- | The new name of the resource.
updateWirelessDevice_name :: Lens.Lens' UpdateWirelessDevice (Prelude.Maybe Prelude.Text)
updateWirelessDevice_name :: Lens' UpdateWirelessDevice (Maybe Text)
updateWirelessDevice_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Maybe Text
name :: Maybe Text
$sel:name:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Maybe Text
a -> UpdateWirelessDevice
s {$sel:name:UpdateWirelessDevice' :: Maybe Text
name = Maybe Text
a} :: UpdateWirelessDevice)

-- | FPort values for the GNSS, stream, and ClockSync functions of the
-- positioning information.
updateWirelessDevice_positioning :: Lens.Lens' UpdateWirelessDevice (Prelude.Maybe PositioningConfigStatus)
updateWirelessDevice_positioning :: Lens' UpdateWirelessDevice (Maybe PositioningConfigStatus)
updateWirelessDevice_positioning = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Maybe PositioningConfigStatus
positioning :: Maybe PositioningConfigStatus
$sel:positioning:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe PositioningConfigStatus
positioning} -> Maybe PositioningConfigStatus
positioning) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Maybe PositioningConfigStatus
a -> UpdateWirelessDevice
s {$sel:positioning:UpdateWirelessDevice' :: Maybe PositioningConfigStatus
positioning = Maybe PositioningConfigStatus
a} :: UpdateWirelessDevice)

-- | The ID of the resource to update.
updateWirelessDevice_id :: Lens.Lens' UpdateWirelessDevice Prelude.Text
updateWirelessDevice_id :: Lens' UpdateWirelessDevice Text
updateWirelessDevice_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWirelessDevice' {Text
id :: Text
$sel:id:UpdateWirelessDevice' :: UpdateWirelessDevice -> Text
id} -> Text
id) (\s :: UpdateWirelessDevice
s@UpdateWirelessDevice' {} Text
a -> UpdateWirelessDevice
s {$sel:id:UpdateWirelessDevice' :: Text
id = Text
a} :: UpdateWirelessDevice)

instance Core.AWSRequest UpdateWirelessDevice where
  type
    AWSResponse UpdateWirelessDevice =
      UpdateWirelessDeviceResponse
  request :: (Service -> Service)
-> UpdateWirelessDevice -> Request UpdateWirelessDevice
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 UpdateWirelessDevice
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateWirelessDevice)))
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 -> UpdateWirelessDeviceResponse
UpdateWirelessDeviceResponse'
            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 UpdateWirelessDevice where
  hashWithSalt :: Int -> UpdateWirelessDevice -> Int
hashWithSalt Int
_salt UpdateWirelessDevice' {Maybe Text
Maybe PositioningConfigStatus
Maybe LoRaWANUpdateDevice
Text
id :: Text
positioning :: Maybe PositioningConfigStatus
name :: Maybe Text
loRaWAN :: Maybe LoRaWANUpdateDevice
destinationName :: Maybe Text
description :: Maybe Text
$sel:id:UpdateWirelessDevice' :: UpdateWirelessDevice -> Text
$sel:positioning:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe PositioningConfigStatus
$sel:name:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:loRaWAN:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
$sel:destinationName:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:description:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoRaWANUpdateDevice
loRaWAN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PositioningConfigStatus
positioning
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateWirelessDevice where
  rnf :: UpdateWirelessDevice -> ()
rnf UpdateWirelessDevice' {Maybe Text
Maybe PositioningConfigStatus
Maybe LoRaWANUpdateDevice
Text
id :: Text
positioning :: Maybe PositioningConfigStatus
name :: Maybe Text
loRaWAN :: Maybe LoRaWANUpdateDevice
destinationName :: Maybe Text
description :: Maybe Text
$sel:id:UpdateWirelessDevice' :: UpdateWirelessDevice -> Text
$sel:positioning:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe PositioningConfigStatus
$sel:name:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:loRaWAN:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
$sel:destinationName:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:description:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
..} =
    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 Text
destinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoRaWANUpdateDevice
loRaWAN
      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 PositioningConfigStatus
positioning
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

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

instance Data.ToJSON UpdateWirelessDevice where
  toJSON :: UpdateWirelessDevice -> Value
toJSON UpdateWirelessDevice' {Maybe Text
Maybe PositioningConfigStatus
Maybe LoRaWANUpdateDevice
Text
id :: Text
positioning :: Maybe PositioningConfigStatus
name :: Maybe Text
loRaWAN :: Maybe LoRaWANUpdateDevice
destinationName :: Maybe Text
description :: Maybe Text
$sel:id:UpdateWirelessDevice' :: UpdateWirelessDevice -> Text
$sel:positioning:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe PositioningConfigStatus
$sel:name:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:loRaWAN:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
$sel:destinationName:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:description:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"DestinationName" 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
destinationName,
            (Key
"LoRaWAN" 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 LoRaWANUpdateDevice
loRaWAN,
            (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
"Positioning" 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 PositioningConfigStatus
positioning
          ]
      )

instance Data.ToPath UpdateWirelessDevice where
  toPath :: UpdateWirelessDevice -> ByteString
toPath UpdateWirelessDevice' {Maybe Text
Maybe PositioningConfigStatus
Maybe LoRaWANUpdateDevice
Text
id :: Text
positioning :: Maybe PositioningConfigStatus
name :: Maybe Text
loRaWAN :: Maybe LoRaWANUpdateDevice
destinationName :: Maybe Text
description :: Maybe Text
$sel:id:UpdateWirelessDevice' :: UpdateWirelessDevice -> Text
$sel:positioning:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe PositioningConfigStatus
$sel:name:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:loRaWAN:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe LoRaWANUpdateDevice
$sel:destinationName:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
$sel:description:UpdateWirelessDevice' :: UpdateWirelessDevice -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/wireless-devices/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
id]

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

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

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

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

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