{-# 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.GetPolicyVersion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about the specified policy version.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions GetPolicyVersion>
-- action.
module Amazonka.IoT.GetPolicyVersion
  ( -- * Creating a Request
    GetPolicyVersion (..),
    newGetPolicyVersion,

    -- * Request Lenses
    getPolicyVersion_policyName,
    getPolicyVersion_policyVersionId,

    -- * Destructuring the Response
    GetPolicyVersionResponse (..),
    newGetPolicyVersionResponse,

    -- * Response Lenses
    getPolicyVersionResponse_creationDate,
    getPolicyVersionResponse_generationId,
    getPolicyVersionResponse_isDefaultVersion,
    getPolicyVersionResponse_lastModifiedDate,
    getPolicyVersionResponse_policyArn,
    getPolicyVersionResponse_policyDocument,
    getPolicyVersionResponse_policyName,
    getPolicyVersionResponse_policyVersionId,
    getPolicyVersionResponse_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 GetPolicyVersion operation.
--
-- /See:/ 'newGetPolicyVersion' smart constructor.
data GetPolicyVersion = GetPolicyVersion'
  { -- | The name of the policy.
    GetPolicyVersion -> Text
policyName :: Prelude.Text,
    -- | The policy version ID.
    GetPolicyVersion -> Text
policyVersionId :: Prelude.Text
  }
  deriving (GetPolicyVersion -> GetPolicyVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPolicyVersion -> GetPolicyVersion -> Bool
$c/= :: GetPolicyVersion -> GetPolicyVersion -> Bool
== :: GetPolicyVersion -> GetPolicyVersion -> Bool
$c== :: GetPolicyVersion -> GetPolicyVersion -> Bool
Prelude.Eq, ReadPrec [GetPolicyVersion]
ReadPrec GetPolicyVersion
Int -> ReadS GetPolicyVersion
ReadS [GetPolicyVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPolicyVersion]
$creadListPrec :: ReadPrec [GetPolicyVersion]
readPrec :: ReadPrec GetPolicyVersion
$creadPrec :: ReadPrec GetPolicyVersion
readList :: ReadS [GetPolicyVersion]
$creadList :: ReadS [GetPolicyVersion]
readsPrec :: Int -> ReadS GetPolicyVersion
$creadsPrec :: Int -> ReadS GetPolicyVersion
Prelude.Read, Int -> GetPolicyVersion -> ShowS
[GetPolicyVersion] -> ShowS
GetPolicyVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPolicyVersion] -> ShowS
$cshowList :: [GetPolicyVersion] -> ShowS
show :: GetPolicyVersion -> String
$cshow :: GetPolicyVersion -> String
showsPrec :: Int -> GetPolicyVersion -> ShowS
$cshowsPrec :: Int -> GetPolicyVersion -> ShowS
Prelude.Show, forall x. Rep GetPolicyVersion x -> GetPolicyVersion
forall x. GetPolicyVersion -> Rep GetPolicyVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPolicyVersion x -> GetPolicyVersion
$cfrom :: forall x. GetPolicyVersion -> Rep GetPolicyVersion x
Prelude.Generic)

-- |
-- Create a value of 'GetPolicyVersion' 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:
--
-- 'policyName', 'getPolicyVersion_policyName' - The name of the policy.
--
-- 'policyVersionId', 'getPolicyVersion_policyVersionId' - The policy version ID.
newGetPolicyVersion ::
  -- | 'policyName'
  Prelude.Text ->
  -- | 'policyVersionId'
  Prelude.Text ->
  GetPolicyVersion
newGetPolicyVersion :: Text -> Text -> GetPolicyVersion
newGetPolicyVersion Text
pPolicyName_ Text
pPolicyVersionId_ =
  GetPolicyVersion'
    { $sel:policyName:GetPolicyVersion' :: Text
policyName = Text
pPolicyName_,
      $sel:policyVersionId:GetPolicyVersion' :: Text
policyVersionId = Text
pPolicyVersionId_
    }

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

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

instance Core.AWSRequest GetPolicyVersion where
  type
    AWSResponse GetPolicyVersion =
      GetPolicyVersionResponse
  request :: (Service -> Service)
-> GetPolicyVersion -> Request GetPolicyVersion
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetPolicyVersion
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetPolicyVersion)))
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 POSIX
-> Maybe Text
-> Maybe Bool
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetPolicyVersionResponse
GetPolicyVersionResponse'
            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
"creationDate")
            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
"generationId")
            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
"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
"lastModifiedDate")
            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
"policyName")
            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 GetPolicyVersion where
  hashWithSalt :: Int -> GetPolicyVersion -> Int
hashWithSalt Int
_salt GetPolicyVersion' {Text
policyVersionId :: Text
policyName :: Text
$sel:policyVersionId:GetPolicyVersion' :: GetPolicyVersion -> Text
$sel:policyName:GetPolicyVersion' :: GetPolicyVersion -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policyVersionId

instance Prelude.NFData GetPolicyVersion where
  rnf :: GetPolicyVersion -> ()
rnf GetPolicyVersion' {Text
policyVersionId :: Text
policyName :: Text
$sel:policyVersionId:GetPolicyVersion' :: GetPolicyVersion -> Text
$sel:policyName:GetPolicyVersion' :: GetPolicyVersion -> Text
..} =
    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
policyVersionId

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

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

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

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

-- |
-- Create a value of 'GetPolicyVersionResponse' 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:
--
-- 'creationDate', 'getPolicyVersionResponse_creationDate' - The date the policy was created.
--
-- 'generationId', 'getPolicyVersionResponse_generationId' - The generation ID of the policy version.
--
-- 'isDefaultVersion', 'getPolicyVersionResponse_isDefaultVersion' - Specifies whether the policy version is the default.
--
-- 'lastModifiedDate', 'getPolicyVersionResponse_lastModifiedDate' - The date the policy was last modified.
--
-- 'policyArn', 'getPolicyVersionResponse_policyArn' - The policy ARN.
--
-- 'policyDocument', 'getPolicyVersionResponse_policyDocument' - The JSON document that describes the policy.
--
-- 'policyName', 'getPolicyVersionResponse_policyName' - The policy name.
--
-- 'policyVersionId', 'getPolicyVersionResponse_policyVersionId' - The policy version ID.
--
-- 'httpStatus', 'getPolicyVersionResponse_httpStatus' - The response's http status code.
newGetPolicyVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPolicyVersionResponse
newGetPolicyVersionResponse :: Int -> GetPolicyVersionResponse
newGetPolicyVersionResponse Int
pHttpStatus_ =
  GetPolicyVersionResponse'
    { $sel:creationDate:GetPolicyVersionResponse' :: Maybe POSIX
creationDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:generationId:GetPolicyVersionResponse' :: Maybe Text
generationId = forall a. Maybe a
Prelude.Nothing,
      $sel:isDefaultVersion:GetPolicyVersionResponse' :: Maybe Bool
isDefaultVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedDate:GetPolicyVersionResponse' :: Maybe POSIX
lastModifiedDate = forall a. Maybe a
Prelude.Nothing,
      $sel:policyArn:GetPolicyVersionResponse' :: Maybe Text
policyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:policyDocument:GetPolicyVersionResponse' :: Maybe Text
policyDocument = forall a. Maybe a
Prelude.Nothing,
      $sel:policyName:GetPolicyVersionResponse' :: Maybe Text
policyName = forall a. Maybe a
Prelude.Nothing,
      $sel:policyVersionId:GetPolicyVersionResponse' :: Maybe Text
policyVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPolicyVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date the policy was created.
getPolicyVersionResponse_creationDate :: Lens.Lens' GetPolicyVersionResponse (Prelude.Maybe Prelude.UTCTime)
getPolicyVersionResponse_creationDate :: Lens' GetPolicyVersionResponse (Maybe UTCTime)
getPolicyVersionResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPolicyVersionResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: GetPolicyVersionResponse
s@GetPolicyVersionResponse' {} Maybe POSIX
a -> GetPolicyVersionResponse
s {$sel:creationDate:GetPolicyVersionResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: GetPolicyVersionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The generation ID of the policy version.
getPolicyVersionResponse_generationId :: Lens.Lens' GetPolicyVersionResponse (Prelude.Maybe Prelude.Text)
getPolicyVersionResponse_generationId :: Lens' GetPolicyVersionResponse (Maybe Text)
getPolicyVersionResponse_generationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPolicyVersionResponse' {Maybe Text
generationId :: Maybe Text
$sel:generationId:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
generationId} -> Maybe Text
generationId) (\s :: GetPolicyVersionResponse
s@GetPolicyVersionResponse' {} Maybe Text
a -> GetPolicyVersionResponse
s {$sel:generationId:GetPolicyVersionResponse' :: Maybe Text
generationId = Maybe Text
a} :: GetPolicyVersionResponse)

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

-- | The date the policy was last modified.
getPolicyVersionResponse_lastModifiedDate :: Lens.Lens' GetPolicyVersionResponse (Prelude.Maybe Prelude.UTCTime)
getPolicyVersionResponse_lastModifiedDate :: Lens' GetPolicyVersionResponse (Maybe UTCTime)
getPolicyVersionResponse_lastModifiedDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPolicyVersionResponse' {Maybe POSIX
lastModifiedDate :: Maybe POSIX
$sel:lastModifiedDate:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe POSIX
lastModifiedDate} -> Maybe POSIX
lastModifiedDate) (\s :: GetPolicyVersionResponse
s@GetPolicyVersionResponse' {} Maybe POSIX
a -> GetPolicyVersionResponse
s {$sel:lastModifiedDate:GetPolicyVersionResponse' :: Maybe POSIX
lastModifiedDate = Maybe POSIX
a} :: GetPolicyVersionResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

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

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

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

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

instance Prelude.NFData GetPolicyVersionResponse where
  rnf :: GetPolicyVersionResponse -> ()
rnf GetPolicyVersionResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
httpStatus :: Int
policyVersionId :: Maybe Text
policyName :: Maybe Text
policyDocument :: Maybe Text
policyArn :: Maybe Text
lastModifiedDate :: Maybe POSIX
isDefaultVersion :: Maybe Bool
generationId :: Maybe Text
creationDate :: Maybe POSIX
$sel:httpStatus:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Int
$sel:policyVersionId:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
$sel:policyName:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
$sel:policyDocument:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
$sel:policyArn:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
$sel:lastModifiedDate:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe POSIX
$sel:isDefaultVersion:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Bool
$sel:generationId:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe Text
$sel:creationDate:GetPolicyVersionResponse' :: GetPolicyVersionResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
generationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 POSIX
lastModifiedDate
      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
policyName
      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