{-# 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.Shield.Types.Subscription
-- 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.Shield.Types.Subscription 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.Shield.Types.AutoRenew
import Amazonka.Shield.Types.Limit
import Amazonka.Shield.Types.ProactiveEngagementStatus
import Amazonka.Shield.Types.SubscriptionLimits

-- | Information about the Shield Advanced subscription for an account.
--
-- /See:/ 'newSubscription' smart constructor.
data Subscription = Subscription'
  { -- | If @ENABLED@, the subscription will be automatically renewed at the end
    -- of the existing subscription period.
    --
    -- When you initally create a subscription, @AutoRenew@ is set to
    -- @ENABLED@. You can change this by submitting an @UpdateSubscription@
    -- request. If the @UpdateSubscription@ request does not included a value
    -- for @AutoRenew@, the existing value for @AutoRenew@ remains unchanged.
    Subscription -> Maybe AutoRenew
autoRenew :: Prelude.Maybe AutoRenew,
    -- | The date and time your subscription will end.
    Subscription -> Maybe POSIX
endTime :: Prelude.Maybe Data.POSIX,
    -- | Specifies how many protections of a given type you can create.
    Subscription -> Maybe [Limit]
limits :: Prelude.Maybe [Limit],
    -- | If @ENABLED@, the Shield Response Team (SRT) will use email and phone to
    -- notify contacts about escalations to the SRT and to initiate proactive
    -- customer support.
    --
    -- If @PENDING@, you have requested proactive engagement and the request is
    -- pending. The status changes to @ENABLED@ when your request is fully
    -- processed.
    --
    -- If @DISABLED@, the SRT will not proactively notify contacts about
    -- escalations or to initiate proactive customer support.
    Subscription -> Maybe ProactiveEngagementStatus
proactiveEngagementStatus :: Prelude.Maybe ProactiveEngagementStatus,
    -- | The start time of the subscription, in Unix time in seconds.
    Subscription -> Maybe POSIX
startTime :: Prelude.Maybe Data.POSIX,
    -- | The ARN (Amazon Resource Name) of the subscription.
    Subscription -> Maybe Text
subscriptionArn :: Prelude.Maybe Prelude.Text,
    -- | The length, in seconds, of the Shield Advanced subscription for the
    -- account.
    Subscription -> Maybe Natural
timeCommitmentInSeconds :: Prelude.Maybe Prelude.Natural,
    -- | Limits settings for your subscription.
    Subscription -> SubscriptionLimits
subscriptionLimits :: SubscriptionLimits
  }
  deriving (Subscription -> Subscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Subscription -> Subscription -> Bool
$c/= :: Subscription -> Subscription -> Bool
== :: Subscription -> Subscription -> Bool
$c== :: Subscription -> Subscription -> Bool
Prelude.Eq, ReadPrec [Subscription]
ReadPrec Subscription
Int -> ReadS Subscription
ReadS [Subscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Subscription]
$creadListPrec :: ReadPrec [Subscription]
readPrec :: ReadPrec Subscription
$creadPrec :: ReadPrec Subscription
readList :: ReadS [Subscription]
$creadList :: ReadS [Subscription]
readsPrec :: Int -> ReadS Subscription
$creadsPrec :: Int -> ReadS Subscription
Prelude.Read, Int -> Subscription -> ShowS
[Subscription] -> ShowS
Subscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Subscription] -> ShowS
$cshowList :: [Subscription] -> ShowS
show :: Subscription -> String
$cshow :: Subscription -> String
showsPrec :: Int -> Subscription -> ShowS
$cshowsPrec :: Int -> Subscription -> ShowS
Prelude.Show, forall x. Rep Subscription x -> Subscription
forall x. Subscription -> Rep Subscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Subscription x -> Subscription
$cfrom :: forall x. Subscription -> Rep Subscription x
Prelude.Generic)

-- |
-- Create a value of 'Subscription' 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:
--
-- 'autoRenew', 'subscription_autoRenew' - If @ENABLED@, the subscription will be automatically renewed at the end
-- of the existing subscription period.
--
-- When you initally create a subscription, @AutoRenew@ is set to
-- @ENABLED@. You can change this by submitting an @UpdateSubscription@
-- request. If the @UpdateSubscription@ request does not included a value
-- for @AutoRenew@, the existing value for @AutoRenew@ remains unchanged.
--
-- 'endTime', 'subscription_endTime' - The date and time your subscription will end.
--
-- 'limits', 'subscription_limits' - Specifies how many protections of a given type you can create.
--
-- 'proactiveEngagementStatus', 'subscription_proactiveEngagementStatus' - If @ENABLED@, the Shield Response Team (SRT) will use email and phone to
-- notify contacts about escalations to the SRT and to initiate proactive
-- customer support.
--
-- If @PENDING@, you have requested proactive engagement and the request is
-- pending. The status changes to @ENABLED@ when your request is fully
-- processed.
--
-- If @DISABLED@, the SRT will not proactively notify contacts about
-- escalations or to initiate proactive customer support.
--
-- 'startTime', 'subscription_startTime' - The start time of the subscription, in Unix time in seconds.
--
-- 'subscriptionArn', 'subscription_subscriptionArn' - The ARN (Amazon Resource Name) of the subscription.
--
-- 'timeCommitmentInSeconds', 'subscription_timeCommitmentInSeconds' - The length, in seconds, of the Shield Advanced subscription for the
-- account.
--
-- 'subscriptionLimits', 'subscription_subscriptionLimits' - Limits settings for your subscription.
newSubscription ::
  -- | 'subscriptionLimits'
  SubscriptionLimits ->
  Subscription
newSubscription :: SubscriptionLimits -> Subscription
newSubscription SubscriptionLimits
pSubscriptionLimits_ =
  Subscription'
    { $sel:autoRenew:Subscription' :: Maybe AutoRenew
autoRenew = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:Subscription' :: Maybe POSIX
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:limits:Subscription' :: Maybe [Limit]
limits = forall a. Maybe a
Prelude.Nothing,
      $sel:proactiveEngagementStatus:Subscription' :: Maybe ProactiveEngagementStatus
proactiveEngagementStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:Subscription' :: Maybe POSIX
startTime = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptionArn:Subscription' :: Maybe Text
subscriptionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:timeCommitmentInSeconds:Subscription' :: Maybe Natural
timeCommitmentInSeconds = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptionLimits:Subscription' :: SubscriptionLimits
subscriptionLimits = SubscriptionLimits
pSubscriptionLimits_
    }

-- | If @ENABLED@, the subscription will be automatically renewed at the end
-- of the existing subscription period.
--
-- When you initally create a subscription, @AutoRenew@ is set to
-- @ENABLED@. You can change this by submitting an @UpdateSubscription@
-- request. If the @UpdateSubscription@ request does not included a value
-- for @AutoRenew@, the existing value for @AutoRenew@ remains unchanged.
subscription_autoRenew :: Lens.Lens' Subscription (Prelude.Maybe AutoRenew)
subscription_autoRenew :: Lens' Subscription (Maybe AutoRenew)
subscription_autoRenew = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe AutoRenew
autoRenew :: Maybe AutoRenew
$sel:autoRenew:Subscription' :: Subscription -> Maybe AutoRenew
autoRenew} -> Maybe AutoRenew
autoRenew) (\s :: Subscription
s@Subscription' {} Maybe AutoRenew
a -> Subscription
s {$sel:autoRenew:Subscription' :: Maybe AutoRenew
autoRenew = Maybe AutoRenew
a} :: Subscription)

-- | The date and time your subscription will end.
subscription_endTime :: Lens.Lens' Subscription (Prelude.Maybe Prelude.UTCTime)
subscription_endTime :: Lens' Subscription (Maybe UTCTime)
subscription_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe POSIX
endTime :: Maybe POSIX
$sel:endTime:Subscription' :: Subscription -> Maybe POSIX
endTime} -> Maybe POSIX
endTime) (\s :: Subscription
s@Subscription' {} Maybe POSIX
a -> Subscription
s {$sel:endTime:Subscription' :: Maybe POSIX
endTime = Maybe POSIX
a} :: Subscription) 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

-- | Specifies how many protections of a given type you can create.
subscription_limits :: Lens.Lens' Subscription (Prelude.Maybe [Limit])
subscription_limits :: Lens' Subscription (Maybe [Limit])
subscription_limits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe [Limit]
limits :: Maybe [Limit]
$sel:limits:Subscription' :: Subscription -> Maybe [Limit]
limits} -> Maybe [Limit]
limits) (\s :: Subscription
s@Subscription' {} Maybe [Limit]
a -> Subscription
s {$sel:limits:Subscription' :: Maybe [Limit]
limits = Maybe [Limit]
a} :: Subscription) 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

-- | If @ENABLED@, the Shield Response Team (SRT) will use email and phone to
-- notify contacts about escalations to the SRT and to initiate proactive
-- customer support.
--
-- If @PENDING@, you have requested proactive engagement and the request is
-- pending. The status changes to @ENABLED@ when your request is fully
-- processed.
--
-- If @DISABLED@, the SRT will not proactively notify contacts about
-- escalations or to initiate proactive customer support.
subscription_proactiveEngagementStatus :: Lens.Lens' Subscription (Prelude.Maybe ProactiveEngagementStatus)
subscription_proactiveEngagementStatus :: Lens' Subscription (Maybe ProactiveEngagementStatus)
subscription_proactiveEngagementStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe ProactiveEngagementStatus
proactiveEngagementStatus :: Maybe ProactiveEngagementStatus
$sel:proactiveEngagementStatus:Subscription' :: Subscription -> Maybe ProactiveEngagementStatus
proactiveEngagementStatus} -> Maybe ProactiveEngagementStatus
proactiveEngagementStatus) (\s :: Subscription
s@Subscription' {} Maybe ProactiveEngagementStatus
a -> Subscription
s {$sel:proactiveEngagementStatus:Subscription' :: Maybe ProactiveEngagementStatus
proactiveEngagementStatus = Maybe ProactiveEngagementStatus
a} :: Subscription)

-- | The start time of the subscription, in Unix time in seconds.
subscription_startTime :: Lens.Lens' Subscription (Prelude.Maybe Prelude.UTCTime)
subscription_startTime :: Lens' Subscription (Maybe UTCTime)
subscription_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe POSIX
startTime :: Maybe POSIX
$sel:startTime:Subscription' :: Subscription -> Maybe POSIX
startTime} -> Maybe POSIX
startTime) (\s :: Subscription
s@Subscription' {} Maybe POSIX
a -> Subscription
s {$sel:startTime:Subscription' :: Maybe POSIX
startTime = Maybe POSIX
a} :: Subscription) 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 ARN (Amazon Resource Name) of the subscription.
subscription_subscriptionArn :: Lens.Lens' Subscription (Prelude.Maybe Prelude.Text)
subscription_subscriptionArn :: Lens' Subscription (Maybe Text)
subscription_subscriptionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe Text
subscriptionArn :: Maybe Text
$sel:subscriptionArn:Subscription' :: Subscription -> Maybe Text
subscriptionArn} -> Maybe Text
subscriptionArn) (\s :: Subscription
s@Subscription' {} Maybe Text
a -> Subscription
s {$sel:subscriptionArn:Subscription' :: Maybe Text
subscriptionArn = Maybe Text
a} :: Subscription)

-- | The length, in seconds, of the Shield Advanced subscription for the
-- account.
subscription_timeCommitmentInSeconds :: Lens.Lens' Subscription (Prelude.Maybe Prelude.Natural)
subscription_timeCommitmentInSeconds :: Lens' Subscription (Maybe Natural)
subscription_timeCommitmentInSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {Maybe Natural
timeCommitmentInSeconds :: Maybe Natural
$sel:timeCommitmentInSeconds:Subscription' :: Subscription -> Maybe Natural
timeCommitmentInSeconds} -> Maybe Natural
timeCommitmentInSeconds) (\s :: Subscription
s@Subscription' {} Maybe Natural
a -> Subscription
s {$sel:timeCommitmentInSeconds:Subscription' :: Maybe Natural
timeCommitmentInSeconds = Maybe Natural
a} :: Subscription)

-- | Limits settings for your subscription.
subscription_subscriptionLimits :: Lens.Lens' Subscription SubscriptionLimits
subscription_subscriptionLimits :: Lens' Subscription SubscriptionLimits
subscription_subscriptionLimits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Subscription' {SubscriptionLimits
subscriptionLimits :: SubscriptionLimits
$sel:subscriptionLimits:Subscription' :: Subscription -> SubscriptionLimits
subscriptionLimits} -> SubscriptionLimits
subscriptionLimits) (\s :: Subscription
s@Subscription' {} SubscriptionLimits
a -> Subscription
s {$sel:subscriptionLimits:Subscription' :: SubscriptionLimits
subscriptionLimits = SubscriptionLimits
a} :: Subscription)

instance Data.FromJSON Subscription where
  parseJSON :: Value -> Parser Subscription
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Subscription"
      ( \Object
x ->
          Maybe AutoRenew
-> Maybe POSIX
-> Maybe [Limit]
-> Maybe ProactiveEngagementStatus
-> Maybe POSIX
-> Maybe Text
-> Maybe Natural
-> SubscriptionLimits
-> Subscription
Subscription'
            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
"AutoRenew")
            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
"EndTime")
            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
"Limits" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            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
"ProactiveEngagementStatus")
            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
"StartTime")
            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
"SubscriptionArn")
            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
"TimeCommitmentInSeconds")
            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
"SubscriptionLimits")
      )

instance Prelude.Hashable Subscription where
  hashWithSalt :: Int -> Subscription -> Int
hashWithSalt Int
_salt Subscription' {Maybe Natural
Maybe [Limit]
Maybe Text
Maybe POSIX
Maybe AutoRenew
Maybe ProactiveEngagementStatus
SubscriptionLimits
subscriptionLimits :: SubscriptionLimits
timeCommitmentInSeconds :: Maybe Natural
subscriptionArn :: Maybe Text
startTime :: Maybe POSIX
proactiveEngagementStatus :: Maybe ProactiveEngagementStatus
limits :: Maybe [Limit]
endTime :: Maybe POSIX
autoRenew :: Maybe AutoRenew
$sel:subscriptionLimits:Subscription' :: Subscription -> SubscriptionLimits
$sel:timeCommitmentInSeconds:Subscription' :: Subscription -> Maybe Natural
$sel:subscriptionArn:Subscription' :: Subscription -> Maybe Text
$sel:startTime:Subscription' :: Subscription -> Maybe POSIX
$sel:proactiveEngagementStatus:Subscription' :: Subscription -> Maybe ProactiveEngagementStatus
$sel:limits:Subscription' :: Subscription -> Maybe [Limit]
$sel:endTime:Subscription' :: Subscription -> Maybe POSIX
$sel:autoRenew:Subscription' :: Subscription -> Maybe AutoRenew
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoRenew
autoRenew
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Limit]
limits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProactiveEngagementStatus
proactiveEngagementStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subscriptionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
timeCommitmentInSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` SubscriptionLimits
subscriptionLimits

instance Prelude.NFData Subscription where
  rnf :: Subscription -> ()
rnf Subscription' {Maybe Natural
Maybe [Limit]
Maybe Text
Maybe POSIX
Maybe AutoRenew
Maybe ProactiveEngagementStatus
SubscriptionLimits
subscriptionLimits :: SubscriptionLimits
timeCommitmentInSeconds :: Maybe Natural
subscriptionArn :: Maybe Text
startTime :: Maybe POSIX
proactiveEngagementStatus :: Maybe ProactiveEngagementStatus
limits :: Maybe [Limit]
endTime :: Maybe POSIX
autoRenew :: Maybe AutoRenew
$sel:subscriptionLimits:Subscription' :: Subscription -> SubscriptionLimits
$sel:timeCommitmentInSeconds:Subscription' :: Subscription -> Maybe Natural
$sel:subscriptionArn:Subscription' :: Subscription -> Maybe Text
$sel:startTime:Subscription' :: Subscription -> Maybe POSIX
$sel:proactiveEngagementStatus:Subscription' :: Subscription -> Maybe ProactiveEngagementStatus
$sel:limits:Subscription' :: Subscription -> Maybe [Limit]
$sel:endTime:Subscription' :: Subscription -> Maybe POSIX
$sel:autoRenew:Subscription' :: Subscription -> Maybe AutoRenew
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoRenew
autoRenew
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Limit]
limits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProactiveEngagementStatus
proactiveEngagementStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subscriptionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
timeCommitmentInSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SubscriptionLimits
subscriptionLimits