{-# 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.EC2.DescribeFleetHistory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the events for the specified EC2 Fleet during the specified
-- time.
--
-- EC2 Fleet events are delayed by up to 30 seconds before they can be
-- described. This ensures that you can query by the last evaluated time
-- and not miss a recorded event. EC2 Fleet events are available for 48
-- hours.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/fleet-monitor.html Monitor fleet events using Amazon EventBridge>
-- in the /Amazon EC2 User Guide/.
module Amazonka.EC2.DescribeFleetHistory
  ( -- * Creating a Request
    DescribeFleetHistory (..),
    newDescribeFleetHistory,

    -- * Request Lenses
    describeFleetHistory_dryRun,
    describeFleetHistory_eventType,
    describeFleetHistory_maxResults,
    describeFleetHistory_nextToken,
    describeFleetHistory_fleetId,
    describeFleetHistory_startTime,

    -- * Destructuring the Response
    DescribeFleetHistoryResponse (..),
    newDescribeFleetHistoryResponse,

    -- * Response Lenses
    describeFleetHistoryResponse_fleetId,
    describeFleetHistoryResponse_historyRecords,
    describeFleetHistoryResponse_lastEvaluatedTime,
    describeFleetHistoryResponse_nextToken,
    describeFleetHistoryResponse_startTime,
    describeFleetHistoryResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeFleetHistory' smart constructor.
data DescribeFleetHistory = DescribeFleetHistory'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DescribeFleetHistory -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The type of events to describe. By default, all events are described.
    DescribeFleetHistory -> Maybe FleetEventType
eventType :: Prelude.Maybe FleetEventType,
    -- | The maximum number of results to return in a single call. Specify a
    -- value between 1 and 1000. The default value is 1000. To retrieve the
    -- remaining results, make another call with the returned @NextToken@
    -- value.
    DescribeFleetHistory -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The token for the next set of results.
    DescribeFleetHistory -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the EC2 Fleet.
    DescribeFleetHistory -> Text
fleetId :: Prelude.Text,
    -- | The start date and time for the events, in UTC format (for example,
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
    DescribeFleetHistory -> ISO8601
startTime :: Data.ISO8601
  }
  deriving (DescribeFleetHistory -> DescribeFleetHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFleetHistory -> DescribeFleetHistory -> Bool
$c/= :: DescribeFleetHistory -> DescribeFleetHistory -> Bool
== :: DescribeFleetHistory -> DescribeFleetHistory -> Bool
$c== :: DescribeFleetHistory -> DescribeFleetHistory -> Bool
Prelude.Eq, ReadPrec [DescribeFleetHistory]
ReadPrec DescribeFleetHistory
Int -> ReadS DescribeFleetHistory
ReadS [DescribeFleetHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeFleetHistory]
$creadListPrec :: ReadPrec [DescribeFleetHistory]
readPrec :: ReadPrec DescribeFleetHistory
$creadPrec :: ReadPrec DescribeFleetHistory
readList :: ReadS [DescribeFleetHistory]
$creadList :: ReadS [DescribeFleetHistory]
readsPrec :: Int -> ReadS DescribeFleetHistory
$creadsPrec :: Int -> ReadS DescribeFleetHistory
Prelude.Read, Int -> DescribeFleetHistory -> ShowS
[DescribeFleetHistory] -> ShowS
DescribeFleetHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFleetHistory] -> ShowS
$cshowList :: [DescribeFleetHistory] -> ShowS
show :: DescribeFleetHistory -> String
$cshow :: DescribeFleetHistory -> String
showsPrec :: Int -> DescribeFleetHistory -> ShowS
$cshowsPrec :: Int -> DescribeFleetHistory -> ShowS
Prelude.Show, forall x. Rep DescribeFleetHistory x -> DescribeFleetHistory
forall x. DescribeFleetHistory -> Rep DescribeFleetHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeFleetHistory x -> DescribeFleetHistory
$cfrom :: forall x. DescribeFleetHistory -> Rep DescribeFleetHistory x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFleetHistory' 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:
--
-- 'dryRun', 'describeFleetHistory_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'eventType', 'describeFleetHistory_eventType' - The type of events to describe. By default, all events are described.
--
-- 'maxResults', 'describeFleetHistory_maxResults' - The maximum number of results to return in a single call. Specify a
-- value between 1 and 1000. The default value is 1000. To retrieve the
-- remaining results, make another call with the returned @NextToken@
-- value.
--
-- 'nextToken', 'describeFleetHistory_nextToken' - The token for the next set of results.
--
-- 'fleetId', 'describeFleetHistory_fleetId' - The ID of the EC2 Fleet.
--
-- 'startTime', 'describeFleetHistory_startTime' - The start date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
newDescribeFleetHistory ::
  -- | 'fleetId'
  Prelude.Text ->
  -- | 'startTime'
  Prelude.UTCTime ->
  DescribeFleetHistory
newDescribeFleetHistory :: Text -> UTCTime -> DescribeFleetHistory
newDescribeFleetHistory Text
pFleetId_ UTCTime
pStartTime_ =
  DescribeFleetHistory'
    { $sel:dryRun:DescribeFleetHistory' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:eventType:DescribeFleetHistory' :: Maybe FleetEventType
eventType = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeFleetHistory' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeFleetHistory' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:DescribeFleetHistory' :: Text
fleetId = Text
pFleetId_,
      $sel:startTime:DescribeFleetHistory' :: ISO8601
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
describeFleetHistory_dryRun :: Lens.Lens' DescribeFleetHistory (Prelude.Maybe Prelude.Bool)
describeFleetHistory_dryRun :: Lens' DescribeFleetHistory (Maybe Bool)
describeFleetHistory_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} Maybe Bool
a -> DescribeFleetHistory
s {$sel:dryRun:DescribeFleetHistory' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeFleetHistory)

-- | The type of events to describe. By default, all events are described.
describeFleetHistory_eventType :: Lens.Lens' DescribeFleetHistory (Prelude.Maybe FleetEventType)
describeFleetHistory_eventType :: Lens' DescribeFleetHistory (Maybe FleetEventType)
describeFleetHistory_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {Maybe FleetEventType
eventType :: Maybe FleetEventType
$sel:eventType:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe FleetEventType
eventType} -> Maybe FleetEventType
eventType) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} Maybe FleetEventType
a -> DescribeFleetHistory
s {$sel:eventType:DescribeFleetHistory' :: Maybe FleetEventType
eventType = Maybe FleetEventType
a} :: DescribeFleetHistory)

