{-# 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.Lambda.GetLayerVersionPolicy
-- 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 the permission policy for a version of an
-- <https://docs.aws.amazon.com/lambda/latest/dg/configuration-layers.html Lambda layer>.
-- For more information, see AddLayerVersionPermission.
module Amazonka.Lambda.GetLayerVersionPolicy
  ( -- * Creating a Request
    GetLayerVersionPolicy (..),
    newGetLayerVersionPolicy,

    -- * Request Lenses
    getLayerVersionPolicy_layerName,
    getLayerVersionPolicy_versionNumber,

    -- * Destructuring the Response
    GetLayerVersionPolicyResponse (..),
    newGetLayerVersionPolicyResponse,

    -- * Response Lenses
    getLayerVersionPolicyResponse_policy,
    getLayerVersionPolicyResponse_revisionId,
    getLayerVersionPolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetLayerVersionPolicy' smart constructor.
data GetLayerVersionPolicy = GetLayerVersionPolicy'
  { -- | The name or Amazon Resource Name (ARN) of the layer.
    GetLayerVersionPolicy -> Text
layerName :: Prelude.Text,
    -- | The version number.
    GetLayerVersionPolicy -> Integer
versionNumber :: Prelude.Integer
  }
  deriving (GetLayerVersionPolicy -> GetLayerVersionPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLayerVersionPolicy -> GetLayerVersionPolicy -> Bool
$c/= :: GetLayerVersionPolicy -> GetLayerVersionPolicy -> Bool
== :: GetLayerVersionPolicy -> GetLayerVersionPolicy -> Bool
$c== :: GetLayerVersionPolicy -> GetLayerVersionPolicy -> Bool
Prelude.Eq, ReadPrec [GetLayerVersionPolicy]
ReadPrec GetLayerVersionPolicy
Int -> ReadS GetLayerVersionPolicy
ReadS [GetLayerVersionPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLayerVersionPolicy]
$creadListPrec :: ReadPrec [GetLayerVersionPolicy]
readPrec :: ReadPrec GetLayerVersionPolicy
$creadPrec :: ReadPrec GetLayerVersionPolicy
readList :: ReadS [GetLayerVersionPolicy]
$creadList :: ReadS [GetLayerVersionPolicy]
readsPrec :: Int -> ReadS GetLayerVersionPolicy
$creadsPrec :: Int -> ReadS GetLayerVersionPolicy
Prelude.Read, Int -> GetLayerVersionPolicy -> ShowS
[GetLayerVersionPolicy] -> ShowS
GetLayerVersionPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLayerVersionPolicy] -> ShowS
$cshowList :: [GetLayerVersionPolicy] -> ShowS
show :: GetLayerVersionPolicy -> String
$cshow :: GetLayerVersionPolicy -> String
showsPrec :: Int -> GetLayerVersionPolicy -> ShowS
$cshowsPrec :: Int -> GetLayerVersionPolicy -> ShowS
Prelude.Show, forall x. Rep GetLayerVersionPolicy x -> GetLayerVersionPolicy
forall x. GetLayerVersionPolicy -> Rep GetLayerVersionPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLayerVersionPolicy x -> GetLayerVersionPolicy
$cfrom :: forall x. GetLayerVersionPolicy -> Rep GetLayerVersionPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetLayerVersionPolicy' 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:
--
-- 'layerName', 'getLayerVersionPolicy_layerName' - The name or Amazon Resource Name (ARN) of the layer.
--
-- 'versionNumber', 'getLayerVersionPolicy_versionNumber' - The version number.
newGetLayerVersionPolicy ::
  -- | 'layerName'
  Prelude.Text ->
  -- | 'versionNumber'
  Prelude.Integer ->
  GetLayerVersionPolicy
newGetLayerVersionPolicy :: Text -> Integer -> GetLayerVersionPolicy
newGetLayerVersionPolicy Text
pLayerName_ Integer
pVersionNumber_ =
  GetLayerVersionPolicy'
    { $sel:layerName:GetLayerVersionPolicy' :: Text
layerName = Text
pLayerName_,
      $sel:versionNumber:GetLayerVersionPolicy' :: Integer
versionNumber = Integer
pVersionNumber_
    }

-- | The name or Amazon Resource Name (ARN) of the layer.
getLayerVersionPolicy_layerName :: Lens.Lens' GetLayerVersionPolicy Prelude.Text
getLayerVersionPolicy_layerName :: Lens' GetLayerVersionPolicy Text
getLayerVersionPolicy_layerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLayerVersionPolicy' {Text
layerName :: Text
$sel:layerName:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Text
layerName} -> Text
layerName) (\s :: GetLayerVersionPolicy
s@GetLayerVersionPolicy' {} Text
a -> GetLayerVersionPolicy
s {$sel:layerName:GetLayerVersionPolicy' :: Text
layerName = Text
a} :: GetLayerVersionPolicy)

-- | The version number.
getLayerVersionPolicy_versionNumber :: Lens.Lens' GetLayerVersionPolicy Prelude.Integer
getLayerVersionPolicy_versionNumber :: Lens' GetLayerVersionPolicy Integer
getLayerVersionPolicy_versionNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLayerVersionPolicy' {Integer
versionNumber :: Integer
$sel:versionNumber:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Integer
versionNumber} -> Integer
versionNumber) (\s :: GetLayerVersionPolicy
s@GetLayerVersionPolicy' {} Integer
a -> GetLayerVersionPolicy
s {$sel:versionNumber:GetLayerVersionPolicy' :: Integer
versionNumber = Integer
a} :: GetLayerVersionPolicy)

instance Core.AWSRequest GetLayerVersionPolicy where
  type
    AWSResponse GetLayerVersionPolicy =
      GetLayerVersionPolicyResponse
  request :: (Service -> Service)
-> GetLayerVersionPolicy -> Request GetLayerVersionPolicy
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 GetLayerVersionPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetLayerVersionPolicy)))
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 -> GetLayerVersionPolicyResponse
GetLayerVersionPolicyResponse'
            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
"RevisionId")
            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 GetLayerVersionPolicy where
  hashWithSalt :: Int -> GetLayerVersionPolicy -> Int
hashWithSalt Int
_salt GetLayerVersionPolicy' {Integer
Text
versionNumber :: Integer
layerName :: Text
$sel:versionNumber:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Integer
$sel:layerName:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
layerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
versionNumber

instance Prelude.NFData GetLayerVersionPolicy where
  rnf :: GetLayerVersionPolicy -> ()
rnf GetLayerVersionPolicy' {Integer
Text
versionNumber :: Integer
layerName :: Text
$sel:versionNumber:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Integer
$sel:layerName:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
layerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
versionNumber

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

instance Data.ToPath GetLayerVersionPolicy where
  toPath :: GetLayerVersionPolicy -> ByteString
toPath GetLayerVersionPolicy' {Integer
Text
versionNumber :: Integer
layerName :: Text
$sel:versionNumber:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Integer
$sel:layerName:GetLayerVersionPolicy' :: GetLayerVersionPolicy -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2018-10-31/layers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
layerName,
        ByteString
"/versions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Integer
versionNumber,
        ByteString
"/policy"
      ]

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

-- | /See:/ 'newGetLayerVersionPolicyResponse' smart constructor.
data GetLayerVersionPolicyResponse = GetLayerVersionPolicyResponse'
  { -- | The policy document.
    GetLayerVersionPolicyResponse -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the current revision of the policy.
    GetLayerVersionPolicyResponse -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetLayerVersionPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLayerVersionPolicyResponse
-> GetLayerVersionPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLayerVersionPolicyResponse
-> GetLayerVersionPolicyResponse -> Bool
$c/= :: GetLayerVersionPolicyResponse
-> GetLayerVersionPolicyResponse -> Bool
== :: GetLayerVersionPolicyResponse
-> GetLayerVersionPolicyResponse -> Bool
$c== :: GetLayerVersionPolicyResponse
-> GetLayerVersionPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetLayerVersionPolicyResponse]
ReadPrec GetLayerVersionPolicyResponse
Int -> ReadS GetLayerVersionPolicyResponse
ReadS [GetLayerVersionPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLayerVersionPolicyResponse]
$creadListPrec :: ReadPrec [GetLayerVersionPolicyResponse]
readPrec :: ReadPrec GetLayerVersionPolicyResponse
$creadPrec :: ReadPrec GetLayerVersionPolicyResponse
readList :: ReadS [GetLayerVersionPolicyResponse]
$creadList :: ReadS [GetLayerVersionPolicyResponse]
readsPrec :: Int -> ReadS GetLayerVersionPolicyResponse
$creadsPrec :: Int -> ReadS GetLayerVersionPolicyResponse
Prelude.Read, Int -> GetLayerVersionPolicyResponse -> ShowS
[GetLayerVersionPolicyResponse] -> ShowS
GetLayerVersionPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLayerVersionPolicyResponse] -> ShowS
$cshowList :: [GetLayerVersionPolicyResponse] -> ShowS
show :: GetLayerVersionPolicyResponse -> String
$cshow :: GetLayerVersionPolicyResponse -> String
showsPrec :: Int -> GetLayerVersionPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetLayerVersionPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep GetLayerVersionPolicyResponse x
-> GetLayerVersionPolicyResponse
forall x.
GetLayerVersionPolicyResponse
-> Rep GetLayerVersionPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetLayerVersionPolicyResponse x
-> GetLayerVersionPolicyResponse
$cfrom :: forall x.
GetLayerVersionPolicyResponse
-> Rep GetLayerVersionPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLayerVersionPolicyResponse' 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', 'getLayerVersionPolicyResponse_policy' - The policy document.
--
-- 'revisionId', 'getLayerVersionPolicyResponse_revisionId' - A unique identifier for the current revision of the policy.
--
-- 'httpStatus', 'getLayerVersionPolicyResponse_httpStatus' - The response's http status code.
newGetLayerVersionPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLayerVersionPolicyResponse
newGetLayerVersionPolicyResponse :: Int -> GetLayerVersionPolicyResponse
newGetLayerVersionPolicyResponse Int
pHttpStatus_ =
  GetLayerVersionPolicyResponse'
    { $sel:policy:GetLayerVersionPolicyResponse' :: Maybe Text
policy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:revisionId:GetLayerVersionPolicyResponse' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLayerVersionPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The policy document.
getLayerVersionPolicyResponse_policy :: Lens.Lens' GetLayerVersionPolicyResponse (Prelude.Maybe Prelude.Text)
getLayerVersionPolicyResponse_policy :: Lens' GetLayerVersionPolicyResponse (Maybe Text)
getLayerVersionPolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLayerVersionPolicyResponse' {Maybe Text
policy :: Maybe Text
$sel:policy:GetLayerVersionPolicyResponse' :: GetLayerVersionPolicyResponse -> Maybe Text
policy} -> Maybe Text
policy) (\s :: GetLayerVersionPolicyResponse
s@GetLayerVersionPolicyResponse' {} Maybe Text
a -> GetLayerVersionPolicyResponse
s {$sel:policy:GetLayerVersionPolicyResponse' :: Maybe Text
policy = Maybe Text
a} :: GetLayerVersionPolicyResponse)

-- | A unique identifier for the current revision of the policy.
getLayerVersionPolicyResponse_revisionId :: Lens.Lens' GetLayerVersionPolicyResponse (Prelude.Maybe Prelude.Text)
getLayerVersionPolicyResponse_revisionId :: Lens' GetLayerVersionPolicyResponse (Maybe Text)
getLayerVersionPolicyResponse_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLayerVersionPolicyResponse' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:GetLayerVersionPolicyResponse' :: GetLayerVersionPolicyResponse -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: GetLayerVersionPolicyResponse
s@GetLayerVersionPolicyResponse' {} Maybe Text
a -> GetLayerVersionPolicyResponse
s {$sel:revisionId:GetLayerVersionPolicyResponse' :: Maybe Text
revisionId = Maybe Text
a} :: GetLayerVersionPolicyResponse)

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

instance Prelude.NFData GetLayerVersionPolicyResponse where
  rnf :: GetLayerVersionPolicyResponse -> ()
rnf GetLayerVersionPolicyResponse' {Int
Maybe Text
httpStatus :: Int
revisionId :: Maybe Text
policy :: Maybe Text
$sel:httpStatus:GetLayerVersionPolicyResponse' :: GetLayerVersionPolicyResponse -> Int
$sel:revisionId:GetLayerVersionPolicyResponse' :: GetLayerVersionPolicyResponse -> Maybe Text
$sel:policy:GetLayerVersionPolicyResponse' :: GetLayerVersionPolicyResponse -> 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
revisionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus