{-# 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.GetComponent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the recipe for a version of a component.
module Amazonka.GreengrassV2.GetComponent
  ( -- * Creating a Request
    GetComponent (..),
    newGetComponent,

    -- * Request Lenses
    getComponent_recipeOutputFormat,
    getComponent_arn,

    -- * Destructuring the Response
    GetComponentResponse (..),
    newGetComponentResponse,

    -- * Response Lenses
    getComponentResponse_tags,
    getComponentResponse_httpStatus,
    getComponentResponse_recipeOutputFormat,
    getComponentResponse_recipe,
  )
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:/ 'newGetComponent' smart constructor.
data GetComponent = GetComponent'
  { -- | The format of the recipe.
    GetComponent -> Maybe RecipeOutputFormat
recipeOutputFormat :: Prelude.Maybe RecipeOutputFormat,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the component version.
    GetComponent -> Text
arn :: Prelude.Text
  }
  deriving (GetComponent -> GetComponent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetComponent -> GetComponent -> Bool
$c/= :: GetComponent -> GetComponent -> Bool
== :: GetComponent -> GetComponent -> Bool
$c== :: GetComponent -> GetComponent -> Bool
Prelude.Eq, ReadPrec [GetComponent]
ReadPrec GetComponent
Int -> ReadS GetComponent
ReadS [GetComponent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetComponent]
$creadListPrec :: ReadPrec [GetComponent]
readPrec :: ReadPrec GetComponent
$creadPrec :: ReadPrec GetComponent
readList :: ReadS [GetComponent]
$creadList :: ReadS [GetComponent]
readsPrec :: Int -> ReadS GetComponent
$creadsPrec :: Int -> ReadS GetComponent
Prelude.Read, Int -> GetComponent -> ShowS
[GetComponent] -> ShowS
GetComponent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetComponent] -> ShowS
$cshowList :: [GetComponent] -> ShowS
show :: GetComponent -> String
$cshow :: GetComponent -> String
showsPrec :: Int -> GetComponent -> ShowS
$cshowsPrec :: Int -> GetComponent -> ShowS
Prelude.Show, forall x. Rep GetComponent x -> GetComponent
forall x. GetComponent -> Rep GetComponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetComponent x -> GetComponent
$cfrom :: forall x. GetComponent -> Rep GetComponent x
Prelude.Generic)

-- |
-- Create a value of 'GetComponent' 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:
--
-- 'recipeOutputFormat', 'getComponent_recipeOutputFormat' - The format of the recipe.
--
-- 'arn', 'getComponent_arn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the component version.
newGetComponent ::
  -- | 'arn'
  Prelude.Text ->
  GetComponent
newGetComponent :: Text -> GetComponent
newGetComponent Text
pArn_ =
  GetComponent'
    { $sel:recipeOutputFormat:GetComponent' :: Maybe RecipeOutputFormat
recipeOutputFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:GetComponent' :: Text
arn = Text
pArn_
    }

-- | The format of the recipe.
getComponent_recipeOutputFormat :: Lens.Lens' GetComponent (Prelude.Maybe RecipeOutputFormat)
getComponent_recipeOutputFormat :: Lens' GetComponent (Maybe RecipeOutputFormat)
getComponent_recipeOutputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComponent' {Maybe RecipeOutputFormat
recipeOutputFormat :: Maybe RecipeOutputFormat
$sel:recipeOutputFormat:GetComponent' :: GetComponent -> Maybe RecipeOutputFormat
recipeOutputFormat} -> Maybe RecipeOutputFormat
recipeOutputFormat) (\s :: GetComponent
s@GetComponent' {} Maybe RecipeOutputFormat
a -> GetComponent
s {$sel:recipeOutputFormat:GetComponent' :: Maybe RecipeOutputFormat
recipeOutputFormat = Maybe RecipeOutputFormat
a} :: GetComponent)

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

instance Core.AWSRequest GetComponent where
  type AWSResponse GetComponent = GetComponentResponse
  request :: (Service -> Service) -> GetComponent -> Request GetComponent
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 GetComponent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetComponent)))
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 (HashMap Text Text)
-> Int -> RecipeOutputFormat -> Base64 -> GetComponentResponse
GetComponentResponse'
            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
"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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"recipeOutputFormat")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"recipe")
      )

instance Prelude.Hashable GetComponent where
  hashWithSalt :: Int -> GetComponent -> Int
hashWithSalt Int
_salt GetComponent' {Maybe RecipeOutputFormat
Text
arn :: Text
recipeOutputFormat :: Maybe RecipeOutputFormat
$sel:arn:GetComponent' :: GetComponent -> Text
$sel:recipeOutputFormat:GetComponent' :: GetComponent -> Maybe RecipeOutputFormat
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecipeOutputFormat
recipeOutputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData GetComponent where
  rnf :: GetComponent -> ()
rnf GetComponent' {Maybe RecipeOutputFormat
Text
arn :: Text
recipeOutputFormat :: Maybe RecipeOutputFormat
$sel:arn:GetComponent' :: GetComponent -> Text
$sel:recipeOutputFormat:GetComponent' :: GetComponent -> Maybe RecipeOutputFormat
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RecipeOutputFormat
recipeOutputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

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

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

instance Data.ToQuery GetComponent where
  toQuery :: GetComponent -> QueryString
toQuery GetComponent' {Maybe RecipeOutputFormat
Text
arn :: Text
recipeOutputFormat :: Maybe RecipeOutputFormat
$sel:arn:GetComponent' :: GetComponent -> Text
$sel:recipeOutputFormat:GetComponent' :: GetComponent -> Maybe RecipeOutputFormat
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"recipeOutputFormat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RecipeOutputFormat
recipeOutputFormat]

-- | /See:/ 'newGetComponentResponse' smart constructor.
data GetComponentResponse = GetComponentResponse'
  { -- | 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/.
    GetComponentResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    GetComponentResponse -> Int
httpStatus :: Prelude.Int,
    -- | The format of the recipe.
    GetComponentResponse -> RecipeOutputFormat
recipeOutputFormat :: RecipeOutputFormat,
    -- | The recipe of the component version.
    GetComponentResponse -> Base64
recipe :: Data.Base64
  }
  deriving (GetComponentResponse -> GetComponentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetComponentResponse -> GetComponentResponse -> Bool
$c/= :: GetComponentResponse -> GetComponentResponse -> Bool
== :: GetComponentResponse -> GetComponentResponse -> Bool
$c== :: GetComponentResponse -> GetComponentResponse -> Bool
Prelude.Eq, ReadPrec [GetComponentResponse]
ReadPrec GetComponentResponse
Int -> ReadS GetComponentResponse
ReadS [GetComponentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetComponentResponse]
$creadListPrec :: ReadPrec [GetComponentResponse]
readPrec :: ReadPrec GetComponentResponse
$creadPrec :: ReadPrec GetComponentResponse
readList :: ReadS [GetComponentResponse]
$creadList :: ReadS [GetComponentResponse]
readsPrec :: Int -> ReadS GetComponentResponse
$creadsPrec :: Int -> ReadS GetComponentResponse
Prelude.Read, Int -> GetComponentResponse -> ShowS
[GetComponentResponse] -> ShowS
GetComponentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetComponentResponse] -> ShowS
$cshowList :: [GetComponentResponse] -> ShowS
show :: GetComponentResponse -> String
$cshow :: GetComponentResponse -> String
showsPrec :: Int -> GetComponentResponse -> ShowS
$cshowsPrec :: Int -> GetComponentResponse -> ShowS
Prelude.Show, forall x. Rep GetComponentResponse x -> GetComponentResponse
forall x. GetComponentResponse -> Rep GetComponentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetComponentResponse x -> GetComponentResponse
$cfrom :: forall x. GetComponentResponse -> Rep GetComponentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetComponentResponse' 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:
--
-- 'tags', 'getComponentResponse_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', 'getComponentResponse_httpStatus' - The response's http status code.
--
-- 'recipeOutputFormat', 'getComponentResponse_recipeOutputFormat' - The format of the recipe.
--
-- 'recipe', 'getComponentResponse_recipe' - The recipe of the component version.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
newGetComponentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'recipeOutputFormat'
  RecipeOutputFormat ->
  -- | 'recipe'
  Prelude.ByteString ->
  GetComponentResponse
newGetComponentResponse :: Int -> RecipeOutputFormat -> ByteString -> GetComponentResponse
newGetComponentResponse
  Int
pHttpStatus_
  RecipeOutputFormat
pRecipeOutputFormat_
  ByteString
pRecipe_ =
    GetComponentResponse'
      { $sel:tags:GetComponentResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetComponentResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:recipeOutputFormat:GetComponentResponse' :: RecipeOutputFormat
recipeOutputFormat = RecipeOutputFormat
pRecipeOutputFormat_,
        $sel:recipe:GetComponentResponse' :: Base64
recipe = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pRecipe_
      }

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

-- | The format of the recipe.
getComponentResponse_recipeOutputFormat :: Lens.Lens' GetComponentResponse RecipeOutputFormat
getComponentResponse_recipeOutputFormat :: Lens' GetComponentResponse RecipeOutputFormat
getComponentResponse_recipeOutputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComponentResponse' {RecipeOutputFormat
recipeOutputFormat :: RecipeOutputFormat
$sel:recipeOutputFormat:GetComponentResponse' :: GetComponentResponse -> RecipeOutputFormat
recipeOutputFormat} -> RecipeOutputFormat
recipeOutputFormat) (\s :: GetComponentResponse
s@GetComponentResponse' {} RecipeOutputFormat
a -> GetComponentResponse
s {$sel:recipeOutputFormat:GetComponentResponse' :: RecipeOutputFormat
recipeOutputFormat = RecipeOutputFormat
a} :: GetComponentResponse)

-- | The recipe of the component version.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
getComponentResponse_recipe :: Lens.Lens' GetComponentResponse Prelude.ByteString
getComponentResponse_recipe :: Lens' GetComponentResponse ByteString
getComponentResponse_recipe = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetComponentResponse' {Base64
recipe :: Base64
$sel:recipe:GetComponentResponse' :: GetComponentResponse -> Base64
recipe} -> Base64
recipe) (\s :: GetComponentResponse
s@GetComponentResponse' {} Base64
a -> GetComponentResponse
s {$sel:recipe:GetComponentResponse' :: Base64
recipe = Base64
a} :: GetComponentResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

instance Prelude.NFData GetComponentResponse where
  rnf :: GetComponentResponse -> ()
rnf GetComponentResponse' {Int
Maybe (HashMap Text Text)
Base64
RecipeOutputFormat
recipe :: Base64
recipeOutputFormat :: RecipeOutputFormat
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
$sel:recipe:GetComponentResponse' :: GetComponentResponse -> Base64
$sel:recipeOutputFormat:GetComponentResponse' :: GetComponentResponse -> RecipeOutputFormat
$sel:httpStatus:GetComponentResponse' :: GetComponentResponse -> Int
$sel:tags:GetComponentResponse' :: GetComponentResponse -> Maybe (HashMap Text Text)
..} =
    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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RecipeOutputFormat
recipeOutputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
recipe