{-# 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.Organizations.DescribePolicy
-- 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 information about a policy.
--
-- This operation can be called only from the organization\'s management
-- account or by a member account that is a delegated administrator for an
-- Amazon Web Services service.
module Amazonka.Organizations.DescribePolicy
  ( -- * Creating a Request
    DescribePolicy (..),
    newDescribePolicy,

    -- * Request Lenses
    describePolicy_policyId,

    -- * Destructuring the Response
    DescribePolicyResponse (..),
    newDescribePolicyResponse,

    -- * Response Lenses
    describePolicyResponse_policy,
    describePolicyResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribePolicy' smart constructor.
data DescribePolicy = DescribePolicy'
  { -- | The unique identifier (ID) of the policy that you want details about.
    -- You can get the ID from the ListPolicies or ListPoliciesForTarget
    -- operations.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
    -- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
    -- letters, digits, or the underscore character (_).
    DescribePolicy -> Text
policyId :: Prelude.Text
  }
  deriving (DescribePolicy -> DescribePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePolicy -> DescribePolicy -> Bool
$c/= :: DescribePolicy -> DescribePolicy -> Bool
== :: DescribePolicy -> DescribePolicy -> Bool
$c== :: DescribePolicy -> DescribePolicy -> Bool
Prelude.Eq, ReadPrec [DescribePolicy]
ReadPrec DescribePolicy
Int -> ReadS DescribePolicy
ReadS [DescribePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePolicy]
$creadListPrec :: ReadPrec [DescribePolicy]
readPrec :: ReadPrec DescribePolicy
$creadPrec :: ReadPrec DescribePolicy
readList :: ReadS [DescribePolicy]
$creadList :: ReadS [DescribePolicy]
readsPrec :: Int -> ReadS DescribePolicy
$creadsPrec :: Int -> ReadS DescribePolicy
Prelude.Read, Int -> DescribePolicy -> ShowS
[DescribePolicy] -> ShowS
DescribePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePolicy] -> ShowS
$cshowList :: [DescribePolicy] -> ShowS
show :: DescribePolicy -> String
$cshow :: DescribePolicy -> String
showsPrec :: Int -> DescribePolicy -> ShowS
$cshowsPrec :: Int -> DescribePolicy -> ShowS
Prelude.Show, forall x. Rep DescribePolicy x -> DescribePolicy
forall x. DescribePolicy -> Rep DescribePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePolicy x -> DescribePolicy
$cfrom :: forall x. DescribePolicy -> Rep DescribePolicy x
Prelude.Generic)

-- |
-- Create a value of 'DescribePolicy' 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:
--
-- 'policyId', 'describePolicy_policyId' - The unique identifier (ID) of the policy that you want details about.
-- You can get the ID from the ListPolicies or ListPoliciesForTarget
-- operations.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
-- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
-- letters, digits, or the underscore character (_).
newDescribePolicy ::
  -- | 'policyId'
  Prelude.Text ->
  DescribePolicy
newDescribePolicy :: Text -> DescribePolicy
newDescribePolicy Text
pPolicyId_ =
  DescribePolicy' {$sel:policyId:DescribePolicy' :: Text
policyId = Text
pPolicyId_}

-- | The unique identifier (ID) of the policy that you want details about.
-- You can get the ID from the ListPolicies or ListPoliciesForTarget
-- operations.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> for a policy ID
-- string requires \"p-\" followed by from 8 to 128 lowercase or uppercase
-- letters, digits, or the underscore character (_).
describePolicy_policyId :: Lens.Lens' DescribePolicy Prelude.Text
describePolicy_policyId :: Lens' DescribePolicy Text
describePolicy_policyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePolicy' {Text
policyId :: Text
$sel:policyId:DescribePolicy' :: DescribePolicy -> Text
policyId} -> Text
policyId) (\s :: DescribePolicy
s@DescribePolicy' {} Text
a -> DescribePolicy
s {$sel:policyId:DescribePolicy' :: Text
policyId = Text
a} :: DescribePolicy)

instance Core.AWSRequest DescribePolicy where
  type
    AWSResponse DescribePolicy =
      DescribePolicyResponse
  request :: (Service -> Service) -> DescribePolicy -> Request DescribePolicy
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 DescribePolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribePolicy)))
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 Policy -> Int -> DescribePolicyResponse
DescribePolicyResponse'
            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 DescribePolicy where
  hashWithSalt :: Int -> DescribePolicy -> Int
hashWithSalt Int
_salt DescribePolicy' {Text
policyId :: Text
$sel:policyId:DescribePolicy' :: DescribePolicy -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyId

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

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

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

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

-- | /See:/ 'newDescribePolicyResponse' smart constructor.
data DescribePolicyResponse = DescribePolicyResponse'
  { -- | A structure that contains details about the specified policy.
    DescribePolicyResponse -> Maybe Policy
policy :: Prelude.Maybe Policy,
    -- | The response's http status code.
    DescribePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePolicyResponse -> DescribePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePolicyResponse -> DescribePolicyResponse -> Bool
$c/= :: DescribePolicyResponse -> DescribePolicyResponse -> Bool
== :: DescribePolicyResponse -> DescribePolicyResponse -> Bool
$c== :: DescribePolicyResponse -> DescribePolicyResponse -> Bool
Prelude.Eq, ReadPrec [DescribePolicyResponse]
ReadPrec DescribePolicyResponse
Int -> ReadS DescribePolicyResponse
ReadS [DescribePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePolicyResponse]
$creadListPrec :: ReadPrec [DescribePolicyResponse]
readPrec :: ReadPrec DescribePolicyResponse
$creadPrec :: ReadPrec DescribePolicyResponse
readList :: ReadS [DescribePolicyResponse]
$creadList :: ReadS [DescribePolicyResponse]
readsPrec :: Int -> ReadS DescribePolicyResponse
$creadsPrec :: Int -> ReadS DescribePolicyResponse
Prelude.Read, Int -> DescribePolicyResponse -> ShowS
[DescribePolicyResponse] -> ShowS
DescribePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePolicyResponse] -> ShowS
$cshowList :: [DescribePolicyResponse] -> ShowS
show :: DescribePolicyResponse -> String
$cshow :: DescribePolicyResponse -> String
showsPrec :: Int -> DescribePolicyResponse -> ShowS
$cshowsPrec :: Int -> DescribePolicyResponse -> ShowS
Prelude.Show, forall x. Rep DescribePolicyResponse x -> DescribePolicyResponse
forall x. DescribePolicyResponse -> Rep DescribePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePolicyResponse x -> DescribePolicyResponse
$cfrom :: forall x. DescribePolicyResponse -> Rep DescribePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePolicyResponse' 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', 'describePolicyResponse_policy' - A structure that contains details about the specified policy.
--
-- 'httpStatus', 'describePolicyResponse_httpStatus' - The response's http status code.
newDescribePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePolicyResponse
newDescribePolicyResponse :: Int -> DescribePolicyResponse
newDescribePolicyResponse Int
pHttpStatus_ =
  DescribePolicyResponse'
    { $sel:policy:DescribePolicyResponse' :: Maybe Policy
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains details about the specified policy.
describePolicyResponse_policy :: Lens.Lens' DescribePolicyResponse (Prelude.Maybe Policy)
describePolicyResponse_policy :: Lens' DescribePolicyResponse (Maybe Policy)
describePolicyResponse_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePolicyResponse' {Maybe Policy
policy :: Maybe Policy
$sel:policy:DescribePolicyResponse' :: DescribePolicyResponse -> Maybe Policy
policy} -> Maybe Policy
policy) (\s :: DescribePolicyResponse
s@DescribePolicyResponse' {} Maybe Policy
a -> DescribePolicyResponse
s {$sel:policy:DescribePolicyResponse' :: Maybe Policy
policy = Maybe Policy
a} :: DescribePolicyResponse)

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

instance Prelude.NFData DescribePolicyResponse where
  rnf :: DescribePolicyResponse -> ()
rnf DescribePolicyResponse' {Int
Maybe Policy
httpStatus :: Int
policy :: Maybe Policy
$sel:httpStatus:DescribePolicyResponse' :: DescribePolicyResponse -> Int
$sel:policy:DescribePolicyResponse' :: DescribePolicyResponse -> Maybe Policy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Policy
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus