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

    -- * Request Lenses
    describeDevice_deviceId,

    -- * Destructuring the Response
    DescribeDeviceResponse (..),
    newDescribeDeviceResponse,

    -- * Response Lenses
    describeDeviceResponse_alternateSoftwares,
    describeDeviceResponse_arn,
    describeDeviceResponse_brand,
    describeDeviceResponse_createdTime,
    describeDeviceResponse_currentNetworkingStatus,
    describeDeviceResponse_currentSoftware,
    describeDeviceResponse_description,
    describeDeviceResponse_deviceAggregatedStatus,
    describeDeviceResponse_deviceConnectionStatus,
    describeDeviceResponse_deviceId,
    describeDeviceResponse_latestAlternateSoftware,
    describeDeviceResponse_latestDeviceJob,
    describeDeviceResponse_latestSoftware,
    describeDeviceResponse_leaseExpirationTime,
    describeDeviceResponse_name,
    describeDeviceResponse_networkingConfiguration,
    describeDeviceResponse_provisioningStatus,
    describeDeviceResponse_serialNumber,
    describeDeviceResponse_tags,
    describeDeviceResponse_type,
    describeDeviceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeDevice' smart constructor.
data DescribeDevice = DescribeDevice'
  { -- | The device\'s ID.
    DescribeDevice -> Text
deviceId :: Prelude.Text
  }
  deriving (DescribeDevice -> DescribeDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDevice -> DescribeDevice -> Bool
$c/= :: DescribeDevice -> DescribeDevice -> Bool
== :: DescribeDevice -> DescribeDevice -> Bool
$c== :: DescribeDevice -> DescribeDevice -> Bool
Prelude.Eq, ReadPrec [DescribeDevice]
ReadPrec DescribeDevice
Int -> ReadS DescribeDevice
ReadS [DescribeDevice]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDevice]
$creadListPrec :: ReadPrec [DescribeDevice]
readPrec :: ReadPrec DescribeDevice
$creadPrec :: ReadPrec DescribeDevice
readList :: ReadS [DescribeDevice]
$creadList :: ReadS [DescribeDevice]
readsPrec :: Int -> ReadS DescribeDevice
$creadsPrec :: Int -> ReadS DescribeDevice
Prelude.Read, Int -> DescribeDevice -> ShowS
[DescribeDevice] -> ShowS
DescribeDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDevice] -> ShowS
$cshowList :: [DescribeDevice] -> ShowS
show :: DescribeDevice -> String
$cshow :: DescribeDevice -> String
showsPrec :: Int -> DescribeDevice -> ShowS
$cshowsPrec :: Int -> DescribeDevice -> ShowS
Prelude.Show, forall x. Rep DescribeDevice x -> DescribeDevice
forall x. DescribeDevice -> Rep DescribeDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeDevice x -> DescribeDevice
$cfrom :: forall x. DescribeDevice -> Rep DescribeDevice x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDevice' 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:
--
-- 'deviceId', 'describeDevice_deviceId' - The device\'s ID.
newDescribeDevice ::
  -- | 'deviceId'
  Prelude.Text ->
  DescribeDevice
newDescribeDevice :: Text -> DescribeDevice
newDescribeDevice Text
pDeviceId_ =
  DescribeDevice' {$sel:deviceId:DescribeDevice' :: Text
deviceId = Text
pDeviceId_}

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

instance Core.AWSRequest DescribeDevice where
  type
    AWSResponse DescribeDevice =
      DescribeDeviceResponse
  request :: (Service -> Service) -> DescribeDevice -> Request DescribeDevice
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 DescribeDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeDevice)))
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 [AlternateSoftwareMetadata]
-> Maybe Text
-> Maybe DeviceBrand
-> Maybe POSIX
-> Maybe NetworkStatus
-> Maybe Text
-> Maybe Text
-> Maybe DeviceAggregatedStatus
-> Maybe DeviceConnectionStatus
-> Maybe Text
-> Maybe Text
-> Maybe LatestDeviceJob
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe NetworkPayload
-> Maybe DeviceStatus
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Maybe DeviceType
-> Int
-> DescribeDeviceResponse
DescribeDeviceResponse'
            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
"AlternateSoftwares"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
"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
"Brand")
            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
"CreatedTime")
            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
"CurrentNetworkingStatus")
            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
"CurrentSoftware")
            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
"DeviceAggregatedStatus")
            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
"DeviceConnectionStatus")
            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
"DeviceId")
            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
"LatestAlternateSoftware")
            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
"LatestDeviceJob")
            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
"LatestSoftware")
            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
"LeaseExpirationTime")
            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
"NetworkingConfiguration")
            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
"ProvisioningStatus")
            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
"SerialNumber")
            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
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 DescribeDevice where
  hashWithSalt :: Int -> DescribeDevice -> Int
hashWithSalt Int
_salt DescribeDevice' {Text
deviceId :: Text
$sel:deviceId:DescribeDevice' :: DescribeDevice -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId

instance Prelude.NFData DescribeDevice where
  rnf :: DescribeDevice -> ()
rnf DescribeDevice' {Text
deviceId :: Text
$sel:deviceId:DescribeDevice' :: DescribeDevice -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId

instance Data.ToHeaders DescribeDevice where
  toHeaders :: DescribeDevice -> 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.ToPath DescribeDevice where
  toPath :: DescribeDevice -> ByteString
toPath DescribeDevice' {Text
deviceId :: Text
$sel:deviceId:DescribeDevice' :: DescribeDevice -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/devices/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceId]

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

-- | /See:/ 'newDescribeDeviceResponse' smart constructor.
data DescribeDeviceResponse = DescribeDeviceResponse'
  { -- | Beta software releases available for the device.
    DescribeDeviceResponse -> Maybe [AlternateSoftwareMetadata]
alternateSoftwares :: Prelude.Maybe [AlternateSoftwareMetadata],
    -- | The device\'s ARN.
    DescribeDeviceResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The device\'s maker.
    DescribeDeviceResponse -> Maybe DeviceBrand
brand :: Prelude.Maybe DeviceBrand,
    -- | When the device was created.
    DescribeDeviceResponse -> Maybe POSIX
createdTime :: Prelude.Maybe Data.POSIX,
    -- | The device\'s networking status.
    DescribeDeviceResponse -> Maybe NetworkStatus
currentNetworkingStatus :: Prelude.Maybe NetworkStatus,
    -- | The device\'s current software version.
    DescribeDeviceResponse -> Maybe Text
currentSoftware :: Prelude.Maybe Prelude.Text,
    -- | The device\'s description.
    DescribeDeviceResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A device\'s aggregated status. Including the device\'s connection
    -- status, provisioning status, and lease status.
    DescribeDeviceResponse -> Maybe DeviceAggregatedStatus
deviceAggregatedStatus :: Prelude.Maybe DeviceAggregatedStatus,
    -- | The device\'s connection status.
    DescribeDeviceResponse -> Maybe DeviceConnectionStatus
deviceConnectionStatus :: Prelude.Maybe DeviceConnectionStatus,
    -- | The device\'s ID.
    DescribeDeviceResponse -> Maybe Text
deviceId :: Prelude.Maybe Prelude.Text,
    -- | The most recent beta software release.
    DescribeDeviceResponse -> Maybe Text
latestAlternateSoftware :: Prelude.Maybe Prelude.Text,
    -- | A device\'s latest job. Includes the target image version, and the job
    -- status.
    DescribeDeviceResponse -> Maybe LatestDeviceJob
latestDeviceJob :: Prelude.Maybe LatestDeviceJob,
    -- | The latest software version available for the device.
    DescribeDeviceResponse -> Maybe Text
latestSoftware :: Prelude.Maybe Prelude.Text,
    -- | The device\'s lease expiration time.
    DescribeDeviceResponse -> Maybe POSIX
leaseExpirationTime :: Prelude.Maybe Data.POSIX,
    -- | The device\'s name.
    DescribeDeviceResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The device\'s networking configuration.
    DescribeDeviceResponse -> Maybe NetworkPayload
networkingConfiguration :: Prelude.Maybe NetworkPayload,
    -- | The device\'s provisioning status.
    DescribeDeviceResponse -> Maybe DeviceStatus
provisioningStatus :: Prelude.Maybe DeviceStatus,
    -- | The device\'s serial number.
    DescribeDeviceResponse -> Maybe Text
serialNumber :: Prelude.Maybe Prelude.Text,
    -- | The device\'s tags.
    DescribeDeviceResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The device\'s type.
    DescribeDeviceResponse -> Maybe DeviceType
type' :: Prelude.Maybe DeviceType,
    -- | The response's http status code.
    DescribeDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDeviceResponse -> DescribeDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDeviceResponse -> DescribeDeviceResponse -> Bool
$c/= :: DescribeDeviceResponse -> DescribeDeviceResponse -> Bool
== :: DescribeDeviceResponse -> DescribeDeviceResponse -> Bool
$c== :: DescribeDeviceResponse -> DescribeDeviceResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDeviceResponse]
ReadPrec DescribeDeviceResponse
Int -> ReadS DescribeDeviceResponse
ReadS [DescribeDeviceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDeviceResponse]
$creadListPrec :: ReadPrec [DescribeDeviceResponse]
readPrec :: ReadPrec DescribeDeviceResponse
$creadPrec :: ReadPrec DescribeDeviceResponse
readList :: ReadS [DescribeDeviceResponse]
$creadList :: ReadS [DescribeDeviceResponse]
readsPrec :: Int -> ReadS DescribeDeviceResponse
$creadsPrec :: Int -> ReadS DescribeDeviceResponse
Prelude.Read, Int -> DescribeDeviceResponse -> ShowS
[DescribeDeviceResponse] -> ShowS
DescribeDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDeviceResponse] -> ShowS
$cshowList :: [DescribeDeviceResponse] -> ShowS
show :: DescribeDeviceResponse -> String
$cshow :: DescribeDeviceResponse -> String
showsPrec :: Int -> DescribeDeviceResponse -> ShowS
$cshowsPrec :: Int -> DescribeDeviceResponse -> ShowS
Prelude.Show, forall x. Rep DescribeDeviceResponse x -> DescribeDeviceResponse
forall x. DescribeDeviceResponse -> Rep DescribeDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeDeviceResponse x -> DescribeDeviceResponse
$cfrom :: forall x. DescribeDeviceResponse -> Rep DescribeDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDeviceResponse' 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:
--
-- 'alternateSoftwares', 'describeDeviceResponse_alternateSoftwares' - Beta software releases available for the device.
--
-- 'arn', 'describeDeviceResponse_arn' - The device\'s ARN.
--
-- 'brand', 'describeDeviceResponse_brand' - The device\'s maker.
--
-- 'createdTime', 'describeDeviceResponse_createdTime' - When the device was created.
--
-- 'currentNetworkingStatus', 'describeDeviceResponse_currentNetworkingStatus' - The device\'s networking status.
--
-- 'currentSoftware', 'describeDeviceResponse_currentSoftware' - The device\'s current software version.
--
-- 'description', 'describeDeviceResponse_description' - The device\'s description.
--
-- 'deviceAggregatedStatus', 'describeDeviceResponse_deviceAggregatedStatus' - A device\'s aggregated status. Including the device\'s connection
-- status, provisioning status, and lease status.
--
-- 'deviceConnectionStatus', 'describeDeviceResponse_deviceConnectionStatus' - The device\'s connection status.
--
-- 'deviceId', 'describeDeviceResponse_deviceId' - The device\'s ID.
--
-- 'latestAlternateSoftware', 'describeDeviceResponse_latestAlternateSoftware' - The most recent beta software release.
--
-- 'latestDeviceJob', 'describeDeviceResponse_latestDeviceJob' - A device\'s latest job. Includes the target image version, and the job
-- status.
--
-- 'latestSoftware', 'describeDeviceResponse_latestSoftware' - The latest software version available for the device.
--
-- 'leaseExpirationTime', 'describeDeviceResponse_leaseExpirationTime' - The device\'s lease expiration time.
--
-- 'name', 'describeDeviceResponse_name' - The device\'s name.
--
-- 'networkingConfiguration', 'describeDeviceResponse_networkingConfiguration' - The device\'s networking configuration.
--
-- 'provisioningStatus', 'describeDeviceResponse_provisioningStatus' - The device\'s provisioning status.
--
-- 'serialNumber', 'describeDeviceResponse_serialNumber' - The device\'s serial number.
--
-- 'tags', 'describeDeviceResponse_tags' - The device\'s tags.
--
-- 'type'', 'describeDeviceResponse_type' - The device\'s type.
--
-- 'httpStatus', 'describeDeviceResponse_httpStatus' - The response's http status code.
newDescribeDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDeviceResponse
newDescribeDeviceResponse :: Int -> DescribeDeviceResponse
newDescribeDeviceResponse Int
pHttpStatus_ =
  DescribeDeviceResponse'
    { $sel:alternateSoftwares:DescribeDeviceResponse' :: Maybe [AlternateSoftwareMetadata]
alternateSoftwares =
        forall a. Maybe a
Prelude.Nothing,
      $sel:arn:DescribeDeviceResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:brand:DescribeDeviceResponse' :: Maybe DeviceBrand
brand = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:DescribeDeviceResponse' :: Maybe POSIX
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:currentNetworkingStatus:DescribeDeviceResponse' :: Maybe NetworkStatus
currentNetworkingStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:currentSoftware:DescribeDeviceResponse' :: Maybe Text
currentSoftware = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeDeviceResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceAggregatedStatus:DescribeDeviceResponse' :: Maybe DeviceAggregatedStatus
deviceAggregatedStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceConnectionStatus:DescribeDeviceResponse' :: Maybe DeviceConnectionStatus
deviceConnectionStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceId:DescribeDeviceResponse' :: Maybe Text
deviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:latestAlternateSoftware:DescribeDeviceResponse' :: Maybe Text
latestAlternateSoftware = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDeviceJob:DescribeDeviceResponse' :: Maybe LatestDeviceJob
latestDeviceJob = forall a. Maybe a
Prelude.Nothing,
      $sel:latestSoftware:DescribeDeviceResponse' :: Maybe Text
latestSoftware = forall a. Maybe a
Prelude.Nothing,
      $sel:leaseExpirationTime:DescribeDeviceResponse' :: Maybe POSIX
leaseExpirationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeDeviceResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:networkingConfiguration:DescribeDeviceResponse' :: Maybe NetworkPayload
networkingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:provisioningStatus:DescribeDeviceResponse' :: Maybe DeviceStatus
provisioningStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:serialNumber:DescribeDeviceResponse' :: Maybe Text
serialNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeDeviceResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':DescribeDeviceResponse' :: Maybe DeviceType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Beta software releases available for the device.
describeDeviceResponse_alternateSoftwares :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe [AlternateSoftwareMetadata])
describeDeviceResponse_alternateSoftwares :: Lens' DescribeDeviceResponse (Maybe [AlternateSoftwareMetadata])
describeDeviceResponse_alternateSoftwares = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe [AlternateSoftwareMetadata]
alternateSoftwares :: Maybe [AlternateSoftwareMetadata]
$sel:alternateSoftwares:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe [AlternateSoftwareMetadata]
alternateSoftwares} -> Maybe [AlternateSoftwareMetadata]
alternateSoftwares) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe [AlternateSoftwareMetadata]
a -> DescribeDeviceResponse
s {$sel:alternateSoftwares:DescribeDeviceResponse' :: Maybe [AlternateSoftwareMetadata]
alternateSoftwares = Maybe [AlternateSoftwareMetadata]
a} :: DescribeDeviceResponse) 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 device\'s ARN.
describeDeviceResponse_arn :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_arn :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:arn:DescribeDeviceResponse' :: Maybe Text
arn = Maybe Text
a} :: DescribeDeviceResponse)

-- | The device\'s maker.
describeDeviceResponse_brand :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe DeviceBrand)
describeDeviceResponse_brand :: Lens' DescribeDeviceResponse (Maybe DeviceBrand)
describeDeviceResponse_brand = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe DeviceBrand
brand :: Maybe DeviceBrand
$sel:brand:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceBrand
brand} -> Maybe DeviceBrand
brand) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe DeviceBrand
a -> DescribeDeviceResponse
s {$sel:brand:DescribeDeviceResponse' :: Maybe DeviceBrand
brand = Maybe DeviceBrand
a} :: DescribeDeviceResponse)

-- | When the device was created.
describeDeviceResponse_createdTime :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.UTCTime)
describeDeviceResponse_createdTime :: Lens' DescribeDeviceResponse (Maybe UTCTime)
describeDeviceResponse_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe POSIX
createdTime :: Maybe POSIX
$sel:createdTime:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe POSIX
createdTime} -> Maybe POSIX
createdTime) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe POSIX
a -> DescribeDeviceResponse
s {$sel:createdTime:DescribeDeviceResponse' :: Maybe POSIX
createdTime = Maybe POSIX
a} :: DescribeDeviceResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The device\'s networking status.
describeDeviceResponse_currentNetworkingStatus :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe NetworkStatus)
describeDeviceResponse_currentNetworkingStatus :: Lens' DescribeDeviceResponse (Maybe NetworkStatus)
describeDeviceResponse_currentNetworkingStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe NetworkStatus
currentNetworkingStatus :: Maybe NetworkStatus
$sel:currentNetworkingStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe NetworkStatus
currentNetworkingStatus} -> Maybe NetworkStatus
currentNetworkingStatus) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe NetworkStatus
a -> DescribeDeviceResponse
s {$sel:currentNetworkingStatus:DescribeDeviceResponse' :: Maybe NetworkStatus
currentNetworkingStatus = Maybe NetworkStatus
a} :: DescribeDeviceResponse)

-- | The device\'s current software version.
describeDeviceResponse_currentSoftware :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_currentSoftware :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_currentSoftware = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
currentSoftware :: Maybe Text
$sel:currentSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
currentSoftware} -> Maybe Text
currentSoftware) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:currentSoftware:DescribeDeviceResponse' :: Maybe Text
currentSoftware = Maybe Text
a} :: DescribeDeviceResponse)

-- | The device\'s description.
describeDeviceResponse_description :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_description :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:description:DescribeDeviceResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeDeviceResponse)

-- | A device\'s aggregated status. Including the device\'s connection
-- status, provisioning status, and lease status.
describeDeviceResponse_deviceAggregatedStatus :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe DeviceAggregatedStatus)
describeDeviceResponse_deviceAggregatedStatus :: Lens' DescribeDeviceResponse (Maybe DeviceAggregatedStatus)
describeDeviceResponse_deviceAggregatedStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe DeviceAggregatedStatus
deviceAggregatedStatus :: Maybe DeviceAggregatedStatus
$sel:deviceAggregatedStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceAggregatedStatus
deviceAggregatedStatus} -> Maybe DeviceAggregatedStatus
deviceAggregatedStatus) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe DeviceAggregatedStatus
a -> DescribeDeviceResponse
s {$sel:deviceAggregatedStatus:DescribeDeviceResponse' :: Maybe DeviceAggregatedStatus
deviceAggregatedStatus = Maybe DeviceAggregatedStatus
a} :: DescribeDeviceResponse)

-- | The device\'s connection status.
describeDeviceResponse_deviceConnectionStatus :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe DeviceConnectionStatus)
describeDeviceResponse_deviceConnectionStatus :: Lens' DescribeDeviceResponse (Maybe DeviceConnectionStatus)
describeDeviceResponse_deviceConnectionStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe DeviceConnectionStatus
deviceConnectionStatus :: Maybe DeviceConnectionStatus
$sel:deviceConnectionStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceConnectionStatus
deviceConnectionStatus} -> Maybe DeviceConnectionStatus
deviceConnectionStatus) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe DeviceConnectionStatus
a -> DescribeDeviceResponse
s {$sel:deviceConnectionStatus:DescribeDeviceResponse' :: Maybe DeviceConnectionStatus
deviceConnectionStatus = Maybe DeviceConnectionStatus
a} :: DescribeDeviceResponse)

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

-- | The most recent beta software release.
describeDeviceResponse_latestAlternateSoftware :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_latestAlternateSoftware :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_latestAlternateSoftware = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
latestAlternateSoftware :: Maybe Text
$sel:latestAlternateSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
latestAlternateSoftware} -> Maybe Text
latestAlternateSoftware) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:latestAlternateSoftware:DescribeDeviceResponse' :: Maybe Text
latestAlternateSoftware = Maybe Text
a} :: DescribeDeviceResponse)

-- | A device\'s latest job. Includes the target image version, and the job
-- status.
describeDeviceResponse_latestDeviceJob :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe LatestDeviceJob)
describeDeviceResponse_latestDeviceJob :: Lens' DescribeDeviceResponse (Maybe LatestDeviceJob)
describeDeviceResponse_latestDeviceJob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe LatestDeviceJob
latestDeviceJob :: Maybe LatestDeviceJob
$sel:latestDeviceJob:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe LatestDeviceJob
latestDeviceJob} -> Maybe LatestDeviceJob
latestDeviceJob) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe LatestDeviceJob
a -> DescribeDeviceResponse
s {$sel:latestDeviceJob:DescribeDeviceResponse' :: Maybe LatestDeviceJob
latestDeviceJob = Maybe LatestDeviceJob
a} :: DescribeDeviceResponse)

-- | The latest software version available for the device.
describeDeviceResponse_latestSoftware :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_latestSoftware :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_latestSoftware = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
latestSoftware :: Maybe Text
$sel:latestSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
latestSoftware} -> Maybe Text
latestSoftware) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:latestSoftware:DescribeDeviceResponse' :: Maybe Text
latestSoftware = Maybe Text
a} :: DescribeDeviceResponse)

-- | The device\'s lease expiration time.
describeDeviceResponse_leaseExpirationTime :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.UTCTime)
describeDeviceResponse_leaseExpirationTime :: Lens' DescribeDeviceResponse (Maybe UTCTime)
describeDeviceResponse_leaseExpirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe POSIX
leaseExpirationTime :: Maybe POSIX
$sel:leaseExpirationTime:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe POSIX
leaseExpirationTime} -> Maybe POSIX
leaseExpirationTime) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe POSIX
a -> DescribeDeviceResponse
s {$sel:leaseExpirationTime:DescribeDeviceResponse' :: Maybe POSIX
leaseExpirationTime = Maybe POSIX
a} :: DescribeDeviceResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The device\'s name.
describeDeviceResponse_name :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_name :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:name:DescribeDeviceResponse' :: Maybe Text
name = Maybe Text
a} :: DescribeDeviceResponse)

-- | The device\'s networking configuration.
describeDeviceResponse_networkingConfiguration :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe NetworkPayload)
describeDeviceResponse_networkingConfiguration :: Lens' DescribeDeviceResponse (Maybe NetworkPayload)
describeDeviceResponse_networkingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe NetworkPayload
networkingConfiguration :: Maybe NetworkPayload
$sel:networkingConfiguration:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe NetworkPayload
networkingConfiguration} -> Maybe NetworkPayload
networkingConfiguration) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe NetworkPayload
a -> DescribeDeviceResponse
s {$sel:networkingConfiguration:DescribeDeviceResponse' :: Maybe NetworkPayload
networkingConfiguration = Maybe NetworkPayload
a} :: DescribeDeviceResponse)

-- | The device\'s provisioning status.
describeDeviceResponse_provisioningStatus :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe DeviceStatus)
describeDeviceResponse_provisioningStatus :: Lens' DescribeDeviceResponse (Maybe DeviceStatus)
describeDeviceResponse_provisioningStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe DeviceStatus
provisioningStatus :: Maybe DeviceStatus
$sel:provisioningStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceStatus
provisioningStatus} -> Maybe DeviceStatus
provisioningStatus) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe DeviceStatus
a -> DescribeDeviceResponse
s {$sel:provisioningStatus:DescribeDeviceResponse' :: Maybe DeviceStatus
provisioningStatus = Maybe DeviceStatus
a} :: DescribeDeviceResponse)

-- | The device\'s serial number.
describeDeviceResponse_serialNumber :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe Prelude.Text)
describeDeviceResponse_serialNumber :: Lens' DescribeDeviceResponse (Maybe Text)
describeDeviceResponse_serialNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe Text
serialNumber :: Maybe Text
$sel:serialNumber:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
serialNumber} -> Maybe Text
serialNumber) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe Text
a -> DescribeDeviceResponse
s {$sel:serialNumber:DescribeDeviceResponse' :: Maybe Text
serialNumber = Maybe Text
a} :: DescribeDeviceResponse)

-- | The device\'s tags.
describeDeviceResponse_tags :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeDeviceResponse_tags :: Lens' DescribeDeviceResponse (Maybe (HashMap Text Text))
describeDeviceResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe (HashMap Text Text)
a -> DescribeDeviceResponse
s {$sel:tags:DescribeDeviceResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: DescribeDeviceResponse) 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 device\'s type.
describeDeviceResponse_type :: Lens.Lens' DescribeDeviceResponse (Prelude.Maybe DeviceType)
describeDeviceResponse_type :: Lens' DescribeDeviceResponse (Maybe DeviceType)
describeDeviceResponse_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDeviceResponse' {Maybe DeviceType
type' :: Maybe DeviceType
$sel:type':DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceType
type'} -> Maybe DeviceType
type') (\s :: DescribeDeviceResponse
s@DescribeDeviceResponse' {} Maybe DeviceType
a -> DescribeDeviceResponse
s {$sel:type':DescribeDeviceResponse' :: Maybe DeviceType
type' = Maybe DeviceType
a} :: DescribeDeviceResponse)

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

instance Prelude.NFData DescribeDeviceResponse where
  rnf :: DescribeDeviceResponse -> ()
rnf DescribeDeviceResponse' {Int
Maybe [AlternateSoftwareMetadata]
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe DeviceAggregatedStatus
Maybe DeviceBrand
Maybe DeviceConnectionStatus
Maybe DeviceStatus
Maybe DeviceType
Maybe NetworkStatus
Maybe NetworkPayload
Maybe LatestDeviceJob
httpStatus :: Int
type' :: Maybe DeviceType
tags :: Maybe (HashMap Text Text)
serialNumber :: Maybe Text
provisioningStatus :: Maybe DeviceStatus
networkingConfiguration :: Maybe NetworkPayload
name :: Maybe Text
leaseExpirationTime :: Maybe POSIX
latestSoftware :: Maybe Text
latestDeviceJob :: Maybe LatestDeviceJob
latestAlternateSoftware :: Maybe Text
deviceId :: Maybe Text
deviceConnectionStatus :: Maybe DeviceConnectionStatus
deviceAggregatedStatus :: Maybe DeviceAggregatedStatus
description :: Maybe Text
currentSoftware :: Maybe Text
currentNetworkingStatus :: Maybe NetworkStatus
createdTime :: Maybe POSIX
brand :: Maybe DeviceBrand
arn :: Maybe Text
alternateSoftwares :: Maybe [AlternateSoftwareMetadata]
$sel:httpStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Int
$sel:type':DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceType
$sel:tags:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe (HashMap Text Text)
$sel:serialNumber:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:provisioningStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceStatus
$sel:networkingConfiguration:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe NetworkPayload
$sel:name:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:leaseExpirationTime:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe POSIX
$sel:latestSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:latestDeviceJob:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe LatestDeviceJob
$sel:latestAlternateSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:deviceId:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:deviceConnectionStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceConnectionStatus
$sel:deviceAggregatedStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceAggregatedStatus
$sel:description:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:currentSoftware:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:currentNetworkingStatus:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe NetworkStatus
$sel:createdTime:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe POSIX
$sel:brand:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe DeviceBrand
$sel:arn:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe Text
$sel:alternateSoftwares:DescribeDeviceResponse' :: DescribeDeviceResponse -> Maybe [AlternateSoftwareMetadata]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AlternateSoftwareMetadata]
alternateSoftwares
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 DeviceBrand
brand
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkStatus
currentNetworkingStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
currentSoftware
      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 DeviceAggregatedStatus
deviceAggregatedStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceConnectionStatus
deviceConnectionStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestAlternateSoftware
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LatestDeviceJob
latestDeviceJob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestSoftware
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
leaseExpirationTime
      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 NetworkPayload
networkingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceStatus
provisioningStatus
      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 (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus