{-# 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.DescribeComponent
-- 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 version of a component.
module Amazonka.GreengrassV2.DescribeComponent
  ( -- * Creating a Request
    DescribeComponent (..),
    newDescribeComponent,

    -- * Request Lenses
    describeComponent_arn,

    -- * Destructuring the Response
    DescribeComponentResponse (..),
    newDescribeComponentResponse,

    -- * Response Lenses
    describeComponentResponse_arn,
    describeComponentResponse_componentName,
    describeComponentResponse_componentVersion,
    describeComponentResponse_creationTimestamp,
    describeComponentResponse_description,
    describeComponentResponse_platforms,
    describeComponentResponse_publisher,
    describeComponentResponse_status,
    describeComponentResponse_tags,
    describeComponentResponse_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:/ 'newDescribeComponent' smart constructor.
data DescribeComponent = DescribeComponent'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the component version.
    DescribeComponent -> Text
arn :: Prelude.Text
  }
  deriving (DescribeComponent -> DescribeComponent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeComponent -> DescribeComponent -> Bool
$c/= :: DescribeComponent -> DescribeComponent -> Bool
== :: DescribeComponent -> DescribeComponent -> Bool
$c== :: DescribeComponent -> DescribeComponent -> Bool
Prelude.Eq, ReadPrec [DescribeComponent]
ReadPrec DescribeComponent
Int -> ReadS DescribeComponent
ReadS [DescribeComponent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeComponent]
$creadListPrec :: ReadPrec [DescribeComponent]
readPrec :: ReadPrec DescribeComponent
$creadPrec :: ReadPrec DescribeComponent
readList :: ReadS [DescribeComponent]
$creadList :: ReadS [DescribeComponent]
readsPrec :: Int -> ReadS DescribeComponent
$creadsPrec :: Int -> ReadS DescribeComponent
Prelude.Read, Int -> DescribeComponent -> ShowS
[DescribeComponent] -> ShowS
DescribeComponent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeComponent] -> ShowS
$cshowList :: [DescribeComponent] -> ShowS
show :: DescribeComponent -> String
$cshow :: DescribeComponent -> String
showsPrec :: Int -> DescribeComponent -> ShowS
$cshowsPrec :: Int -> DescribeComponent -> ShowS
Prelude.Show, forall x. Rep DescribeComponent x -> DescribeComponent
forall x. DescribeComponent -> Rep DescribeComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeComponent x -> DescribeComponent
$cfrom :: forall x. DescribeComponent -> Rep DescribeComponent x
Prelude.Generic)

-- |
-- Create a value of 'DescribeComponent' 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', 'describeComponent_arn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the component version.
newDescribeComponent ::
  -- | 'arn'
  Prelude.Text ->
  DescribeComponent
newDescribeComponent :: Text -> DescribeComponent
newDescribeComponent Text
pArn_ =
  DescribeComponent' {$sel:arn:DescribeComponent' :: Text
arn = Text
pArn_}

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the component version.
describeComponent_arn :: Lens.Lens' DescribeComponent Prelude.Text
describeComponent_arn :: Lens' DescribeComponent Text
describeComponent_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponent' {Text
arn :: Text
$sel:arn:DescribeComponent' :: DescribeComponent -> Text
arn} -> Text
arn) (\s :: DescribeComponent
s@DescribeComponent' {} Text
a -> DescribeComponent
s {$sel:arn:DescribeComponent' :: Text
arn = Text
a} :: DescribeComponent)

instance Core.AWSRequest DescribeComponent where
  type
    AWSResponse DescribeComponent =
      DescribeComponentResponse
  request :: (Service -> Service)
-> DescribeComponent -> Request DescribeComponent
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 DescribeComponent
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeComponent)))
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 [ComponentPlatform]
-> Maybe Text
-> Maybe CloudComponentStatus
-> Maybe (HashMap Text Text)
-> Int
-> DescribeComponentResponse
DescribeComponentResponse'
            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
"componentName")
            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
"componentVersion")
            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
"creationTimestamp")
            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
"platforms" 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
"publisher")
            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 DescribeComponent where
  hashWithSalt :: Int -> DescribeComponent -> Int
hashWithSalt Int
_salt DescribeComponent' {Text
arn :: Text
$sel:arn:DescribeComponent' :: DescribeComponent -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

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

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

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

-- | /See:/ 'newDescribeComponentResponse' smart constructor.
data DescribeComponentResponse = DescribeComponentResponse'
  { -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the component version.
    DescribeComponentResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The name of the component.
    DescribeComponentResponse -> Maybe Text
componentName :: Prelude.Maybe Prelude.Text,
    -- | The version of the component.
    DescribeComponentResponse -> Maybe Text
componentVersion :: Prelude.Maybe Prelude.Text,
    -- | The time at which the component was created, expressed in ISO 8601
    -- format.
    DescribeComponentResponse -> Maybe POSIX
creationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The description of the component version.
    DescribeComponentResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The platforms that the component version supports.
    DescribeComponentResponse -> Maybe [ComponentPlatform]
platforms :: Prelude.Maybe [ComponentPlatform],
    -- | The publisher of the component version.
    DescribeComponentResponse -> Maybe Text
publisher :: Prelude.Maybe Prelude.Text,
    -- | The status of the component version in IoT Greengrass V2. This status is
    -- different from the status of the component on a core device.
    DescribeComponentResponse -> Maybe CloudComponentStatus
status :: Prelude.Maybe CloudComponentStatus,
    -- | 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/.
    DescribeComponentResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    DescribeComponentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeComponentResponse -> DescribeComponentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeComponentResponse -> DescribeComponentResponse -> Bool
$c/= :: DescribeComponentResponse -> DescribeComponentResponse -> Bool
== :: DescribeComponentResponse -> DescribeComponentResponse -> Bool
$c== :: DescribeComponentResponse -> DescribeComponentResponse -> Bool
Prelude.Eq, ReadPrec [DescribeComponentResponse]
ReadPrec DescribeComponentResponse
Int -> ReadS DescribeComponentResponse
ReadS [DescribeComponentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeComponentResponse]
$creadListPrec :: ReadPrec [DescribeComponentResponse]
readPrec :: ReadPrec DescribeComponentResponse
$creadPrec :: ReadPrec DescribeComponentResponse
readList :: ReadS [DescribeComponentResponse]
$creadList :: ReadS [DescribeComponentResponse]
readsPrec :: Int -> ReadS DescribeComponentResponse
$creadsPrec :: Int -> ReadS DescribeComponentResponse
Prelude.Read, Int -> DescribeComponentResponse -> ShowS
[DescribeComponentResponse] -> ShowS
DescribeComponentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeComponentResponse] -> ShowS
$cshowList :: [DescribeComponentResponse] -> ShowS
show :: DescribeComponentResponse -> String
$cshow :: DescribeComponentResponse -> String
showsPrec :: Int -> DescribeComponentResponse -> ShowS
$cshowsPrec :: Int -> DescribeComponentResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeComponentResponse x -> DescribeComponentResponse
forall x.
DescribeComponentResponse -> Rep DescribeComponentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeComponentResponse x -> DescribeComponentResponse
$cfrom :: forall x.
DescribeComponentResponse -> Rep DescribeComponentResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeComponentResponse' 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', 'describeComponentResponse_arn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the component version.
--
-- 'componentName', 'describeComponentResponse_componentName' - The name of the component.
--
-- 'componentVersion', 'describeComponentResponse_componentVersion' - The version of the component.
--
-- 'creationTimestamp', 'describeComponentResponse_creationTimestamp' - The time at which the component was created, expressed in ISO 8601
-- format.
--
-- 'description', 'describeComponentResponse_description' - The description of the component version.
--
-- 'platforms', 'describeComponentResponse_platforms' - The platforms that the component version supports.
--
-- 'publisher', 'describeComponentResponse_publisher' - The publisher of the component version.
--
-- 'status', 'describeComponentResponse_status' - The status of the component version in IoT Greengrass V2. This status is
-- different from the status of the component on a core device.
--
-- 'tags', 'describeComponentResponse_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', 'describeComponentResponse_httpStatus' - The response's http status code.
newDescribeComponentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeComponentResponse
newDescribeComponentResponse :: Int -> DescribeComponentResponse
newDescribeComponentResponse Int
pHttpStatus_ =
  DescribeComponentResponse'
    { $sel:arn:DescribeComponentResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:componentName:DescribeComponentResponse' :: Maybe Text
componentName = forall a. Maybe a
Prelude.Nothing,
      $sel:componentVersion:DescribeComponentResponse' :: Maybe Text
componentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimestamp:DescribeComponentResponse' :: Maybe POSIX
creationTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribeComponentResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:platforms:DescribeComponentResponse' :: Maybe [ComponentPlatform]
platforms = forall a. Maybe a
Prelude.Nothing,
      $sel:publisher:DescribeComponentResponse' :: Maybe Text
publisher = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeComponentResponse' :: Maybe CloudComponentStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeComponentResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeComponentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the component version.
describeComponentResponse_arn :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe Prelude.Text)
describeComponentResponse_arn :: Lens' DescribeComponentResponse (Maybe Text)
describeComponentResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe Text
a -> DescribeComponentResponse
s {$sel:arn:DescribeComponentResponse' :: Maybe Text
arn = Maybe Text
a} :: DescribeComponentResponse)

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

-- | The version of the component.
describeComponentResponse_componentVersion :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe Prelude.Text)
describeComponentResponse_componentVersion :: Lens' DescribeComponentResponse (Maybe Text)
describeComponentResponse_componentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe Text
componentVersion :: Maybe Text
$sel:componentVersion:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
componentVersion} -> Maybe Text
componentVersion) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe Text
a -> DescribeComponentResponse
s {$sel:componentVersion:DescribeComponentResponse' :: Maybe Text
componentVersion = Maybe Text
a} :: DescribeComponentResponse)

-- | The time at which the component was created, expressed in ISO 8601
-- format.
describeComponentResponse_creationTimestamp :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe Prelude.UTCTime)
describeComponentResponse_creationTimestamp :: Lens' DescribeComponentResponse (Maybe UTCTime)
describeComponentResponse_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe POSIX
creationTimestamp :: Maybe POSIX
$sel:creationTimestamp:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe POSIX
creationTimestamp} -> Maybe POSIX
creationTimestamp) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe POSIX
a -> DescribeComponentResponse
s {$sel:creationTimestamp:DescribeComponentResponse' :: Maybe POSIX
creationTimestamp = Maybe POSIX
a} :: DescribeComponentResponse) 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 description of the component version.
describeComponentResponse_description :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe Prelude.Text)
describeComponentResponse_description :: Lens' DescribeComponentResponse (Maybe Text)
describeComponentResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe Text
a -> DescribeComponentResponse
s {$sel:description:DescribeComponentResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeComponentResponse)

-- | The platforms that the component version supports.
describeComponentResponse_platforms :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe [ComponentPlatform])
describeComponentResponse_platforms :: Lens' DescribeComponentResponse (Maybe [ComponentPlatform])
describeComponentResponse_platforms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe [ComponentPlatform]
platforms :: Maybe [ComponentPlatform]
$sel:platforms:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe [ComponentPlatform]
platforms} -> Maybe [ComponentPlatform]
platforms) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe [ComponentPlatform]
a -> DescribeComponentResponse
s {$sel:platforms:DescribeComponentResponse' :: Maybe [ComponentPlatform]
platforms = Maybe [ComponentPlatform]
a} :: DescribeComponentResponse) 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 publisher of the component version.
describeComponentResponse_publisher :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe Prelude.Text)
describeComponentResponse_publisher :: Lens' DescribeComponentResponse (Maybe Text)
describeComponentResponse_publisher = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe Text
publisher :: Maybe Text
$sel:publisher:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
publisher} -> Maybe Text
publisher) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe Text
a -> DescribeComponentResponse
s {$sel:publisher:DescribeComponentResponse' :: Maybe Text
publisher = Maybe Text
a} :: DescribeComponentResponse)

-- | The status of the component version in IoT Greengrass V2. This status is
-- different from the status of the component on a core device.
describeComponentResponse_status :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe CloudComponentStatus)
describeComponentResponse_status :: Lens' DescribeComponentResponse (Maybe CloudComponentStatus)
describeComponentResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe CloudComponentStatus
status :: Maybe CloudComponentStatus
$sel:status:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe CloudComponentStatus
status} -> Maybe CloudComponentStatus
status) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe CloudComponentStatus
a -> DescribeComponentResponse
s {$sel:status:DescribeComponentResponse' :: Maybe CloudComponentStatus
status = Maybe CloudComponentStatus
a} :: DescribeComponentResponse)

-- | 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/.
describeComponentResponse_tags :: Lens.Lens' DescribeComponentResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeComponentResponse_tags :: Lens' DescribeComponentResponse (Maybe (HashMap Text Text))
describeComponentResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Maybe (HashMap Text Text)
a -> DescribeComponentResponse
s {$sel:tags:DescribeComponentResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: DescribeComponentResponse) 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.
describeComponentResponse_httpStatus :: Lens.Lens' DescribeComponentResponse Prelude.Int
describeComponentResponse_httpStatus :: Lens' DescribeComponentResponse Int
describeComponentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeComponentResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeComponentResponse' :: DescribeComponentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeComponentResponse
s@DescribeComponentResponse' {} Int
a -> DescribeComponentResponse
s {$sel:httpStatus:DescribeComponentResponse' :: Int
httpStatus = Int
a} :: DescribeComponentResponse)

instance Prelude.NFData DescribeComponentResponse where
  rnf :: DescribeComponentResponse -> ()
rnf DescribeComponentResponse' {Int
Maybe [ComponentPlatform]
Maybe Text
Maybe (HashMap Text Text)
Maybe POSIX
Maybe CloudComponentStatus
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
status :: Maybe CloudComponentStatus
publisher :: Maybe Text
platforms :: Maybe [ComponentPlatform]
description :: Maybe Text
creationTimestamp :: Maybe POSIX
componentVersion :: Maybe Text
componentName :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:DescribeComponentResponse' :: DescribeComponentResponse -> Int
$sel:tags:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe (HashMap Text Text)
$sel:status:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe CloudComponentStatus
$sel:publisher:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
$sel:platforms:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe [ComponentPlatform]
$sel:description:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
$sel:creationTimestamp:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe POSIX
$sel:componentVersion:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
$sel:componentName:DescribeComponentResponse' :: DescribeComponentResponse -> Maybe Text
$sel:arn:DescribeComponentResponse' :: DescribeComponentResponse -> 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
componentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
componentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimestamp
      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 [ComponentPlatform]
platforms
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publisher
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CloudComponentStatus
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