{-# 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.GetPolicy
-- 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 resource-based policy attached to a private CA. If either
-- the private CA resource or the policy cannot be found, this action
-- returns a @ResourceNotFoundException@.
--
-- The policy can be attached or updated with
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_PutPolicy.html PutPolicy>
-- and removed with
-- <https://docs.aws.amazon.com/privateca/latest/APIReference/API_DeletePolicy.html DeletePolicy>.
--
-- __About Policies__
--
-- -   A policy grants access on a private CA to an Amazon Web Services
--     customer account, to Amazon Web Services Organizations, or to an
--     Amazon Web Services Organizations unit. Policies are under the
--     control of a CA administrator. For more information, see
--     <https://docs.aws.amazon.com/privateca/latest/userguide/pca-rbp.html Using a Resource Based Policy with Amazon Web Services Private CA>.
--
-- -   A policy permits a user of Certificate Manager (ACM) to issue ACM
--     certificates signed by a CA in another account.
--
-- -   For ACM to manage automatic renewal of these certificates, the ACM
--     user must configure a Service Linked Role (SLR). The SLR allows the
--     ACM service to assume the identity of the user, subject to
--     confirmation against the Amazon Web Services Private CA policy. For
--     more information, see
--     <https://docs.aws.amazon.com/acm/latest/userguide/acm-slr.html Using a Service Linked Role with ACM>.
--
-- -   Updates made in Amazon Web Services Resource Manager (RAM) are
--     reflected in policies. For more information, see
--     <https://docs.aws.amazon.com/privateca/latest/userguide/pca-ram.html Attach a Policy for Cross-Account Access>.
module Amazonka.CertificateManagerPCA.GetPolicy
  ( -- * Creating a Request
    GetPolicy (..),
    newGetPolicy,

    -- * Request Lenses
    getPolicy_resourceArn,

    -- * Destructuring the Response
    GetPolicyResponse (..),
    newGetPolicyResponse,

    -- * Response Lenses
    getPolicyResponse_policy,
    getPolicyResponse_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:/ 'newGetPolicy' smart constructor.
data GetPolicy = GetPolicy'
  { -- | The Amazon Resource Number (ARN) of the private CA that will have its
    -- policy retrieved. You can find the CA\'s ARN by calling the
    -- ListCertificateAuthorities action.
    GetPolicy -> Text
resourceArn :: Prelude.Text
  }
  deriving (GetPolicy -> GetPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPolicy -> GetPolicy -> Bool
$c/= :: GetPolicy -> GetPolicy -> Bool
== :: GetPolicy -> GetPolicy -> Bool
$c== :: GetPolicy -> GetPolicy -> Bool
Prelude.Eq, ReadPrec [GetPolicy]
ReadPrec GetPolicy
Int -> ReadS GetPolicy
ReadS [GetPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPolicy]
$creadListPrec :: ReadPrec [GetPolicy]
readPrec :: ReadPrec GetPolicy
$creadPrec :: ReadPrec GetPolicy
readList :: ReadS [GetPolicy]
$creadList :: ReadS [GetPolicy]
readsPrec :: Int -> ReadS GetPolicy
$creadsPrec :: Int -> ReadS GetPolicy
Prelude.Read, Int -> GetPolicy -> ShowS
[GetPolicy] -> ShowS
GetPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPolicy] -> ShowS
$cshowList :: [GetPolicy] -> ShowS
show :: GetPolicy -> String
$cshow :: GetPolicy -> String
showsPrec :: Int -> GetPolicy -> ShowS
$cshowsPrec :: Int -> GetPolicy -> ShowS
Prelude.Show, forall x. Rep GetPolicy x -> GetPolicy
forall x. GetPolicy -> Rep GetPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPolicy x -> GetPolicy
$cfrom :: forall x. GetPolicy -> Rep GetPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetPolicy' 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:
--
-- 'resourceArn', 'getPolicy_resourceArn' - The Amazon Resource Number (ARN) of the private CA that will have its
-- policy retrieved. You can find the CA\'s ARN by calling the
-- ListCertificateAuthorities action.
newGetPolicy ::
  -- | 'resourceArn'
  Prelude.Text ->
  GetPolicy
newGetPolicy :: Text -> GetPolicy
newGetPolicy Text
pResourceArn_ =
  GetPolicy' {$sel:resourceArn:GetPolicy' :: Text
resourceArn = Text
pResourceArn_}

-- | The Amazon Resource Number (ARN) of the private CA that will have its
-- policy retrieved. You can find the CA\'s ARN by calling the
-- ListCertificateAuthorities action.
getPolicy_resourceArn :: Lens.Lens' GetPolicy Prelude.Text
getPolicy_resourceArn :: Lens' GetPolicy Text
getPolicy_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPolicy' {Text
resourceArn :: Text
$sel:resourceArn:GetPolicy' :: GetPolicy -> Text
resourceArn} -> Text
resourceArn) (\s :: GetPolicy
s@GetPolicy' {} Text
a -> GetPolicy
s {$sel:resourceArn:GetPolicy' :: Text
resourceArn = Text
a} :: GetPolicy)

instance Core.AWSRequest GetPolicy where
  type AWSResponse GetPolicy = GetPolicyResponse
  request :: (Service -> Service) -> GetPolicy -> Request GetPolicy
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 GetPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPolicy)))
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 -> Int -> GetPolicyResponse
GetPolicyResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

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

instance Data.ToHeaders GetPolicy where
  toHeaders :: GetPolicy -> 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.GetPolicy" :: 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 GetPolicy where
  toJSON :: GetPolicy -> Value
toJSON GetPolicy' {Text
resourceArn :: Text
$sel:resourceArn:GetPolicy' :: GetPolicy -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn)]
      )

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

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

-- | /See:/ 'newGetPolicyResponse' smart constructor.
data GetPolicyResponse = GetPolicyResponse'
  { -- | The policy attached to the private CA as a JSON document.
    GetPolicyResponse -> Maybe Text
policy :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPolicyResponse -> GetPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPolicyResponse -> GetPolicyResponse -> Bool
$c/= :: GetPolicyResponse -> GetPolicyResponse -> Bool
== :: GetPolicyResponse -> GetPolicyResponse -> Bool
$c== :: GetPolicyResponse -> GetPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetPolicyResponse]
ReadPrec GetPolicyResponse
Int -> ReadS GetPolicyResponse
ReadS [GetPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPolicyResponse]
$creadListPrec :: ReadPrec [GetPolicyResponse]
readPrec :: ReadPrec GetPolicyResponse
$creadPrec :: ReadPrec GetPolicyResponse
readList :: ReadS [GetPolicyResponse]
$creadList :: ReadS [GetPolicyResponse]
readsPrec :: Int -> ReadS GetPolicyResponse
$creadsPrec :: Int -> ReadS GetPolicyResponse
Prelude.Read, Int -> GetPolicyResponse -> ShowS
[GetPolicyResponse] -> ShowS
GetPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPolicyResponse] -> ShowS
$cshowList :: [GetPolicyResponse] -> ShowS
show :: GetPolicyResponse -> String
$cshow :: GetPolicyResponse -> String
showsPrec :: Int -> GetPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetPolicyResponse -> ShowS
Prelude.Show, forall x. Rep GetPolicyResponse x -> GetPolicyResponse
forall x. GetPolicyResponse -> Rep GetPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPolicyResponse x -> GetPolicyResponse
$cfrom :: forall x. GetPolicyResponse -> Rep GetPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPolicyResponse' 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', 'getPolicyResponse_policy' - The policy attached to the private CA as a JSON document.
--
-- 'httpStatus', 'getPolicyResponse_httpStatus' - The response's http status code.
newGetPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPolicyResponse
newGetPolicyResponse :: Int -> GetPolicyResponse
newGetPolicyResponse Int
pHttpStatus_ =
  GetPolicyResponse'
    { $sel:policy:GetPolicyResponse' :: Maybe Text
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The policy attached to the private CA as a JSON document.
getPolicyResponse_policy :: Lens.Lens' GetPolicyResponse (Prelude.Maybe Prelude.Text)
getPolicyResponse_policy :: Lens' GetPolicyResponse (Maybe Text)
getPolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPolicyResponse' {Maybe Text
policy :: Maybe Text
$sel:policy:GetPolicyResponse' :: GetPolicyResponse -> Maybe Text
policy} -> Maybe Text
policy) (\s :: GetPolicyResponse
s@GetPolicyResponse' {} Maybe Text
a -> GetPolicyResponse
s {$sel:policy:GetPolicyResponse' :: Maybe Text
policy = Maybe Text
a} :: GetPolicyResponse)

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

instance Prelude.NFData GetPolicyResponse where
  rnf :: GetPolicyResponse -> ()
rnf GetPolicyResponse' {Int
Maybe Text
httpStatus :: Int
policy :: Maybe Text
$sel:httpStatus:GetPolicyResponse' :: GetPolicyResponse -> Int
$sel:policy:GetPolicyResponse' :: GetPolicyResponse -> 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 Int
httpStatus