{-# 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.IoT.CreatePolicyVersion
-- 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 version of the specified IoT policy. To update a policy,
-- create a new policy version. A managed policy can have up to five
-- versions. If the policy has five versions, you must use
-- DeletePolicyVersion to delete an existing version before you create a
-- new one.
--
-- Optionally, you can set the new version as the policy\'s default
-- version. The default version is the operative version (that is, the
-- version that is in effect for the certificates to which the policy is
-- attached).
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions CreatePolicyVersion>
-- action.
module Amazonka.IoT.CreatePolicyVersion
  ( -- * Creating a Request
    CreatePolicyVersion (..),
    newCreatePolicyVersion,

    -- * Request Lenses
    createPolicyVersion_setAsDefault,
    createPolicyVersion_policyName,
    createPolicyVersion_policyDocument,

    -- * Destructuring the Response
    CreatePolicyVersionResponse (..),
    newCreatePolicyVersionResponse,

    -- * Response Lenses
    createPolicyVersionResponse_isDefaultVersion,
    createPolicyVersionResponse_policyArn,
    createPolicyVersionResponse_policyDocument,
    createPolicyVersionResponse_policyVersionId,
    createPolicyVersionResponse_httpStatus,
  )
where

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

-- | The input for the CreatePolicyVersion operation.
--
-- /See:/ 'newCreatePolicyVersion' smart constructor.
data CreatePolicyVersion = CreatePolicyVersion'
  { -- | Specifies whether the policy version is set as the default. When this
    -- parameter is true, the new policy version becomes the operative version
    -- (that is, the version that is in effect for the certificates to which
    -- the policy is attached).
    CreatePolicyVersion -> Maybe Bool
setAsDefault :: Prelude.Maybe Prelude.Bool,
    -- | The policy name.
    CreatePolicyVersion -> Text
policyName :: Prelude.Text,
    -- | The JSON document that describes the policy. Minimum length of 1.
    -- Maximum length of 2048, excluding whitespace.
    CreatePolicyVersion -> Text
policyDocument :: Prelude.Text
  }
  deriving (CreatePolicyVersion -> CreatePolicyVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePolicyVersion -> CreatePolicyVersion -> Bool
$c/= :: CreatePolicyVersion -> CreatePolicyVersion -> Bool
== :: CreatePolicyVersion -> CreatePolicyVersion -> Bool
$c== :: CreatePolicyVersion -> CreatePolicyVersion -> Bool
Prelude.Eq, ReadPrec [CreatePolicyVersion]
ReadPrec CreatePolicyVersion
Int -> ReadS CreatePolicyVersion
ReadS [CreatePolicyVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePolicyVersion]
$creadListPrec :: ReadPrec [CreatePolicyVersion]
readPrec :: ReadPrec CreatePolicyVersion
$creadPrec :: ReadPrec CreatePolicyVersion
readList :: ReadS [CreatePolicyVersion]
$creadList :: ReadS [CreatePolicyVersion]
readsPrec :: Int -> ReadS CreatePolicyVersion
$creadsPrec :: Int -> ReadS CreatePolicyVersion
Prelude.Read, Int -> CreatePolicyVersion -> ShowS
[CreatePolicyVersion] -> ShowS
CreatePolicyVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePolicyVersion] -> ShowS
$cshowList :: [CreatePolicyVersion] -> ShowS
show :: CreatePolicyVersion -> String
$cshow :: CreatePolicyVersion -> String
showsPrec :: Int -> CreatePolicyVersion -> ShowS
$cshowsPrec :: Int -> CreatePolicyVersion -> ShowS
Prelude.Show, forall x. Rep CreatePolicyVersion x -> CreatePolicyVersion
forall x. CreatePolicyVersion -> Rep CreatePolicyVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePolicyVersion x -> CreatePolicyVersion
$cfrom :: forall x. CreatePolicyVersion -> Rep CreatePolicyVersion x
Prelude.Generic)

-- |
-- Create a value of 'CreatePolicyVersion' 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:
--
-- 'setAsDefault', 'createPolicyVersion_setAsDefault' - Specifies whether the policy version is set as the default. When this
-- parameter is true, the new policy version becomes the operative version
-- (that is, the version that is in effect for the certificates to which
-- the policy is attached).
--
-- 'policyName', 'createPolicyVersion_policyName' - The policy name.
--
-- 'policyDocument', 'createPolicyVersion_policyDocument' - The JSON document that describes the policy. Minimum length of 1.
-- Maximum length of 2048, excluding whitespace.
newCreatePolicyVersion ::
  -- | 'policyName'
  Prelude.Text ->
  -- | 'policyDocument'
  Prelude.Text ->
  CreatePolicyVersion
newCreatePolicyVersion :: Text -> Text -> CreatePolicyVersion
newCreatePolicyVersion Text
pPolicyName_ Text
pPolicyDocument_ =
  CreatePolicyVersion'
    { $sel:setAsDefault:CreatePolicyVersion' :: Maybe Bool
setAsDefault =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policyName:CreatePolicyVersion' :: Text
policyName = Text
pPolicyName_,
      $sel:policyDocument:CreatePolicyVersion' :: Text
policyDocument = Text
pPolicyDocument_
    }

-- | Specifies whether the policy version is set as the default. When this
-- parameter is true, the new policy version becomes the operative version
-- (that is, the version that is in effect for the certificates to which
-- the policy is attached).
createPolicyVersion_setAsDefault :: Lens.Lens' CreatePolicyVersion (Prelude.Maybe Prelude.Bool)
createPolicyVersion_setAsDefault :: Lens' CreatePolicyVersion (Maybe Bool)
createPolicyVersion_setAsDefault = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersion' {Maybe Bool
setAsDefault :: Maybe Bool
$sel:setAsDefault:CreatePolicyVersion' :: CreatePolicyVersion -> Maybe Bool
setAsDefault} -> Maybe Bool
setAsDefault) (\s :: CreatePolicyVersion
s@CreatePolicyVersion' {} Maybe Bool
a -> CreatePolicyVersion
s {$sel:setAsDefault:CreatePolicyVersion' :: Maybe Bool
setAsDefault = Maybe Bool
a} :: CreatePolicyVersion)

-- | The policy name.
createPolicyVersion_policyName :: Lens.Lens' CreatePolicyVersion Prelude.Text
createPolicyVersion_policyName :: Lens' CreatePolicyVersion Text
createPolicyVersion_policyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersion' {Text
policyName :: Text
$sel:policyName:CreatePolicyVersion' :: CreatePolicyVersion -> Text
policyName} -> Text
policyName) (\s :: CreatePolicyVersion
s@CreatePolicyVersion' {} Text
a -> CreatePolicyVersion
s {$sel:policyName:CreatePolicyVersion' :: Text
policyName = Text
a} :: CreatePolicyVersion)

-- | The JSON document that describes the policy. Minimum length of 1.
-- Maximum length of 2048, excluding whitespace.
createPolicyVersion_policyDocument :: Lens.Lens' CreatePolicyVersion Prelude.Text
createPolicyVersion_policyDocument :: Lens' CreatePolicyVersion Text
createPolicyVersion_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersion' {Text
policyDocument :: Text
$sel:policyDocument:CreatePolicyVersion' :: CreatePolicyVersion -> Text
policyDocument} -> Text
policyDocument) (\s :: CreatePolicyVersion
s@CreatePolicyVersion' {} Text
a -> CreatePolicyVersion
s {$sel:policyDocument:CreatePolicyVersion' :: Text
policyDocument = Text
a} :: CreatePolicyVersion)

instance Core.AWSRequest CreatePolicyVersion where
  type
    AWSResponse CreatePolicyVersion =
      CreatePolicyVersionResponse
  request :: (Service -> Service)
-> CreatePolicyVersion -> Request CreatePolicyVersion
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 CreatePolicyVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePolicyVersion)))
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 Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> CreatePolicyVersionResponse
CreatePolicyVersionResponse'
            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
"isDefaultVersion")
            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
"policyArn")
            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
"policyDocument")
            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
"policyVersionId")
            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 CreatePolicyVersion where
  hashWithSalt :: Int -> CreatePolicyVersion -> Int
hashWithSalt Int
_salt CreatePolicyVersion' {Maybe Bool
Text
policyDocument :: Text
policyName :: Text
setAsDefault :: Maybe Bool
$sel:policyDocument:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:policyName:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:setAsDefault:CreatePolicyVersion' :: CreatePolicyVersion -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
setAsDefault
      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 CreatePolicyVersion where
  rnf :: CreatePolicyVersion -> ()
rnf CreatePolicyVersion' {Maybe Bool
Text
policyDocument :: Text
policyName :: Text
setAsDefault :: Maybe Bool
$sel:policyDocument:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:policyName:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:setAsDefault:CreatePolicyVersion' :: CreatePolicyVersion -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
setAsDefault
      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 CreatePolicyVersion where
  toHeaders :: CreatePolicyVersion -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToPath CreatePolicyVersion where
  toPath :: CreatePolicyVersion -> ByteString
toPath CreatePolicyVersion' {Maybe Bool
Text
policyDocument :: Text
policyName :: Text
setAsDefault :: Maybe Bool
$sel:policyDocument:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:policyName:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:setAsDefault:CreatePolicyVersion' :: CreatePolicyVersion -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/policies/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
policyName, ByteString
"/version"]

instance Data.ToQuery CreatePolicyVersion where
  toQuery :: CreatePolicyVersion -> QueryString
toQuery CreatePolicyVersion' {Maybe Bool
Text
policyDocument :: Text
policyName :: Text
setAsDefault :: Maybe Bool
$sel:policyDocument:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:policyName:CreatePolicyVersion' :: CreatePolicyVersion -> Text
$sel:setAsDefault:CreatePolicyVersion' :: CreatePolicyVersion -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"setAsDefault" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
setAsDefault]

-- | The output of the CreatePolicyVersion operation.
--
-- /See:/ 'newCreatePolicyVersionResponse' smart constructor.
data CreatePolicyVersionResponse = CreatePolicyVersionResponse'
  { -- | Specifies whether the policy version is the default.
    CreatePolicyVersionResponse -> Maybe Bool
isDefaultVersion :: Prelude.Maybe Prelude.Bool,
    -- | The policy ARN.
    CreatePolicyVersionResponse -> Maybe Text
policyArn :: Prelude.Maybe Prelude.Text,
    -- | The JSON document that describes the policy.
    CreatePolicyVersionResponse -> Maybe Text
policyDocument :: Prelude.Maybe Prelude.Text,
    -- | The policy version ID.
    CreatePolicyVersionResponse -> Maybe Text
policyVersionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreatePolicyVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreatePolicyVersionResponse -> CreatePolicyVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePolicyVersionResponse -> CreatePolicyVersionResponse -> Bool
$c/= :: CreatePolicyVersionResponse -> CreatePolicyVersionResponse -> Bool
== :: CreatePolicyVersionResponse -> CreatePolicyVersionResponse -> Bool
$c== :: CreatePolicyVersionResponse -> CreatePolicyVersionResponse -> Bool
Prelude.Eq, ReadPrec [CreatePolicyVersionResponse]
ReadPrec CreatePolicyVersionResponse
Int -> ReadS CreatePolicyVersionResponse
ReadS [CreatePolicyVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePolicyVersionResponse]
$creadListPrec :: ReadPrec [CreatePolicyVersionResponse]
readPrec :: ReadPrec CreatePolicyVersionResponse
$creadPrec :: ReadPrec CreatePolicyVersionResponse
readList :: ReadS [CreatePolicyVersionResponse]
$creadList :: ReadS [CreatePolicyVersionResponse]
readsPrec :: Int -> ReadS CreatePolicyVersionResponse
$creadsPrec :: Int -> ReadS CreatePolicyVersionResponse
Prelude.Read, Int -> CreatePolicyVersionResponse -> ShowS
[CreatePolicyVersionResponse] -> ShowS
CreatePolicyVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePolicyVersionResponse] -> ShowS
$cshowList :: [CreatePolicyVersionResponse] -> ShowS
show :: CreatePolicyVersionResponse -> String
$cshow :: CreatePolicyVersionResponse -> String
showsPrec :: Int -> CreatePolicyVersionResponse -> ShowS
$cshowsPrec :: Int -> CreatePolicyVersionResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePolicyVersionResponse x -> CreatePolicyVersionResponse
forall x.
CreatePolicyVersionResponse -> Rep CreatePolicyVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePolicyVersionResponse x -> CreatePolicyVersionResponse
$cfrom :: forall x.
CreatePolicyVersionResponse -> Rep CreatePolicyVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePolicyVersionResponse' 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:
--
-- 'isDefaultVersion', 'createPolicyVersionResponse_isDefaultVersion' - Specifies whether the policy version is the default.
--
-- 'policyArn', 'createPolicyVersionResponse_policyArn' - The policy ARN.
--
-- 'policyDocument', 'createPolicyVersionResponse_policyDocument' - The JSON document that describes the policy.
--
-- 'policyVersionId', 'createPolicyVersionResponse_policyVersionId' - The policy version ID.
--
-- 'httpStatus', 'createPolicyVersionResponse_httpStatus' - The response's http status code.
newCreatePolicyVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreatePolicyVersionResponse
newCreatePolicyVersionResponse :: Int -> CreatePolicyVersionResponse
newCreatePolicyVersionResponse Int
pHttpStatus_ =
  CreatePolicyVersionResponse'
    { $sel:isDefaultVersion:CreatePolicyVersionResponse' :: Maybe Bool
isDefaultVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policyArn:CreatePolicyVersionResponse' :: Maybe Text
policyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDocument:CreatePolicyVersionResponse' :: Maybe Text
policyDocument = forall a. Maybe a
Prelude.Nothing,
      $sel:policyVersionId:CreatePolicyVersionResponse' :: Maybe Text
policyVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreatePolicyVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Specifies whether the policy version is the default.
createPolicyVersionResponse_isDefaultVersion :: Lens.Lens' CreatePolicyVersionResponse (Prelude.Maybe Prelude.Bool)
createPolicyVersionResponse_isDefaultVersion :: Lens' CreatePolicyVersionResponse (Maybe Bool)
createPolicyVersionResponse_isDefaultVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersionResponse' {Maybe Bool
isDefaultVersion :: Maybe Bool
$sel:isDefaultVersion:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Bool
isDefaultVersion} -> Maybe Bool
isDefaultVersion) (\s :: CreatePolicyVersionResponse
s@CreatePolicyVersionResponse' {} Maybe Bool
a -> CreatePolicyVersionResponse
s {$sel:isDefaultVersion:CreatePolicyVersionResponse' :: Maybe Bool
isDefaultVersion = Maybe Bool
a} :: CreatePolicyVersionResponse)

-- | The policy ARN.
createPolicyVersionResponse_policyArn :: Lens.Lens' CreatePolicyVersionResponse (Prelude.Maybe Prelude.Text)
createPolicyVersionResponse_policyArn :: Lens' CreatePolicyVersionResponse (Maybe Text)
createPolicyVersionResponse_policyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersionResponse' {Maybe Text
policyArn :: Maybe Text
$sel:policyArn:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
policyArn} -> Maybe Text
policyArn) (\s :: CreatePolicyVersionResponse
s@CreatePolicyVersionResponse' {} Maybe Text
a -> CreatePolicyVersionResponse
s {$sel:policyArn:CreatePolicyVersionResponse' :: Maybe Text
policyArn = Maybe Text
a} :: CreatePolicyVersionResponse)

-- | The JSON document that describes the policy.
createPolicyVersionResponse_policyDocument :: Lens.Lens' CreatePolicyVersionResponse (Prelude.Maybe Prelude.Text)
createPolicyVersionResponse_policyDocument :: Lens' CreatePolicyVersionResponse (Maybe Text)
createPolicyVersionResponse_policyDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersionResponse' {Maybe Text
policyDocument :: Maybe Text
$sel:policyDocument:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
policyDocument} -> Maybe Text
policyDocument) (\s :: CreatePolicyVersionResponse
s@CreatePolicyVersionResponse' {} Maybe Text
a -> CreatePolicyVersionResponse
s {$sel:policyDocument:CreatePolicyVersionResponse' :: Maybe Text
policyDocument = Maybe Text
a} :: CreatePolicyVersionResponse)

-- | The policy version ID.
createPolicyVersionResponse_policyVersionId :: Lens.Lens' CreatePolicyVersionResponse (Prelude.Maybe Prelude.Text)
createPolicyVersionResponse_policyVersionId :: Lens' CreatePolicyVersionResponse (Maybe Text)
createPolicyVersionResponse_policyVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePolicyVersionResponse' {Maybe Text
policyVersionId :: Maybe Text
$sel:policyVersionId:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
policyVersionId} -> Maybe Text
policyVersionId) (\s :: CreatePolicyVersionResponse
s@CreatePolicyVersionResponse' {} Maybe Text
a -> CreatePolicyVersionResponse
s {$sel:policyVersionId:CreatePolicyVersionResponse' :: Maybe Text
policyVersionId = Maybe Text
a} :: CreatePolicyVersionResponse)

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

instance Prelude.NFData CreatePolicyVersionResponse where
  rnf :: CreatePolicyVersionResponse -> ()
rnf CreatePolicyVersionResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
policyVersionId :: Maybe Text
policyDocument :: Maybe Text
policyArn :: Maybe Text
isDefaultVersion :: Maybe Bool
$sel:httpStatus:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Int
$sel:policyVersionId:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
$sel:policyDocument:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
$sel:policyArn:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Text
$sel:isDefaultVersion:CreatePolicyVersionResponse' :: CreatePolicyVersionResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isDefaultVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyVersionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus