{-# 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.IAM.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 new managed policy for your Amazon Web Services account.
--
-- This operation creates a policy version with a version identifier of
-- @v1@ and sets v1 as the policy\'s default version. For more information
-- about policy versions, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/policies-managed-versions.html Versioning for managed policies>
-- in the /IAM User Guide/.
--
-- As a best practice, you can validate your IAM policies. To learn more,
-- see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_policy-validator.html Validating IAM policies>
-- in the /IAM User Guide/.
--
-- For more information about managed policies in general, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/policies-managed-vs-inline.html Managed policies and inline policies>
-- in the /IAM User Guide/.
module Amazonka.IAM.CreatePolicy
  ( -- * Creating a Request
    CreatePolicy (..),
    newCreatePolicy,

    -- * Request Lenses
    createPolicy_description,
    createPolicy_path,
    createPolicy_tags,
    createPolicy_policyName,
    createPolicy_policyDocument,

    -- * 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.IAM.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 friendly description of the policy.
    --
    -- Typically used to store information about the permissions defined in the
    -- policy. For example, \"Grants access to production DynamoDB tables.\"
    --
    -- The policy description is immutable. After a value is assigned, it
    -- cannot be changed.
    CreatePolicy -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The path for the policy.
    --
    -- For more information about paths, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    --
    -- This parameter is optional. If it is not included, it defaults to a
    -- slash (\/).
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of either a forward slash (\/) by itself or a string that
    -- must begin and end with forward slashes. In addition, it can contain any
    -- ASCII character from the ! (@\\u0021@) through the DEL character
    -- (@\\u007F@), including most punctuation characters, digits, and upper
    -- and lowercased letters.
    --
    -- You cannot use an asterisk (*) in the path name.
    CreatePolicy -> Maybe Text
path :: Prelude.Maybe Prelude.Text,
    -- | A list of tags that you want to attach to the new IAM customer managed
    -- policy. Each tag consists of a key name and an associated value. For
    -- more information about tagging, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
    -- in the /IAM User Guide/.
    --
    -- If any one of the tags is invalid or if you exceed the allowed maximum
    -- number of tags, then the entire request fails and the resource is not
    -- created.
    CreatePolicy -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The friendly name of the policy.
    --
    -- IAM user, group, role, and policy names must be unique within the
    -- account. Names are not distinguished by case. For example, you cannot
    -- create resources named both \"MyResource\" and \"myresource\".
    CreatePolicy -> Text
policyName :: Prelude.Text,
    -- | The JSON policy document that you want to use as the content for the new
    -- policy.
    --
    -- You must provide policies in JSON format in IAM. However, for
    -- CloudFormation templates formatted in YAML, you can provide the policy
    -- in JSON or YAML format. CloudFormation always converts a YAML policy to
    -- JSON format before submitting it to IAM.
    --
    -- The maximum length of the policy document that you can pass in this
    -- operation, including whitespace, is listed below. To view the maximum
    -- character counts of a managed policy with no whitespaces, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html#reference_iam-quotas-entity-length IAM and STS character quotas>.
    --
    -- To learn more about JSON policy grammar, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_grammar.html Grammar of the IAM JSON policy language>
    -- in the /IAM User Guide/.
    --
    -- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
    -- this parameter is a string of characters consisting of the following:
    --
    -- -   Any printable ASCII character ranging from the space character
    --     (@\\u0020@) through the end of the ASCII character range
    --
    -- -   The printable characters in the Basic Latin and Latin-1 Supplement
    --     character set (through @\\u00FF@)
    --
    -- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
    --     carriage return (@\\u000D@)
    CreatePolicy -> Text
policyDocument :: Prelude.Text
  }
  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:
--
-- 'description', 'createPolicy_description' - A friendly description of the policy.
--
-- Typically used to store information about the permissions defined in the
-- policy. For example, \"Grants access to production DynamoDB tables.\"
--
-- The policy description is immutable. After a value is assigned, it
-- cannot be changed.
--
-- 'path', 'createPolicy_path' - The path for the policy.
--
-- For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- You cannot use an asterisk (*) in the path name.
--
-- 'tags', 'createPolicy_tags' - A list of tags that you want to attach to the new IAM customer managed
-- policy. Each tag consists of a key name and an associated value. For
-- more information about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- If any one of the tags is invalid or if you exceed the allowed maximum
-- number of tags, then the entire request fails and the resource is not
-- created.
--
-- 'policyName', 'createPolicy_policyName' - The friendly name of the policy.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
--
-- 'policyDocument', 'createPolicy_policyDocument' - The JSON policy document that you want to use as the content for the new
-- policy.
--
-- You must provide policies in JSON format in IAM. However, for
-- CloudFormation templates formatted in YAML, you can provide the policy
-- in JSON or YAML format. CloudFormation always converts a YAML policy to
-- JSON format before submitting it to IAM.
--
-- The maximum length of the policy document that you can pass in this
-- operation, including whitespace, is listed below. To view the maximum
-- character counts of a managed policy with no whitespaces, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html#reference_iam-quotas-entity-length IAM and STS character quotas>.
--
-- To learn more about JSON policy grammar, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_grammar.html Grammar of the IAM JSON policy language>
-- in the /IAM User Guide/.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
newCreatePolicy ::
  -- | 'policyName'
  Prelude.Text ->
  -- | 'policyDocument'
  Prelude.Text ->
  CreatePolicy
newCreatePolicy :: Text -> Text -> CreatePolicy
newCreatePolicy Text
pPolicyName_ Text
pPolicyDocument_ =
  CreatePolicy'
    { $sel:description:CreatePolicy' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:path:CreatePolicy' :: Maybe Text
path = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreatePolicy' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:policyName:CreatePolicy' :: Text
policyName = Text
pPolicyName_,
      $sel:policyDocument:CreatePolicy' :: Text
policyDocument = Text
pPolicyDocument_
    }

-- | A friendly description of the policy.
--
-- Typically used to store information about the permissions defined in the
-- policy. For example, \"Grants access to production DynamoDB tables.\"
--
-- The policy description is immutable. After a value is assigned, it
-- cannot be changed.
createPolicy_description :: Lens.Lens' CreatePolicy (Prelude.Maybe Prelude.Text)
createPolicy_description :: Lens' CreatePolicy (Maybe Text)
createPolicy_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Maybe Text
description :: Maybe Text
$sel:description:CreatePolicy' :: CreatePolicy -> Maybe Text
description} -> Maybe Text
description) (\s :: CreatePolicy
s@CreatePolicy' {} Maybe Text
a -> CreatePolicy
s {$sel:description:CreatePolicy' :: Maybe Text
description = Maybe Text
a} :: CreatePolicy)

-- | The path for the policy.
--
-- For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- This parameter is optional. If it is not included, it defaults to a
-- slash (\/).
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- You cannot use an asterisk (*) in the path name.
createPolicy_path :: Lens.Lens' CreatePolicy (Prelude.Maybe Prelude.Text)
createPolicy_path :: Lens' CreatePolicy (Maybe Text)
createPolicy_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Maybe Text
path :: Maybe Text
$sel:path:CreatePolicy' :: CreatePolicy -> Maybe Text
path} -> Maybe Text
path) (\s :: CreatePolicy
s@CreatePolicy' {} Maybe Text
a -> CreatePolicy
s {$sel:path:CreatePolicy' :: Maybe Text
path = Maybe Text
a} :: CreatePolicy)

-- | A list of tags that you want to attach to the new IAM customer managed
-- policy. Each tag consists of a key name and an associated value. For
-- more information about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- If any one of the tags is invalid or if you exceed the allowed maximum
-- number of tags, then the entire request fails and the resource 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 friendly name of the policy.
--
-- IAM user, group, role, and policy names must be unique within the
-- account. Names are not distinguished by case. For example, you cannot
-- create resources named both \"MyResource\" and \"myresource\".
createPolicy_policyName :: Lens.Lens' CreatePolicy Prelude.Text
createPolicy_policyName :: Lens' CreatePolicy Text
createPolicy_policyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Text
policyName :: Text
$sel:policyName:CreatePolicy' :: CreatePolicy -> Text
policyName} -> Text
policyName) (\s :: CreatePolicy
s@CreatePolicy' {} Text
a -> CreatePolicy
s {$sel:policyName:CreatePolicy' :: Text
policyName = Text
a} :: CreatePolicy)

-- | The JSON policy document that you want to use as the content for the new
-- policy.
--
-- You must provide policies in JSON format in IAM. However, for
-- CloudFormation templates formatted in YAML, you can provide the policy
-- in JSON or YAML format. CloudFormation always converts a YAML policy to
-- JSON format before submitting it to IAM.
--
-- The maximum length of the policy document that you can pass in this
-- operation, including whitespace, is listed below. To view the maximum
-- character counts of a managed policy with no whitespaces, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_iam-quotas.html#reference_iam-quotas-entity-length IAM and STS character quotas>.
--
-- To learn more about JSON policy grammar, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_grammar.html Grammar of the IAM JSON policy language>
-- in the /IAM User Guide/.
--
-- The <http://wikipedia.org/wiki/regex regex pattern> used to validate
-- this parameter is a string of characters consisting of the following:
--
-- -   Any printable ASCII character ranging from the space character
--     (@\\u0020@) through the end of the ASCII character range
--
-- -   The printable characters in the Basic Latin and Latin-1 Supplement
--     character set (through @\\u00FF@)
--
-- -   The special characters tab (@\\u0009@), line feed (@\\u000A@), and
--     carriage return (@\\u000D@)
createPolicy_policyDocument :: Lens.Lens' CreatePolicy Prelude.Text
createPolicy_policyDocument :: Lens' CreatePolicy Text
createPolicy_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicy' {Text
policyDocument :: Text
$sel:policyDocument:CreatePolicy' :: CreatePolicy -> Text
policyDocument} -> Text
policyDocument) (\s :: CreatePolicy
s@CreatePolicy' {} Text
a -> CreatePolicy
s {$sel:policyDocument:CreatePolicy' :: Text
policyDocument = Text
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 => Service -> a -> Request a
Request.postQuery (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 =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CreatePolicyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Policy -> Int -> CreatePolicyResponse
CreatePolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"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]
Maybe Text
Text
policyDocument :: Text
policyName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
description :: Maybe Text
$sel:policyDocument:CreatePolicy' :: CreatePolicy -> Text
$sel:policyName:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
$sel:path:CreatePolicy' :: CreatePolicy -> Maybe Text
$sel:description:CreatePolicy' :: CreatePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyDocument

instance Prelude.NFData CreatePolicy where
  rnf :: CreatePolicy -> ()
rnf CreatePolicy' {Maybe [Tag]
Maybe Text
Text
policyDocument :: Text
policyName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
description :: Maybe Text
$sel:policyDocument:CreatePolicy' :: CreatePolicy -> Text
$sel:policyName:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
$sel:path:CreatePolicy' :: CreatePolicy -> Maybe Text
$sel:description:CreatePolicy' :: CreatePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
path
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
policyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyDocument

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

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 CreatePolicy' {Maybe [Tag]
Maybe Text
Text
policyDocument :: Text
policyName :: Text
tags :: Maybe [Tag]
path :: Maybe Text
description :: Maybe Text
$sel:policyDocument:CreatePolicy' :: CreatePolicy -> Text
$sel:policyName:CreatePolicy' :: CreatePolicy -> Text
$sel:tags:CreatePolicy' :: CreatePolicy -> Maybe [Tag]
$sel:path:CreatePolicy' :: CreatePolicy -> Maybe Text
$sel:description:CreatePolicy' :: CreatePolicy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreatePolicy" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"Description" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
description,
        ByteString
"Path" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
path,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"PolicyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
policyName,
        ByteString
"PolicyDocument" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
policyDocument
      ]

-- | Contains the response to a successful CreatePolicy request.
--
-- /See:/ 'newCreatePolicyResponse' smart constructor.
data CreatePolicyResponse = CreatePolicyResponse'
  { -- | A structure containing details about the new 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 containing details about the new 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 containing details about the new 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