{-# 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.GetWirelessDevice
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a wireless device.
module Amazonka.IoTWireless.GetWirelessDevice
  ( -- * Creating a Request
    GetWirelessDevice (..),
    newGetWirelessDevice,

    -- * Request Lenses
    getWirelessDevice_identifier,
    getWirelessDevice_identifierType,

    -- * Destructuring the Response
    GetWirelessDeviceResponse (..),
    newGetWirelessDeviceResponse,

    -- * Response Lenses
    getWirelessDeviceResponse_arn,
    getWirelessDeviceResponse_description,
    getWirelessDeviceResponse_destinationName,
    getWirelessDeviceResponse_id,
    getWirelessDeviceResponse_loRaWAN,
    getWirelessDeviceResponse_name,
    getWirelessDeviceResponse_positioning,
    getWirelessDeviceResponse_sidewalk,
    getWirelessDeviceResponse_thingArn,
    getWirelessDeviceResponse_thingName,
    getWirelessDeviceResponse_type,
    getWirelessDeviceResponse_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:/ 'newGetWirelessDevice' smart constructor.
data GetWirelessDevice = GetWirelessDevice'
  { -- | The identifier of the wireless device to get.
    GetWirelessDevice -> Text
identifier :: Prelude.Text,
    -- | The type of identifier used in @identifier@.
    GetWirelessDevice -> WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
  }
  deriving (GetWirelessDevice -> GetWirelessDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWirelessDevice -> GetWirelessDevice -> Bool
$c/= :: GetWirelessDevice -> GetWirelessDevice -> Bool
== :: GetWirelessDevice -> GetWirelessDevice -> Bool
$c== :: GetWirelessDevice -> GetWirelessDevice -> Bool
Prelude.Eq, ReadPrec [GetWirelessDevice]
ReadPrec GetWirelessDevice
Int -> ReadS GetWirelessDevice
ReadS [GetWirelessDevice]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWirelessDevice]
$creadListPrec :: ReadPrec [GetWirelessDevice]
readPrec :: ReadPrec GetWirelessDevice
$creadPrec :: ReadPrec GetWirelessDevice
readList :: ReadS [GetWirelessDevice]
$creadList :: ReadS [GetWirelessDevice]
readsPrec :: Int -> ReadS GetWirelessDevice
$creadsPrec :: Int -> ReadS GetWirelessDevice
Prelude.Read, Int -> GetWirelessDevice -> ShowS
[GetWirelessDevice] -> ShowS
GetWirelessDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWirelessDevice] -> ShowS
$cshowList :: [GetWirelessDevice] -> ShowS
show :: GetWirelessDevice -> String
$cshow :: GetWirelessDevice -> String
showsPrec :: Int -> GetWirelessDevice -> ShowS
$cshowsPrec :: Int -> GetWirelessDevice -> ShowS
Prelude.Show, forall x. Rep GetWirelessDevice x -> GetWirelessDevice
forall x. GetWirelessDevice -> Rep GetWirelessDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWirelessDevice x -> GetWirelessDevice
$cfrom :: forall x. GetWirelessDevice -> Rep GetWirelessDevice x
Prelude.Generic)

-- |
-- Create a value of 'GetWirelessDevice' 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:
--
-- 'identifier', 'getWirelessDevice_identifier' - The identifier of the wireless device to get.
--
-- 'identifierType', 'getWirelessDevice_identifierType' - The type of identifier used in @identifier@.
newGetWirelessDevice ::
  -- | 'identifier'
  Prelude.Text ->
  -- | 'identifierType'
  WirelessDeviceIdType ->
  GetWirelessDevice
newGetWirelessDevice :: Text -> WirelessDeviceIdType -> GetWirelessDevice
newGetWirelessDevice Text
pIdentifier_ WirelessDeviceIdType
pIdentifierType_ =
  GetWirelessDevice'
    { $sel:identifier:GetWirelessDevice' :: Text
identifier = Text
pIdentifier_,
      $sel:identifierType:GetWirelessDevice' :: WirelessDeviceIdType
identifierType = WirelessDeviceIdType
pIdentifierType_
    }

