{-# 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.GreengrassV2.GetCoreDevice
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves metadata for a Greengrass core device.
--
-- IoT Greengrass relies on individual devices to send status updates to
-- the Amazon Web Services Cloud. If the IoT Greengrass Core software
-- isn\'t running on the device, or if device isn\'t connected to the
-- Amazon Web Services Cloud, then the reported status of that device might
-- not reflect its current status. The status timestamp indicates when the
-- device status was last updated.
--
-- Core devices send status updates at the following times:
--
-- -   When the IoT Greengrass Core software starts
--
-- -   When the core device receives a deployment from the Amazon Web
--     Services Cloud
--
-- -   When the status of any component on the core device becomes @BROKEN@
--
-- -   At a
--     <https://docs.aws.amazon.com/greengrass/v2/developerguide/greengrass-nucleus-component.html#greengrass-nucleus-component-configuration-fss regular interval that you can configure>,
--     which defaults to 24 hours
--
-- -   For IoT Greengrass Core v2.7.0, the core device sends status updates
--     upon local deployment and cloud deployment
module Amazonka.GreengrassV2.GetCoreDevice
  ( -- * Creating a Request
    GetCoreDevice (..),
    newGetCoreDevice,

    -- * Request Lenses
    getCoreDevice_coreDeviceThingName,

    -- * Destructuring the Response
    GetCoreDeviceResponse (..),
    newGetCoreDeviceResponse,

    -- * Response Lenses
    getCoreDeviceResponse_architecture,
    getCoreDeviceResponse_coreDeviceThingName,
    getCoreDeviceResponse_coreVersion,
    getCoreDeviceResponse_lastStatusUpdateTimestamp,
    getCoreDeviceResponse_platform,
    getCoreDeviceResponse_status,
    getCoreDeviceResponse_tags,
    getCoreDeviceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetCoreDevice' smart constructor.
data GetCoreDevice = GetCoreDevice'
  { -- | The name of the core device. This is also the name of the IoT thing.
    GetCoreDevice -> Text
coreDeviceThingName :: Prelude.Text
  }
  deriving (GetCoreDevice -> GetCoreDevice -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCoreDevice -> GetCoreDevice -> Bool
$c/= :: GetCoreDevice -> GetCoreDevice -> Bool
== :: GetCoreDevice -> GetCoreDevice -> Bool
$c== :: GetCoreDevice -> GetCoreDevice -> Bool
Prelude.Eq, ReadPrec [GetCoreDevice]
ReadPrec GetCoreDevice
Int -> ReadS GetCoreDevice
ReadS [GetCoreDevice]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCoreDevice]
$creadListPrec :: ReadPrec [GetCoreDevice]
readPrec :: ReadPrec GetCoreDevice
$creadPrec :: ReadPrec GetCoreDevice
readList :: ReadS [GetCoreDevice]
$creadList :: ReadS [GetCoreDevice]
readsPrec :: Int -> ReadS GetCoreDevice
$creadsPrec :: Int -> ReadS GetCoreDevice
Prelude.Read, Int -> GetCoreDevice -> ShowS
[GetCoreDevice] -> ShowS
GetCoreDevice -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCoreDevice] -> ShowS
$cshowList :: [GetCoreDevice] -> ShowS
show :: GetCoreDevice -> String
$cshow :: GetCoreDevice -> String
showsPrec :: Int -> GetCoreDevice -> ShowS
$cshowsPrec :: Int -> GetCoreDevice -> ShowS
Prelude.Show, forall x. Rep GetCoreDevice x -> GetCoreDevice
forall x. GetCoreDevice -> Rep GetCoreDevice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCoreDevice x -> GetCoreDevice
$cfrom :: forall x. GetCoreDevice -> Rep GetCoreDevice x
Prelude.Generic)

-- |
-- Create a value of 'GetCoreDevice' 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:
--
-- 'coreDeviceThingName', 'getCoreDevice_coreDeviceThingName' - The name of the core device. This is also the name of the IoT thing.
newGetCoreDevice ::
  -- | 'coreDeviceThingName'
  Prelude.Text ->
  GetCoreDevice
newGetCoreDevice :: Text -> GetCoreDevice
newGetCoreDevice Text
pCoreDeviceThingName_ =
  GetCoreDevice'
    { $sel:coreDeviceThingName:GetCoreDevice' :: Text
coreDeviceThingName =
        Text
pCoreDeviceThingName_
    }

-- | The name of the core device. This is also the name of the IoT thing.
getCoreDevice_coreDeviceThingName :: Lens.Lens' GetCoreDevice Prelude.Text
getCoreDevice_coreDeviceThingName :: Lens' GetCoreDevice Text
getCoreDevice_coreDeviceThingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDevice' {Text
coreDeviceThingName :: Text
$sel:coreDeviceThingName:GetCoreDevice' :: GetCoreDevice -> Text
coreDeviceThingName} -> Text
coreDeviceThingName) (\s :: GetCoreDevice
s@GetCoreDevice' {} Text
a -> GetCoreDevice
s {$sel:coreDeviceThingName:GetCoreDevice' :: Text
coreDeviceThingName = Text
a} :: GetCoreDevice)

instance Core.AWSRequest GetCoreDevice where
  type
    AWSResponse GetCoreDevice =
      GetCoreDeviceResponse
  request :: (Service -> Service) -> GetCoreDevice -> Request GetCoreDevice
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 GetCoreDevice
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCoreDevice)))
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 POSIX
-> Maybe Text
-> Maybe CoreDeviceStatus
-> Maybe (HashMap Text Text)
-> Int
-> GetCoreDeviceResponse
GetCoreDeviceResponse'
            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
"architecture")
            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
"coreDeviceThingName")
            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
"coreVersion")
            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
"lastStatusUpdateTimestamp")
            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
"platform")
            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
"status")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetCoreDevice where
  hashWithSalt :: Int -> GetCoreDevice -> Int
hashWithSalt Int
_salt GetCoreDevice' {Text
coreDeviceThingName :: Text
$sel:coreDeviceThingName:GetCoreDevice' :: GetCoreDevice -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
coreDeviceThingName

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

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

instance Data.ToPath GetCoreDevice where
  toPath :: GetCoreDevice -> ByteString
toPath GetCoreDevice' {Text
coreDeviceThingName :: Text
$sel:coreDeviceThingName:GetCoreDevice' :: GetCoreDevice -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/greengrass/v2/coreDevices/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
coreDeviceThingName
      ]

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

-- | /See:/ 'newGetCoreDeviceResponse' smart constructor.
data GetCoreDeviceResponse = GetCoreDeviceResponse'
  { -- | The computer architecture of the core device.
    GetCoreDeviceResponse -> Maybe Text
architecture :: Prelude.Maybe Prelude.Text,
    -- | The name of the core device. This is also the name of the IoT thing.
    GetCoreDeviceResponse -> Maybe Text
coreDeviceThingName :: Prelude.Maybe Prelude.Text,
    -- | The version of the IoT Greengrass Core software that the core device
    -- runs. This version is equivalent to the version of the Greengrass
    -- nucleus component that runs on the core device. For more information,
    -- see the
    -- <https://docs.aws.amazon.com/greengrass/v2/developerguide/greengrass-nucleus-component.html Greengrass nucleus component>
    -- in the /IoT Greengrass V2 Developer Guide/.
    GetCoreDeviceResponse -> Maybe Text
coreVersion :: Prelude.Maybe Prelude.Text,
    -- | The time at which the core device\'s status last updated, expressed in
    -- ISO 8601 format.
    GetCoreDeviceResponse -> Maybe POSIX
lastStatusUpdateTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The operating system platform that the core device runs.
    GetCoreDeviceResponse -> Maybe Text
platform :: Prelude.Maybe Prelude.Text,
    -- | The status of the core device. The core device status can be:
    --
    -- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
    --     on the core device without issue.
    --
    -- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
    --     a failed state on the core device.
    GetCoreDeviceResponse -> Maybe CoreDeviceStatus
status :: Prelude.Maybe CoreDeviceStatus,
    -- | A list of key-value pairs that contain metadata for the resource. For
    -- more information, see
    -- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
    -- in the /IoT Greengrass V2 Developer Guide/.
    GetCoreDeviceResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetCoreDeviceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCoreDeviceResponse -> GetCoreDeviceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCoreDeviceResponse -> GetCoreDeviceResponse -> Bool
$c/= :: GetCoreDeviceResponse -> GetCoreDeviceResponse -> Bool
== :: GetCoreDeviceResponse -> GetCoreDeviceResponse -> Bool
$c== :: GetCoreDeviceResponse -> GetCoreDeviceResponse -> Bool
Prelude.Eq, ReadPrec [GetCoreDeviceResponse]
ReadPrec GetCoreDeviceResponse
Int -> ReadS GetCoreDeviceResponse
ReadS [GetCoreDeviceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCoreDeviceResponse]
$creadListPrec :: ReadPrec [GetCoreDeviceResponse]
readPrec :: ReadPrec GetCoreDeviceResponse
$creadPrec :: ReadPrec GetCoreDeviceResponse
readList :: ReadS [GetCoreDeviceResponse]
$creadList :: ReadS [GetCoreDeviceResponse]
readsPrec :: Int -> ReadS GetCoreDeviceResponse
$creadsPrec :: Int -> ReadS GetCoreDeviceResponse
Prelude.Read, Int -> GetCoreDeviceResponse -> ShowS
[GetCoreDeviceResponse] -> ShowS
GetCoreDeviceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCoreDeviceResponse] -> ShowS
$cshowList :: [GetCoreDeviceResponse] -> ShowS
show :: GetCoreDeviceResponse -> String
$cshow :: GetCoreDeviceResponse -> String
showsPrec :: Int -> GetCoreDeviceResponse -> ShowS
$cshowsPrec :: Int -> GetCoreDeviceResponse -> ShowS
Prelude.Show, forall x. Rep GetCoreDeviceResponse x -> GetCoreDeviceResponse
forall x. GetCoreDeviceResponse -> Rep GetCoreDeviceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCoreDeviceResponse x -> GetCoreDeviceResponse
$cfrom :: forall x. GetCoreDeviceResponse -> Rep GetCoreDeviceResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCoreDeviceResponse' 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:
--
-- 'architecture', 'getCoreDeviceResponse_architecture' - The computer architecture of the core device.
--
-- 'coreDeviceThingName', 'getCoreDeviceResponse_coreDeviceThingName' - The name of the core device. This is also the name of the IoT thing.
--
-- 'coreVersion', 'getCoreDeviceResponse_coreVersion' - The version of the IoT Greengrass Core software that the core device
-- runs. This version is equivalent to the version of the Greengrass
-- nucleus component that runs on the core device. For more information,
-- see the
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/greengrass-nucleus-component.html Greengrass nucleus component>
-- in the /IoT Greengrass V2 Developer Guide/.
--
-- 'lastStatusUpdateTimestamp', 'getCoreDeviceResponse_lastStatusUpdateTimestamp' - The time at which the core device\'s status last updated, expressed in
-- ISO 8601 format.
--
-- 'platform', 'getCoreDeviceResponse_platform' - The operating system platform that the core device runs.
--
-- 'status', 'getCoreDeviceResponse_status' - The status of the core device. The core device status can be:
--
-- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
--     on the core device without issue.
--
-- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
--     a failed state on the core device.
--
-- 'tags', 'getCoreDeviceResponse_tags' - A list of key-value pairs that contain metadata for the resource. For
-- more information, see
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
-- in the /IoT Greengrass V2 Developer Guide/.
--
-- 'httpStatus', 'getCoreDeviceResponse_httpStatus' - The response's http status code.
newGetCoreDeviceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCoreDeviceResponse
newGetCoreDeviceResponse :: Int -> GetCoreDeviceResponse
newGetCoreDeviceResponse Int
pHttpStatus_ =
  GetCoreDeviceResponse'
    { $sel:architecture:GetCoreDeviceResponse' :: Maybe Text
architecture =
        forall a. Maybe a
Prelude.Nothing,
      $sel:coreDeviceThingName:GetCoreDeviceResponse' :: Maybe Text
coreDeviceThingName = forall a. Maybe a
Prelude.Nothing,
      $sel:coreVersion:GetCoreDeviceResponse' :: Maybe Text
coreVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:lastStatusUpdateTimestamp:GetCoreDeviceResponse' :: Maybe POSIX
lastStatusUpdateTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:platform:GetCoreDeviceResponse' :: Maybe Text
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetCoreDeviceResponse' :: Maybe CoreDeviceStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:GetCoreDeviceResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCoreDeviceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The computer architecture of the core device.
getCoreDeviceResponse_architecture :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe Prelude.Text)
getCoreDeviceResponse_architecture :: Lens' GetCoreDeviceResponse (Maybe Text)
getCoreDeviceResponse_architecture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe Text
architecture :: Maybe Text
$sel:architecture:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
architecture} -> Maybe Text
architecture) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe Text
a -> GetCoreDeviceResponse
s {$sel:architecture:GetCoreDeviceResponse' :: Maybe Text
architecture = Maybe Text
a} :: GetCoreDeviceResponse)

-- | The name of the core device. This is also the name of the IoT thing.
getCoreDeviceResponse_coreDeviceThingName :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe Prelude.Text)
getCoreDeviceResponse_coreDeviceThingName :: Lens' GetCoreDeviceResponse (Maybe Text)
getCoreDeviceResponse_coreDeviceThingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe Text
coreDeviceThingName :: Maybe Text
$sel:coreDeviceThingName:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
coreDeviceThingName} -> Maybe Text
coreDeviceThingName) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe Text
a -> GetCoreDeviceResponse
s {$sel:coreDeviceThingName:GetCoreDeviceResponse' :: Maybe Text
coreDeviceThingName = Maybe Text
a} :: GetCoreDeviceResponse)

-- | The version of the IoT Greengrass Core software that the core device
-- runs. This version is equivalent to the version of the Greengrass
-- nucleus component that runs on the core device. For more information,
-- see the
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/greengrass-nucleus-component.html Greengrass nucleus component>
-- in the /IoT Greengrass V2 Developer Guide/.
getCoreDeviceResponse_coreVersion :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe Prelude.Text)
getCoreDeviceResponse_coreVersion :: Lens' GetCoreDeviceResponse (Maybe Text)
getCoreDeviceResponse_coreVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe Text
coreVersion :: Maybe Text
$sel:coreVersion:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
coreVersion} -> Maybe Text
coreVersion) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe Text
a -> GetCoreDeviceResponse
s {$sel:coreVersion:GetCoreDeviceResponse' :: Maybe Text
coreVersion = Maybe Text
a} :: GetCoreDeviceResponse)

-- | The time at which the core device\'s status last updated, expressed in
-- ISO 8601 format.
getCoreDeviceResponse_lastStatusUpdateTimestamp :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe Prelude.UTCTime)
getCoreDeviceResponse_lastStatusUpdateTimestamp :: Lens' GetCoreDeviceResponse (Maybe UTCTime)
getCoreDeviceResponse_lastStatusUpdateTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe POSIX
lastStatusUpdateTimestamp :: Maybe POSIX
$sel:lastStatusUpdateTimestamp:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe POSIX
lastStatusUpdateTimestamp} -> Maybe POSIX
lastStatusUpdateTimestamp) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe POSIX
a -> GetCoreDeviceResponse
s {$sel:lastStatusUpdateTimestamp:GetCoreDeviceResponse' :: Maybe POSIX
lastStatusUpdateTimestamp = Maybe POSIX
a} :: GetCoreDeviceResponse) 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 operating system platform that the core device runs.
getCoreDeviceResponse_platform :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe Prelude.Text)
getCoreDeviceResponse_platform :: Lens' GetCoreDeviceResponse (Maybe Text)
getCoreDeviceResponse_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe Text
platform :: Maybe Text
$sel:platform:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
platform} -> Maybe Text
platform) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe Text
a -> GetCoreDeviceResponse
s {$sel:platform:GetCoreDeviceResponse' :: Maybe Text
platform = Maybe Text
a} :: GetCoreDeviceResponse)

-- | The status of the core device. The core device status can be:
--
-- -   @HEALTHY@ – The IoT Greengrass Core software and all components run
--     on the core device without issue.
--
-- -   @UNHEALTHY@ – The IoT Greengrass Core software or a component is in
--     a failed state on the core device.
getCoreDeviceResponse_status :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe CoreDeviceStatus)
getCoreDeviceResponse_status :: Lens' GetCoreDeviceResponse (Maybe CoreDeviceStatus)
getCoreDeviceResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe CoreDeviceStatus
status :: Maybe CoreDeviceStatus
$sel:status:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe CoreDeviceStatus
status} -> Maybe CoreDeviceStatus
status) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe CoreDeviceStatus
a -> GetCoreDeviceResponse
s {$sel:status:GetCoreDeviceResponse' :: Maybe CoreDeviceStatus
status = Maybe CoreDeviceStatus
a} :: GetCoreDeviceResponse)

-- | A list of key-value pairs that contain metadata for the resource. For
-- more information, see
-- <https://docs.aws.amazon.com/greengrass/v2/developerguide/tag-resources.html Tag your resources>
-- in the /IoT Greengrass V2 Developer Guide/.
getCoreDeviceResponse_tags :: Lens.Lens' GetCoreDeviceResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getCoreDeviceResponse_tags :: Lens' GetCoreDeviceResponse (Maybe (HashMap Text Text))
getCoreDeviceResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Maybe (HashMap Text Text)
a -> GetCoreDeviceResponse
s {$sel:tags:GetCoreDeviceResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: GetCoreDeviceResponse) 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 response's http status code.
getCoreDeviceResponse_httpStatus :: Lens.Lens' GetCoreDeviceResponse Prelude.Int
getCoreDeviceResponse_httpStatus :: Lens' GetCoreDeviceResponse Int
getCoreDeviceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCoreDeviceResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCoreDeviceResponse
s@GetCoreDeviceResponse' {} Int
a -> GetCoreDeviceResponse
s {$sel:httpStatus:GetCoreDeviceResponse' :: Int
httpStatus = Int
a} :: GetCoreDeviceResponse)

instance Prelude.NFData GetCoreDeviceResponse where
  rnf :: GetCoreDeviceResponse -> ()
rnf GetCoreDeviceResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe CoreDeviceStatus
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
status :: Maybe CoreDeviceStatus
platform :: Maybe Text
lastStatusUpdateTimestamp :: Maybe POSIX
coreVersion :: Maybe Text
coreDeviceThingName :: Maybe Text
architecture :: Maybe Text
$sel:httpStatus:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Int
$sel:tags:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe (HashMap Text Text)
$sel:status:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe CoreDeviceStatus
$sel:platform:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
$sel:lastStatusUpdateTimestamp:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe POSIX
$sel:coreVersion:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
$sel:coreDeviceThingName:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
$sel:architecture:GetCoreDeviceResponse' :: GetCoreDeviceResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
architecture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
coreDeviceThingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
coreVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastStatusUpdateTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CoreDeviceStatus
status
      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 Int
httpStatus