{-# 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.GetFunctionCodeSigningConfig
-- 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 code signing configuration for the specified function.
module Amazonka.Lambda.GetFunctionCodeSigningConfig
  ( -- * Creating a Request
    GetFunctionCodeSigningConfig (..),
    newGetFunctionCodeSigningConfig,

    -- * Request Lenses
    getFunctionCodeSigningConfig_functionName,

    -- * Destructuring the Response
    GetFunctionCodeSigningConfigResponse (..),
    newGetFunctionCodeSigningConfigResponse,

    -- * Response Lenses
    getFunctionCodeSigningConfigResponse_httpStatus,
    getFunctionCodeSigningConfigResponse_codeSigningConfigArn,
    getFunctionCodeSigningConfigResponse_functionName,
  )
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:/ 'newGetFunctionCodeSigningConfig' smart constructor.
data GetFunctionCodeSigningConfig = GetFunctionCodeSigningConfig'
  { -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ - @MyFunction@.
    --
    -- -   __Function ARN__ -
    --     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
    --
    -- -   __Partial ARN__ - @123456789012:function:MyFunction@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it is limited to 64 characters in length.
    GetFunctionCodeSigningConfig -> Text
functionName :: Prelude.Text
  }
  deriving (GetFunctionCodeSigningConfig
-> GetFunctionCodeSigningConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFunctionCodeSigningConfig
-> GetFunctionCodeSigningConfig -> Bool
$c/= :: GetFunctionCodeSigningConfig
-> GetFunctionCodeSigningConfig -> Bool
== :: GetFunctionCodeSigningConfig
-> GetFunctionCodeSigningConfig -> Bool
$c== :: GetFunctionCodeSigningConfig
-> GetFunctionCodeSigningConfig -> Bool
Prelude.Eq, ReadPrec [GetFunctionCodeSigningConfig]
ReadPrec GetFunctionCodeSigningConfig
Int -> ReadS GetFunctionCodeSigningConfig
ReadS [GetFunctionCodeSigningConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFunctionCodeSigningConfig]
$creadListPrec :: ReadPrec [GetFunctionCodeSigningConfig]
readPrec :: ReadPrec GetFunctionCodeSigningConfig
$creadPrec :: ReadPrec GetFunctionCodeSigningConfig
readList :: ReadS [GetFunctionCodeSigningConfig]
$creadList :: ReadS [GetFunctionCodeSigningConfig]
readsPrec :: Int -> ReadS GetFunctionCodeSigningConfig
$creadsPrec :: Int -> ReadS GetFunctionCodeSigningConfig
Prelude.Read, Int -> GetFunctionCodeSigningConfig -> ShowS
[GetFunctionCodeSigningConfig] -> ShowS
GetFunctionCodeSigningConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFunctionCodeSigningConfig] -> ShowS
$cshowList :: [GetFunctionCodeSigningConfig] -> ShowS
show :: GetFunctionCodeSigningConfig -> String
$cshow :: GetFunctionCodeSigningConfig -> String
showsPrec :: Int -> GetFunctionCodeSigningConfig -> ShowS
$cshowsPrec :: Int -> GetFunctionCodeSigningConfig -> ShowS
Prelude.Show, forall x.
Rep GetFunctionCodeSigningConfig x -> GetFunctionCodeSigningConfig
forall x.
GetFunctionCodeSigningConfig -> Rep GetFunctionCodeSigningConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetFunctionCodeSigningConfig x -> GetFunctionCodeSigningConfig
$cfrom :: forall x.
GetFunctionCodeSigningConfig -> Rep GetFunctionCodeSigningConfig x
Prelude.Generic)

-- |
-- Create a value of 'GetFunctionCodeSigningConfig' 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:
--
-- 'functionName', 'getFunctionCodeSigningConfig_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
newGetFunctionCodeSigningConfig ::
  -- | 'functionName'
  Prelude.Text ->
  GetFunctionCodeSigningConfig
newGetFunctionCodeSigningConfig :: Text -> GetFunctionCodeSigningConfig
newGetFunctionCodeSigningConfig Text
pFunctionName_ =
  GetFunctionCodeSigningConfig'
    { $sel:functionName:GetFunctionCodeSigningConfig' :: Text
functionName =
        Text
pFunctionName_
    }

-- | The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
getFunctionCodeSigningConfig_functionName :: Lens.Lens' GetFunctionCodeSigningConfig Prelude.Text
getFunctionCodeSigningConfig_functionName :: Lens' GetFunctionCodeSigningConfig Text
getFunctionCodeSigningConfig_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionCodeSigningConfig' {Text
functionName :: Text
$sel:functionName:GetFunctionCodeSigningConfig' :: GetFunctionCodeSigningConfig -> Text
functionName} -> Text
functionName) (\s :: GetFunctionCodeSigningConfig
s@GetFunctionCodeSigningConfig' {} Text
a -> GetFunctionCodeSigningConfig
s {$sel:functionName:GetFunctionCodeSigningConfig' :: Text
functionName = Text
a} :: GetFunctionCodeSigningConfig)

instance Core.AWSRequest GetFunctionCodeSigningConfig where
  type
    AWSResponse GetFunctionCodeSigningConfig =
      GetFunctionCodeSigningConfigResponse
  request :: (Service -> Service)
-> GetFunctionCodeSigningConfig
-> Request GetFunctionCodeSigningConfig
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 GetFunctionCodeSigningConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetFunctionCodeSigningConfig)))
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 ->
          Int -> Text -> Text -> GetFunctionCodeSigningConfigResponse
GetFunctionCodeSigningConfigResponse'
            forall (f :: * -> *) a b. Functor 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
"CodeSigningConfigArn")
            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
"FunctionName")
      )

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

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

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

instance Data.ToPath GetFunctionCodeSigningConfig where
  toPath :: GetFunctionCodeSigningConfig -> ByteString
toPath GetFunctionCodeSigningConfig' {Text
functionName :: Text
$sel:functionName:GetFunctionCodeSigningConfig' :: GetFunctionCodeSigningConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-06-30/functions/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
functionName,
        ByteString
"/code-signing-config"
      ]

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

-- | /See:/ 'newGetFunctionCodeSigningConfigResponse' smart constructor.
data GetFunctionCodeSigningConfigResponse = GetFunctionCodeSigningConfigResponse'
  { -- | The response's http status code.
    GetFunctionCodeSigningConfigResponse -> Int
httpStatus :: Prelude.Int,
    -- | The The Amazon Resource Name (ARN) of the code signing configuration.
    GetFunctionCodeSigningConfigResponse -> Text
codeSigningConfigArn :: Prelude.Text,
    -- | The name of the Lambda function.
    --
    -- __Name formats__
    --
    -- -   __Function name__ - @MyFunction@.
    --
    -- -   __Function ARN__ -
    --     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
    --
    -- -   __Partial ARN__ - @123456789012:function:MyFunction@.
    --
    -- The length constraint applies only to the full ARN. If you specify only
    -- the function name, it is limited to 64 characters in length.
    GetFunctionCodeSigningConfigResponse -> Text
functionName :: Prelude.Text
  }
  deriving (GetFunctionCodeSigningConfigResponse
-> GetFunctionCodeSigningConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetFunctionCodeSigningConfigResponse
-> GetFunctionCodeSigningConfigResponse -> Bool
$c/= :: GetFunctionCodeSigningConfigResponse
-> GetFunctionCodeSigningConfigResponse -> Bool
== :: GetFunctionCodeSigningConfigResponse
-> GetFunctionCodeSigningConfigResponse -> Bool
$c== :: GetFunctionCodeSigningConfigResponse
-> GetFunctionCodeSigningConfigResponse -> Bool
Prelude.Eq, ReadPrec [GetFunctionCodeSigningConfigResponse]
ReadPrec GetFunctionCodeSigningConfigResponse
Int -> ReadS GetFunctionCodeSigningConfigResponse
ReadS [GetFunctionCodeSigningConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetFunctionCodeSigningConfigResponse]
$creadListPrec :: ReadPrec [GetFunctionCodeSigningConfigResponse]
readPrec :: ReadPrec GetFunctionCodeSigningConfigResponse
$creadPrec :: ReadPrec GetFunctionCodeSigningConfigResponse
readList :: ReadS [GetFunctionCodeSigningConfigResponse]
$creadList :: ReadS [GetFunctionCodeSigningConfigResponse]
readsPrec :: Int -> ReadS GetFunctionCodeSigningConfigResponse
$creadsPrec :: Int -> ReadS GetFunctionCodeSigningConfigResponse
Prelude.Read, Int -> GetFunctionCodeSigningConfigResponse -> ShowS
[GetFunctionCodeSigningConfigResponse] -> ShowS
GetFunctionCodeSigningConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetFunctionCodeSigningConfigResponse] -> ShowS
$cshowList :: [GetFunctionCodeSigningConfigResponse] -> ShowS
show :: GetFunctionCodeSigningConfigResponse -> String
$cshow :: GetFunctionCodeSigningConfigResponse -> String
showsPrec :: Int -> GetFunctionCodeSigningConfigResponse -> ShowS
$cshowsPrec :: Int -> GetFunctionCodeSigningConfigResponse -> ShowS
Prelude.Show, forall x.
Rep GetFunctionCodeSigningConfigResponse x
-> GetFunctionCodeSigningConfigResponse
forall x.
GetFunctionCodeSigningConfigResponse
-> Rep GetFunctionCodeSigningConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetFunctionCodeSigningConfigResponse x
-> GetFunctionCodeSigningConfigResponse
$cfrom :: forall x.
GetFunctionCodeSigningConfigResponse
-> Rep GetFunctionCodeSigningConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetFunctionCodeSigningConfigResponse' 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:
--
-- 'httpStatus', 'getFunctionCodeSigningConfigResponse_httpStatus' - The response's http status code.
--
-- 'codeSigningConfigArn', 'getFunctionCodeSigningConfigResponse_codeSigningConfigArn' - The The Amazon Resource Name (ARN) of the code signing configuration.
--
-- 'functionName', 'getFunctionCodeSigningConfigResponse_functionName' - The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
newGetFunctionCodeSigningConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'codeSigningConfigArn'
  Prelude.Text ->
  -- | 'functionName'
  Prelude.Text ->
  GetFunctionCodeSigningConfigResponse
newGetFunctionCodeSigningConfigResponse :: Int -> Text -> Text -> GetFunctionCodeSigningConfigResponse
newGetFunctionCodeSigningConfigResponse
  Int
pHttpStatus_
  Text
pCodeSigningConfigArn_
  Text
pFunctionName_ =
    GetFunctionCodeSigningConfigResponse'
      { $sel:httpStatus:GetFunctionCodeSigningConfigResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:codeSigningConfigArn:GetFunctionCodeSigningConfigResponse' :: Text
codeSigningConfigArn =
          Text
pCodeSigningConfigArn_,
        $sel:functionName:GetFunctionCodeSigningConfigResponse' :: Text
functionName = Text
pFunctionName_
      }

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

-- | The The Amazon Resource Name (ARN) of the code signing configuration.
getFunctionCodeSigningConfigResponse_codeSigningConfigArn :: Lens.Lens' GetFunctionCodeSigningConfigResponse Prelude.Text
getFunctionCodeSigningConfigResponse_codeSigningConfigArn :: Lens' GetFunctionCodeSigningConfigResponse Text
getFunctionCodeSigningConfigResponse_codeSigningConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionCodeSigningConfigResponse' {Text
codeSigningConfigArn :: Text
$sel:codeSigningConfigArn:GetFunctionCodeSigningConfigResponse' :: GetFunctionCodeSigningConfigResponse -> Text
codeSigningConfigArn} -> Text
codeSigningConfigArn) (\s :: GetFunctionCodeSigningConfigResponse
s@GetFunctionCodeSigningConfigResponse' {} Text
a -> GetFunctionCodeSigningConfigResponse
s {$sel:codeSigningConfigArn:GetFunctionCodeSigningConfigResponse' :: Text
codeSigningConfigArn = Text
a} :: GetFunctionCodeSigningConfigResponse)

-- | The name of the Lambda function.
--
-- __Name formats__
--
-- -   __Function name__ - @MyFunction@.
--
-- -   __Function ARN__ -
--     @arn:aws:lambda:us-west-2:123456789012:function:MyFunction@.
--
-- -   __Partial ARN__ - @123456789012:function:MyFunction@.
--
-- The length constraint applies only to the full ARN. If you specify only
-- the function name, it is limited to 64 characters in length.
getFunctionCodeSigningConfigResponse_functionName :: Lens.Lens' GetFunctionCodeSigningConfigResponse Prelude.Text
getFunctionCodeSigningConfigResponse_functionName :: Lens' GetFunctionCodeSigningConfigResponse Text
getFunctionCodeSigningConfigResponse_functionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetFunctionCodeSigningConfigResponse' {Text
functionName :: Text
$sel:functionName:GetFunctionCodeSigningConfigResponse' :: GetFunctionCodeSigningConfigResponse -> Text
functionName} -> Text
functionName) (\s :: GetFunctionCodeSigningConfigResponse
s@GetFunctionCodeSigningConfigResponse' {} Text
a -> GetFunctionCodeSigningConfigResponse
s {$sel:functionName:GetFunctionCodeSigningConfigResponse' :: Text
functionName = Text
a} :: GetFunctionCodeSigningConfigResponse)

instance
  Prelude.NFData
    GetFunctionCodeSigningConfigResponse
  where
  rnf :: GetFunctionCodeSigningConfigResponse -> ()
rnf GetFunctionCodeSigningConfigResponse' {Int
Text
functionName :: Text
codeSigningConfigArn :: Text
httpStatus :: Int
$sel:functionName:GetFunctionCodeSigningConfigResponse' :: GetFunctionCodeSigningConfigResponse -> Text
$sel:codeSigningConfigArn:GetFunctionCodeSigningConfigResponse' :: GetFunctionCodeSigningConfigResponse -> Text
$sel:httpStatus:GetFunctionCodeSigningConfigResponse' :: GetFunctionCodeSigningConfigResponse -> Int
..} =
    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 Text
codeSigningConfigArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
functionName