{-# 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.Budgets.Types.ActionHistory
-- 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.Budgets.Types.ActionHistory where

import Amazonka.Budgets.Types.ActionHistoryDetails
import Amazonka.Budgets.Types.ActionStatus
import Amazonka.Budgets.Types.EventType
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

-- | The historical records for a budget action.
--
-- /See:/ 'newActionHistory' smart constructor.
data ActionHistory = ActionHistory'
  { ActionHistory -> POSIX
timestamp :: Data.POSIX,
    -- | The status of action at the time of the event.
    ActionHistory -> ActionStatus
status :: ActionStatus,
    -- | This distinguishes between whether the events are triggered by the user
    -- or are generated by the system.
    ActionHistory -> EventType
eventType :: EventType,
    -- | The description of the details for the event.
    ActionHistory -> ActionHistoryDetails
actionHistoryDetails :: ActionHistoryDetails
  }
  deriving (ActionHistory -> ActionHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActionHistory -> ActionHistory -> Bool
$c/= :: ActionHistory -> ActionHistory -> Bool
== :: ActionHistory -> ActionHistory -> Bool
$c== :: ActionHistory -> ActionHistory -> Bool
Prelude.Eq, Int -> ActionHistory -> ShowS
[ActionHistory] -> ShowS
ActionHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActionHistory] -> ShowS
$cshowList :: [ActionHistory] -> ShowS
show :: ActionHistory -> String
$cshow :: ActionHistory -> String
showsPrec :: Int -> ActionHistory -> ShowS
$cshowsPrec :: Int -> ActionHistory -> ShowS
Prelude.Show, forall x. Rep ActionHistory x -> ActionHistory
forall x. ActionHistory -> Rep ActionHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ActionHistory x -> ActionHistory
$cfrom :: forall x. ActionHistory -> Rep ActionHistory x
Prelude.Generic)

-- |
-- Create a value of 'ActionHistory' 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:
--
-- 'timestamp', 'actionHistory_timestamp' - Undocumented member.
--
-- 'status', 'actionHistory_status' - The status of action at the time of the event.
--
-- 'eventType', 'actionHistory_eventType' - This distinguishes between whether the events are triggered by the user
-- or are generated by the system.
--
-- 'actionHistoryDetails', 'actionHistory_actionHistoryDetails' - The description of the details for the event.
newActionHistory ::
  -- | 'timestamp'
  Prelude.UTCTime ->
  -- | 'status'
  ActionStatus ->
  -- | 'eventType'
  EventType ->
  -- | 'actionHistoryDetails'
  ActionHistoryDetails ->
  ActionHistory
newActionHistory :: UTCTime
-> ActionStatus
-> EventType
-> ActionHistoryDetails
-> ActionHistory
newActionHistory
  UTCTime
pTimestamp_
  ActionStatus
pStatus_
  EventType
pEventType_
  ActionHistoryDetails
pActionHistoryDetails_ =
    ActionHistory'
      { $sel:timestamp:ActionHistory' :: POSIX
timestamp =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pTimestamp_,
        $sel:status:ActionHistory' :: ActionStatus
status = ActionStatus
pStatus_,
        $sel:eventType:ActionHistory' :: EventType
eventType = EventType
pEventType_,
        $sel:actionHistoryDetails:ActionHistory' :: ActionHistoryDetails
actionHistoryDetails = ActionHistoryDetails
pActionHistoryDetails_
      }

-- | Undocumented member.
actionHistory_timestamp :: Lens.Lens' ActionHistory Prelude.UTCTime
actionHistory_timestamp :: Lens' ActionHistory UTCTime
actionHistory_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionHistory' {POSIX
timestamp :: POSIX
$sel:timestamp:ActionHistory' :: ActionHistory -> POSIX
timestamp} -> POSIX
timestamp) (\s :: ActionHistory
s@ActionHistory' {} POSIX
a -> ActionHistory
s {$sel:timestamp:ActionHistory' :: POSIX
timestamp = POSIX
a} :: ActionHistory) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status of action at the time of the event.
actionHistory_status :: Lens.Lens' ActionHistory ActionStatus
actionHistory_status :: Lens' ActionHistory ActionStatus
actionHistory_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionHistory' {ActionStatus
status :: ActionStatus
$sel:status:ActionHistory' :: ActionHistory -> ActionStatus
status} -> ActionStatus
status) (\s :: ActionHistory
s@ActionHistory' {} ActionStatus
a -> ActionHistory
s {$sel:status:ActionHistory' :: ActionStatus
status = ActionStatus
a} :: ActionHistory)

-- | This distinguishes between whether the events are triggered by the user
-- or are generated by the system.
actionHistory_eventType :: Lens.Lens' ActionHistory EventType
actionHistory_eventType :: Lens' ActionHistory EventType
actionHistory_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionHistory' {EventType
eventType :: EventType
$sel:eventType:ActionHistory' :: ActionHistory -> EventType
eventType} -> EventType
eventType) (\s :: ActionHistory
s@ActionHistory' {} EventType
a -> ActionHistory
s {$sel:eventType:ActionHistory' :: EventType
eventType = EventType
a} :: ActionHistory)

-- | The description of the details for the event.
actionHistory_actionHistoryDetails :: Lens.Lens' ActionHistory ActionHistoryDetails
actionHistory_actionHistoryDetails :: Lens' ActionHistory ActionHistoryDetails
actionHistory_actionHistoryDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ActionHistory' {ActionHistoryDetails
actionHistoryDetails :: ActionHistoryDetails
$sel:actionHistoryDetails:ActionHistory' :: ActionHistory -> ActionHistoryDetails
actionHistoryDetails} -> ActionHistoryDetails
actionHistoryDetails) (\s :: ActionHistory
s@ActionHistory' {} ActionHistoryDetails
a -> ActionHistory
s {$sel:actionHistoryDetails:ActionHistory' :: ActionHistoryDetails
actionHistoryDetails = ActionHistoryDetails
a} :: ActionHistory)

instance Data.FromJSON ActionHistory where
  parseJSON :: Value -> Parser ActionHistory
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ActionHistory"
      ( \Object
x ->
          POSIX
-> ActionStatus
-> EventType
-> ActionHistoryDetails
-> ActionHistory
ActionHistory'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Timestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"EventType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ActionHistoryDetails")
      )

instance Prelude.Hashable ActionHistory where
  hashWithSalt :: Int -> ActionHistory -> Int
hashWithSalt Int
_salt ActionHistory' {POSIX
ActionStatus
EventType
ActionHistoryDetails
actionHistoryDetails :: ActionHistoryDetails
eventType :: EventType
status :: ActionStatus
timestamp :: POSIX
$sel:actionHistoryDetails:ActionHistory' :: ActionHistory -> ActionHistoryDetails
$sel:eventType:ActionHistory' :: ActionHistory -> EventType
$sel:status:ActionHistory' :: ActionHistory -> ActionStatus
$sel:timestamp:ActionHistory' :: ActionHistory -> POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
timestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EventType
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionHistoryDetails
actionHistoryDetails

instance Prelude.NFData ActionHistory where
  rnf :: ActionHistory -> ()
rnf ActionHistory' {POSIX
ActionStatus
EventType
ActionHistoryDetails
actionHistoryDetails :: ActionHistoryDetails
eventType :: EventType
status :: ActionStatus
timestamp :: POSIX
$sel:actionHistoryDetails:ActionHistory' :: ActionHistory -> ActionHistoryDetails
$sel:eventType:ActionHistory' :: ActionHistory -> EventType
$sel:status:ActionHistory' :: ActionHistory -> ActionStatus
$sel:timestamp:ActionHistory' :: ActionHistory -> POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf POSIX
timestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EventType
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionHistoryDetails
actionHistoryDetails