-- | The identifier of the wireless device to get.
getWirelessDevice_identifier :: Lens.Lens' GetWirelessDevice Prelude.Text
getWirelessDevice_identifier :: Lens' GetWirelessDevice Text
getWirelessDevice_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDevice' {Text
identifier :: Text
$sel:identifier:GetWirelessDevice' :: GetWirelessDevice -> Text
identifier} -> Text
identifier) (\s :: GetWirelessDevice
s@GetWirelessDevice' {} Text
a -> GetWirelessDevice
s {$sel:identifier:GetWirelessDevice' :: Text
identifier = Text
a} :: GetWirelessDevice)

-- | The type of identifier used in @identifier@.
getWirelessDevice_identifierType :: Lens.Lens' GetWirelessDevice WirelessDeviceIdType
getWirelessDevice_identifierType :: Lens' GetWirelessDevice WirelessDeviceIdType
getWirelessDevice_identifierType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDevice' {WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
$sel:identifierType:GetWirelessDevice' :: GetWirelessDevice -> WirelessDeviceIdType
identifierType} -> WirelessDeviceIdType
identifierType) (\s :: GetWirelessDevice
s@GetWirelessDevice' {} WirelessDeviceIdType
a -> GetWirelessDevice
s {$sel:identifierType:GetWirelessDevice' :: WirelessDeviceIdType
identifierType = WirelessDeviceIdType
a} :: GetWirelessDevice)

instance Core.AWSRequest GetWirelessDevice where
  type
    AWSResponse GetWirelessDevice =
      GetWirelessDeviceResponse
  request :: (Service -> Service)
-> GetWirelessDevice -> Request GetWirelessDevice
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetWirelessDevice
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetWirelessDevice)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe LoRaWANDevice
-> Maybe Text
-> Maybe PositioningConfigStatus
-> Maybe SidewalkDevice
-> Maybe Text
-> Maybe Text
-> Maybe WirelessDeviceType
-> Int
-> GetWirelessDeviceResponse
GetWirelessDeviceResponse'
            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
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DestinationName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LoRaWAN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Positioning")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Sidewalk")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ThingArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ThingName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Type")
            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 GetWirelessDevice where
  hashWithSalt :: Int -> GetWirelessDevice -> Int
hashWithSalt Int
_salt GetWirelessDevice' {Text
WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
identifier :: Text
$sel:identifierType:GetWirelessDevice' :: GetWirelessDevice -> WirelessDeviceIdType
$sel:identifier:GetWirelessDevice' :: GetWirelessDevice -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
identifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` WirelessDeviceIdType
identifierType

instance Prelude.NFData GetWirelessDevice where
  rnf :: GetWirelessDevice -> ()
rnf GetWirelessDevice' {Text
WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
identifier :: Text
$sel:identifierType:GetWirelessDevice' :: GetWirelessDevice -> WirelessDeviceIdType
$sel:identifier:GetWirelessDevice' :: GetWirelessDevice -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf WirelessDeviceIdType
identifierType

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

instance Data.ToPath GetWirelessDevice where
  toPath :: GetWirelessDevice -> ByteString
toPath GetWirelessDevice' {Text
WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
identifier :: Text
$sel:identifierType:GetWirelessDevice' :: GetWirelessDevice -> WirelessDeviceIdType
$sel:identifier:GetWirelessDevice' :: GetWirelessDevice -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/wireless-devices/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
identifier]

instance Data.ToQuery GetWirelessDevice where
  toQuery :: GetWirelessDevice -> QueryString
toQuery GetWirelessDevice' {Text
WirelessDeviceIdType
identifierType :: WirelessDeviceIdType
identifier :: Text
$sel:identifierType:GetWirelessDevice' :: GetWirelessDevice -> WirelessDeviceIdType
$sel:identifier:GetWirelessDevice' :: GetWirelessDevice -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"identifierType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: WirelessDeviceIdType
identifierType]

-- | /See:/ 'newGetWirelessDeviceResponse' smart constructor.
data GetWirelessDeviceResponse = GetWirelessDeviceResponse'
  { -- | The Amazon Resource Name of the resource.
    GetWirelessDeviceResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The description of the resource.
    GetWirelessDeviceResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The name of the destination to which the device is assigned.
    GetWirelessDeviceResponse -> Maybe Text
destinationName :: Prelude.Maybe Prelude.Text,
    -- | The ID of the wireless device.
    GetWirelessDeviceResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | Information about the wireless device.
    GetWirelessDeviceResponse -> Maybe LoRaWANDevice
loRaWAN :: Prelude.Maybe LoRaWANDevice,
    -- | The name of the resource.
    GetWirelessDeviceResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | FPort values for the GNSS, stream, and ClockSync functions of the
    -- positioning information.
    GetWirelessDeviceResponse -> Maybe PositioningConfigStatus
positioning :: Prelude.Maybe PositioningConfigStatus,
    -- | Sidewalk device object.
    GetWirelessDeviceResponse -> Maybe SidewalkDevice
sidewalk :: Prelude.Maybe SidewalkDevice,
    -- | The ARN of the thing associated with the wireless device.
    GetWirelessDeviceResponse -> Maybe Text
thingArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing associated with the wireless device. The value is
    -- empty if a thing isn\'t associated with the device.
    GetWirelessDeviceResponse -> Maybe Text
thingName :: Prelude.Maybe Prelude.Text,
    -- | The wireless device type.
    GetWirelessDeviceResponse -> Maybe WirelessDeviceType
type' :: Prelude.Maybe WirelessDeviceType,
    -- | The response's http status code.
    GetWirelessDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetWirelessDeviceResponse -> GetWirelessDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWirelessDeviceResponse -> GetWirelessDeviceResponse -> Bool
$c/= :: GetWirelessDeviceResponse -> GetWirelessDeviceResponse -> Bool
== :: GetWirelessDeviceResponse -> GetWirelessDeviceResponse -> Bool
$c== :: GetWirelessDeviceResponse -> GetWirelessDeviceResponse -> Bool
Prelude.Eq, ReadPrec [GetWirelessDeviceResponse]
ReadPrec GetWirelessDeviceResponse
Int -> ReadS GetWirelessDeviceResponse
ReadS [GetWirelessDeviceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWirelessDeviceResponse]
$creadListPrec :: ReadPrec [GetWirelessDeviceResponse]
readPrec :: ReadPrec GetWirelessDeviceResponse
$creadPrec :: ReadPrec GetWirelessDeviceResponse
readList :: ReadS [GetWirelessDeviceResponse]
$creadList :: ReadS [GetWirelessDeviceResponse]
readsPrec :: Int -> ReadS GetWirelessDeviceResponse
$creadsPrec :: Int -> ReadS GetWirelessDeviceResponse
Prelude.Read, Int -> GetWirelessDeviceResponse -> ShowS
[GetWirelessDeviceResponse] -> ShowS
GetWirelessDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWirelessDeviceResponse] -> ShowS
$cshowList :: [GetWirelessDeviceResponse] -> ShowS
show :: GetWirelessDeviceResponse -> String
$cshow :: GetWirelessDeviceResponse -> String
showsPrec :: Int -> GetWirelessDeviceResponse -> ShowS
$cshowsPrec :: Int -> GetWirelessDeviceResponse -> ShowS
Prelude.Show, forall x.
Rep GetWirelessDeviceResponse x -> GetWirelessDeviceResponse
forall x.
GetWirelessDeviceResponse -> Rep GetWirelessDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetWirelessDeviceResponse x -> GetWirelessDeviceResponse
$cfrom :: forall x.
GetWirelessDeviceResponse -> Rep GetWirelessDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWirelessDeviceResponse' 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:
--
-- 'arn', 'getWirelessDeviceResponse_arn' - The Amazon Resource Name of the resource.
--
-- 'description', 'getWirelessDeviceResponse_description' - The description of the resource.
--
-- 'destinationName', 'getWirelessDeviceResponse_destinationName' - The name of the destination to which the device is assigned.
--
-- 'id', 'getWirelessDeviceResponse_id' - The ID of the wireless device.
--
-- 'loRaWAN', 'getWirelessDeviceResponse_loRaWAN' - Information about the wireless device.
--
-- 'name', 'getWirelessDeviceResponse_name' - The name of the resource.
--
-- 'positioning', 'getWirelessDeviceResponse_positioning' - FPort values for the GNSS, stream, and ClockSync functions of the
-- positioning information.
--
-- 'sidewalk', 'getWirelessDeviceResponse_sidewalk' - Sidewalk device object.
--
-- 'thingArn', 'getWirelessDeviceResponse_thingArn' - The ARN of the thing associated with the wireless device.
--
-- 'thingName', 'getWirelessDeviceResponse_thingName' - The name of the thing associated with the wireless device. The value is
-- empty if a thing isn\'t associated with the device.
--
-- 'type'', 'getWirelessDeviceResponse_type' - The wireless device type.
--
-- 'httpStatus', 'getWirelessDeviceResponse_httpStatus' - The response's http status code.
newGetWirelessDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetWirelessDeviceResponse
newGetWirelessDeviceResponse :: Int -> GetWirelessDeviceResponse
newGetWirelessDeviceResponse Int
pHttpStatus_ =
  GetWirelessDeviceResponse'
    { $sel:arn:GetWirelessDeviceResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetWirelessDeviceResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:destinationName:GetWirelessDeviceResponse' :: Maybe Text
destinationName = forall a. Maybe a
Prelude.Nothing,
      $sel:id:GetWirelessDeviceResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:loRaWAN:GetWirelessDeviceResponse' :: Maybe LoRaWANDevice
loRaWAN = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetWirelessDeviceResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:positioning:GetWirelessDeviceResponse' :: Maybe PositioningConfigStatus
positioning = forall a. Maybe a
Prelude.Nothing,
      $sel:sidewalk:GetWirelessDeviceResponse' :: Maybe SidewalkDevice
sidewalk = forall a. Maybe a
Prelude.Nothing,
      $sel:thingArn:GetWirelessDeviceResponse' :: Maybe Text
thingArn = forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:GetWirelessDeviceResponse' :: Maybe Text
thingName = forall a. Maybe a
Prelude.Nothing,
      $sel:type':GetWirelessDeviceResponse' :: Maybe WirelessDeviceType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetWirelessDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name of the resource.
getWirelessDeviceResponse_arn :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe Prelude.Text)
getWirelessDeviceResponse_arn :: Lens' GetWirelessDeviceResponse (Maybe Text)
getWirelessDeviceResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe Text
a -> GetWirelessDeviceResponse
s {$sel:arn:GetWirelessDeviceResponse' :: Maybe Text
arn = Maybe Text
a} :: GetWirelessDeviceResponse)

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

-- | The name of the destination to which the device is assigned.
getWirelessDeviceResponse_destinationName :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe Prelude.Text)
getWirelessDeviceResponse_destinationName :: Lens' GetWirelessDeviceResponse (Maybe Text)
getWirelessDeviceResponse_destinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe Text
destinationName :: Maybe Text
$sel:destinationName:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
destinationName} -> Maybe Text
destinationName) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe Text
a -> GetWirelessDeviceResponse
s {$sel:destinationName:GetWirelessDeviceResponse' :: Maybe Text
destinationName = Maybe Text
a} :: GetWirelessDeviceResponse)

-- | The ID of the wireless device.
getWirelessDeviceResponse_id :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe Prelude.Text)
getWirelessDeviceResponse_id :: Lens' GetWirelessDeviceResponse (Maybe Text)
getWirelessDeviceResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe Text
id :: Maybe Text
$sel:id:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe Text
a -> GetWirelessDeviceResponse
s {$sel:id:GetWirelessDeviceResponse' :: Maybe Text
id = Maybe Text
a} :: GetWirelessDeviceResponse)

-- | Information about the wireless device.
getWirelessDeviceResponse_loRaWAN :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe LoRaWANDevice)
getWirelessDeviceResponse_loRaWAN :: Lens' GetWirelessDeviceResponse (Maybe LoRaWANDevice)
getWirelessDeviceResponse_loRaWAN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe LoRaWANDevice
loRaWAN :: Maybe LoRaWANDevice
$sel:loRaWAN:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe LoRaWANDevice
loRaWAN} -> Maybe LoRaWANDevice
loRaWAN) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe LoRaWANDevice
a -> GetWirelessDeviceResponse
s {$sel:loRaWAN:GetWirelessDeviceResponse' :: Maybe LoRaWANDevice
loRaWAN = Maybe LoRaWANDevice
a} :: GetWirelessDeviceResponse)

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

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

-- | Sidewalk device object.
getWirelessDeviceResponse_sidewalk :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe SidewalkDevice)
getWirelessDeviceResponse_sidewalk :: Lens' GetWirelessDeviceResponse (Maybe SidewalkDevice)
getWirelessDeviceResponse_sidewalk = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe SidewalkDevice
sidewalk :: Maybe SidewalkDevice
$sel:sidewalk:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe SidewalkDevice
sidewalk} -> Maybe SidewalkDevice
sidewalk) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe SidewalkDevice
a -> GetWirelessDeviceResponse
s {$sel:sidewalk:GetWirelessDeviceResponse' :: Maybe SidewalkDevice
sidewalk = Maybe SidewalkDevice
a} :: GetWirelessDeviceResponse)

-- | The ARN of the thing associated with the wireless device.
getWirelessDeviceResponse_thingArn :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe Prelude.Text)
getWirelessDeviceResponse_thingArn :: Lens' GetWirelessDeviceResponse (Maybe Text)
getWirelessDeviceResponse_thingArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe Text
thingArn :: Maybe Text
$sel:thingArn:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
thingArn} -> Maybe Text
thingArn) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe Text
a -> GetWirelessDeviceResponse
s {$sel:thingArn:GetWirelessDeviceResponse' :: Maybe Text
thingArn = Maybe Text
a} :: GetWirelessDeviceResponse)

-- | The name of the thing associated with the wireless device. The value is
-- empty if a thing isn\'t associated with the device.
getWirelessDeviceResponse_thingName :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe Prelude.Text)
getWirelessDeviceResponse_thingName :: Lens' GetWirelessDeviceResponse (Maybe Text)
getWirelessDeviceResponse_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe Text
thingName :: Maybe Text
$sel:thingName:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
thingName} -> Maybe Text
thingName) (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe Text
a -> GetWirelessDeviceResponse
s {$sel:thingName:GetWirelessDeviceResponse' :: Maybe Text
thingName = Maybe Text
a} :: GetWirelessDeviceResponse)

-- | The wireless device type.
getWirelessDeviceResponse_type :: Lens.Lens' GetWirelessDeviceResponse (Prelude.Maybe WirelessDeviceType)
getWirelessDeviceResponse_type :: Lens' GetWirelessDeviceResponse (Maybe WirelessDeviceType)
getWirelessDeviceResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWirelessDeviceResponse' {Maybe WirelessDeviceType
type' :: Maybe WirelessDeviceType
$sel:type':GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe WirelessDeviceType
type'} -> Maybe WirelessDeviceType
type') (\s :: GetWirelessDeviceResponse
s@GetWirelessDeviceResponse' {} Maybe WirelessDeviceType
a -> GetWirelessDeviceResponse
s {$sel:type':GetWirelessDeviceResponse' :: Maybe WirelessDeviceType
type' = Maybe WirelessDeviceType
a} :: GetWirelessDeviceResponse)

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

instance Prelude.NFData GetWirelessDeviceResponse where
  rnf :: GetWirelessDeviceResponse -> ()
rnf GetWirelessDeviceResponse' {Int
Maybe Text
Maybe PositioningConfigStatus
Maybe LoRaWANDevice
Maybe SidewalkDevice
Maybe WirelessDeviceType
httpStatus :: Int
type' :: Maybe WirelessDeviceType
thingName :: Maybe Text
thingArn :: Maybe Text
sidewalk :: Maybe SidewalkDevice
positioning :: Maybe PositioningConfigStatus
name :: Maybe Text
loRaWAN :: Maybe LoRaWANDevice
id :: Maybe Text
destinationName :: Maybe Text
description :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Int
$sel:type':GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe WirelessDeviceType
$sel:thingName:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:thingArn:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:sidewalk:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe SidewalkDevice
$sel:positioning:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe PositioningConfigStatus
$sel:name:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:loRaWAN:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe LoRaWANDevice
$sel:id:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:destinationName:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:description:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
$sel:arn:GetWirelessDeviceResponse' :: GetWirelessDeviceResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      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 Text
destinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoRaWANDevice
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 Maybe SidewalkDevice
sidewalk
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
thingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WirelessDeviceType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus