{-# 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.CloudTrail.GetTrailStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a JSON-formatted list of information about the specified trail.
-- Fields include information on delivery errors, Amazon SNS and Amazon S3
-- errors, and start and stop logging times for each trail. This operation
-- returns trail status from a single region. To return trail status from
-- all regions, you must call the operation on each region.
module Amazonka.CloudTrail.GetTrailStatus
  ( -- * Creating a Request
    GetTrailStatus (..),
    newGetTrailStatus,

    -- * Request Lenses
    getTrailStatus_name,

    -- * Destructuring the Response
    GetTrailStatusResponse (..),
    newGetTrailStatusResponse,

    -- * Response Lenses
    getTrailStatusResponse_isLogging,
    getTrailStatusResponse_latestCloudWatchLogsDeliveryError,
    getTrailStatusResponse_latestCloudWatchLogsDeliveryTime,
    getTrailStatusResponse_latestDeliveryAttemptSucceeded,
    getTrailStatusResponse_latestDeliveryAttemptTime,
    getTrailStatusResponse_latestDeliveryError,
    getTrailStatusResponse_latestDeliveryTime,
    getTrailStatusResponse_latestDigestDeliveryError,
    getTrailStatusResponse_latestDigestDeliveryTime,
    getTrailStatusResponse_latestNotificationAttemptSucceeded,
    getTrailStatusResponse_latestNotificationAttemptTime,
    getTrailStatusResponse_latestNotificationError,
    getTrailStatusResponse_latestNotificationTime,
    getTrailStatusResponse_startLoggingTime,
    getTrailStatusResponse_stopLoggingTime,
    getTrailStatusResponse_timeLoggingStarted,
    getTrailStatusResponse_timeLoggingStopped,
    getTrailStatusResponse_httpStatus,
  )
where

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

-- | The name of a trail about which you want the current status.
--
-- /See:/ 'newGetTrailStatus' smart constructor.
data GetTrailStatus = GetTrailStatus'
  { -- | Specifies the name or the CloudTrail ARN of the trail for which you are
    -- requesting status. To get the status of a shadow trail (a replication of
    -- the trail in another region), you must specify its ARN. The following is
    -- the format of a trail ARN.
    --
    -- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
    GetTrailStatus -> Text
name :: Prelude.Text
  }
  deriving (GetTrailStatus -> GetTrailStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTrailStatus -> GetTrailStatus -> Bool
$c/= :: GetTrailStatus -> GetTrailStatus -> Bool
== :: GetTrailStatus -> GetTrailStatus -> Bool
$c== :: GetTrailStatus -> GetTrailStatus -> Bool
Prelude.Eq, ReadPrec [GetTrailStatus]
ReadPrec GetTrailStatus
Int -> ReadS GetTrailStatus
ReadS [GetTrailStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTrailStatus]
$creadListPrec :: ReadPrec [GetTrailStatus]
readPrec :: ReadPrec GetTrailStatus
$creadPrec :: ReadPrec GetTrailStatus
readList :: ReadS [GetTrailStatus]
$creadList :: ReadS [GetTrailStatus]
readsPrec :: Int -> ReadS GetTrailStatus
$creadsPrec :: Int -> ReadS GetTrailStatus
Prelude.Read, Int -> GetTrailStatus -> ShowS
[GetTrailStatus] -> ShowS
GetTrailStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTrailStatus] -> ShowS
$cshowList :: [GetTrailStatus] -> ShowS
show :: GetTrailStatus -> String
$cshow :: GetTrailStatus -> String
showsPrec :: Int -> GetTrailStatus -> ShowS
$cshowsPrec :: Int -> GetTrailStatus -> ShowS
Prelude.Show, forall x. Rep GetTrailStatus x -> GetTrailStatus
forall x. GetTrailStatus -> Rep GetTrailStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTrailStatus x -> GetTrailStatus
$cfrom :: forall x. GetTrailStatus -> Rep GetTrailStatus x
Prelude.Generic)

-- |
-- Create a value of 'GetTrailStatus' 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:
--
-- 'name', 'getTrailStatus_name' - Specifies the name or the CloudTrail ARN of the trail for which you are
-- requesting status. To get the status of a shadow trail (a replication of
-- the trail in another region), you must specify its ARN. The following is
-- the format of a trail ARN.
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
newGetTrailStatus ::
  -- | 'name'
  Prelude.Text ->
  GetTrailStatus
newGetTrailStatus :: Text -> GetTrailStatus
newGetTrailStatus Text
pName_ =
  GetTrailStatus' {$sel:name:GetTrailStatus' :: Text
name = Text
pName_}

-- | Specifies the name or the CloudTrail ARN of the trail for which you are
-- requesting status. To get the status of a shadow trail (a replication of
-- the trail in another region), you must specify its ARN. The following is
-- the format of a trail ARN.
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
getTrailStatus_name :: Lens.Lens' GetTrailStatus Prelude.Text
getTrailStatus_name :: Lens' GetTrailStatus Text
getTrailStatus_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatus' {Text
name :: Text
$sel:name:GetTrailStatus' :: GetTrailStatus -> Text
name} -> Text
name) (\s :: GetTrailStatus
s@GetTrailStatus' {} Text
a -> GetTrailStatus
s {$sel:name:GetTrailStatus' :: Text
name = Text
a} :: GetTrailStatus)

instance Core.AWSRequest GetTrailStatus where
  type
    AWSResponse GetTrailStatus =
      GetTrailStatusResponse
  request :: (Service -> Service) -> GetTrailStatus -> Request GetTrailStatus
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 GetTrailStatus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTrailStatus)))
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Int
-> GetTrailStatusResponse
GetTrailStatusResponse'
            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
"IsLogging")
            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
"LatestCloudWatchLogsDeliveryError")
            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
"LatestCloudWatchLogsDeliveryTime")
            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
"LatestDeliveryAttemptSucceeded")
            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
"LatestDeliveryAttemptTime")
            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
"LatestDeliveryError")
            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
"LatestDeliveryTime")
            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
"LatestDigestDeliveryError")
            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
"LatestDigestDeliveryTime")
            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
"LatestNotificationAttemptSucceeded")
            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
"LatestNotificationAttemptTime")
            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
"LatestNotificationError")
            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
"LatestNotificationTime")
            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
"StartLoggingTime")
            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
"StopLoggingTime")
            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
"TimeLoggingStarted")
            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
"TimeLoggingStopped")
            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 GetTrailStatus where
  hashWithSalt :: Int -> GetTrailStatus -> Int
hashWithSalt Int
_salt GetTrailStatus' {Text
name :: Text
$sel:name:GetTrailStatus' :: GetTrailStatus -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetTrailStatus where
  rnf :: GetTrailStatus -> ()
rnf GetTrailStatus' {Text
name :: Text
$sel:name:GetTrailStatus' :: GetTrailStatus -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders GetTrailStatus where
  toHeaders :: GetTrailStatus -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.GetTrailStatus" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | Returns the objects or data listed below if successful. Otherwise,
-- returns an error.
--
-- /See:/ 'newGetTrailStatusResponse' smart constructor.
data GetTrailStatusResponse = GetTrailStatusResponse'
  { -- | Whether the CloudTrail trail is currently logging Amazon Web Services
    -- API calls.
    GetTrailStatusResponse -> Maybe Bool
isLogging :: Prelude.Maybe Prelude.Bool,
    -- | Displays any CloudWatch Logs error that CloudTrail encountered when
    -- attempting to deliver logs to CloudWatch Logs.
    GetTrailStatusResponse -> Maybe Text
latestCloudWatchLogsDeliveryError :: Prelude.Maybe Prelude.Text,
    -- | Displays the most recent date and time when CloudTrail delivered logs to
    -- CloudWatch Logs.
    GetTrailStatusResponse -> Maybe POSIX
latestCloudWatchLogsDeliveryTime :: Prelude.Maybe Data.POSIX,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
latestDeliveryAttemptSucceeded :: Prelude.Maybe Prelude.Text,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
latestDeliveryAttemptTime :: Prelude.Maybe Prelude.Text,
    -- | Displays any Amazon S3 error that CloudTrail encountered when attempting
    -- to deliver log files to the designated bucket. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
    -- in the Amazon S3 API Reference.
    --
    -- This error occurs only when there is a problem with the destination S3
    -- bucket, and does not occur for requests that time out. To resolve the
    -- issue, create a new bucket, and then call @UpdateTrail@ to specify the
    -- new bucket; or fix the existing objects so that CloudTrail can again
    -- write to the bucket.
    GetTrailStatusResponse -> Maybe Text
latestDeliveryError :: Prelude.Maybe Prelude.Text,
    -- | Specifies the date and time that CloudTrail last delivered log files to
    -- an account\'s Amazon S3 bucket.
    GetTrailStatusResponse -> Maybe POSIX
latestDeliveryTime :: Prelude.Maybe Data.POSIX,
    -- | Displays any Amazon S3 error that CloudTrail encountered when attempting
    -- to deliver a digest file to the designated bucket. For more information,
    -- see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
    -- in the Amazon S3 API Reference.
    --
    -- This error occurs only when there is a problem with the destination S3
    -- bucket, and does not occur for requests that time out. To resolve the
    -- issue, create a new bucket, and then call @UpdateTrail@ to specify the
    -- new bucket; or fix the existing objects so that CloudTrail can again
    -- write to the bucket.
    GetTrailStatusResponse -> Maybe Text
latestDigestDeliveryError :: Prelude.Maybe Prelude.Text,
    -- | Specifies the date and time that CloudTrail last delivered a digest file
    -- to an account\'s Amazon S3 bucket.
    GetTrailStatusResponse -> Maybe POSIX
latestDigestDeliveryTime :: Prelude.Maybe Data.POSIX,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
latestNotificationAttemptSucceeded :: Prelude.Maybe Prelude.Text,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
latestNotificationAttemptTime :: Prelude.Maybe Prelude.Text,
    -- | Displays any Amazon SNS error that CloudTrail encountered when
    -- attempting to send a notification. For more information about Amazon SNS
    -- errors, see the
    -- <https://docs.aws.amazon.com/sns/latest/dg/welcome.html Amazon SNS Developer Guide>.
    GetTrailStatusResponse -> Maybe Text
latestNotificationError :: Prelude.Maybe Prelude.Text,
    -- | Specifies the date and time of the most recent Amazon SNS notification
    -- that CloudTrail has written a new log file to an account\'s Amazon S3
    -- bucket.
    GetTrailStatusResponse -> Maybe POSIX
latestNotificationTime :: Prelude.Maybe Data.POSIX,
    -- | Specifies the most recent date and time when CloudTrail started
    -- recording API calls for an Amazon Web Services account.
    GetTrailStatusResponse -> Maybe POSIX
startLoggingTime :: Prelude.Maybe Data.POSIX,
    -- | Specifies the most recent date and time when CloudTrail stopped
    -- recording API calls for an Amazon Web Services account.
    GetTrailStatusResponse -> Maybe POSIX
stopLoggingTime :: Prelude.Maybe Data.POSIX,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
timeLoggingStarted :: Prelude.Maybe Prelude.Text,
    -- | This field is no longer in use.
    GetTrailStatusResponse -> Maybe Text
timeLoggingStopped :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetTrailStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTrailStatusResponse -> GetTrailStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTrailStatusResponse -> GetTrailStatusResponse -> Bool
$c/= :: GetTrailStatusResponse -> GetTrailStatusResponse -> Bool
== :: GetTrailStatusResponse -> GetTrailStatusResponse -> Bool
$c== :: GetTrailStatusResponse -> GetTrailStatusResponse -> Bool
Prelude.Eq, ReadPrec [GetTrailStatusResponse]
ReadPrec GetTrailStatusResponse
Int -> ReadS GetTrailStatusResponse
ReadS [GetTrailStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTrailStatusResponse]
$creadListPrec :: ReadPrec [GetTrailStatusResponse]
readPrec :: ReadPrec GetTrailStatusResponse
$creadPrec :: ReadPrec GetTrailStatusResponse
readList :: ReadS [GetTrailStatusResponse]
$creadList :: ReadS [GetTrailStatusResponse]
readsPrec :: Int -> ReadS GetTrailStatusResponse
$creadsPrec :: Int -> ReadS GetTrailStatusResponse
Prelude.Read, Int -> GetTrailStatusResponse -> ShowS
[GetTrailStatusResponse] -> ShowS
GetTrailStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTrailStatusResponse] -> ShowS
$cshowList :: [GetTrailStatusResponse] -> ShowS
show :: GetTrailStatusResponse -> String
$cshow :: GetTrailStatusResponse -> String
showsPrec :: Int -> GetTrailStatusResponse -> ShowS
$cshowsPrec :: Int -> GetTrailStatusResponse -> ShowS
Prelude.Show, forall x. Rep GetTrailStatusResponse x -> GetTrailStatusResponse
forall x. GetTrailStatusResponse -> Rep GetTrailStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTrailStatusResponse x -> GetTrailStatusResponse
$cfrom :: forall x. GetTrailStatusResponse -> Rep GetTrailStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTrailStatusResponse' 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:
--
-- 'isLogging', 'getTrailStatusResponse_isLogging' - Whether the CloudTrail trail is currently logging Amazon Web Services
-- API calls.
--
-- 'latestCloudWatchLogsDeliveryError', 'getTrailStatusResponse_latestCloudWatchLogsDeliveryError' - Displays any CloudWatch Logs error that CloudTrail encountered when
-- attempting to deliver logs to CloudWatch Logs.
--
-- 'latestCloudWatchLogsDeliveryTime', 'getTrailStatusResponse_latestCloudWatchLogsDeliveryTime' - Displays the most recent date and time when CloudTrail delivered logs to
-- CloudWatch Logs.
--
-- 'latestDeliveryAttemptSucceeded', 'getTrailStatusResponse_latestDeliveryAttemptSucceeded' - This field is no longer in use.
--
-- 'latestDeliveryAttemptTime', 'getTrailStatusResponse_latestDeliveryAttemptTime' - This field is no longer in use.
--
-- 'latestDeliveryError', 'getTrailStatusResponse_latestDeliveryError' - Displays any Amazon S3 error that CloudTrail encountered when attempting
-- to deliver log files to the designated bucket. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
-- in the Amazon S3 API Reference.
--
-- This error occurs only when there is a problem with the destination S3
-- bucket, and does not occur for requests that time out. To resolve the
-- issue, create a new bucket, and then call @UpdateTrail@ to specify the
-- new bucket; or fix the existing objects so that CloudTrail can again
-- write to the bucket.
--
-- 'latestDeliveryTime', 'getTrailStatusResponse_latestDeliveryTime' - Specifies the date and time that CloudTrail last delivered log files to
-- an account\'s Amazon S3 bucket.
--
-- 'latestDigestDeliveryError', 'getTrailStatusResponse_latestDigestDeliveryError' - Displays any Amazon S3 error that CloudTrail encountered when attempting
-- to deliver a digest file to the designated bucket. For more information,
-- see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
-- in the Amazon S3 API Reference.
--
-- This error occurs only when there is a problem with the destination S3
-- bucket, and does not occur for requests that time out. To resolve the
-- issue, create a new bucket, and then call @UpdateTrail@ to specify the
-- new bucket; or fix the existing objects so that CloudTrail can again
-- write to the bucket.
--
-- 'latestDigestDeliveryTime', 'getTrailStatusResponse_latestDigestDeliveryTime' - Specifies the date and time that CloudTrail last delivered a digest file
-- to an account\'s Amazon S3 bucket.
--
-- 'latestNotificationAttemptSucceeded', 'getTrailStatusResponse_latestNotificationAttemptSucceeded' - This field is no longer in use.
--
-- 'latestNotificationAttemptTime', 'getTrailStatusResponse_latestNotificationAttemptTime' - This field is no longer in use.
--
-- 'latestNotificationError', 'getTrailStatusResponse_latestNotificationError' - Displays any Amazon SNS error that CloudTrail encountered when
-- attempting to send a notification. For more information about Amazon SNS
-- errors, see the
-- <https://docs.aws.amazon.com/sns/latest/dg/welcome.html Amazon SNS Developer Guide>.
--
-- 'latestNotificationTime', 'getTrailStatusResponse_latestNotificationTime' - Specifies the date and time of the most recent Amazon SNS notification
-- that CloudTrail has written a new log file to an account\'s Amazon S3
-- bucket.
--
-- 'startLoggingTime', 'getTrailStatusResponse_startLoggingTime' - Specifies the most recent date and time when CloudTrail started
-- recording API calls for an Amazon Web Services account.
--
-- 'stopLoggingTime', 'getTrailStatusResponse_stopLoggingTime' - Specifies the most recent date and time when CloudTrail stopped
-- recording API calls for an Amazon Web Services account.
--
-- 'timeLoggingStarted', 'getTrailStatusResponse_timeLoggingStarted' - This field is no longer in use.
--
-- 'timeLoggingStopped', 'getTrailStatusResponse_timeLoggingStopped' - This field is no longer in use.
--
-- 'httpStatus', 'getTrailStatusResponse_httpStatus' - The response's http status code.
newGetTrailStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTrailStatusResponse
newGetTrailStatusResponse :: Int -> GetTrailStatusResponse
newGetTrailStatusResponse Int
pHttpStatus_ =
  GetTrailStatusResponse'
    { $sel:isLogging:GetTrailStatusResponse' :: Maybe Bool
isLogging =
        forall a. Maybe a
Prelude.Nothing,
      $sel:latestCloudWatchLogsDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestCloudWatchLogsDeliveryError = forall a. Maybe a
Prelude.Nothing,
      $sel:latestCloudWatchLogsDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestCloudWatchLogsDeliveryTime = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDeliveryAttemptSucceeded:GetTrailStatusResponse' :: Maybe Text
latestDeliveryAttemptSucceeded = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDeliveryAttemptTime:GetTrailStatusResponse' :: Maybe Text
latestDeliveryAttemptTime = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestDeliveryError = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestDeliveryTime = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDigestDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestDigestDeliveryError = forall a. Maybe a
Prelude.Nothing,
      $sel:latestDigestDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestDigestDeliveryTime = forall a. Maybe a
Prelude.Nothing,
      $sel:latestNotificationAttemptSucceeded:GetTrailStatusResponse' :: Maybe Text
latestNotificationAttemptSucceeded =
        forall a. Maybe a
Prelude.Nothing,
      $sel:latestNotificationAttemptTime:GetTrailStatusResponse' :: Maybe Text
latestNotificationAttemptTime = forall a. Maybe a
Prelude.Nothing,
      $sel:latestNotificationError:GetTrailStatusResponse' :: Maybe Text
latestNotificationError = forall a. Maybe a
Prelude.Nothing,
      $sel:latestNotificationTime:GetTrailStatusResponse' :: Maybe POSIX
latestNotificationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:startLoggingTime:GetTrailStatusResponse' :: Maybe POSIX
startLoggingTime = forall a. Maybe a
Prelude.Nothing,
      $sel:stopLoggingTime:GetTrailStatusResponse' :: Maybe POSIX
stopLoggingTime = forall a. Maybe a
Prelude.Nothing,
      $sel:timeLoggingStarted:GetTrailStatusResponse' :: Maybe Text
timeLoggingStarted = forall a. Maybe a
Prelude.Nothing,
      $sel:timeLoggingStopped:GetTrailStatusResponse' :: Maybe Text
timeLoggingStopped = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTrailStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Whether the CloudTrail trail is currently logging Amazon Web Services
-- API calls.
getTrailStatusResponse_isLogging :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Bool)
getTrailStatusResponse_isLogging :: Lens' GetTrailStatusResponse (Maybe Bool)
getTrailStatusResponse_isLogging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Bool
isLogging :: Maybe Bool
$sel:isLogging:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Bool
isLogging} -> Maybe Bool
isLogging) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Bool
a -> GetTrailStatusResponse
s {$sel:isLogging:GetTrailStatusResponse' :: Maybe Bool
isLogging = Maybe Bool
a} :: GetTrailStatusResponse)

-- | Displays any CloudWatch Logs error that CloudTrail encountered when
-- attempting to deliver logs to CloudWatch Logs.
getTrailStatusResponse_latestCloudWatchLogsDeliveryError :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestCloudWatchLogsDeliveryError :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestCloudWatchLogsDeliveryError = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestCloudWatchLogsDeliveryError :: Maybe Text
$sel:latestCloudWatchLogsDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestCloudWatchLogsDeliveryError} -> Maybe Text
latestCloudWatchLogsDeliveryError) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestCloudWatchLogsDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestCloudWatchLogsDeliveryError = Maybe Text
a} :: GetTrailStatusResponse)

-- | Displays the most recent date and time when CloudTrail delivered logs to
-- CloudWatch Logs.
getTrailStatusResponse_latestCloudWatchLogsDeliveryTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_latestCloudWatchLogsDeliveryTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_latestCloudWatchLogsDeliveryTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
latestCloudWatchLogsDeliveryTime :: Maybe POSIX
$sel:latestCloudWatchLogsDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
latestCloudWatchLogsDeliveryTime} -> Maybe POSIX
latestCloudWatchLogsDeliveryTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:latestCloudWatchLogsDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestCloudWatchLogsDeliveryTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | This field is no longer in use.
getTrailStatusResponse_latestDeliveryAttemptSucceeded :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestDeliveryAttemptSucceeded :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestDeliveryAttemptSucceeded = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestDeliveryAttemptSucceeded :: Maybe Text
$sel:latestDeliveryAttemptSucceeded:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestDeliveryAttemptSucceeded} -> Maybe Text
latestDeliveryAttemptSucceeded) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestDeliveryAttemptSucceeded:GetTrailStatusResponse' :: Maybe Text
latestDeliveryAttemptSucceeded = Maybe Text
a} :: GetTrailStatusResponse)

-- | This field is no longer in use.
getTrailStatusResponse_latestDeliveryAttemptTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestDeliveryAttemptTime :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestDeliveryAttemptTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestDeliveryAttemptTime :: Maybe Text
$sel:latestDeliveryAttemptTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestDeliveryAttemptTime} -> Maybe Text
latestDeliveryAttemptTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestDeliveryAttemptTime:GetTrailStatusResponse' :: Maybe Text
latestDeliveryAttemptTime = Maybe Text
a} :: GetTrailStatusResponse)

-- | Displays any Amazon S3 error that CloudTrail encountered when attempting
-- to deliver log files to the designated bucket. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
-- in the Amazon S3 API Reference.
--
-- This error occurs only when there is a problem with the destination S3
-- bucket, and does not occur for requests that time out. To resolve the
-- issue, create a new bucket, and then call @UpdateTrail@ to specify the
-- new bucket; or fix the existing objects so that CloudTrail can again
-- write to the bucket.
getTrailStatusResponse_latestDeliveryError :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestDeliveryError :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestDeliveryError = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestDeliveryError :: Maybe Text
$sel:latestDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestDeliveryError} -> Maybe Text
latestDeliveryError) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestDeliveryError = Maybe Text
a} :: GetTrailStatusResponse)

-- | Specifies the date and time that CloudTrail last delivered log files to
-- an account\'s Amazon S3 bucket.
getTrailStatusResponse_latestDeliveryTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_latestDeliveryTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_latestDeliveryTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
latestDeliveryTime :: Maybe POSIX
$sel:latestDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
latestDeliveryTime} -> Maybe POSIX
latestDeliveryTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:latestDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestDeliveryTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | Displays any Amazon S3 error that CloudTrail encountered when attempting
-- to deliver a digest file to the designated bucket. For more information,
-- see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html Error Responses>
-- in the Amazon S3 API Reference.
--
-- This error occurs only when there is a problem with the destination S3
-- bucket, and does not occur for requests that time out. To resolve the
-- issue, create a new bucket, and then call @UpdateTrail@ to specify the
-- new bucket; or fix the existing objects so that CloudTrail can again
-- write to the bucket.
getTrailStatusResponse_latestDigestDeliveryError :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestDigestDeliveryError :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestDigestDeliveryError = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestDigestDeliveryError :: Maybe Text
$sel:latestDigestDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestDigestDeliveryError} -> Maybe Text
latestDigestDeliveryError) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestDigestDeliveryError:GetTrailStatusResponse' :: Maybe Text
latestDigestDeliveryError = Maybe Text
a} :: GetTrailStatusResponse)

-- | Specifies the date and time that CloudTrail last delivered a digest file
-- to an account\'s Amazon S3 bucket.
getTrailStatusResponse_latestDigestDeliveryTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_latestDigestDeliveryTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_latestDigestDeliveryTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
latestDigestDeliveryTime :: Maybe POSIX
$sel:latestDigestDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
latestDigestDeliveryTime} -> Maybe POSIX
latestDigestDeliveryTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:latestDigestDeliveryTime:GetTrailStatusResponse' :: Maybe POSIX
latestDigestDeliveryTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | This field is no longer in use.
getTrailStatusResponse_latestNotificationAttemptSucceeded :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestNotificationAttemptSucceeded :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestNotificationAttemptSucceeded = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestNotificationAttemptSucceeded :: Maybe Text
$sel:latestNotificationAttemptSucceeded:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestNotificationAttemptSucceeded} -> Maybe Text
latestNotificationAttemptSucceeded) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestNotificationAttemptSucceeded:GetTrailStatusResponse' :: Maybe Text
latestNotificationAttemptSucceeded = Maybe Text
a} :: GetTrailStatusResponse)

-- | This field is no longer in use.
getTrailStatusResponse_latestNotificationAttemptTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestNotificationAttemptTime :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestNotificationAttemptTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestNotificationAttemptTime :: Maybe Text
$sel:latestNotificationAttemptTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestNotificationAttemptTime} -> Maybe Text
latestNotificationAttemptTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestNotificationAttemptTime:GetTrailStatusResponse' :: Maybe Text
latestNotificationAttemptTime = Maybe Text
a} :: GetTrailStatusResponse)

-- | Displays any Amazon SNS error that CloudTrail encountered when
-- attempting to send a notification. For more information about Amazon SNS
-- errors, see the
-- <https://docs.aws.amazon.com/sns/latest/dg/welcome.html Amazon SNS Developer Guide>.
getTrailStatusResponse_latestNotificationError :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_latestNotificationError :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_latestNotificationError = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
latestNotificationError :: Maybe Text
$sel:latestNotificationError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
latestNotificationError} -> Maybe Text
latestNotificationError) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:latestNotificationError:GetTrailStatusResponse' :: Maybe Text
latestNotificationError = Maybe Text
a} :: GetTrailStatusResponse)

-- | Specifies the date and time of the most recent Amazon SNS notification
-- that CloudTrail has written a new log file to an account\'s Amazon S3
-- bucket.
getTrailStatusResponse_latestNotificationTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_latestNotificationTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_latestNotificationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
latestNotificationTime :: Maybe POSIX
$sel:latestNotificationTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
latestNotificationTime} -> Maybe POSIX
latestNotificationTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:latestNotificationTime:GetTrailStatusResponse' :: Maybe POSIX
latestNotificationTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | Specifies the most recent date and time when CloudTrail started
-- recording API calls for an Amazon Web Services account.
getTrailStatusResponse_startLoggingTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_startLoggingTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_startLoggingTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
startLoggingTime :: Maybe POSIX
$sel:startLoggingTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
startLoggingTime} -> Maybe POSIX
startLoggingTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:startLoggingTime:GetTrailStatusResponse' :: Maybe POSIX
startLoggingTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | Specifies the most recent date and time when CloudTrail stopped
-- recording API calls for an Amazon Web Services account.
getTrailStatusResponse_stopLoggingTime :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.UTCTime)
getTrailStatusResponse_stopLoggingTime :: Lens' GetTrailStatusResponse (Maybe UTCTime)
getTrailStatusResponse_stopLoggingTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe POSIX
stopLoggingTime :: Maybe POSIX
$sel:stopLoggingTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
stopLoggingTime} -> Maybe POSIX
stopLoggingTime) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe POSIX
a -> GetTrailStatusResponse
s {$sel:stopLoggingTime:GetTrailStatusResponse' :: Maybe POSIX
stopLoggingTime = Maybe POSIX
a} :: GetTrailStatusResponse) 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

-- | This field is no longer in use.
getTrailStatusResponse_timeLoggingStarted :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_timeLoggingStarted :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_timeLoggingStarted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
timeLoggingStarted :: Maybe Text
$sel:timeLoggingStarted:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
timeLoggingStarted} -> Maybe Text
timeLoggingStarted) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:timeLoggingStarted:GetTrailStatusResponse' :: Maybe Text
timeLoggingStarted = Maybe Text
a} :: GetTrailStatusResponse)

-- | This field is no longer in use.
getTrailStatusResponse_timeLoggingStopped :: Lens.Lens' GetTrailStatusResponse (Prelude.Maybe Prelude.Text)
getTrailStatusResponse_timeLoggingStopped :: Lens' GetTrailStatusResponse (Maybe Text)
getTrailStatusResponse_timeLoggingStopped = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailStatusResponse' {Maybe Text
timeLoggingStopped :: Maybe Text
$sel:timeLoggingStopped:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
timeLoggingStopped} -> Maybe Text
timeLoggingStopped) (\s :: GetTrailStatusResponse
s@GetTrailStatusResponse' {} Maybe Text
a -> GetTrailStatusResponse
s {$sel:timeLoggingStopped:GetTrailStatusResponse' :: Maybe Text
timeLoggingStopped = Maybe Text
a} :: GetTrailStatusResponse)

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

instance Prelude.NFData GetTrailStatusResponse where
  rnf :: GetTrailStatusResponse -> ()
rnf GetTrailStatusResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
httpStatus :: Int
timeLoggingStopped :: Maybe Text
timeLoggingStarted :: Maybe Text
stopLoggingTime :: Maybe POSIX
startLoggingTime :: Maybe POSIX
latestNotificationTime :: Maybe POSIX
latestNotificationError :: Maybe Text
latestNotificationAttemptTime :: Maybe Text
latestNotificationAttemptSucceeded :: Maybe Text
latestDigestDeliveryTime :: Maybe POSIX
latestDigestDeliveryError :: Maybe Text
latestDeliveryTime :: Maybe POSIX
latestDeliveryError :: Maybe Text
latestDeliveryAttemptTime :: Maybe Text
latestDeliveryAttemptSucceeded :: Maybe Text
latestCloudWatchLogsDeliveryTime :: Maybe POSIX
latestCloudWatchLogsDeliveryError :: Maybe Text
isLogging :: Maybe Bool
$sel:httpStatus:GetTrailStatusResponse' :: GetTrailStatusResponse -> Int
$sel:timeLoggingStopped:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:timeLoggingStarted:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:stopLoggingTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:startLoggingTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:latestNotificationTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:latestNotificationError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestNotificationAttemptTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestNotificationAttemptSucceeded:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestDigestDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:latestDigestDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:latestDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestDeliveryAttemptTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestDeliveryAttemptSucceeded:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:latestCloudWatchLogsDeliveryTime:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe POSIX
$sel:latestCloudWatchLogsDeliveryError:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Text
$sel:isLogging:GetTrailStatusResponse' :: GetTrailStatusResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isLogging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestCloudWatchLogsDeliveryError
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
latestCloudWatchLogsDeliveryTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestDeliveryAttemptSucceeded
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestDeliveryAttemptTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestDeliveryError
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
latestDeliveryTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestDigestDeliveryError
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
latestDigestDeliveryTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestNotificationAttemptSucceeded
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestNotificationAttemptTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
latestNotificationError
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
latestNotificationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startLoggingTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
stopLoggingTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeLoggingStarted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeLoggingStopped
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus