{-# 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.SESV2.Types.Recommendation
-- 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.SESV2.Types.Recommendation where

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 Amazonka.SESV2.Types.RecommendationImpact
import Amazonka.SESV2.Types.RecommendationStatus
import Amazonka.SESV2.Types.RecommendationType

-- | A recommendation generated for your account.
--
-- /See:/ 'newRecommendation' smart constructor.
data Recommendation = Recommendation'
  { -- | The first time this issue was encountered and the recommendation was
    -- generated.
    Recommendation -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The recommendation description \/ disambiguator - e.g. @DKIM1@ and
    -- @DKIM2@ are different recommendations about your DKIM setup.
    Recommendation -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The recommendation impact, with values like @HIGH@ or @LOW@.
    Recommendation -> Maybe RecommendationImpact
impact :: Prelude.Maybe RecommendationImpact,
    -- | The last time the recommendation was updated.
    Recommendation -> Maybe POSIX
lastUpdatedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The resource affected by the recommendation, with values like
    -- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
    Recommendation -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The recommendation status, with values like @OPEN@ or @FIXED@.
    Recommendation -> Maybe RecommendationStatus
status :: Prelude.Maybe RecommendationStatus,
    -- | The recommendation type, with values like @DKIM@, @SPF@ or @DMARC@.
    Recommendation -> Maybe RecommendationType
type' :: Prelude.Maybe RecommendationType
  }
  deriving (Recommendation -> Recommendation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Recommendation -> Recommendation -> Bool
$c/= :: Recommendation -> Recommendation -> Bool
== :: Recommendation -> Recommendation -> Bool
$c== :: Recommendation -> Recommendation -> Bool
Prelude.Eq, ReadPrec [Recommendation]
ReadPrec Recommendation
Int -> ReadS Recommendation
ReadS [Recommendation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Recommendation]
$creadListPrec :: ReadPrec [Recommendation]
readPrec :: ReadPrec Recommendation
$creadPrec :: ReadPrec Recommendation
readList :: ReadS [Recommendation]
$creadList :: ReadS [Recommendation]
readsPrec :: Int -> ReadS Recommendation
$creadsPrec :: Int -> ReadS Recommendation
Prelude.Read, Int -> Recommendation -> ShowS
[Recommendation] -> ShowS
Recommendation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Recommendation] -> ShowS
$cshowList :: [Recommendation] -> ShowS
show :: Recommendation -> String
$cshow :: Recommendation -> String
showsPrec :: Int -> Recommendation -> ShowS
$cshowsPrec :: Int -> Recommendation -> ShowS
Prelude.Show, forall x. Rep Recommendation x -> Recommendation
forall x. Recommendation -> Rep Recommendation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Recommendation x -> Recommendation
$cfrom :: forall x. Recommendation -> Rep Recommendation x
Prelude.Generic)

-- |
-- Create a value of 'Recommendation' 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:
--
-- 'createdTimestamp', 'recommendation_createdTimestamp' - The first time this issue was encountered and the recommendation was
-- generated.
--
-- 'description', 'recommendation_description' - The recommendation description \/ disambiguator - e.g. @DKIM1@ and
-- @DKIM2@ are different recommendations about your DKIM setup.
--
-- 'impact', 'recommendation_impact' - The recommendation impact, with values like @HIGH@ or @LOW@.
--
-- 'lastUpdatedTimestamp', 'recommendation_lastUpdatedTimestamp' - The last time the recommendation was updated.
--
-- 'resourceArn', 'recommendation_resourceArn' - The resource affected by the recommendation, with values like
-- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
--
-- 'status', 'recommendation_status' - The recommendation status, with values like @OPEN@ or @FIXED@.
--
-- 'type'', 'recommendation_type' - The recommendation type, with values like @DKIM@, @SPF@ or @DMARC@.
newRecommendation ::
  Recommendation
newRecommendation :: Recommendation
newRecommendation =
  Recommendation'
    { $sel:createdTimestamp:Recommendation' :: Maybe POSIX
createdTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Recommendation' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:impact:Recommendation' :: Maybe RecommendationImpact
impact = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTimestamp:Recommendation' :: Maybe POSIX
lastUpdatedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:Recommendation' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Recommendation' :: Maybe RecommendationStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Recommendation' :: Maybe RecommendationType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The first time this issue was encountered and the recommendation was
-- generated.
recommendation_createdTimestamp :: Lens.Lens' Recommendation (Prelude.Maybe Prelude.UTCTime)
recommendation_createdTimestamp :: Lens' Recommendation (Maybe UTCTime)
recommendation_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: Recommendation
s@Recommendation' {} Maybe POSIX
a -> Recommendation
s {$sel:createdTimestamp:Recommendation' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: Recommendation) 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 recommendation description \/ disambiguator - e.g. @DKIM1@ and
-- @DKIM2@ are different recommendations about your DKIM setup.
recommendation_description :: Lens.Lens' Recommendation (Prelude.Maybe Prelude.Text)
recommendation_description :: Lens' Recommendation (Maybe Text)
recommendation_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe Text
description :: Maybe Text
$sel:description:Recommendation' :: Recommendation -> Maybe Text
description} -> Maybe Text
description) (\s :: Recommendation
s@Recommendation' {} Maybe Text
a -> Recommendation
s {$sel:description:Recommendation' :: Maybe Text
description = Maybe Text
a} :: Recommendation)

-- | The recommendation impact, with values like @HIGH@ or @LOW@.
recommendation_impact :: Lens.Lens' Recommendation (Prelude.Maybe RecommendationImpact)
recommendation_impact :: Lens' Recommendation (Maybe RecommendationImpact)
recommendation_impact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe RecommendationImpact
impact :: Maybe RecommendationImpact
$sel:impact:Recommendation' :: Recommendation -> Maybe RecommendationImpact
impact} -> Maybe RecommendationImpact
impact) (\s :: Recommendation
s@Recommendation' {} Maybe RecommendationImpact
a -> Recommendation
s {$sel:impact:Recommendation' :: Maybe RecommendationImpact
impact = Maybe RecommendationImpact
a} :: Recommendation)

-- | The last time the recommendation was updated.
recommendation_lastUpdatedTimestamp :: Lens.Lens' Recommendation (Prelude.Maybe Prelude.UTCTime)
recommendation_lastUpdatedTimestamp :: Lens' Recommendation (Maybe UTCTime)
recommendation_lastUpdatedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe POSIX
lastUpdatedTimestamp :: Maybe POSIX
$sel:lastUpdatedTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
lastUpdatedTimestamp} -> Maybe POSIX
lastUpdatedTimestamp) (\s :: Recommendation
s@Recommendation' {} Maybe POSIX
a -> Recommendation
s {$sel:lastUpdatedTimestamp:Recommendation' :: Maybe POSIX
lastUpdatedTimestamp = Maybe POSIX
a} :: Recommendation) 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 resource affected by the recommendation, with values like
-- @arn:aws:ses:us-east-1:123456789012:identity\/example.com@.
recommendation_resourceArn :: Lens.Lens' Recommendation (Prelude.Maybe Prelude.Text)
recommendation_resourceArn :: Lens' Recommendation (Maybe Text)
recommendation_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe Text
resourceArn :: Maybe Text
$sel:resourceArn:Recommendation' :: Recommendation -> Maybe Text
resourceArn} -> Maybe Text
resourceArn) (\s :: Recommendation
s@Recommendation' {} Maybe Text
a -> Recommendation
s {$sel:resourceArn:Recommendation' :: Maybe Text
resourceArn = Maybe Text
a} :: Recommendation)

-- | The recommendation status, with values like @OPEN@ or @FIXED@.
recommendation_status :: Lens.Lens' Recommendation (Prelude.Maybe RecommendationStatus)
recommendation_status :: Lens' Recommendation (Maybe RecommendationStatus)
recommendation_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe RecommendationStatus
status :: Maybe RecommendationStatus
$sel:status:Recommendation' :: Recommendation -> Maybe RecommendationStatus
status} -> Maybe RecommendationStatus
status) (\s :: Recommendation
s@Recommendation' {} Maybe RecommendationStatus
a -> Recommendation
s {$sel:status:Recommendation' :: Maybe RecommendationStatus
status = Maybe RecommendationStatus
a} :: Recommendation)

-- | The recommendation type, with values like @DKIM@, @SPF@ or @DMARC@.
recommendation_type :: Lens.Lens' Recommendation (Prelude.Maybe RecommendationType)
recommendation_type :: Lens' Recommendation (Maybe RecommendationType)
recommendation_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Recommendation' {Maybe RecommendationType
type' :: Maybe RecommendationType
$sel:type':Recommendation' :: Recommendation -> Maybe RecommendationType
type'} -> Maybe RecommendationType
type') (\s :: Recommendation
s@Recommendation' {} Maybe RecommendationType
a -> Recommendation
s {$sel:type':Recommendation' :: Maybe RecommendationType
type' = Maybe RecommendationType
a} :: Recommendation)

instance Data.FromJSON Recommendation where
  parseJSON :: Value -> Parser Recommendation
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Recommendation"
      ( \Object
x ->
          Maybe POSIX
-> Maybe Text
-> Maybe RecommendationImpact
-> Maybe POSIX
-> Maybe Text
-> Maybe RecommendationStatus
-> Maybe RecommendationType
-> Recommendation
Recommendation'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreatedTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Impact")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"LastUpdatedTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 (Maybe a)
Data..:? Key
"Type")
      )

instance Prelude.Hashable Recommendation where
  hashWithSalt :: Int -> Recommendation -> Int
hashWithSalt Int
_salt Recommendation' {Maybe Text
Maybe POSIX
Maybe RecommendationImpact
Maybe RecommendationStatus
Maybe RecommendationType
type' :: Maybe RecommendationType
status :: Maybe RecommendationStatus
resourceArn :: Maybe Text
lastUpdatedTimestamp :: Maybe POSIX
impact :: Maybe RecommendationImpact
description :: Maybe Text
createdTimestamp :: Maybe POSIX
$sel:type':Recommendation' :: Recommendation -> Maybe RecommendationType
$sel:status:Recommendation' :: Recommendation -> Maybe RecommendationStatus
$sel:resourceArn:Recommendation' :: Recommendation -> Maybe Text
$sel:lastUpdatedTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
$sel:impact:Recommendation' :: Recommendation -> Maybe RecommendationImpact
$sel:description:Recommendation' :: Recommendation -> Maybe Text
$sel:createdTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecommendationImpact
impact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecommendationStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecommendationType
type'

instance Prelude.NFData Recommendation where
  rnf :: Recommendation -> ()
rnf Recommendation' {Maybe Text
Maybe POSIX
Maybe RecommendationImpact
Maybe RecommendationStatus
Maybe RecommendationType
type' :: Maybe RecommendationType
status :: Maybe RecommendationStatus
resourceArn :: Maybe Text
lastUpdatedTimestamp :: Maybe POSIX
impact :: Maybe RecommendationImpact
description :: Maybe Text
createdTimestamp :: Maybe POSIX
$sel:type':Recommendation' :: Recommendation -> Maybe RecommendationType
$sel:status:Recommendation' :: Recommendation -> Maybe RecommendationStatus
$sel:resourceArn:Recommendation' :: Recommendation -> Maybe Text
$sel:lastUpdatedTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
$sel:impact:Recommendation' :: Recommendation -> Maybe RecommendationImpact
$sel:description:Recommendation' :: Recommendation -> Maybe Text
$sel:createdTimestamp:Recommendation' :: Recommendation -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecommendationImpact
impact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecommendationStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecommendationType
type'