{-# 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.GetCodeSigningConfig
-- 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 information about the specified code signing configuration.
module Amazonka.Lambda.GetCodeSigningConfig
  ( -- * Creating a Request
    GetCodeSigningConfig (..),
    newGetCodeSigningConfig,

    -- * Request Lenses
    getCodeSigningConfig_codeSigningConfigArn,

    -- * Destructuring the Response
    GetCodeSigningConfigResponse (..),
    newGetCodeSigningConfigResponse,

    -- * Response Lenses
    getCodeSigningConfigResponse_httpStatus,
    getCodeSigningConfigResponse_codeSigningConfig,
  )
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:/ 'newGetCodeSigningConfig' smart constructor.
data GetCodeSigningConfig = GetCodeSigningConfig'
  { -- | The The Amazon Resource Name (ARN) of the code signing configuration.
    GetCodeSigningConfig -> Text
codeSigningConfigArn :: Prelude.Text
  }
  deriving (GetCodeSigningConfig -> GetCodeSigningConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCodeSigningConfig -> GetCodeSigningConfig -> Bool
$c/= :: GetCodeSigningConfig -> GetCodeSigningConfig -> Bool
== :: GetCodeSigningConfig -> GetCodeSigningConfig -> Bool
$c== :: GetCodeSigningConfig -> GetCodeSigningConfig -> Bool
Prelude.Eq, ReadPrec [GetCodeSigningConfig]
ReadPrec GetCodeSigningConfig
Int -> ReadS GetCodeSigningConfig
ReadS [GetCodeSigningConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCodeSigningConfig]
$creadListPrec :: ReadPrec [GetCodeSigningConfig]
readPrec :: ReadPrec GetCodeSigningConfig
$creadPrec :: ReadPrec GetCodeSigningConfig
readList :: ReadS [GetCodeSigningConfig]
$creadList :: ReadS [GetCodeSigningConfig]
readsPrec :: Int -> ReadS GetCodeSigningConfig
$creadsPrec :: Int -> ReadS GetCodeSigningConfig
Prelude.Read, Int -> GetCodeSigningConfig -> ShowS
[GetCodeSigningConfig] -> ShowS
GetCodeSigningConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCodeSigningConfig] -> ShowS
$cshowList :: [GetCodeSigningConfig] -> ShowS
show :: GetCodeSigningConfig -> String
$cshow :: GetCodeSigningConfig -> String
showsPrec :: Int -> GetCodeSigningConfig -> ShowS
$cshowsPrec :: Int -> GetCodeSigningConfig -> ShowS
Prelude.Show, forall x. Rep GetCodeSigningConfig x -> GetCodeSigningConfig
forall x. GetCodeSigningConfig -> Rep GetCodeSigningConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCodeSigningConfig x -> GetCodeSigningConfig
$cfrom :: forall x. GetCodeSigningConfig -> Rep GetCodeSigningConfig x
Prelude.Generic)

-- |
-- Create a value of 'GetCodeSigningConfig' 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:
--
-- 'codeSigningConfigArn', 'getCodeSigningConfig_codeSigningConfigArn' - The The Amazon Resource Name (ARN) of the code signing configuration.
newGetCodeSigningConfig ::
  -- | 'codeSigningConfigArn'
  Prelude.Text ->
  GetCodeSigningConfig
newGetCodeSigningConfig :: Text -> GetCodeSigningConfig
newGetCodeSigningConfig Text
pCodeSigningConfigArn_ =
  GetCodeSigningConfig'
    { $sel:codeSigningConfigArn:GetCodeSigningConfig' :: Text
codeSigningConfigArn =
        Text
pCodeSigningConfigArn_
    }

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

instance Core.AWSRequest GetCodeSigningConfig where
  type
    AWSResponse GetCodeSigningConfig =
      GetCodeSigningConfigResponse
  request :: (Service -> Service)
-> GetCodeSigningConfig -> Request GetCodeSigningConfig
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 GetCodeSigningConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCodeSigningConfig)))
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 -> CodeSigningConfig -> GetCodeSigningConfigResponse
GetCodeSigningConfigResponse'
            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
"CodeSigningConfig")
      )

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

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

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

instance Data.ToPath GetCodeSigningConfig where
  toPath :: GetCodeSigningConfig -> ByteString
toPath GetCodeSigningConfig' {Text
codeSigningConfigArn :: Text
$sel:codeSigningConfigArn:GetCodeSigningConfig' :: GetCodeSigningConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2020-04-22/code-signing-configs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
codeSigningConfigArn
      ]

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

-- | /See:/ 'newGetCodeSigningConfigResponse' smart constructor.
data GetCodeSigningConfigResponse = GetCodeSigningConfigResponse'
  { -- | The response's http status code.
    GetCodeSigningConfigResponse -> Int
httpStatus :: Prelude.Int,
    -- | The code signing configuration
    GetCodeSigningConfigResponse -> CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
  }
  deriving (GetCodeSigningConfigResponse
-> GetCodeSigningConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCodeSigningConfigResponse
-> GetCodeSigningConfigResponse -> Bool
$c/= :: GetCodeSigningConfigResponse
-> GetCodeSigningConfigResponse -> Bool
== :: GetCodeSigningConfigResponse
-> GetCodeSigningConfigResponse -> Bool
$c== :: GetCodeSigningConfigResponse
-> GetCodeSigningConfigResponse -> Bool
Prelude.Eq, ReadPrec [GetCodeSigningConfigResponse]
ReadPrec GetCodeSigningConfigResponse
Int -> ReadS GetCodeSigningConfigResponse
ReadS [GetCodeSigningConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCodeSigningConfigResponse]
$creadListPrec :: ReadPrec [GetCodeSigningConfigResponse]
readPrec :: ReadPrec GetCodeSigningConfigResponse
$creadPrec :: ReadPrec GetCodeSigningConfigResponse
readList :: ReadS [GetCodeSigningConfigResponse]
$creadList :: ReadS [GetCodeSigningConfigResponse]
readsPrec :: Int -> ReadS GetCodeSigningConfigResponse
$creadsPrec :: Int -> ReadS GetCodeSigningConfigResponse
Prelude.Read, Int -> GetCodeSigningConfigResponse -> ShowS
[GetCodeSigningConfigResponse] -> ShowS
GetCodeSigningConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCodeSigningConfigResponse] -> ShowS
$cshowList :: [GetCodeSigningConfigResponse] -> ShowS
show :: GetCodeSigningConfigResponse -> String
$cshow :: GetCodeSigningConfigResponse -> String
showsPrec :: Int -> GetCodeSigningConfigResponse -> ShowS
$cshowsPrec :: Int -> GetCodeSigningConfigResponse -> ShowS
Prelude.Show, forall x.
Rep GetCodeSigningConfigResponse x -> GetCodeSigningConfigResponse
forall x.
GetCodeSigningConfigResponse -> Rep GetCodeSigningConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCodeSigningConfigResponse x -> GetCodeSigningConfigResponse
$cfrom :: forall x.
GetCodeSigningConfigResponse -> Rep GetCodeSigningConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCodeSigningConfigResponse' 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', 'getCodeSigningConfigResponse_httpStatus' - The response's http status code.
--
-- 'codeSigningConfig', 'getCodeSigningConfigResponse_codeSigningConfig' - The code signing configuration
newGetCodeSigningConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'codeSigningConfig'
  CodeSigningConfig ->
  GetCodeSigningConfigResponse
newGetCodeSigningConfigResponse :: Int -> CodeSigningConfig -> GetCodeSigningConfigResponse
newGetCodeSigningConfigResponse
  Int
pHttpStatus_
  CodeSigningConfig
pCodeSigningConfig_ =
    GetCodeSigningConfigResponse'
      { $sel:httpStatus:GetCodeSigningConfigResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:codeSigningConfig:GetCodeSigningConfigResponse' :: CodeSigningConfig
codeSigningConfig = CodeSigningConfig
pCodeSigningConfig_
      }

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

-- | The code signing configuration
getCodeSigningConfigResponse_codeSigningConfig :: Lens.Lens' GetCodeSigningConfigResponse CodeSigningConfig
getCodeSigningConfigResponse_codeSigningConfig :: Lens' GetCodeSigningConfigResponse CodeSigningConfig
getCodeSigningConfigResponse_codeSigningConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeSigningConfigResponse' {CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
$sel:codeSigningConfig:GetCodeSigningConfigResponse' :: GetCodeSigningConfigResponse -> CodeSigningConfig
codeSigningConfig} -> CodeSigningConfig
codeSigningConfig) (\s :: GetCodeSigningConfigResponse
s@GetCodeSigningConfigResponse' {} CodeSigningConfig
a -> GetCodeSigningConfigResponse
s {$sel:codeSigningConfig:GetCodeSigningConfigResponse' :: CodeSigningConfig
codeSigningConfig = CodeSigningConfig
a} :: GetCodeSigningConfigResponse)

instance Prelude.NFData GetCodeSigningConfigResponse where
  rnf :: GetCodeSigningConfigResponse -> ()
rnf GetCodeSigningConfigResponse' {Int
CodeSigningConfig
codeSigningConfig :: CodeSigningConfig
httpStatus :: Int
$sel:codeSigningConfig:GetCodeSigningConfigResponse' :: GetCodeSigningConfigResponse -> CodeSigningConfig
$sel:httpStatus:GetCodeSigningConfigResponse' :: GetCodeSigningConfigResponse -> 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 CodeSigningConfig
codeSigningConfig