{-# 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.CreatePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a policy of a specified type that you can attach to a root, an
-- organizational unit (OU), or an individual Amazon Web Services account.
--
-- For more information about policies and their use, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies.html Managing Organization Policies>.
--
-- If the request includes tags, then the requester must have the
-- @organizations:TagResource@ permission.
--
-- This operation can be called only from the organization\'s management
-- account.
module Amazonka.Organizations.CreatePolicy
  ( -- * Creating a Request
    CreatePolicy (..),
    newCreatePolicy,

    -- * Request Lenses
    createPolicy_tags,
    createPolicy_content,
    createPolicy_description,
    createPolicy_name,
    createPolicy_type,

    -- * Destructuring the Response
    CreatePolicyResponse (..),
    newCreatePolicyResponse,

    -- * Response Lenses
    createPolicyResponse_policy,
    createPolicyResponse_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:/ 'newCreatePolicy' smart constructor.
data CreatePolicy = CreatePolicy'
  { -- | A list of tags that you want to attach to the newly created policy. For
    -- each tag in the list, you must specify both a tag key and a value. You
    -- can set the value to an empty string, but you can\'t set it to @null@.
    -- For more information about tagging, see
    -- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_tagging.html Tagging Organizations resources>
    -- in the Organizations User Guide.
    --
    -- If any one of the tags is invalid or if you exceed the allowed number of
    -- tags for a policy, then the entire request fails and the policy is not
    -- created.
    CreatePolicy -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The policy text content to add to the new policy. The text that you
    -- supply must adhere to the rules of the policy type you specify in the
    -- @Type@ parameter.
    CreatePolicy -> Text
content :: Prelude.Text,
    -- | An optional description to assign to the policy.
    CreatePolicy -> Text
description :: Prelude.Text,
    -- | The friendly name to assign to the policy.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
    -- validate this parameter is a string of any of the characters in the
    -- ASCII character range.
    CreatePolicy -> Text
name :: Prelude.Text,
    -- | The type of policy to create. You can specify one of the following
    -- values:
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_scp.html SERVICE_CONTROL_POLICY>
    --
    -- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
    CreatePolicy -> PolicyType
type' :: PolicyType
  }
  deriving (CreatePolicy -> CreatePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePolicy -> CreatePolicy -> Bool
$c/= :: CreatePolicy -> CreatePolicy -> Bool
== :: CreatePolicy -> CreatePolicy -> Bool
$c== :: CreatePolicy -> CreatePolicy -> Bool
Prelude.Eq, ReadPrec [CreatePolicy]
ReadPrec CreatePolicy
Int -> ReadS CreatePolicy
ReadS [CreatePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePolicy]
$creadListPrec :: ReadPrec [CreatePolicy]
readPrec :: ReadPrec CreatePolicy
$creadPrec :: ReadPrec CreatePolicy
readList :: ReadS [CreatePolicy]
$creadList :: ReadS [CreatePolicy]
readsPrec :: Int -> ReadS CreatePolicy
$creadsPrec :: Int -> ReadS CreatePolicy
Prelude.Read, Int -> CreatePolicy -> ShowS
[CreatePolicy] -> ShowS
CreatePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePolicy] -> ShowS
$cshowList :: [CreatePolicy] -> ShowS
show :: CreatePolicy -> String
$cshow :: CreatePolicy -> String
showsPrec :: Int -> CreatePolicy -> ShowS
$cshowsPrec :: Int -> CreatePolicy -> ShowS
Prelude.Show, forall x. Rep CreatePolicy x -> CreatePolicy
forall x. CreatePolicy -> Rep CreatePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePolicy x -> CreatePolicy
$cfrom :: forall x. CreatePolicy -> Rep CreatePolicy x
Prelude.Generic)

-- |
-- Create a value of 'CreatePolicy' 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:
--
-- 'tags', 'createPolicy_tags' - A list of tags that you want to attach to the newly created policy. For
-- each tag in the list, you must specify both a tag key and a value. You
-- can set the value to an empty string, but you can\'t set it to @null@.
-- For more information about tagging, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_tagging.html Tagging Organizations resources>
-- in the Organizations User Guide.
--
-- If any one of the tags is invalid or if you exceed the allowed number of
-- tags for a policy, then the entire request fails and the policy is not
-- created.
--
-- 'content', 'createPolicy_content' - The policy text content to add to the new policy. The text that you
-- supply must adhere to the rules of the policy type you specify in the
-- @Type@ parameter.
--
-- 'description', 'createPolicy_description' - An optional description to assign to the policy.
--
-- 'name', 'createPolicy_name' - The friendly name to assign to the policy.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of any of the characters in the
-- ASCII character range.
--
-- 'type'', 'createPolicy_type' - The type of policy to create. You can specify one of the following
-- values:
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_scp.html SERVICE_CONTROL_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
newCreatePolicy ::
  -- | 'content'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'type''
  PolicyType ->
  CreatePolicy
newCreatePolicy :: Text -> Text -> Text -> PolicyType -> CreatePolicy
newCreatePolicy Text
pContent_ Text
pDescription_ Text
pName_ PolicyType
pType_ =
  CreatePolicy'
    { $sel:tags:CreatePolicy' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:content:CreatePolicy' :: Text
content = Text
pContent_,
      $sel:description:CreatePolicy' :: Text
description = Text
pDescription_,
      $sel:name:CreatePolicy' :: Text
name = Text
pName_,
      $sel:type':CreatePolicy' :: PolicyType
type' = PolicyType
pType_
    }

-- | A list of tags that you want to attach to the newly created policy. For
-- each tag in the list, you must specify both a tag key and a value. You
-- can set the value to an empty string, but you can\'t set it to @null@.
-- For more information about tagging, see
-- <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_tagging.html Tagging Organizations resources>
-- in the Organizations User Guide.
--
-- If any one of the tags is invalid or if you exceed the allowed number of
-- tags for a policy, then the entire request fails and the policy is not
-- created.
createPolicy_tags :: Lens.Lens' CreatePolicy (Prelude.Maybe [Tag])
createPolicy_tags :: Lens' CreatePolicy (Maybe [Tag])
createPolicy_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreatePolicy
s@CreatePolicy' {} Maybe [Tag]
a -> CreatePolicy
s {$sel:tags:CreatePolicy' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreatePolicy) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The policy text content to add to the new policy. The text that you
-- supply must adhere to the rules of the policy type you specify in the
-- @Type@ parameter.
createPolicy_content :: Lens.Lens' CreatePolicy Prelude.Text
createPolicy_content :: Lens' CreatePolicy Text
createPolicy_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Text
content :: Text
$sel:content:CreatePolicy' :: CreatePolicy -> Text
content} -> Text
content) (\s :: CreatePolicy
s@CreatePolicy' {} Text
a -> CreatePolicy
s {$sel:content:CreatePolicy' :: Text
content = Text
a} :: CreatePolicy)

-- | An optional description to assign to the policy.
createPolicy_description :: Lens.Lens' CreatePolicy Prelude.Text
createPolicy_description :: Lens' CreatePolicy Text
createPolicy_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Text
description :: Text
$sel:description:CreatePolicy' :: CreatePolicy -> Text
description} -> Text
description) (\s :: CreatePolicy
s@CreatePolicy' {} Text
a -> CreatePolicy
s {$sel:description:CreatePolicy' :: Text
description = Text
a} :: CreatePolicy)

-- | The friendly name to assign to the policy.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> that is used to
-- validate this parameter is a string of any of the characters in the
-- ASCII character range.
createPolicy_name :: Lens.Lens' CreatePolicy Prelude.Text
createPolicy_name :: Lens' CreatePolicy Text
createPolicy_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Text
name :: Text
$sel:name:CreatePolicy' :: CreatePolicy -> Text
name} -> Text
name) (\s :: CreatePolicy
s@CreatePolicy' {} Text
a -> CreatePolicy
s {$sel:name:CreatePolicy' :: Text
name = Text
a} :: CreatePolicy)

-- | The type of policy to create. You can specify one of the following
-- values:
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_ai-opt-out.html AISERVICES_OPT_OUT_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_backup.html BACKUP_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_scp.html SERVICE_CONTROL_POLICY>
--
-- -   <https://docs.aws.amazon.com/organizations/latest/userguide/orgs_manage_policies_tag-policies.html TAG_POLICY>
createPolicy_type :: Lens.Lens' CreatePolicy PolicyType
createPolicy_type :: Lens' CreatePolicy PolicyType
createPolicy_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {PolicyType
type' :: PolicyType
$sel:type':CreatePolicy' :: CreatePolicy -> PolicyType
type'} -> PolicyType
type') (\s :: CreatePolicy
s@CreatePolicy' {} PolicyType
a -> CreatePolicy
s {$sel:type':CreatePolicy' :: PolicyType
type' = PolicyType
a} :: CreatePolicy)

instance Core.AWSRequest CreatePolicy where
  type AWSResponse CreatePolicy = CreatePolicyResponse
  request :: (Service -> Service) -> CreatePolicy -> Request CreatePolicy
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 CreatePolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreatePolicy)))
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 -> CreatePolicyResponse
CreatePolicyResponse'
            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 CreatePolicy where
  hashWithSalt :: Int -> CreatePolicy -> Int
hashWithSalt Int
_salt CreatePolicy' {Maybe [Tag]
Text
PolicyType
type' :: PolicyType
name :: Text
description :: Text
content :: Text
tags :: Maybe [Tag]
$sel:type':CreatePolicy' :: CreatePolicy -> PolicyType
$sel:name:CreatePolicy' :: CreatePolicy -> Text
$sel:description:CreatePolicy' :: CreatePolicy -> Text
$sel:content:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PolicyType
type'

instance Prelude.NFData CreatePolicy where
  rnf :: CreatePolicy -> ()
rnf CreatePolicy' {Maybe [Tag]
Text
PolicyType
type' :: PolicyType
name :: Text
description :: Text
content :: Text
tags :: Maybe [Tag]
$sel:type':CreatePolicy' :: CreatePolicy -> PolicyType
$sel:name:CreatePolicy' :: CreatePolicy -> Text
$sel:description:CreatePolicy' :: CreatePolicy -> Text
$sel:content:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PolicyType
type'

instance Data.ToHeaders CreatePolicy where
  toHeaders :: CreatePolicy -> 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.CreatePolicy" ::
                          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 CreatePolicy where
  toJSON :: CreatePolicy -> Value
toJSON CreatePolicy' {Maybe [Tag]
Text
PolicyType
type' :: PolicyType
name :: Text
description :: Text
content :: Text
tags :: Maybe [Tag]
$sel:type':CreatePolicy' :: CreatePolicy -> PolicyType
$sel:name:CreatePolicy' :: CreatePolicy -> Text
$sel:description:CreatePolicy' :: CreatePolicy -> Text
$sel:content:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Content" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
content),
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PolicyType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'CreatePolicyResponse' 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', 'createPolicyResponse_policy' - A structure that contains details about the newly created policy.
--
-- 'httpStatus', 'createPolicyResponse_httpStatus' - The response's http status code.
newCreatePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePolicyResponse
newCreatePolicyResponse :: Int -> CreatePolicyResponse
newCreatePolicyResponse Int
pHttpStatus_ =
  CreatePolicyResponse'
    { $sel:policy:CreatePolicyResponse' :: Maybe Policy
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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