{-# 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.GetServiceLastAccessedDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a service last accessed report that was created using the
-- @GenerateServiceLastAccessedDetails@ operation. You can use the @JobId@
-- parameter in @GetServiceLastAccessedDetails@ to retrieve the status of
-- your report job. When the report is complete, you can retrieve the
-- generated report. The report includes a list of Amazon Web Services
-- services that the resource (user, group, role, or managed policy) can
-- access.
--
-- Service last accessed data does not use other policy types when
-- determining whether a resource could access a service. These other
-- policy types include resource-based policies, access control lists,
-- Organizations policies, IAM permissions boundaries, and STS assume role
-- policies. It only applies permissions policy logic. For more about the
-- evaluation of policy types, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_evaluation-logic.html#policy-eval-basics Evaluating policies>
-- in the /IAM User Guide/.
--
-- For each service that the resource could access using permissions
-- policies, the operation returns details about the most recent access
-- attempt. If there was no attempt, the service is listed without details
-- about the most recent attempt to access the service. If the operation
-- fails, the @GetServiceLastAccessedDetails@ operation returns the reason
-- that it failed.
--
-- The @GetServiceLastAccessedDetails@ operation returns a list of
-- services. This list includes the number of entities that have attempted
-- to access the service and the date and time of the last attempt. It also
-- returns the ARN of the following entity, depending on the resource ARN
-- that you used to generate the report:
--
-- -   __User__ – Returns the user ARN that you used to generate the report
--
-- -   __Group__ – Returns the ARN of the group member (user) that last
--     attempted to access the service
--
-- -   __Role__ – Returns the role ARN that you used to generate the report
--
-- -   __Policy__ – Returns the ARN of the user or role that last used the
--     policy to attempt to access the service
--
-- By default, the list is sorted by service namespace.
--
-- If you specified @ACTION_LEVEL@ granularity when you generated the
-- report, this operation returns service and action last accessed data.
-- This includes the most recent access attempt for each tracked action
-- within a service. Otherwise, this operation returns only service data.
--
-- For more information about service and action last accessed data, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_access-advisor.html Reducing permissions using service last accessed data>
-- in the /IAM User Guide/.
module Amazonka.IAM.GetServiceLastAccessedDetails
  ( -- * Creating a Request
    GetServiceLastAccessedDetails (..),
    newGetServiceLastAccessedDetails,

    -- * Request Lenses
    getServiceLastAccessedDetails_marker,
    getServiceLastAccessedDetails_maxItems,
    getServiceLastAccessedDetails_jobId,

    -- * Destructuring the Response
    GetServiceLastAccessedDetailsResponse (..),
    newGetServiceLastAccessedDetailsResponse,

    -- * Response Lenses
    getServiceLastAccessedDetailsResponse_error,
    getServiceLastAccessedDetailsResponse_isTruncated,
    getServiceLastAccessedDetailsResponse_jobType,
    getServiceLastAccessedDetailsResponse_marker,
    getServiceLastAccessedDetailsResponse_httpStatus,
    getServiceLastAccessedDetailsResponse_jobStatus,
    getServiceLastAccessedDetailsResponse_jobCreationDate,
    getServiceLastAccessedDetailsResponse_servicesLastAccessed,
    getServiceLastAccessedDetailsResponse_jobCompletionDate,
  )
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:/ 'newGetServiceLastAccessedDetails' smart constructor.
data GetServiceLastAccessedDetails = GetServiceLastAccessedDetails'
  { -- | Use this parameter only when paginating results and only after you
    -- receive a response indicating that the results are truncated. Set it to
    -- the value of the @Marker@ element in the response that you received to
    -- indicate where the next call should start.
    GetServiceLastAccessedDetails -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Use this only when paginating results to indicate the maximum number of
    -- items you want in the response. If additional items exist beyond the
    -- maximum you specify, the @IsTruncated@ response element is @true@.
    --
    -- If you do not include this parameter, the number of items defaults to
    -- 100. Note that IAM might return fewer results, even when there are more
    -- results available. In that case, the @IsTruncated@ response element
    -- returns @true@, and @Marker@ contains a value to include in the
    -- subsequent call that tells the service where to continue from.
    GetServiceLastAccessedDetails -> Maybe Natural
maxItems :: Prelude.Maybe Prelude.Natural,
    -- | The ID of the request generated by the
    -- GenerateServiceLastAccessedDetails operation. The @JobId@ returned by
    -- @GenerateServiceLastAccessedDetail@ must be used by the same role within
    -- a session, or by the same user when used to call
    -- @GetServiceLastAccessedDetail@.
    GetServiceLastAccessedDetails -> Text
jobId :: Prelude.Text
  }
  deriving (GetServiceLastAccessedDetails
-> GetServiceLastAccessedDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceLastAccessedDetails
-> GetServiceLastAccessedDetails -> Bool
$c/= :: GetServiceLastAccessedDetails
-> GetServiceLastAccessedDetails -> Bool
== :: GetServiceLastAccessedDetails
-> GetServiceLastAccessedDetails -> Bool
$c== :: GetServiceLastAccessedDetails
-> GetServiceLastAccessedDetails -> Bool
Prelude.Eq, ReadPrec [GetServiceLastAccessedDetails]
ReadPrec GetServiceLastAccessedDetails
Int -> ReadS GetServiceLastAccessedDetails
ReadS [GetServiceLastAccessedDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceLastAccessedDetails]
$creadListPrec :: ReadPrec [GetServiceLastAccessedDetails]
readPrec :: ReadPrec GetServiceLastAccessedDetails
$creadPrec :: ReadPrec GetServiceLastAccessedDetails
readList :: ReadS [GetServiceLastAccessedDetails]
$creadList :: ReadS [GetServiceLastAccessedDetails]
readsPrec :: Int -> ReadS GetServiceLastAccessedDetails
$creadsPrec :: Int -> ReadS GetServiceLastAccessedDetails
Prelude.Read, Int -> GetServiceLastAccessedDetails -> ShowS
[GetServiceLastAccessedDetails] -> ShowS
GetServiceLastAccessedDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceLastAccessedDetails] -> ShowS
$cshowList :: [GetServiceLastAccessedDetails] -> ShowS
show :: GetServiceLastAccessedDetails -> String
$cshow :: GetServiceLastAccessedDetails -> String
showsPrec :: Int -> GetServiceLastAccessedDetails -> ShowS
$cshowsPrec :: Int -> GetServiceLastAccessedDetails -> ShowS
Prelude.Show, forall x.
Rep GetServiceLastAccessedDetails x
-> GetServiceLastAccessedDetails
forall x.
GetServiceLastAccessedDetails
-> Rep GetServiceLastAccessedDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServiceLastAccessedDetails x
-> GetServiceLastAccessedDetails
$cfrom :: forall x.
GetServiceLastAccessedDetails
-> Rep GetServiceLastAccessedDetails x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceLastAccessedDetails' 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:
--
-- 'marker', 'getServiceLastAccessedDetails_marker' - Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
--
-- 'maxItems', 'getServiceLastAccessedDetails_maxItems' - Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
--
-- 'jobId', 'getServiceLastAccessedDetails_jobId' - The ID of the request generated by the
-- GenerateServiceLastAccessedDetails operation. The @JobId@ returned by
-- @GenerateServiceLastAccessedDetail@ must be used by the same role within
-- a session, or by the same user when used to call
-- @GetServiceLastAccessedDetail@.
newGetServiceLastAccessedDetails ::
  -- | 'jobId'
  Prelude.Text ->
  GetServiceLastAccessedDetails
newGetServiceLastAccessedDetails :: Text -> GetServiceLastAccessedDetails
newGetServiceLastAccessedDetails Text
pJobId_ =
  GetServiceLastAccessedDetails'
    { $sel:marker:GetServiceLastAccessedDetails' :: Maybe Text
marker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:GetServiceLastAccessedDetails' :: Maybe Natural
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetServiceLastAccessedDetails' :: Text
jobId = Text
pJobId_
    }

-- | Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
getServiceLastAccessedDetails_marker :: Lens.Lens' GetServiceLastAccessedDetails (Prelude.Maybe Prelude.Text)
getServiceLastAccessedDetails_marker :: Lens' GetServiceLastAccessedDetails (Maybe Text)
getServiceLastAccessedDetails_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetails' {Maybe Text
marker :: Maybe Text
$sel:marker:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Text
marker} -> Maybe Text
marker) (\s :: GetServiceLastAccessedDetails
s@GetServiceLastAccessedDetails' {} Maybe Text
a -> GetServiceLastAccessedDetails
s {$sel:marker:GetServiceLastAccessedDetails' :: Maybe Text
marker = Maybe Text
a} :: GetServiceLastAccessedDetails)

-- | Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
getServiceLastAccessedDetails_maxItems :: Lens.Lens' GetServiceLastAccessedDetails (Prelude.Maybe Prelude.Natural)
getServiceLastAccessedDetails_maxItems :: Lens' GetServiceLastAccessedDetails (Maybe Natural)
getServiceLastAccessedDetails_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetails' {Maybe Natural
maxItems :: Maybe Natural
$sel:maxItems:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Natural
maxItems} -> Maybe Natural
maxItems) (\s :: GetServiceLastAccessedDetails
s@GetServiceLastAccessedDetails' {} Maybe Natural
a -> GetServiceLastAccessedDetails
s {$sel:maxItems:GetServiceLastAccessedDetails' :: Maybe Natural
maxItems = Maybe Natural
a} :: GetServiceLastAccessedDetails)

-- | The ID of the request generated by the
-- GenerateServiceLastAccessedDetails operation. The @JobId@ returned by
-- @GenerateServiceLastAccessedDetail@ must be used by the same role within
-- a session, or by the same user when used to call
-- @GetServiceLastAccessedDetail@.
getServiceLastAccessedDetails_jobId :: Lens.Lens' GetServiceLastAccessedDetails Prelude.Text
getServiceLastAccessedDetails_jobId :: Lens' GetServiceLastAccessedDetails Text
getServiceLastAccessedDetails_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetails' {Text
jobId :: Text
$sel:jobId:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Text
jobId} -> Text
jobId) (\s :: GetServiceLastAccessedDetails
s@GetServiceLastAccessedDetails' {} Text
a -> GetServiceLastAccessedDetails
s {$sel:jobId:GetServiceLastAccessedDetails' :: Text
jobId = Text
a} :: GetServiceLastAccessedDetails)

instance
  Core.AWSRequest
    GetServiceLastAccessedDetails
  where
  type
    AWSResponse GetServiceLastAccessedDetails =
      GetServiceLastAccessedDetailsResponse
  request :: (Service -> Service)
-> GetServiceLastAccessedDetails
-> Request GetServiceLastAccessedDetails
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 GetServiceLastAccessedDetails
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetServiceLastAccessedDetails)))
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
"GetServiceLastAccessedDetailsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ErrorDetails
-> Maybe Bool
-> Maybe AccessAdvisorUsageGranularityType
-> Maybe Text
-> Int
-> JobStatusType
-> ISO8601
-> [ServiceLastAccessed]
-> ISO8601
-> GetServiceLastAccessedDetailsResponse
GetServiceLastAccessedDetailsResponse'
            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
"Error")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"IsTruncated")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"JobType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"JobStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"JobCreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ServicesLastAccessed"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"JobCompletionDate")
      )

instance
  Prelude.Hashable
    GetServiceLastAccessedDetails
  where
  hashWithSalt :: Int -> GetServiceLastAccessedDetails -> Int
hashWithSalt Int
_salt GetServiceLastAccessedDetails' {Maybe Natural
Maybe Text
Text
jobId :: Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:jobId:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Text
$sel:maxItems:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Natural
$sel:marker:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxItems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData GetServiceLastAccessedDetails where
  rnf :: GetServiceLastAccessedDetails -> ()
rnf GetServiceLastAccessedDetails' {Maybe Natural
Maybe Text
Text
jobId :: Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:jobId:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Text
$sel:maxItems:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Natural
$sel:marker:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

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

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

instance Data.ToQuery GetServiceLastAccessedDetails where
  toQuery :: GetServiceLastAccessedDetails -> QueryString
toQuery GetServiceLastAccessedDetails' {Maybe Natural
Maybe Text
Text
jobId :: Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:jobId:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Text
$sel:maxItems:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Natural
$sel:marker:GetServiceLastAccessedDetails' :: GetServiceLastAccessedDetails -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetServiceLastAccessedDetails" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxItems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxItems,
        ByteString
"JobId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
jobId
      ]

-- | /See:/ 'newGetServiceLastAccessedDetailsResponse' smart constructor.
data GetServiceLastAccessedDetailsResponse = GetServiceLastAccessedDetailsResponse'
  { -- | An object that contains details about the reason the operation failed.
    GetServiceLastAccessedDetailsResponse -> Maybe ErrorDetails
error :: Prelude.Maybe ErrorDetails,
    -- | A flag that indicates whether there are more items to return. If your
    -- results were truncated, you can make a subsequent pagination request
    -- using the @Marker@ request parameter to retrieve more items. Note that
    -- IAM might return fewer than the @MaxItems@ number of results even when
    -- there are more results available. We recommend that you check
    -- @IsTruncated@ after every call to ensure that you receive all your
    -- results.
    GetServiceLastAccessedDetailsResponse -> Maybe Bool
isTruncated :: Prelude.Maybe Prelude.Bool,
    -- | The type of job. Service jobs return information about when each service
    -- was last accessed. Action jobs also include information about when
    -- tracked actions within the service were last accessed.
    GetServiceLastAccessedDetailsResponse
-> Maybe AccessAdvisorUsageGranularityType
jobType :: Prelude.Maybe AccessAdvisorUsageGranularityType,
    -- | When @IsTruncated@ is @true@, this element is present and contains the
    -- value to use for the @Marker@ parameter in a subsequent pagination
    -- request.
    GetServiceLastAccessedDetailsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetServiceLastAccessedDetailsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The status of the job.
    GetServiceLastAccessedDetailsResponse -> JobStatusType
jobStatus :: JobStatusType,
    -- | The date and time,
    -- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
    -- report job was created.
    GetServiceLastAccessedDetailsResponse -> ISO8601
jobCreationDate :: Data.ISO8601,
    -- | A @ServiceLastAccessed@ object that contains details about the most
    -- recent attempt to access the service.
    GetServiceLastAccessedDetailsResponse -> [ServiceLastAccessed]
servicesLastAccessed :: [ServiceLastAccessed],
    -- | The date and time,
    -- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
    -- generated report job was completed or failed.
    --
    -- This field is null if the job is still in progress, as indicated by a
    -- job status value of @IN_PROGRESS@.
    GetServiceLastAccessedDetailsResponse -> ISO8601
jobCompletionDate :: Data.ISO8601
  }
  deriving (GetServiceLastAccessedDetailsResponse
-> GetServiceLastAccessedDetailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetServiceLastAccessedDetailsResponse
-> GetServiceLastAccessedDetailsResponse -> Bool
$c/= :: GetServiceLastAccessedDetailsResponse
-> GetServiceLastAccessedDetailsResponse -> Bool
== :: GetServiceLastAccessedDetailsResponse
-> GetServiceLastAccessedDetailsResponse -> Bool
$c== :: GetServiceLastAccessedDetailsResponse
-> GetServiceLastAccessedDetailsResponse -> Bool
Prelude.Eq, ReadPrec [GetServiceLastAccessedDetailsResponse]
ReadPrec GetServiceLastAccessedDetailsResponse
Int -> ReadS GetServiceLastAccessedDetailsResponse
ReadS [GetServiceLastAccessedDetailsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetServiceLastAccessedDetailsResponse]
$creadListPrec :: ReadPrec [GetServiceLastAccessedDetailsResponse]
readPrec :: ReadPrec GetServiceLastAccessedDetailsResponse
$creadPrec :: ReadPrec GetServiceLastAccessedDetailsResponse
readList :: ReadS [GetServiceLastAccessedDetailsResponse]
$creadList :: ReadS [GetServiceLastAccessedDetailsResponse]
readsPrec :: Int -> ReadS GetServiceLastAccessedDetailsResponse
$creadsPrec :: Int -> ReadS GetServiceLastAccessedDetailsResponse
Prelude.Read, Int -> GetServiceLastAccessedDetailsResponse -> ShowS
[GetServiceLastAccessedDetailsResponse] -> ShowS
GetServiceLastAccessedDetailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetServiceLastAccessedDetailsResponse] -> ShowS
$cshowList :: [GetServiceLastAccessedDetailsResponse] -> ShowS
show :: GetServiceLastAccessedDetailsResponse -> String
$cshow :: GetServiceLastAccessedDetailsResponse -> String
showsPrec :: Int -> GetServiceLastAccessedDetailsResponse -> ShowS
$cshowsPrec :: Int -> GetServiceLastAccessedDetailsResponse -> ShowS
Prelude.Show, forall x.
Rep GetServiceLastAccessedDetailsResponse x
-> GetServiceLastAccessedDetailsResponse
forall x.
GetServiceLastAccessedDetailsResponse
-> Rep GetServiceLastAccessedDetailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetServiceLastAccessedDetailsResponse x
-> GetServiceLastAccessedDetailsResponse
$cfrom :: forall x.
GetServiceLastAccessedDetailsResponse
-> Rep GetServiceLastAccessedDetailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetServiceLastAccessedDetailsResponse' 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:
--
-- 'error', 'getServiceLastAccessedDetailsResponse_error' - An object that contains details about the reason the operation failed.
--
-- 'isTruncated', 'getServiceLastAccessedDetailsResponse_isTruncated' - A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
--
-- 'jobType', 'getServiceLastAccessedDetailsResponse_jobType' - The type of job. Service jobs return information about when each service
-- was last accessed. Action jobs also include information about when
-- tracked actions within the service were last accessed.
--
-- 'marker', 'getServiceLastAccessedDetailsResponse_marker' - When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
--
-- 'httpStatus', 'getServiceLastAccessedDetailsResponse_httpStatus' - The response's http status code.
--
-- 'jobStatus', 'getServiceLastAccessedDetailsResponse_jobStatus' - The status of the job.
--
-- 'jobCreationDate', 'getServiceLastAccessedDetailsResponse_jobCreationDate' - The date and time,
-- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- report job was created.
--
-- 'servicesLastAccessed', 'getServiceLastAccessedDetailsResponse_servicesLastAccessed' - A @ServiceLastAccessed@ object that contains details about the most
-- recent attempt to access the service.
--
-- 'jobCompletionDate', 'getServiceLastAccessedDetailsResponse_jobCompletionDate' - The date and time,
-- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- generated report job was completed or failed.
--
-- This field is null if the job is still in progress, as indicated by a
-- job status value of @IN_PROGRESS@.
newGetServiceLastAccessedDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobStatus'
  JobStatusType ->
  -- | 'jobCreationDate'
  Prelude.UTCTime ->
  -- | 'jobCompletionDate'
  Prelude.UTCTime ->
  GetServiceLastAccessedDetailsResponse
newGetServiceLastAccessedDetailsResponse :: Int
-> JobStatusType
-> UTCTime
-> UTCTime
-> GetServiceLastAccessedDetailsResponse
newGetServiceLastAccessedDetailsResponse
  Int
pHttpStatus_
  JobStatusType
pJobStatus_
  UTCTime
pJobCreationDate_
  UTCTime
pJobCompletionDate_ =
    GetServiceLastAccessedDetailsResponse'
      { $sel:error:GetServiceLastAccessedDetailsResponse' :: Maybe ErrorDetails
error =
          forall a. Maybe a
Prelude.Nothing,
        $sel:isTruncated:GetServiceLastAccessedDetailsResponse' :: Maybe Bool
isTruncated = forall a. Maybe a
Prelude.Nothing,
        $sel:jobType:GetServiceLastAccessedDetailsResponse' :: Maybe AccessAdvisorUsageGranularityType
jobType = forall a. Maybe a
Prelude.Nothing,
        $sel:marker:GetServiceLastAccessedDetailsResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetServiceLastAccessedDetailsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:jobStatus:GetServiceLastAccessedDetailsResponse' :: JobStatusType
jobStatus = JobStatusType
pJobStatus_,
        $sel:jobCreationDate:GetServiceLastAccessedDetailsResponse' :: ISO8601
jobCreationDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
            forall t b. AReview t b -> b -> t
Lens.# UTCTime
pJobCreationDate_,
        $sel:servicesLastAccessed:GetServiceLastAccessedDetailsResponse' :: [ServiceLastAccessed]
servicesLastAccessed =
          forall a. Monoid a => a
Prelude.mempty,
        $sel:jobCompletionDate:GetServiceLastAccessedDetailsResponse' :: ISO8601
jobCompletionDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
            forall t b. AReview t b -> b -> t
Lens.# UTCTime
pJobCompletionDate_
      }

-- | An object that contains details about the reason the operation failed.
getServiceLastAccessedDetailsResponse_error :: Lens.Lens' GetServiceLastAccessedDetailsResponse (Prelude.Maybe ErrorDetails)
getServiceLastAccessedDetailsResponse_error :: Lens' GetServiceLastAccessedDetailsResponse (Maybe ErrorDetails)
getServiceLastAccessedDetailsResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {Maybe ErrorDetails
error :: Maybe ErrorDetails
$sel:error:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe ErrorDetails
error} -> Maybe ErrorDetails
error) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} Maybe ErrorDetails
a -> GetServiceLastAccessedDetailsResponse
s {$sel:error:GetServiceLastAccessedDetailsResponse' :: Maybe ErrorDetails
error = Maybe ErrorDetails
a} :: GetServiceLastAccessedDetailsResponse)

-- | A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
getServiceLastAccessedDetailsResponse_isTruncated :: Lens.Lens' GetServiceLastAccessedDetailsResponse (Prelude.Maybe Prelude.Bool)
getServiceLastAccessedDetailsResponse_isTruncated :: Lens' GetServiceLastAccessedDetailsResponse (Maybe Bool)
getServiceLastAccessedDetailsResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {Maybe Bool
isTruncated :: Maybe Bool
$sel:isTruncated:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe Bool
isTruncated} -> Maybe Bool
isTruncated) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} Maybe Bool
a -> GetServiceLastAccessedDetailsResponse
s {$sel:isTruncated:GetServiceLastAccessedDetailsResponse' :: Maybe Bool
isTruncated = Maybe Bool
a} :: GetServiceLastAccessedDetailsResponse)

-- | The type of job. Service jobs return information about when each service
-- was last accessed. Action jobs also include information about when
-- tracked actions within the service were last accessed.
getServiceLastAccessedDetailsResponse_jobType :: Lens.Lens' GetServiceLastAccessedDetailsResponse (Prelude.Maybe AccessAdvisorUsageGranularityType)
getServiceLastAccessedDetailsResponse_jobType :: Lens'
  GetServiceLastAccessedDetailsResponse
  (Maybe AccessAdvisorUsageGranularityType)
getServiceLastAccessedDetailsResponse_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {Maybe AccessAdvisorUsageGranularityType
jobType :: Maybe AccessAdvisorUsageGranularityType
$sel:jobType:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse
-> Maybe AccessAdvisorUsageGranularityType
jobType} -> Maybe AccessAdvisorUsageGranularityType
jobType) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} Maybe AccessAdvisorUsageGranularityType
a -> GetServiceLastAccessedDetailsResponse
s {$sel:jobType:GetServiceLastAccessedDetailsResponse' :: Maybe AccessAdvisorUsageGranularityType
jobType = Maybe AccessAdvisorUsageGranularityType
a} :: GetServiceLastAccessedDetailsResponse)

-- | When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
getServiceLastAccessedDetailsResponse_marker :: Lens.Lens' GetServiceLastAccessedDetailsResponse (Prelude.Maybe Prelude.Text)
getServiceLastAccessedDetailsResponse_marker :: Lens' GetServiceLastAccessedDetailsResponse (Maybe Text)
getServiceLastAccessedDetailsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} Maybe Text
a -> GetServiceLastAccessedDetailsResponse
s {$sel:marker:GetServiceLastAccessedDetailsResponse' :: Maybe Text
marker = Maybe Text
a} :: GetServiceLastAccessedDetailsResponse)

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

-- | The status of the job.
getServiceLastAccessedDetailsResponse_jobStatus :: Lens.Lens' GetServiceLastAccessedDetailsResponse JobStatusType
getServiceLastAccessedDetailsResponse_jobStatus :: Lens' GetServiceLastAccessedDetailsResponse JobStatusType
getServiceLastAccessedDetailsResponse_jobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {JobStatusType
jobStatus :: JobStatusType
$sel:jobStatus:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> JobStatusType
jobStatus} -> JobStatusType
jobStatus) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} JobStatusType
a -> GetServiceLastAccessedDetailsResponse
s {$sel:jobStatus:GetServiceLastAccessedDetailsResponse' :: JobStatusType
jobStatus = JobStatusType
a} :: GetServiceLastAccessedDetailsResponse)

-- | The date and time,
-- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- report job was created.
getServiceLastAccessedDetailsResponse_jobCreationDate :: Lens.Lens' GetServiceLastAccessedDetailsResponse Prelude.UTCTime
getServiceLastAccessedDetailsResponse_jobCreationDate :: Lens' GetServiceLastAccessedDetailsResponse UTCTime
getServiceLastAccessedDetailsResponse_jobCreationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {ISO8601
jobCreationDate :: ISO8601
$sel:jobCreationDate:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> ISO8601
jobCreationDate} -> ISO8601
jobCreationDate) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} ISO8601
a -> GetServiceLastAccessedDetailsResponse
s {$sel:jobCreationDate:GetServiceLastAccessedDetailsResponse' :: ISO8601
jobCreationDate = ISO8601
a} :: GetServiceLastAccessedDetailsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A @ServiceLastAccessed@ object that contains details about the most
-- recent attempt to access the service.
getServiceLastAccessedDetailsResponse_servicesLastAccessed :: Lens.Lens' GetServiceLastAccessedDetailsResponse [ServiceLastAccessed]
getServiceLastAccessedDetailsResponse_servicesLastAccessed :: Lens' GetServiceLastAccessedDetailsResponse [ServiceLastAccessed]
getServiceLastAccessedDetailsResponse_servicesLastAccessed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {[ServiceLastAccessed]
servicesLastAccessed :: [ServiceLastAccessed]
$sel:servicesLastAccessed:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> [ServiceLastAccessed]
servicesLastAccessed} -> [ServiceLastAccessed]
servicesLastAccessed) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} [ServiceLastAccessed]
a -> GetServiceLastAccessedDetailsResponse
s {$sel:servicesLastAccessed:GetServiceLastAccessedDetailsResponse' :: [ServiceLastAccessed]
servicesLastAccessed = [ServiceLastAccessed]
a} :: GetServiceLastAccessedDetailsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date and time,
-- in <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- generated report job was completed or failed.
--
-- This field is null if the job is still in progress, as indicated by a
-- job status value of @IN_PROGRESS@.
getServiceLastAccessedDetailsResponse_jobCompletionDate :: Lens.Lens' GetServiceLastAccessedDetailsResponse Prelude.UTCTime
getServiceLastAccessedDetailsResponse_jobCompletionDate :: Lens' GetServiceLastAccessedDetailsResponse UTCTime
getServiceLastAccessedDetailsResponse_jobCompletionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetServiceLastAccessedDetailsResponse' {ISO8601
jobCompletionDate :: ISO8601
$sel:jobCompletionDate:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> ISO8601
jobCompletionDate} -> ISO8601
jobCompletionDate) (\s :: GetServiceLastAccessedDetailsResponse
s@GetServiceLastAccessedDetailsResponse' {} ISO8601
a -> GetServiceLastAccessedDetailsResponse
s {$sel:jobCompletionDate:GetServiceLastAccessedDetailsResponse' :: ISO8601
jobCompletionDate = ISO8601
a} :: GetServiceLastAccessedDetailsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance
  Prelude.NFData
    GetServiceLastAccessedDetailsResponse
  where
  rnf :: GetServiceLastAccessedDetailsResponse -> ()
rnf GetServiceLastAccessedDetailsResponse' {Int
[ServiceLastAccessed]
Maybe Bool
Maybe Text
Maybe AccessAdvisorUsageGranularityType
Maybe ErrorDetails
ISO8601
JobStatusType
jobCompletionDate :: ISO8601
servicesLastAccessed :: [ServiceLastAccessed]
jobCreationDate :: ISO8601
jobStatus :: JobStatusType
httpStatus :: Int
marker :: Maybe Text
jobType :: Maybe AccessAdvisorUsageGranularityType
isTruncated :: Maybe Bool
error :: Maybe ErrorDetails
$sel:jobCompletionDate:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> ISO8601
$sel:servicesLastAccessed:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> [ServiceLastAccessed]
$sel:jobCreationDate:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> ISO8601
$sel:jobStatus:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> JobStatusType
$sel:httpStatus:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Int
$sel:marker:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe Text
$sel:jobType:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse
-> Maybe AccessAdvisorUsageGranularityType
$sel:isTruncated:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe Bool
$sel:error:GetServiceLastAccessedDetailsResponse' :: GetServiceLastAccessedDetailsResponse -> Maybe ErrorDetails
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ErrorDetails
error
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AccessAdvisorUsageGranularityType
jobType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobStatusType
jobStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
jobCreationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ServiceLastAccessed]
servicesLastAccessed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
jobCompletionDate