{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.HistoryRecord
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.EC2.Types.HistoryRecord where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.EventInformation
import Amazonka.EC2.Types.EventType
import qualified Amazonka.Prelude as Prelude

-- | Describes an event in the history of the Spot Fleet request.
--
-- /See:/ 'newHistoryRecord' smart constructor.
data HistoryRecord = HistoryRecord'
  { -- | Information about the event.
    HistoryRecord -> Maybe EventInformation
eventInformation :: Prelude.Maybe EventInformation,
    -- | The event type.
    --
    -- -   @error@ - An error with the Spot Fleet request.
    --
    -- -   @fleetRequestChange@ - A change in the status or configuration of
    --     the Spot Fleet request.
    --
    -- -   @instanceChange@ - An instance was launched or terminated.
    --
    -- -   @Information@ - An informational event.
    HistoryRecord -> Maybe EventType
eventType :: Prelude.Maybe EventType,
    -- | The date and time of the event, in UTC format (for example,
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
    HistoryRecord -> Maybe ISO8601
timestamp :: Prelude.Maybe Data.ISO8601
  }
  deriving (HistoryRecord -> HistoryRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HistoryRecord -> HistoryRecord -> Bool
$c/= :: HistoryRecord -> HistoryRecord -> Bool
== :: HistoryRecord -> HistoryRecord -> Bool
$c== :: HistoryRecord -> HistoryRecord -> Bool
Prelude.Eq, ReadPrec [HistoryRecord]
ReadPrec HistoryRecord
Int -> ReadS HistoryRecord
ReadS [HistoryRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HistoryRecord]
$creadListPrec :: ReadPrec [HistoryRecord]
readPrec :: ReadPrec HistoryRecord
$creadPrec :: ReadPrec HistoryRecord
readList :: ReadS [HistoryRecord]
$creadList :: ReadS [HistoryRecord]
readsPrec :: Int -> ReadS HistoryRecord
$creadsPrec :: Int -> ReadS HistoryRecord
Prelude.Read, Int -> HistoryRecord -> ShowS
[HistoryRecord] -> ShowS
HistoryRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HistoryRecord] -> ShowS
$cshowList :: [HistoryRecord] -> ShowS
show :: HistoryRecord -> String
$cshow :: HistoryRecord -> String
showsPrec :: Int -> HistoryRecord -> ShowS
$cshowsPrec :: Int -> HistoryRecord -> ShowS
Prelude.Show, forall x. Rep HistoryRecord x -> HistoryRecord
forall x. HistoryRecord -> Rep HistoryRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HistoryRecord x -> HistoryRecord
$cfrom :: forall x. HistoryRecord -> Rep HistoryRecord x
Prelude.Generic)

-- |
-- Create a value of 'HistoryRecord' 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:
--
-- 'eventInformation', 'historyRecord_eventInformation' - Information about the event.
--
-- 'eventType', 'historyRecord_eventType' - The event type.
--
-- -   @error@ - An error with the Spot Fleet request.
--
-- -   @fleetRequestChange@ - A change in the status or configuration of
--     the Spot Fleet request.
--
-- -   @instanceChange@ - An instance was launched or terminated.
--
-- -   @Information@ - An informational event.
--
-- 'timestamp', 'historyRecord_timestamp' - The date and time of the event, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
newHistoryRecord ::
  HistoryRecord
newHistoryRecord :: HistoryRecord
newHistoryRecord =
  HistoryRecord'
    { $sel:eventInformation:HistoryRecord' :: Maybe EventInformation
eventInformation = forall a. Maybe a
Prelude.Nothing,
      $sel:eventType:HistoryRecord' :: Maybe EventType
eventType = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:HistoryRecord' :: Maybe ISO8601
timestamp = forall a. Maybe a
Prelude.Nothing
    }

-- | Information about the event.
historyRecord_eventInformation :: Lens.Lens' HistoryRecord (Prelude.Maybe EventInformation)
historyRecord_eventInformation :: Lens' HistoryRecord (Maybe EventInformation)
historyRecord_eventInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HistoryRecord' {Maybe EventInformation
eventInformation :: Maybe EventInformation
$sel:eventInformation:HistoryRecord' :: HistoryRecord -> Maybe EventInformation
eventInformation} -> Maybe EventInformation
eventInformation) (\s :: HistoryRecord
s@HistoryRecord' {} Maybe EventInformation
a -> HistoryRecord
s {$sel:eventInformation:HistoryRecord' :: Maybe EventInformation
eventInformation = Maybe EventInformation
a} :: HistoryRecord)

-- | The event type.
--
-- -   @error@ - An error with the Spot Fleet request.
--
-- -   @fleetRequestChange@ - A change in the status or configuration of
--     the Spot Fleet request.
--
-- -   @instanceChange@ - An instance was launched or terminated.
--
-- -   @Information@ - An informational event.
historyRecord_eventType :: Lens.Lens' HistoryRecord (Prelude.Maybe EventType)
historyRecord_eventType :: Lens' HistoryRecord (Maybe EventType)
historyRecord_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HistoryRecord' {Maybe EventType
eventType :: Maybe EventType
$sel:eventType:HistoryRecord' :: HistoryRecord -> Maybe EventType
eventType} -> Maybe EventType
eventType) (\s :: HistoryRecord
s@HistoryRecord' {} Maybe EventType
a -> HistoryRecord
s {$sel:eventType:HistoryRecord' :: Maybe EventType
eventType = Maybe EventType
a} :: HistoryRecord)

-- | The date and time of the event, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
historyRecord_timestamp :: Lens.Lens' HistoryRecord (Prelude.Maybe Prelude.UTCTime)
historyRecord_timestamp :: Lens' HistoryRecord (Maybe UTCTime)
historyRecord_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\HistoryRecord' {Maybe ISO8601
timestamp :: Maybe ISO8601
$sel:timestamp:HistoryRecord' :: HistoryRecord -> Maybe ISO8601
timestamp} -> Maybe ISO8601
timestamp) (\s :: HistoryRecord
s@HistoryRecord' {} Maybe ISO8601
a -> HistoryRecord
s {$sel:timestamp:HistoryRecord' :: Maybe ISO8601
timestamp = Maybe ISO8601
a} :: HistoryRecord) 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

instance Data.FromXML HistoryRecord where
  parseXML :: [Node] -> Either String HistoryRecord
parseXML [Node]
x =
    Maybe EventInformation
-> Maybe EventType -> Maybe ISO8601 -> HistoryRecord
HistoryRecord'
      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
"eventInformation")
      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
"eventType")
      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
"timestamp")

instance Prelude.Hashable HistoryRecord where
  hashWithSalt :: Int -> HistoryRecord -> Int
hashWithSalt Int
_salt HistoryRecord' {Maybe ISO8601
Maybe EventInformation
Maybe EventType
timestamp :: Maybe ISO8601
eventType :: Maybe EventType
eventInformation :: Maybe EventInformation
$sel:timestamp:HistoryRecord' :: HistoryRecord -> Maybe ISO8601
$sel:eventType:HistoryRecord' :: HistoryRecord -> Maybe EventType
$sel:eventInformation:HistoryRecord' :: HistoryRecord -> Maybe EventInformation
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventInformation
eventInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EventType
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
timestamp

instance Prelude.NFData HistoryRecord where
  rnf :: HistoryRecord -> ()
rnf HistoryRecord' {Maybe ISO8601
Maybe EventInformation
Maybe EventType
timestamp :: Maybe ISO8601
eventType :: Maybe EventType
eventInformation :: Maybe EventInformation
$sel:timestamp:HistoryRecord' :: HistoryRecord -> Maybe ISO8601
$sel:eventType:HistoryRecord' :: HistoryRecord -> Maybe EventType
$sel:eventInformation:HistoryRecord' :: HistoryRecord -> Maybe EventInformation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe EventInformation
eventInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EventType
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
timestamp