{-# 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.ImageBuilder.GetContainerRecipePolicy
-- 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 the policy for a container recipe.
module Amazonka.ImageBuilder.GetContainerRecipePolicy
  ( -- * Creating a Request
    GetContainerRecipePolicy (..),
    newGetContainerRecipePolicy,

    -- * Request Lenses
    getContainerRecipePolicy_containerRecipeArn,

    -- * Destructuring the Response
    GetContainerRecipePolicyResponse (..),
    newGetContainerRecipePolicyResponse,

    -- * Response Lenses
    getContainerRecipePolicyResponse_policy,
    getContainerRecipePolicyResponse_requestId,
    getContainerRecipePolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetContainerRecipePolicy' smart constructor.
data GetContainerRecipePolicy = GetContainerRecipePolicy'
  { -- | The Amazon Resource Name (ARN) of the container recipe for the policy
    -- being requested.
    GetContainerRecipePolicy -> Text
containerRecipeArn :: Prelude.Text
  }
  deriving (GetContainerRecipePolicy -> GetContainerRecipePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContainerRecipePolicy -> GetContainerRecipePolicy -> Bool
$c/= :: GetContainerRecipePolicy -> GetContainerRecipePolicy -> Bool
== :: GetContainerRecipePolicy -> GetContainerRecipePolicy -> Bool
$c== :: GetContainerRecipePolicy -> GetContainerRecipePolicy -> Bool
Prelude.Eq, ReadPrec [GetContainerRecipePolicy]
ReadPrec GetContainerRecipePolicy
Int -> ReadS GetContainerRecipePolicy
ReadS [GetContainerRecipePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContainerRecipePolicy]
$creadListPrec :: ReadPrec [GetContainerRecipePolicy]
readPrec :: ReadPrec GetContainerRecipePolicy
$creadPrec :: ReadPrec GetContainerRecipePolicy
readList :: ReadS [GetContainerRecipePolicy]
$creadList :: ReadS [GetContainerRecipePolicy]
readsPrec :: Int -> ReadS GetContainerRecipePolicy
$creadsPrec :: Int -> ReadS GetContainerRecipePolicy
Prelude.Read, Int -> GetContainerRecipePolicy -> ShowS
[GetContainerRecipePolicy] -> ShowS
GetContainerRecipePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContainerRecipePolicy] -> ShowS
$cshowList :: [GetContainerRecipePolicy] -> ShowS
show :: GetContainerRecipePolicy -> String
$cshow :: GetContainerRecipePolicy -> String
showsPrec :: Int -> GetContainerRecipePolicy -> ShowS
$cshowsPrec :: Int -> GetContainerRecipePolicy -> ShowS
Prelude.Show, forall x.
Rep GetContainerRecipePolicy x -> GetContainerRecipePolicy
forall x.
GetContainerRecipePolicy -> Rep GetContainerRecipePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContainerRecipePolicy x -> GetContainerRecipePolicy
$cfrom :: forall x.
GetContainerRecipePolicy -> Rep GetContainerRecipePolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetContainerRecipePolicy' 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:
--
-- 'containerRecipeArn', 'getContainerRecipePolicy_containerRecipeArn' - The Amazon Resource Name (ARN) of the container recipe for the policy
-- being requested.
newGetContainerRecipePolicy ::
  -- | 'containerRecipeArn'
  Prelude.Text ->
  GetContainerRecipePolicy
newGetContainerRecipePolicy :: Text -> GetContainerRecipePolicy
newGetContainerRecipePolicy Text
pContainerRecipeArn_ =
  GetContainerRecipePolicy'
    { $sel:containerRecipeArn:GetContainerRecipePolicy' :: Text
containerRecipeArn =
        Text
pContainerRecipeArn_
    }

-- | The Amazon Resource Name (ARN) of the container recipe for the policy
-- being requested.
getContainerRecipePolicy_containerRecipeArn :: Lens.Lens' GetContainerRecipePolicy Prelude.Text
getContainerRecipePolicy_containerRecipeArn :: Lens' GetContainerRecipePolicy Text
getContainerRecipePolicy_containerRecipeArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContainerRecipePolicy' {Text
containerRecipeArn :: Text
$sel:containerRecipeArn:GetContainerRecipePolicy' :: GetContainerRecipePolicy -> Text
containerRecipeArn} -> Text
containerRecipeArn) (\s :: GetContainerRecipePolicy
s@GetContainerRecipePolicy' {} Text
a -> GetContainerRecipePolicy
s {$sel:containerRecipeArn:GetContainerRecipePolicy' :: Text
containerRecipeArn = Text
a} :: GetContainerRecipePolicy)

instance Core.AWSRequest GetContainerRecipePolicy where
  type
    AWSResponse GetContainerRecipePolicy =
      GetContainerRecipePolicyResponse
  request :: (Service -> Service)
-> GetContainerRecipePolicy -> Request GetContainerRecipePolicy
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 GetContainerRecipePolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetContainerRecipePolicy)))
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 -> Int -> GetContainerRecipePolicyResponse
GetContainerRecipePolicyResponse'
            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
"policy")
            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
"requestId")
            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 GetContainerRecipePolicy where
  hashWithSalt :: Int -> GetContainerRecipePolicy -> Int
hashWithSalt Int
_salt GetContainerRecipePolicy' {Text
containerRecipeArn :: Text
$sel:containerRecipeArn:GetContainerRecipePolicy' :: GetContainerRecipePolicy -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
containerRecipeArn

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

instance Data.ToHeaders GetContainerRecipePolicy where
  toHeaders :: GetContainerRecipePolicy -> 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 GetContainerRecipePolicy where
  toPath :: GetContainerRecipePolicy -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/GetContainerRecipePolicy"

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

-- | /See:/ 'newGetContainerRecipePolicyResponse' smart constructor.
data GetContainerRecipePolicyResponse = GetContainerRecipePolicyResponse'
  { -- | The container recipe policy object that is returned.
    GetContainerRecipePolicyResponse -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    GetContainerRecipePolicyResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetContainerRecipePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetContainerRecipePolicyResponse
-> GetContainerRecipePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContainerRecipePolicyResponse
-> GetContainerRecipePolicyResponse -> Bool
$c/= :: GetContainerRecipePolicyResponse
-> GetContainerRecipePolicyResponse -> Bool
== :: GetContainerRecipePolicyResponse
-> GetContainerRecipePolicyResponse -> Bool
$c== :: GetContainerRecipePolicyResponse
-> GetContainerRecipePolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetContainerRecipePolicyResponse]
ReadPrec GetContainerRecipePolicyResponse
Int -> ReadS GetContainerRecipePolicyResponse
ReadS [GetContainerRecipePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContainerRecipePolicyResponse]
$creadListPrec :: ReadPrec [GetContainerRecipePolicyResponse]
readPrec :: ReadPrec GetContainerRecipePolicyResponse
$creadPrec :: ReadPrec GetContainerRecipePolicyResponse
readList :: ReadS [GetContainerRecipePolicyResponse]
$creadList :: ReadS [GetContainerRecipePolicyResponse]
readsPrec :: Int -> ReadS GetContainerRecipePolicyResponse
$creadsPrec :: Int -> ReadS GetContainerRecipePolicyResponse
Prelude.Read, Int -> GetContainerRecipePolicyResponse -> ShowS
[GetContainerRecipePolicyResponse] -> ShowS
GetContainerRecipePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContainerRecipePolicyResponse] -> ShowS
$cshowList :: [GetContainerRecipePolicyResponse] -> ShowS
show :: GetContainerRecipePolicyResponse -> String
$cshow :: GetContainerRecipePolicyResponse -> String
showsPrec :: Int -> GetContainerRecipePolicyResponse -> ShowS
$cshowsPrec :: Int -> GetContainerRecipePolicyResponse -> ShowS
Prelude.Show, forall x.
Rep GetContainerRecipePolicyResponse x
-> GetContainerRecipePolicyResponse
forall x.
GetContainerRecipePolicyResponse
-> Rep GetContainerRecipePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContainerRecipePolicyResponse x
-> GetContainerRecipePolicyResponse
$cfrom :: forall x.
GetContainerRecipePolicyResponse
-> Rep GetContainerRecipePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContainerRecipePolicyResponse' 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:
--
-- 'policy', 'getContainerRecipePolicyResponse_policy' - The container recipe policy object that is returned.
--
-- 'requestId', 'getContainerRecipePolicyResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'getContainerRecipePolicyResponse_httpStatus' - The response's http status code.
newGetContainerRecipePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetContainerRecipePolicyResponse
newGetContainerRecipePolicyResponse :: Int -> GetContainerRecipePolicyResponse
newGetContainerRecipePolicyResponse Int
pHttpStatus_ =
  GetContainerRecipePolicyResponse'
    { $sel:policy:GetContainerRecipePolicyResponse' :: Maybe Text
policy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestId:GetContainerRecipePolicyResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetContainerRecipePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The container recipe policy object that is returned.
getContainerRecipePolicyResponse_policy :: Lens.Lens' GetContainerRecipePolicyResponse (Prelude.Maybe Prelude.Text)
getContainerRecipePolicyResponse_policy :: Lens' GetContainerRecipePolicyResponse (Maybe Text)
getContainerRecipePolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContainerRecipePolicyResponse' {Maybe Text
policy :: Maybe Text
$sel:policy:GetContainerRecipePolicyResponse' :: GetContainerRecipePolicyResponse -> Maybe Text
policy} -> Maybe Text
policy) (\s :: GetContainerRecipePolicyResponse
s@GetContainerRecipePolicyResponse' {} Maybe Text
a -> GetContainerRecipePolicyResponse
s {$sel:policy:GetContainerRecipePolicyResponse' :: Maybe Text
policy = Maybe Text
a} :: GetContainerRecipePolicyResponse)

-- | The request ID that uniquely identifies this request.
getContainerRecipePolicyResponse_requestId :: Lens.Lens' GetContainerRecipePolicyResponse (Prelude.Maybe Prelude.Text)
getContainerRecipePolicyResponse_requestId :: Lens' GetContainerRecipePolicyResponse (Maybe Text)
getContainerRecipePolicyResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContainerRecipePolicyResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:GetContainerRecipePolicyResponse' :: GetContainerRecipePolicyResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: GetContainerRecipePolicyResponse
s@GetContainerRecipePolicyResponse' {} Maybe Text
a -> GetContainerRecipePolicyResponse
s {$sel:requestId:GetContainerRecipePolicyResponse' :: Maybe Text
requestId = Maybe Text
a} :: GetContainerRecipePolicyResponse)

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

instance
  Prelude.NFData
    GetContainerRecipePolicyResponse
  where
  rnf :: GetContainerRecipePolicyResponse -> ()
rnf GetContainerRecipePolicyResponse' {Int
Maybe Text
httpStatus :: Int
requestId :: Maybe Text
policy :: Maybe Text
$sel:httpStatus:GetContainerRecipePolicyResponse' :: GetContainerRecipePolicyResponse -> Int
$sel:requestId:GetContainerRecipePolicyResponse' :: GetContainerRecipePolicyResponse -> Maybe Text
$sel:policy:GetContainerRecipePolicyResponse' :: GetContainerRecipePolicyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus