{-# 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.ElastiCache.Types.ServiceUpdate
-- 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.ElastiCache.Types.ServiceUpdate where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElastiCache.Types.ServiceUpdateSeverity
import Amazonka.ElastiCache.Types.ServiceUpdateStatus
import Amazonka.ElastiCache.Types.ServiceUpdateType
import qualified Amazonka.Prelude as Prelude

-- | An update that you can apply to your Redis clusters.
--
-- /See:/ 'newServiceUpdate' smart constructor.
data ServiceUpdate = ServiceUpdate'
  { -- | Indicates whether the service update will be automatically applied once
    -- the recommended apply-by date has expired.
    ServiceUpdate -> Maybe Bool
autoUpdateAfterRecommendedApplyByDate :: Prelude.Maybe Prelude.Bool,
    -- | The Elasticache engine to which the update applies. Either Redis or
    -- Memcached
    ServiceUpdate -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | The Elasticache engine version to which the update applies. Either Redis
    -- or Memcached engine version
    ServiceUpdate -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The estimated length of time the service update will take
    ServiceUpdate -> Maybe Text
estimatedUpdateTime :: Prelude.Maybe Prelude.Text,
    -- | Provides details of the service update
    ServiceUpdate -> Maybe Text
serviceUpdateDescription :: Prelude.Maybe Prelude.Text,
    -- | The date after which the service update is no longer available
    ServiceUpdate -> Maybe ISO8601
serviceUpdateEndDate :: Prelude.Maybe Data.ISO8601,
    -- | The unique ID of the service update
    ServiceUpdate -> Maybe Text
serviceUpdateName :: Prelude.Maybe Prelude.Text,
    -- | The recommendend date to apply the service update in order to ensure
    -- compliance. For information on compliance, see
    -- <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/elasticache-compliance.html#elasticache-compliance-self-service Self-Service Security Updates for Compliance>.
    ServiceUpdate -> Maybe ISO8601
serviceUpdateRecommendedApplyByDate :: Prelude.Maybe Data.ISO8601,
    -- | The date when the service update is initially available
    ServiceUpdate -> Maybe ISO8601
serviceUpdateReleaseDate :: Prelude.Maybe Data.ISO8601,
    -- | The severity of the service update
    ServiceUpdate -> Maybe ServiceUpdateSeverity
serviceUpdateSeverity :: Prelude.Maybe ServiceUpdateSeverity,
    -- | The status of the service update
    ServiceUpdate -> Maybe ServiceUpdateStatus
serviceUpdateStatus :: Prelude.Maybe ServiceUpdateStatus,
    -- | Reflects the nature of the service update
    ServiceUpdate -> Maybe ServiceUpdateType
serviceUpdateType :: Prelude.Maybe ServiceUpdateType
  }
  deriving (ServiceUpdate -> ServiceUpdate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServiceUpdate -> ServiceUpdate -> Bool
$c/= :: ServiceUpdate -> ServiceUpdate -> Bool
== :: ServiceUpdate -> ServiceUpdate -> Bool
$c== :: ServiceUpdate -> ServiceUpdate -> Bool
Prelude.Eq, ReadPrec [ServiceUpdate]
ReadPrec ServiceUpdate
Int -> ReadS ServiceUpdate
ReadS [ServiceUpdate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServiceUpdate]
$creadListPrec :: ReadPrec [ServiceUpdate]
readPrec :: ReadPrec ServiceUpdate
$creadPrec :: ReadPrec ServiceUpdate
readList :: ReadS [ServiceUpdate]
$creadList :: ReadS [ServiceUpdate]
readsPrec :: Int -> ReadS ServiceUpdate
$creadsPrec :: Int -> ReadS ServiceUpdate
Prelude.Read, Int -> ServiceUpdate -> ShowS
[ServiceUpdate] -> ShowS
ServiceUpdate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServiceUpdate] -> ShowS
$cshowList :: [ServiceUpdate] -> ShowS
show :: ServiceUpdate -> String
$cshow :: ServiceUpdate -> String
showsPrec :: Int -> ServiceUpdate -> ShowS
$cshowsPrec :: Int -> ServiceUpdate -> ShowS
Prelude.Show, forall x. Rep ServiceUpdate x -> ServiceUpdate
forall x. ServiceUpdate -> Rep ServiceUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ServiceUpdate x -> ServiceUpdate
$cfrom :: forall x. ServiceUpdate -> Rep ServiceUpdate x
Prelude.Generic)

-- |
-- Create a value of 'ServiceUpdate' 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:
--
-- 'autoUpdateAfterRecommendedApplyByDate', 'serviceUpdate_autoUpdateAfterRecommendedApplyByDate' - Indicates whether the service update will be automatically applied once
-- the recommended apply-by date has expired.
--
-- 'engine', 'serviceUpdate_engine' - The Elasticache engine to which the update applies. Either Redis or
-- Memcached
--
-- 'engineVersion', 'serviceUpdate_engineVersion' - The Elasticache engine version to which the update applies. Either Redis
-- or Memcached engine version
--
-- 'estimatedUpdateTime', 'serviceUpdate_estimatedUpdateTime' - The estimated length of time the service update will take
--
-- 'serviceUpdateDescription', 'serviceUpdate_serviceUpdateDescription' - Provides details of the service update
--
-- 'serviceUpdateEndDate', 'serviceUpdate_serviceUpdateEndDate' - The date after which the service update is no longer available
--
-- 'serviceUpdateName', 'serviceUpdate_serviceUpdateName' - The unique ID of the service update
--
-- 'serviceUpdateRecommendedApplyByDate', 'serviceUpdate_serviceUpdateRecommendedApplyByDate' - The recommendend date to apply the service update in order to ensure
-- compliance. For information on compliance, see
-- <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/elasticache-compliance.html#elasticache-compliance-self-service Self-Service Security Updates for Compliance>.
--
-- 'serviceUpdateReleaseDate', 'serviceUpdate_serviceUpdateReleaseDate' - The date when the service update is initially available
--
-- 'serviceUpdateSeverity', 'serviceUpdate_serviceUpdateSeverity' - The severity of the service update
--
-- 'serviceUpdateStatus', 'serviceUpdate_serviceUpdateStatus' - The status of the service update
--
-- 'serviceUpdateType', 'serviceUpdate_serviceUpdateType' - Reflects the nature of the service update
newServiceUpdate ::
  ServiceUpdate
newServiceUpdate :: ServiceUpdate
newServiceUpdate =
  ServiceUpdate'
    { $sel:autoUpdateAfterRecommendedApplyByDate:ServiceUpdate' :: Maybe Bool
autoUpdateAfterRecommendedApplyByDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:engine:ServiceUpdate' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:ServiceUpdate' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedUpdateTime:ServiceUpdate' :: Maybe Text
estimatedUpdateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateDescription:ServiceUpdate' :: Maybe Text
serviceUpdateDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateEndDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateEndDate = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateName:ServiceUpdate' :: Maybe Text
serviceUpdateName = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateRecommendedApplyByDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateRecommendedApplyByDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateReleaseDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateReleaseDate = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateSeverity:ServiceUpdate' :: Maybe ServiceUpdateSeverity
serviceUpdateSeverity = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateStatus:ServiceUpdate' :: Maybe ServiceUpdateStatus
serviceUpdateStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceUpdateType:ServiceUpdate' :: Maybe ServiceUpdateType
serviceUpdateType = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether the service update will be automatically applied once
-- the recommended apply-by date has expired.
serviceUpdate_autoUpdateAfterRecommendedApplyByDate :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Bool)
serviceUpdate_autoUpdateAfterRecommendedApplyByDate :: Lens' ServiceUpdate (Maybe Bool)
serviceUpdate_autoUpdateAfterRecommendedApplyByDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Bool
autoUpdateAfterRecommendedApplyByDate :: Maybe Bool
$sel:autoUpdateAfterRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe Bool
autoUpdateAfterRecommendedApplyByDate} -> Maybe Bool
autoUpdateAfterRecommendedApplyByDate) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Bool
a -> ServiceUpdate
s {$sel:autoUpdateAfterRecommendedApplyByDate:ServiceUpdate' :: Maybe Bool
autoUpdateAfterRecommendedApplyByDate = Maybe Bool
a} :: ServiceUpdate)

-- | The Elasticache engine to which the update applies. Either Redis or
-- Memcached
serviceUpdate_engine :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Text)
serviceUpdate_engine :: Lens' ServiceUpdate (Maybe Text)
serviceUpdate_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Text
engine :: Maybe Text
$sel:engine:ServiceUpdate' :: ServiceUpdate -> Maybe Text
engine} -> Maybe Text
engine) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Text
a -> ServiceUpdate
s {$sel:engine:ServiceUpdate' :: Maybe Text
engine = Maybe Text
a} :: ServiceUpdate)

-- | The Elasticache engine version to which the update applies. Either Redis
-- or Memcached engine version
serviceUpdate_engineVersion :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Text)
serviceUpdate_engineVersion :: Lens' ServiceUpdate (Maybe Text)
serviceUpdate_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:ServiceUpdate' :: ServiceUpdate -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Text
a -> ServiceUpdate
s {$sel:engineVersion:ServiceUpdate' :: Maybe Text
engineVersion = Maybe Text
a} :: ServiceUpdate)

-- | The estimated length of time the service update will take
serviceUpdate_estimatedUpdateTime :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Text)
serviceUpdate_estimatedUpdateTime :: Lens' ServiceUpdate (Maybe Text)
serviceUpdate_estimatedUpdateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Text
estimatedUpdateTime :: Maybe Text
$sel:estimatedUpdateTime:ServiceUpdate' :: ServiceUpdate -> Maybe Text
estimatedUpdateTime} -> Maybe Text
estimatedUpdateTime) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Text
a -> ServiceUpdate
s {$sel:estimatedUpdateTime:ServiceUpdate' :: Maybe Text
estimatedUpdateTime = Maybe Text
a} :: ServiceUpdate)

-- | Provides details of the service update
serviceUpdate_serviceUpdateDescription :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Text)
serviceUpdate_serviceUpdateDescription :: Lens' ServiceUpdate (Maybe Text)
serviceUpdate_serviceUpdateDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Text
serviceUpdateDescription :: Maybe Text
$sel:serviceUpdateDescription:ServiceUpdate' :: ServiceUpdate -> Maybe Text
serviceUpdateDescription} -> Maybe Text
serviceUpdateDescription) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Text
a -> ServiceUpdate
s {$sel:serviceUpdateDescription:ServiceUpdate' :: Maybe Text
serviceUpdateDescription = Maybe Text
a} :: ServiceUpdate)

-- | The date after which the service update is no longer available
serviceUpdate_serviceUpdateEndDate :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.UTCTime)
serviceUpdate_serviceUpdateEndDate :: Lens' ServiceUpdate (Maybe UTCTime)
serviceUpdate_serviceUpdateEndDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ISO8601
serviceUpdateEndDate :: Maybe ISO8601
$sel:serviceUpdateEndDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
serviceUpdateEndDate} -> Maybe ISO8601
serviceUpdateEndDate) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ISO8601
a -> ServiceUpdate
s {$sel:serviceUpdateEndDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateEndDate = Maybe ISO8601
a} :: ServiceUpdate) 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 unique ID of the service update
serviceUpdate_serviceUpdateName :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.Text)
serviceUpdate_serviceUpdateName :: Lens' ServiceUpdate (Maybe Text)
serviceUpdate_serviceUpdateName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe Text
serviceUpdateName :: Maybe Text
$sel:serviceUpdateName:ServiceUpdate' :: ServiceUpdate -> Maybe Text
serviceUpdateName} -> Maybe Text
serviceUpdateName) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe Text
a -> ServiceUpdate
s {$sel:serviceUpdateName:ServiceUpdate' :: Maybe Text
serviceUpdateName = Maybe Text
a} :: ServiceUpdate)

-- | The recommendend date to apply the service update in order to ensure
-- compliance. For information on compliance, see
-- <https://docs.aws.amazon.com/AmazonElastiCache/latest/red-ug/elasticache-compliance.html#elasticache-compliance-self-service Self-Service Security Updates for Compliance>.
serviceUpdate_serviceUpdateRecommendedApplyByDate :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.UTCTime)
serviceUpdate_serviceUpdateRecommendedApplyByDate :: Lens' ServiceUpdate (Maybe UTCTime)
serviceUpdate_serviceUpdateRecommendedApplyByDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ISO8601
serviceUpdateRecommendedApplyByDate :: Maybe ISO8601
$sel:serviceUpdateRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
serviceUpdateRecommendedApplyByDate} -> Maybe ISO8601
serviceUpdateRecommendedApplyByDate) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ISO8601
a -> ServiceUpdate
s {$sel:serviceUpdateRecommendedApplyByDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateRecommendedApplyByDate = Maybe ISO8601
a} :: ServiceUpdate) 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 date when the service update is initially available
serviceUpdate_serviceUpdateReleaseDate :: Lens.Lens' ServiceUpdate (Prelude.Maybe Prelude.UTCTime)
serviceUpdate_serviceUpdateReleaseDate :: Lens' ServiceUpdate (Maybe UTCTime)
serviceUpdate_serviceUpdateReleaseDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ISO8601
serviceUpdateReleaseDate :: Maybe ISO8601
$sel:serviceUpdateReleaseDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
serviceUpdateReleaseDate} -> Maybe ISO8601
serviceUpdateReleaseDate) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ISO8601
a -> ServiceUpdate
s {$sel:serviceUpdateReleaseDate:ServiceUpdate' :: Maybe ISO8601
serviceUpdateReleaseDate = Maybe ISO8601
a} :: ServiceUpdate) 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 severity of the service update
serviceUpdate_serviceUpdateSeverity :: Lens.Lens' ServiceUpdate (Prelude.Maybe ServiceUpdateSeverity)
serviceUpdate_serviceUpdateSeverity :: Lens' ServiceUpdate (Maybe ServiceUpdateSeverity)
serviceUpdate_serviceUpdateSeverity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ServiceUpdateSeverity
serviceUpdateSeverity :: Maybe ServiceUpdateSeverity
$sel:serviceUpdateSeverity:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateSeverity
serviceUpdateSeverity} -> Maybe ServiceUpdateSeverity
serviceUpdateSeverity) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ServiceUpdateSeverity
a -> ServiceUpdate
s {$sel:serviceUpdateSeverity:ServiceUpdate' :: Maybe ServiceUpdateSeverity
serviceUpdateSeverity = Maybe ServiceUpdateSeverity
a} :: ServiceUpdate)

-- | The status of the service update
serviceUpdate_serviceUpdateStatus :: Lens.Lens' ServiceUpdate (Prelude.Maybe ServiceUpdateStatus)
serviceUpdate_serviceUpdateStatus :: Lens' ServiceUpdate (Maybe ServiceUpdateStatus)
serviceUpdate_serviceUpdateStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ServiceUpdateStatus
serviceUpdateStatus :: Maybe ServiceUpdateStatus
$sel:serviceUpdateStatus:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateStatus
serviceUpdateStatus} -> Maybe ServiceUpdateStatus
serviceUpdateStatus) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ServiceUpdateStatus
a -> ServiceUpdate
s {$sel:serviceUpdateStatus:ServiceUpdate' :: Maybe ServiceUpdateStatus
serviceUpdateStatus = Maybe ServiceUpdateStatus
a} :: ServiceUpdate)

-- | Reflects the nature of the service update
serviceUpdate_serviceUpdateType :: Lens.Lens' ServiceUpdate (Prelude.Maybe ServiceUpdateType)
serviceUpdate_serviceUpdateType :: Lens' ServiceUpdate (Maybe ServiceUpdateType)
serviceUpdate_serviceUpdateType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ServiceUpdate' {Maybe ServiceUpdateType
serviceUpdateType :: Maybe ServiceUpdateType
$sel:serviceUpdateType:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateType
serviceUpdateType} -> Maybe ServiceUpdateType
serviceUpdateType) (\s :: ServiceUpdate
s@ServiceUpdate' {} Maybe ServiceUpdateType
a -> ServiceUpdate
s {$sel:serviceUpdateType:ServiceUpdate' :: Maybe ServiceUpdateType
serviceUpdateType = Maybe ServiceUpdateType
a} :: ServiceUpdate)

instance Data.FromXML ServiceUpdate where
  parseXML :: [Node] -> Either String ServiceUpdate
parseXML [Node]
x =
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe ISO8601
-> Maybe ISO8601
-> Maybe ServiceUpdateSeverity
-> Maybe ServiceUpdateStatus
-> Maybe ServiceUpdateType
-> ServiceUpdate
ServiceUpdate'
      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
"AutoUpdateAfterRecommendedApplyByDate")
      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
"Engine")
      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
"EngineVersion")
      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
"EstimatedUpdateTime")
      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
"ServiceUpdateDescription")
      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
"ServiceUpdateEndDate")
      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
"ServiceUpdateName")
      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
"ServiceUpdateRecommendedApplyByDate")
      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
"ServiceUpdateReleaseDate")
      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
"ServiceUpdateSeverity")
      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
"ServiceUpdateStatus")
      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
"ServiceUpdateType")

instance Prelude.Hashable ServiceUpdate where
  hashWithSalt :: Int -> ServiceUpdate -> Int
hashWithSalt Int
_salt ServiceUpdate' {Maybe Bool
Maybe Text
Maybe ISO8601
Maybe ServiceUpdateSeverity
Maybe ServiceUpdateStatus
Maybe ServiceUpdateType
serviceUpdateType :: Maybe ServiceUpdateType
serviceUpdateStatus :: Maybe ServiceUpdateStatus
serviceUpdateSeverity :: Maybe ServiceUpdateSeverity
serviceUpdateReleaseDate :: Maybe ISO8601
serviceUpdateRecommendedApplyByDate :: Maybe ISO8601
serviceUpdateName :: Maybe Text
serviceUpdateEndDate :: Maybe ISO8601
serviceUpdateDescription :: Maybe Text
estimatedUpdateTime :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
autoUpdateAfterRecommendedApplyByDate :: Maybe Bool
$sel:serviceUpdateType:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateType
$sel:serviceUpdateStatus:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateStatus
$sel:serviceUpdateSeverity:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateSeverity
$sel:serviceUpdateReleaseDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateName:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:serviceUpdateEndDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateDescription:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:estimatedUpdateTime:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:engineVersion:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:engine:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:autoUpdateAfterRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoUpdateAfterRecommendedApplyByDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
estimatedUpdateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceUpdateDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
serviceUpdateEndDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceUpdateName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
serviceUpdateRecommendedApplyByDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
serviceUpdateReleaseDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceUpdateSeverity
serviceUpdateSeverity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceUpdateStatus
serviceUpdateStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServiceUpdateType
serviceUpdateType

instance Prelude.NFData ServiceUpdate where
  rnf :: ServiceUpdate -> ()
rnf ServiceUpdate' {Maybe Bool
Maybe Text
Maybe ISO8601
Maybe ServiceUpdateSeverity
Maybe ServiceUpdateStatus
Maybe ServiceUpdateType
serviceUpdateType :: Maybe ServiceUpdateType
serviceUpdateStatus :: Maybe ServiceUpdateStatus
serviceUpdateSeverity :: Maybe ServiceUpdateSeverity
serviceUpdateReleaseDate :: Maybe ISO8601
serviceUpdateRecommendedApplyByDate :: Maybe ISO8601
serviceUpdateName :: Maybe Text
serviceUpdateEndDate :: Maybe ISO8601
serviceUpdateDescription :: Maybe Text
estimatedUpdateTime :: Maybe Text
engineVersion :: Maybe Text
engine :: Maybe Text
autoUpdateAfterRecommendedApplyByDate :: Maybe Bool
$sel:serviceUpdateType:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateType
$sel:serviceUpdateStatus:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateStatus
$sel:serviceUpdateSeverity:ServiceUpdate' :: ServiceUpdate -> Maybe ServiceUpdateSeverity
$sel:serviceUpdateReleaseDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateName:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:serviceUpdateEndDate:ServiceUpdate' :: ServiceUpdate -> Maybe ISO8601
$sel:serviceUpdateDescription:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:estimatedUpdateTime:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:engineVersion:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:engine:ServiceUpdate' :: ServiceUpdate -> Maybe Text
$sel:autoUpdateAfterRecommendedApplyByDate:ServiceUpdate' :: ServiceUpdate -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoUpdateAfterRecommendedApplyByDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
estimatedUpdateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceUpdateDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
serviceUpdateEndDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceUpdateName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
serviceUpdateRecommendedApplyByDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
serviceUpdateReleaseDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceUpdateSeverity
serviceUpdateSeverity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceUpdateStatus
serviceUpdateStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServiceUpdateType
serviceUpdateType