{-# 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.CertificateManagerPCA.GetCertificateAuthorityCertificate
-- 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 certificate and certificate chain for your private
-- certificate authority (CA) or one that has been shared with you. Both
-- the certificate and the chain are base64 PEM-encoded. The chain does not
-- include the CA certificate. Each certificate in the chain signs the one
-- before it.
module Amazonka.CertificateManagerPCA.GetCertificateAuthorityCertificate
  ( -- * Creating a Request
    GetCertificateAuthorityCertificate (..),
    newGetCertificateAuthorityCertificate,

    -- * Request Lenses
    getCertificateAuthorityCertificate_certificateAuthorityArn,

    -- * Destructuring the Response
    GetCertificateAuthorityCertificateResponse (..),
    newGetCertificateAuthorityCertificateResponse,

    -- * Response Lenses
    getCertificateAuthorityCertificateResponse_certificate,
    getCertificateAuthorityCertificateResponse_certificateChain,
    getCertificateAuthorityCertificateResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetCertificateAuthorityCertificate' smart constructor.
data GetCertificateAuthorityCertificate = GetCertificateAuthorityCertificate'
  { -- | The Amazon Resource Name (ARN) of your private CA. This is of the form:
    --
    -- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
    GetCertificateAuthorityCertificate -> Text
certificateAuthorityArn :: Prelude.Text
  }
  deriving (GetCertificateAuthorityCertificate
-> GetCertificateAuthorityCertificate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCertificateAuthorityCertificate
-> GetCertificateAuthorityCertificate -> Bool
$c/= :: GetCertificateAuthorityCertificate
-> GetCertificateAuthorityCertificate -> Bool
== :: GetCertificateAuthorityCertificate
-> GetCertificateAuthorityCertificate -> Bool
$c== :: GetCertificateAuthorityCertificate
-> GetCertificateAuthorityCertificate -> Bool
Prelude.Eq, ReadPrec [GetCertificateAuthorityCertificate]
ReadPrec GetCertificateAuthorityCertificate
Int -> ReadS GetCertificateAuthorityCertificate
ReadS [GetCertificateAuthorityCertificate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCertificateAuthorityCertificate]
$creadListPrec :: ReadPrec [GetCertificateAuthorityCertificate]
readPrec :: ReadPrec GetCertificateAuthorityCertificate
$creadPrec :: ReadPrec GetCertificateAuthorityCertificate
readList :: ReadS [GetCertificateAuthorityCertificate]
$creadList :: ReadS [GetCertificateAuthorityCertificate]
readsPrec :: Int -> ReadS GetCertificateAuthorityCertificate
$creadsPrec :: Int -> ReadS GetCertificateAuthorityCertificate
Prelude.Read, Int -> GetCertificateAuthorityCertificate -> ShowS
[GetCertificateAuthorityCertificate] -> ShowS
GetCertificateAuthorityCertificate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCertificateAuthorityCertificate] -> ShowS
$cshowList :: [GetCertificateAuthorityCertificate] -> ShowS
show :: GetCertificateAuthorityCertificate -> String
$cshow :: GetCertificateAuthorityCertificate -> String
showsPrec :: Int -> GetCertificateAuthorityCertificate -> ShowS
$cshowsPrec :: Int -> GetCertificateAuthorityCertificate -> ShowS
Prelude.Show, forall x.
Rep GetCertificateAuthorityCertificate x
-> GetCertificateAuthorityCertificate
forall x.
GetCertificateAuthorityCertificate
-> Rep GetCertificateAuthorityCertificate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCertificateAuthorityCertificate x
-> GetCertificateAuthorityCertificate
$cfrom :: forall x.
GetCertificateAuthorityCertificate
-> Rep GetCertificateAuthorityCertificate x
Prelude.Generic)

-- |
-- Create a value of 'GetCertificateAuthorityCertificate' 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:
--
-- 'certificateAuthorityArn', 'getCertificateAuthorityCertificate_certificateAuthorityArn' - The Amazon Resource Name (ARN) of your private CA. This is of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
newGetCertificateAuthorityCertificate ::
  -- | 'certificateAuthorityArn'
  Prelude.Text ->
  GetCertificateAuthorityCertificate
newGetCertificateAuthorityCertificate :: Text -> GetCertificateAuthorityCertificate
newGetCertificateAuthorityCertificate
  Text
pCertificateAuthorityArn_ =
    GetCertificateAuthorityCertificate'
      { $sel:certificateAuthorityArn:GetCertificateAuthorityCertificate' :: Text
certificateAuthorityArn =
          Text
pCertificateAuthorityArn_
      }

-- | The Amazon Resource Name (ARN) of your private CA. This is of the form:
--
-- @arn:aws:acm-pca:@/@region@/@:@/@account@/@:certificate-authority\/@/@12345678-1234-1234-1234-123456789012@/@ @.
getCertificateAuthorityCertificate_certificateAuthorityArn :: Lens.Lens' GetCertificateAuthorityCertificate Prelude.Text
getCertificateAuthorityCertificate_certificateAuthorityArn :: Lens' GetCertificateAuthorityCertificate Text
getCertificateAuthorityCertificate_certificateAuthorityArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificateAuthorityCertificate' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:GetCertificateAuthorityCertificate' :: GetCertificateAuthorityCertificate -> Text
certificateAuthorityArn} -> Text
certificateAuthorityArn) (\s :: GetCertificateAuthorityCertificate
s@GetCertificateAuthorityCertificate' {} Text
a -> GetCertificateAuthorityCertificate
s {$sel:certificateAuthorityArn:GetCertificateAuthorityCertificate' :: Text
certificateAuthorityArn = Text
a} :: GetCertificateAuthorityCertificate)

instance
  Core.AWSRequest
    GetCertificateAuthorityCertificate
  where
  type
    AWSResponse GetCertificateAuthorityCertificate =
      GetCertificateAuthorityCertificateResponse
  request :: (Service -> Service)
-> GetCertificateAuthorityCertificate
-> Request GetCertificateAuthorityCertificate
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetCertificateAuthorityCertificate
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetCertificateAuthorityCertificate)))
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 -> GetCertificateAuthorityCertificateResponse
GetCertificateAuthorityCertificateResponse'
            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
"Certificate")
            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
"CertificateChain")
            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
    GetCertificateAuthorityCertificate
  where
  hashWithSalt :: Int -> GetCertificateAuthorityCertificate -> Int
hashWithSalt
    Int
_salt
    GetCertificateAuthorityCertificate' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:GetCertificateAuthorityCertificate' :: GetCertificateAuthorityCertificate -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
certificateAuthorityArn

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

instance
  Data.ToHeaders
    GetCertificateAuthorityCertificate
  where
  toHeaders :: GetCertificateAuthorityCertificate -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"ACMPrivateCA.GetCertificateAuthorityCertificate" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    GetCertificateAuthorityCertificate
  where
  toJSON :: GetCertificateAuthorityCertificate -> Value
toJSON GetCertificateAuthorityCertificate' {Text
certificateAuthorityArn :: Text
$sel:certificateAuthorityArn:GetCertificateAuthorityCertificate' :: GetCertificateAuthorityCertificate -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"CertificateAuthorityArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
certificateAuthorityArn
              )
          ]
      )

instance
  Data.ToPath
    GetCertificateAuthorityCertificate
  where
  toPath :: GetCertificateAuthorityCertificate -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetCertificateAuthorityCertificateResponse' smart constructor.
data GetCertificateAuthorityCertificateResponse = GetCertificateAuthorityCertificateResponse'
  { -- | Base64-encoded certificate authority (CA) certificate.
    GetCertificateAuthorityCertificateResponse -> Maybe Text
certificate :: Prelude.Maybe Prelude.Text,
    -- | Base64-encoded certificate chain that includes any intermediate
    -- certificates and chains up to root certificate that you used to sign
    -- your private CA certificate. The chain does not include your private CA
    -- certificate. If this is a root CA, the value will be null.
    GetCertificateAuthorityCertificateResponse -> Maybe Text
certificateChain :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCertificateAuthorityCertificateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCertificateAuthorityCertificateResponse
-> GetCertificateAuthorityCertificateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCertificateAuthorityCertificateResponse
-> GetCertificateAuthorityCertificateResponse -> Bool
$c/= :: GetCertificateAuthorityCertificateResponse
-> GetCertificateAuthorityCertificateResponse -> Bool
== :: GetCertificateAuthorityCertificateResponse
-> GetCertificateAuthorityCertificateResponse -> Bool
$c== :: GetCertificateAuthorityCertificateResponse
-> GetCertificateAuthorityCertificateResponse -> Bool
Prelude.Eq, ReadPrec [GetCertificateAuthorityCertificateResponse]
ReadPrec GetCertificateAuthorityCertificateResponse
Int -> ReadS GetCertificateAuthorityCertificateResponse
ReadS [GetCertificateAuthorityCertificateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCertificateAuthorityCertificateResponse]
$creadListPrec :: ReadPrec [GetCertificateAuthorityCertificateResponse]
readPrec :: ReadPrec GetCertificateAuthorityCertificateResponse
$creadPrec :: ReadPrec GetCertificateAuthorityCertificateResponse
readList :: ReadS [GetCertificateAuthorityCertificateResponse]
$creadList :: ReadS [GetCertificateAuthorityCertificateResponse]
readsPrec :: Int -> ReadS GetCertificateAuthorityCertificateResponse
$creadsPrec :: Int -> ReadS GetCertificateAuthorityCertificateResponse
Prelude.Read, Int -> GetCertificateAuthorityCertificateResponse -> ShowS
[GetCertificateAuthorityCertificateResponse] -> ShowS
GetCertificateAuthorityCertificateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCertificateAuthorityCertificateResponse] -> ShowS
$cshowList :: [GetCertificateAuthorityCertificateResponse] -> ShowS
show :: GetCertificateAuthorityCertificateResponse -> String
$cshow :: GetCertificateAuthorityCertificateResponse -> String
showsPrec :: Int -> GetCertificateAuthorityCertificateResponse -> ShowS
$cshowsPrec :: Int -> GetCertificateAuthorityCertificateResponse -> ShowS
Prelude.Show, forall x.
Rep GetCertificateAuthorityCertificateResponse x
-> GetCertificateAuthorityCertificateResponse
forall x.
GetCertificateAuthorityCertificateResponse
-> Rep GetCertificateAuthorityCertificateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCertificateAuthorityCertificateResponse x
-> GetCertificateAuthorityCertificateResponse
$cfrom :: forall x.
GetCertificateAuthorityCertificateResponse
-> Rep GetCertificateAuthorityCertificateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCertificateAuthorityCertificateResponse' 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:
--
-- 'certificate', 'getCertificateAuthorityCertificateResponse_certificate' - Base64-encoded certificate authority (CA) certificate.
--
-- 'certificateChain', 'getCertificateAuthorityCertificateResponse_certificateChain' - Base64-encoded certificate chain that includes any intermediate
-- certificates and chains up to root certificate that you used to sign
-- your private CA certificate. The chain does not include your private CA
-- certificate. If this is a root CA, the value will be null.
--
-- 'httpStatus', 'getCertificateAuthorityCertificateResponse_httpStatus' - The response's http status code.
newGetCertificateAuthorityCertificateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCertificateAuthorityCertificateResponse
newGetCertificateAuthorityCertificateResponse :: Int -> GetCertificateAuthorityCertificateResponse
newGetCertificateAuthorityCertificateResponse
  Int
pHttpStatus_ =
    GetCertificateAuthorityCertificateResponse'
      { $sel:certificate:GetCertificateAuthorityCertificateResponse' :: Maybe Text
certificate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:certificateChain:GetCertificateAuthorityCertificateResponse' :: Maybe Text
certificateChain =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetCertificateAuthorityCertificateResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Base64-encoded certificate authority (CA) certificate.
getCertificateAuthorityCertificateResponse_certificate :: Lens.Lens' GetCertificateAuthorityCertificateResponse (Prelude.Maybe Prelude.Text)
getCertificateAuthorityCertificateResponse_certificate :: Lens' GetCertificateAuthorityCertificateResponse (Maybe Text)
getCertificateAuthorityCertificateResponse_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificateAuthorityCertificateResponse' {Maybe Text
certificate :: Maybe Text
$sel:certificate:GetCertificateAuthorityCertificateResponse' :: GetCertificateAuthorityCertificateResponse -> Maybe Text
certificate} -> Maybe Text
certificate) (\s :: GetCertificateAuthorityCertificateResponse
s@GetCertificateAuthorityCertificateResponse' {} Maybe Text
a -> GetCertificateAuthorityCertificateResponse
s {$sel:certificate:GetCertificateAuthorityCertificateResponse' :: Maybe Text
certificate = Maybe Text
a} :: GetCertificateAuthorityCertificateResponse)

-- | Base64-encoded certificate chain that includes any intermediate
-- certificates and chains up to root certificate that you used to sign
-- your private CA certificate. The chain does not include your private CA
-- certificate. If this is a root CA, the value will be null.
getCertificateAuthorityCertificateResponse_certificateChain :: Lens.Lens' GetCertificateAuthorityCertificateResponse (Prelude.Maybe Prelude.Text)
getCertificateAuthorityCertificateResponse_certificateChain :: Lens' GetCertificateAuthorityCertificateResponse (Maybe Text)
getCertificateAuthorityCertificateResponse_certificateChain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCertificateAuthorityCertificateResponse' {Maybe Text
certificateChain :: Maybe Text
$sel:certificateChain:GetCertificateAuthorityCertificateResponse' :: GetCertificateAuthorityCertificateResponse -> Maybe Text
certificateChain} -> Maybe Text
certificateChain) (\s :: GetCertificateAuthorityCertificateResponse
s@GetCertificateAuthorityCertificateResponse' {} Maybe Text
a -> GetCertificateAuthorityCertificateResponse
s {$sel:certificateChain:GetCertificateAuthorityCertificateResponse' :: Maybe Text
certificateChain = Maybe Text
a} :: GetCertificateAuthorityCertificateResponse)

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

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