-- | The maximum number of results to return in a single call. Specify a
-- value between 1 and 1000. The default value is 1000. To retrieve the
-- remaining results, make another call with the returned @NextToken@
-- value.
describeFleetHistory_maxResults :: Lens.Lens' DescribeFleetHistory (Prelude.Maybe Prelude.Int)
describeFleetHistory_maxResults :: Lens' DescribeFleetHistory (Maybe Int)
describeFleetHistory_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} Maybe Int
a -> DescribeFleetHistory
s {$sel:maxResults:DescribeFleetHistory' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeFleetHistory)

-- | The token for the next set of results.
describeFleetHistory_nextToken :: Lens.Lens' DescribeFleetHistory (Prelude.Maybe Prelude.Text)
describeFleetHistory_nextToken :: Lens' DescribeFleetHistory (Maybe Text)
describeFleetHistory_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} Maybe Text
a -> DescribeFleetHistory
s {$sel:nextToken:DescribeFleetHistory' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeFleetHistory)

-- | The ID of the EC2 Fleet.
describeFleetHistory_fleetId :: Lens.Lens' DescribeFleetHistory Prelude.Text
describeFleetHistory_fleetId :: Lens' DescribeFleetHistory Text
describeFleetHistory_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {Text
fleetId :: Text
$sel:fleetId:DescribeFleetHistory' :: DescribeFleetHistory -> Text
fleetId} -> Text
fleetId) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} Text
a -> DescribeFleetHistory
s {$sel:fleetId:DescribeFleetHistory' :: Text
fleetId = Text
a} :: DescribeFleetHistory)

-- | The start date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
describeFleetHistory_startTime :: Lens.Lens' DescribeFleetHistory Prelude.UTCTime
describeFleetHistory_startTime :: Lens' DescribeFleetHistory UTCTime
describeFleetHistory_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistory' {ISO8601
startTime :: ISO8601
$sel:startTime:DescribeFleetHistory' :: DescribeFleetHistory -> ISO8601
startTime} -> ISO8601
startTime) (\s :: DescribeFleetHistory
s@DescribeFleetHistory' {} ISO8601
a -> DescribeFleetHistory
s {$sel:startTime:DescribeFleetHistory' :: ISO8601
startTime = ISO8601
a} :: DescribeFleetHistory) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSRequest DescribeFleetHistory where
  type
    AWSResponse DescribeFleetHistory =
      DescribeFleetHistoryResponse
  request :: (Service -> Service)
-> DescribeFleetHistory -> Request DescribeFleetHistory
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 DescribeFleetHistory
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeFleetHistory)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [HistoryRecordEntry]
-> Maybe ISO8601
-> Maybe Text
-> Maybe ISO8601
-> Int
-> DescribeFleetHistoryResponse
DescribeFleetHistoryResponse'
            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
"fleetId")
            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
"historyRecordSet"
                            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 (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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
"lastEvaluatedTime")
            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
"nextToken")
            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
"startTime")
            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 DescribeFleetHistory where
  hashWithSalt :: Int -> DescribeFleetHistory -> Int
hashWithSalt Int
_salt DescribeFleetHistory' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetEventType
Text
ISO8601
startTime :: ISO8601
fleetId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
eventType :: Maybe FleetEventType
dryRun :: Maybe Bool
$sel:startTime:DescribeFleetHistory' :: DescribeFleetHistory -> ISO8601
$sel:fleetId:DescribeFleetHistory' :: DescribeFleetHistory -> Text
$sel:nextToken:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Text
$sel:maxResults:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Int
$sel:eventType:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe FleetEventType
$sel:dryRun:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FleetEventType
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
startTime

instance Prelude.NFData DescribeFleetHistory where
  rnf :: DescribeFleetHistory -> ()
rnf DescribeFleetHistory' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetEventType
Text
ISO8601
startTime :: ISO8601
fleetId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
eventType :: Maybe FleetEventType
dryRun :: Maybe Bool
$sel:startTime:DescribeFleetHistory' :: DescribeFleetHistory -> ISO8601
$sel:fleetId:DescribeFleetHistory' :: DescribeFleetHistory -> Text
$sel:nextToken:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Text
$sel:maxResults:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Int
$sel:eventType:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe FleetEventType
$sel:dryRun:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FleetEventType
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
startTime

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

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

instance Data.ToQuery DescribeFleetHistory where
  toQuery :: DescribeFleetHistory -> QueryString
toQuery DescribeFleetHistory' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetEventType
Text
ISO8601
startTime :: ISO8601
fleetId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
eventType :: Maybe FleetEventType
dryRun :: Maybe Bool
$sel:startTime:DescribeFleetHistory' :: DescribeFleetHistory -> ISO8601
$sel:fleetId:DescribeFleetHistory' :: DescribeFleetHistory -> Text
$sel:nextToken:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Text
$sel:maxResults:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Int
$sel:eventType:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe FleetEventType
$sel:dryRun:DescribeFleetHistory' :: DescribeFleetHistory -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeFleetHistory" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"EventType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FleetEventType
eventType,
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"FleetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
fleetId,
        ByteString
"StartTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ISO8601
startTime
      ]

-- | /See:/ 'newDescribeFleetHistoryResponse' smart constructor.
data DescribeFleetHistoryResponse = DescribeFleetHistoryResponse'
  { -- | The ID of the EC Fleet.
    DescribeFleetHistoryResponse -> Maybe Text
fleetId :: Prelude.Maybe Prelude.Text,
    -- | Information about the events in the history of the EC2 Fleet.
    DescribeFleetHistoryResponse -> Maybe [HistoryRecordEntry]
historyRecords :: Prelude.Maybe [HistoryRecordEntry],
    -- | The last date and time for the events, in UTC format (for example,
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). All records up to this time were
    -- retrieved.
    --
    -- If @nextToken@ indicates that there are more results, this value is not
    -- present.
    DescribeFleetHistoryResponse -> Maybe ISO8601
lastEvaluatedTime :: Prelude.Maybe Data.ISO8601,
    -- | The token for the next set of results.
    DescribeFleetHistoryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The start date and time for the events, in UTC format (for example,
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
    DescribeFleetHistoryResponse -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    DescribeFleetHistoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeFleetHistoryResponse
-> DescribeFleetHistoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeFleetHistoryResponse
-> DescribeFleetHistoryResponse -> Bool
$c/= :: DescribeFleetHistoryResponse
-> DescribeFleetHistoryResponse -> Bool
== :: DescribeFleetHistoryResponse
-> DescribeFleetHistoryResponse -> Bool
$c== :: DescribeFleetHistoryResponse
-> DescribeFleetHistoryResponse -> Bool
Prelude.Eq, ReadPrec [DescribeFleetHistoryResponse]
ReadPrec DescribeFleetHistoryResponse
Int -> ReadS DescribeFleetHistoryResponse
ReadS [DescribeFleetHistoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeFleetHistoryResponse]
$creadListPrec :: ReadPrec [DescribeFleetHistoryResponse]
readPrec :: ReadPrec DescribeFleetHistoryResponse
$creadPrec :: ReadPrec DescribeFleetHistoryResponse
readList :: ReadS [DescribeFleetHistoryResponse]
$creadList :: ReadS [DescribeFleetHistoryResponse]
readsPrec :: Int -> ReadS DescribeFleetHistoryResponse
$creadsPrec :: Int -> ReadS DescribeFleetHistoryResponse
Prelude.Read, Int -> DescribeFleetHistoryResponse -> ShowS
[DescribeFleetHistoryResponse] -> ShowS
DescribeFleetHistoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeFleetHistoryResponse] -> ShowS
$cshowList :: [DescribeFleetHistoryResponse] -> ShowS
show :: DescribeFleetHistoryResponse -> String
$cshow :: DescribeFleetHistoryResponse -> String
showsPrec :: Int -> DescribeFleetHistoryResponse -> ShowS
$cshowsPrec :: Int -> DescribeFleetHistoryResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeFleetHistoryResponse x -> DescribeFleetHistoryResponse
forall x.
DescribeFleetHistoryResponse -> Rep DescribeFleetHistoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeFleetHistoryResponse x -> DescribeFleetHistoryResponse
$cfrom :: forall x.
DescribeFleetHistoryResponse -> Rep DescribeFleetHistoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeFleetHistoryResponse' 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:
--
-- 'fleetId', 'describeFleetHistoryResponse_fleetId' - The ID of the EC Fleet.
--
-- 'historyRecords', 'describeFleetHistoryResponse_historyRecords' - Information about the events in the history of the EC2 Fleet.
--
-- 'lastEvaluatedTime', 'describeFleetHistoryResponse_lastEvaluatedTime' - The last date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). All records up to this time were
-- retrieved.
--
-- If @nextToken@ indicates that there are more results, this value is not
-- present.
--
-- 'nextToken', 'describeFleetHistoryResponse_nextToken' - The token for the next set of results.
--
-- 'startTime', 'describeFleetHistoryResponse_startTime' - The start date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
--
-- 'httpStatus', 'describeFleetHistoryResponse_httpStatus' - The response's http status code.
newDescribeFleetHistoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeFleetHistoryResponse
newDescribeFleetHistoryResponse :: Int -> DescribeFleetHistoryResponse
newDescribeFleetHistoryResponse Int
pHttpStatus_ =
  DescribeFleetHistoryResponse'
    { $sel:fleetId:DescribeFleetHistoryResponse' :: Maybe Text
fleetId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:historyRecords:DescribeFleetHistoryResponse' :: Maybe [HistoryRecordEntry]
historyRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:lastEvaluatedTime:DescribeFleetHistoryResponse' :: Maybe ISO8601
lastEvaluatedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeFleetHistoryResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:DescribeFleetHistoryResponse' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeFleetHistoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the EC Fleet.
describeFleetHistoryResponse_fleetId :: Lens.Lens' DescribeFleetHistoryResponse (Prelude.Maybe Prelude.Text)
describeFleetHistoryResponse_fleetId :: Lens' DescribeFleetHistoryResponse (Maybe Text)
describeFleetHistoryResponse_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistoryResponse' {Maybe Text
fleetId :: Maybe Text
$sel:fleetId:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe Text
fleetId} -> Maybe Text
fleetId) (\s :: DescribeFleetHistoryResponse
s@DescribeFleetHistoryResponse' {} Maybe Text
a -> DescribeFleetHistoryResponse
s {$sel:fleetId:DescribeFleetHistoryResponse' :: Maybe Text
fleetId = Maybe Text
a} :: DescribeFleetHistoryResponse)

-- | Information about the events in the history of the EC2 Fleet.
describeFleetHistoryResponse_historyRecords :: Lens.Lens' DescribeFleetHistoryResponse (Prelude.Maybe [HistoryRecordEntry])
describeFleetHistoryResponse_historyRecords :: Lens' DescribeFleetHistoryResponse (Maybe [HistoryRecordEntry])
describeFleetHistoryResponse_historyRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistoryResponse' {Maybe [HistoryRecordEntry]
historyRecords :: Maybe [HistoryRecordEntry]
$sel:historyRecords:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe [HistoryRecordEntry]
historyRecords} -> Maybe [HistoryRecordEntry]
historyRecords) (\s :: DescribeFleetHistoryResponse
s@DescribeFleetHistoryResponse' {} Maybe [HistoryRecordEntry]
a -> DescribeFleetHistoryResponse
s {$sel:historyRecords:DescribeFleetHistoryResponse' :: Maybe [HistoryRecordEntry]
historyRecords = Maybe [HistoryRecordEntry]
a} :: DescribeFleetHistoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The last date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). All records up to this time were
-- retrieved.
--
-- If @nextToken@ indicates that there are more results, this value is not
-- present.
describeFleetHistoryResponse_lastEvaluatedTime :: Lens.Lens' DescribeFleetHistoryResponse (Prelude.Maybe Prelude.UTCTime)
describeFleetHistoryResponse_lastEvaluatedTime :: Lens' DescribeFleetHistoryResponse (Maybe UTCTime)
describeFleetHistoryResponse_lastEvaluatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistoryResponse' {Maybe ISO8601
lastEvaluatedTime :: Maybe ISO8601
$sel:lastEvaluatedTime:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe ISO8601
lastEvaluatedTime} -> Maybe ISO8601
lastEvaluatedTime) (\s :: DescribeFleetHistoryResponse
s@DescribeFleetHistoryResponse' {} Maybe ISO8601
a -> DescribeFleetHistoryResponse
s {$sel:lastEvaluatedTime:DescribeFleetHistoryResponse' :: Maybe ISO8601
lastEvaluatedTime = Maybe ISO8601
a} :: DescribeFleetHistoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The token for the next set of results.
describeFleetHistoryResponse_nextToken :: Lens.Lens' DescribeFleetHistoryResponse (Prelude.Maybe Prelude.Text)
describeFleetHistoryResponse_nextToken :: Lens' DescribeFleetHistoryResponse (Maybe Text)
describeFleetHistoryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistoryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeFleetHistoryResponse
s@DescribeFleetHistoryResponse' {} Maybe Text
a -> DescribeFleetHistoryResponse
s {$sel:nextToken:DescribeFleetHistoryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeFleetHistoryResponse)

-- | The start date and time for the events, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
describeFleetHistoryResponse_startTime :: Lens.Lens' DescribeFleetHistoryResponse (Prelude.Maybe Prelude.UTCTime)
describeFleetHistoryResponse_startTime :: Lens' DescribeFleetHistoryResponse (Maybe UTCTime)
describeFleetHistoryResponse_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeFleetHistoryResponse' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: DescribeFleetHistoryResponse
s@DescribeFleetHistoryResponse' {} Maybe ISO8601
a -> DescribeFleetHistoryResponse
s {$sel:startTime:DescribeFleetHistoryResponse' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: DescribeFleetHistoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData DescribeFleetHistoryResponse where
  rnf :: DescribeFleetHistoryResponse -> ()
rnf DescribeFleetHistoryResponse' {Int
Maybe [HistoryRecordEntry]
Maybe Text
Maybe ISO8601
httpStatus :: Int
startTime :: Maybe ISO8601
nextToken :: Maybe Text
lastEvaluatedTime :: Maybe ISO8601
historyRecords :: Maybe [HistoryRecordEntry]
fleetId :: Maybe Text
$sel:httpStatus:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Int
$sel:startTime:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe ISO8601
$sel:nextToken:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe Text
$sel:lastEvaluatedTime:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe ISO8601
$sel:historyRecords:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe [HistoryRecordEntry]
$sel:fleetId:DescribeFleetHistoryResponse' :: DescribeFleetHistoryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
fleetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [HistoryRecordEntry]
historyRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
lastEvaluatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus