{-# 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.GlobalAccelerator.Types.Accelerator
-- 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.GlobalAccelerator.Types.Accelerator where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GlobalAccelerator.Types.AcceleratorEvent
import Amazonka.GlobalAccelerator.Types.AcceleratorStatus
import Amazonka.GlobalAccelerator.Types.IpAddressType
import Amazonka.GlobalAccelerator.Types.IpSet
import qualified Amazonka.Prelude as Prelude

-- | An accelerator is a complex type that includes one or more listeners
-- that process inbound connections and then direct traffic to one or more
-- endpoint groups, each of which includes endpoints, such as load
-- balancers.
--
-- /See:/ 'newAccelerator' smart constructor.
data Accelerator = Accelerator'
  { -- | The Amazon Resource Name (ARN) of the accelerator.
    Accelerator -> Maybe Text
acceleratorArn :: Prelude.Maybe Prelude.Text,
    -- | The date and time that the accelerator was created.
    Accelerator -> Maybe POSIX
createdTime :: Prelude.Maybe Data.POSIX,
    -- | The Domain Name System (DNS) name that Global Accelerator creates that
    -- points to an accelerator\'s static IPv4 addresses.
    --
    -- The naming convention for the DNS name for an accelerator is the
    -- following: A lowercase letter a, followed by a 16-bit random hex string,
    -- followed by .awsglobalaccelerator.com. For example:
    -- a1234567890abcdef.awsglobalaccelerator.com.
    --
    -- If you have a dual-stack accelerator, you also have a second DNS name,
    -- @DualStackDnsName@, that points to both the A record and the AAAA record
    -- for all four static addresses for the accelerator: two IPv4 addresses
    -- and two IPv6 addresses.
    --
    -- For more information about the default DNS name, see
    -- <https://docs.aws.amazon.com/global-accelerator/latest/dg/dns-addressing-custom-domains.dns-addressing.html Support for DNS addressing in Global Accelerator>
    -- in the /Global Accelerator Developer Guide/.
    Accelerator -> Maybe Text
dnsName :: Prelude.Maybe Prelude.Text,
    -- | The Domain Name System (DNS) name that Global Accelerator creates that
    -- points to a dual-stack accelerator\'s four static IP addresses: two IPv4
    -- addresses and two IPv6 addresses.
    --
    -- The naming convention for the dual-stack DNS name is the following: A
    -- lowercase letter a, followed by a 16-bit random hex string, followed by
    -- .dualstack.awsglobalaccelerator.com. For example:
    -- a1234567890abcdef.dualstack.awsglobalaccelerator.com.
    --
    -- Note: Global Accelerator also assigns a default DNS name, @DnsName@, to
    -- your accelerator that points just to the static IPv4 addresses.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/global-accelerator/latest/dg/about-accelerators.html#about-accelerators.dns-addressing Support for DNS addressing in Global Accelerator>
    -- in the /Global Accelerator Developer Guide/.
    Accelerator -> Maybe Text
dualStackDnsName :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the accelerator is enabled. The value is true or
    -- false. The default value is true.
    --
    -- If the value is set to true, the accelerator cannot be deleted. If set
    -- to false, accelerator can be deleted.
    Accelerator -> Maybe Bool
enabled :: Prelude.Maybe Prelude.Bool,
    -- | A history of changes that you make to an accelerator in Global
    -- Accelerator.
    Accelerator -> Maybe [AcceleratorEvent]
events :: Prelude.Maybe [AcceleratorEvent],
    -- | The IP address type that an accelerator supports. For a standard
    -- accelerator, the value can be IPV4 or DUAL_STACK.
    Accelerator -> Maybe IpAddressType
ipAddressType :: Prelude.Maybe IpAddressType,
    -- | The static IP addresses that Global Accelerator associates with the
    -- accelerator.
    Accelerator -> Maybe [IpSet]
ipSets :: Prelude.Maybe [IpSet],
    -- | The date and time that the accelerator was last modified.
    Accelerator -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the accelerator. The name must contain only alphanumeric
    -- characters or hyphens (-), and must not begin or end with a hyphen.
    Accelerator -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Describes the deployment status of the accelerator.
    Accelerator -> Maybe AcceleratorStatus
status :: Prelude.Maybe AcceleratorStatus
  }
  deriving (Accelerator -> Accelerator -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Accelerator -> Accelerator -> Bool
$c/= :: Accelerator -> Accelerator -> Bool
== :: Accelerator -> Accelerator -> Bool
$c== :: Accelerator -> Accelerator -> Bool
Prelude.Eq, ReadPrec [Accelerator]
ReadPrec Accelerator
Int -> ReadS Accelerator
ReadS [Accelerator]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Accelerator]
$creadListPrec :: ReadPrec [Accelerator]
readPrec :: ReadPrec Accelerator
$creadPrec :: ReadPrec Accelerator
readList :: ReadS [Accelerator]
$creadList :: ReadS [Accelerator]
readsPrec :: Int -> ReadS Accelerator
$creadsPrec :: Int -> ReadS Accelerator
Prelude.Read, Int -> Accelerator -> ShowS
[Accelerator] -> ShowS
Accelerator -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Accelerator] -> ShowS
$cshowList :: [Accelerator] -> ShowS
show :: Accelerator -> String
$cshow :: Accelerator -> String
showsPrec :: Int -> Accelerator -> ShowS
$cshowsPrec :: Int -> Accelerator -> ShowS
Prelude.Show, forall x. Rep Accelerator x -> Accelerator
forall x. Accelerator -> Rep Accelerator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Accelerator x -> Accelerator
$cfrom :: forall x. Accelerator -> Rep Accelerator x
Prelude.Generic)

-- |
-- Create a value of 'Accelerator' 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:
--
-- 'acceleratorArn', 'accelerator_acceleratorArn' - The Amazon Resource Name (ARN) of the accelerator.
--
-- 'createdTime', 'accelerator_createdTime' - The date and time that the accelerator was created.
--
-- 'dnsName', 'accelerator_dnsName' - The Domain Name System (DNS) name that Global Accelerator creates that
-- points to an accelerator\'s static IPv4 addresses.
--
-- The naming convention for the DNS name for an accelerator is the
-- following: A lowercase letter a, followed by a 16-bit random hex string,
-- followed by .awsglobalaccelerator.com. For example:
-- a1234567890abcdef.awsglobalaccelerator.com.
--
-- If you have a dual-stack accelerator, you also have a second DNS name,
-- @DualStackDnsName@, that points to both the A record and the AAAA record
-- for all four static addresses for the accelerator: two IPv4 addresses
-- and two IPv6 addresses.
--
-- For more information about the default DNS name, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/dns-addressing-custom-domains.dns-addressing.html Support for DNS addressing in Global Accelerator>
-- in the /Global Accelerator Developer Guide/.
--
-- 'dualStackDnsName', 'accelerator_dualStackDnsName' - The Domain Name System (DNS) name that Global Accelerator creates that
-- points to a dual-stack accelerator\'s four static IP addresses: two IPv4
-- addresses and two IPv6 addresses.
--
-- The naming convention for the dual-stack DNS name is the following: A
-- lowercase letter a, followed by a 16-bit random hex string, followed by
-- .dualstack.awsglobalaccelerator.com. For example:
-- a1234567890abcdef.dualstack.awsglobalaccelerator.com.
--
-- Note: Global Accelerator also assigns a default DNS name, @DnsName@, to
-- your accelerator that points just to the static IPv4 addresses.
--
-- For more information, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/about-accelerators.html#about-accelerators.dns-addressing Support for DNS addressing in Global Accelerator>
-- in the /Global Accelerator Developer Guide/.
--
-- 'enabled', 'accelerator_enabled' - Indicates whether the accelerator is enabled. The value is true or
-- false. The default value is true.
--
-- If the value is set to true, the accelerator cannot be deleted. If set
-- to false, accelerator can be deleted.
--
-- 'events', 'accelerator_events' - A history of changes that you make to an accelerator in Global
-- Accelerator.
--
-- 'ipAddressType', 'accelerator_ipAddressType' - The IP address type that an accelerator supports. For a standard
-- accelerator, the value can be IPV4 or DUAL_STACK.
--
-- 'ipSets', 'accelerator_ipSets' - The static IP addresses that Global Accelerator associates with the
-- accelerator.
--
-- 'lastModifiedTime', 'accelerator_lastModifiedTime' - The date and time that the accelerator was last modified.
--
-- 'name', 'accelerator_name' - The name of the accelerator. The name must contain only alphanumeric
-- characters or hyphens (-), and must not begin or end with a hyphen.
--
-- 'status', 'accelerator_status' - Describes the deployment status of the accelerator.
newAccelerator ::
  Accelerator
newAccelerator :: Accelerator
newAccelerator =
  Accelerator'
    { $sel:acceleratorArn:Accelerator' :: Maybe Text
acceleratorArn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:Accelerator' :: Maybe POSIX
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:dnsName:Accelerator' :: Maybe Text
dnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:dualStackDnsName:Accelerator' :: Maybe Text
dualStackDnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:enabled:Accelerator' :: Maybe Bool
enabled = forall a. Maybe a
Prelude.Nothing,
      $sel:events:Accelerator' :: Maybe [AcceleratorEvent]
events = forall a. Maybe a
Prelude.Nothing,
      $sel:ipAddressType:Accelerator' :: Maybe IpAddressType
ipAddressType = forall a. Maybe a
Prelude.Nothing,
      $sel:ipSets:Accelerator' :: Maybe [IpSet]
ipSets = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:Accelerator' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Accelerator' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Accelerator' :: Maybe AcceleratorStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the accelerator.
accelerator_acceleratorArn :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.Text)
accelerator_acceleratorArn :: Lens' Accelerator (Maybe Text)
accelerator_acceleratorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe Text
acceleratorArn :: Maybe Text
$sel:acceleratorArn:Accelerator' :: Accelerator -> Maybe Text
acceleratorArn} -> Maybe Text
acceleratorArn) (\s :: Accelerator
s@Accelerator' {} Maybe Text
a -> Accelerator
s {$sel:acceleratorArn:Accelerator' :: Maybe Text
acceleratorArn = Maybe Text
a} :: Accelerator)

-- | The date and time that the accelerator was created.
accelerator_createdTime :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.UTCTime)
accelerator_createdTime :: Lens' Accelerator (Maybe UTCTime)
accelerator_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe POSIX
createdTime :: Maybe POSIX
$sel:createdTime:Accelerator' :: Accelerator -> Maybe POSIX
createdTime} -> Maybe POSIX
createdTime) (\s :: Accelerator
s@Accelerator' {} Maybe POSIX
a -> Accelerator
s {$sel:createdTime:Accelerator' :: Maybe POSIX
createdTime = Maybe POSIX
a} :: Accelerator) 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 Domain Name System (DNS) name that Global Accelerator creates that
-- points to an accelerator\'s static IPv4 addresses.
--
-- The naming convention for the DNS name for an accelerator is the
-- following: A lowercase letter a, followed by a 16-bit random hex string,
-- followed by .awsglobalaccelerator.com. For example:
-- a1234567890abcdef.awsglobalaccelerator.com.
--
-- If you have a dual-stack accelerator, you also have a second DNS name,
-- @DualStackDnsName@, that points to both the A record and the AAAA record
-- for all four static addresses for the accelerator: two IPv4 addresses
-- and two IPv6 addresses.
--
-- For more information about the default DNS name, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/dns-addressing-custom-domains.dns-addressing.html Support for DNS addressing in Global Accelerator>
-- in the /Global Accelerator Developer Guide/.
accelerator_dnsName :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.Text)
accelerator_dnsName :: Lens' Accelerator (Maybe Text)
accelerator_dnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe Text
dnsName :: Maybe Text
$sel:dnsName:Accelerator' :: Accelerator -> Maybe Text
dnsName} -> Maybe Text
dnsName) (\s :: Accelerator
s@Accelerator' {} Maybe Text
a -> Accelerator
s {$sel:dnsName:Accelerator' :: Maybe Text
dnsName = Maybe Text
a} :: Accelerator)

-- | The Domain Name System (DNS) name that Global Accelerator creates that
-- points to a dual-stack accelerator\'s four static IP addresses: two IPv4
-- addresses and two IPv6 addresses.
--
-- The naming convention for the dual-stack DNS name is the following: A
-- lowercase letter a, followed by a 16-bit random hex string, followed by
-- .dualstack.awsglobalaccelerator.com. For example:
-- a1234567890abcdef.dualstack.awsglobalaccelerator.com.
--
-- Note: Global Accelerator also assigns a default DNS name, @DnsName@, to
-- your accelerator that points just to the static IPv4 addresses.
--
-- For more information, see
-- <https://docs.aws.amazon.com/global-accelerator/latest/dg/about-accelerators.html#about-accelerators.dns-addressing Support for DNS addressing in Global Accelerator>
-- in the /Global Accelerator Developer Guide/.
accelerator_dualStackDnsName :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.Text)
accelerator_dualStackDnsName :: Lens' Accelerator (Maybe Text)
accelerator_dualStackDnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe Text
dualStackDnsName :: Maybe Text
$sel:dualStackDnsName:Accelerator' :: Accelerator -> Maybe Text
dualStackDnsName} -> Maybe Text
dualStackDnsName) (\s :: Accelerator
s@Accelerator' {} Maybe Text
a -> Accelerator
s {$sel:dualStackDnsName:Accelerator' :: Maybe Text
dualStackDnsName = Maybe Text
a} :: Accelerator)

-- | Indicates whether the accelerator is enabled. The value is true or
-- false. The default value is true.
--
-- If the value is set to true, the accelerator cannot be deleted. If set
-- to false, accelerator can be deleted.
accelerator_enabled :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.Bool)
accelerator_enabled :: Lens' Accelerator (Maybe Bool)
accelerator_enabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe Bool
enabled :: Maybe Bool
$sel:enabled:Accelerator' :: Accelerator -> Maybe Bool
enabled} -> Maybe Bool
enabled) (\s :: Accelerator
s@Accelerator' {} Maybe Bool
a -> Accelerator
s {$sel:enabled:Accelerator' :: Maybe Bool
enabled = Maybe Bool
a} :: Accelerator)

-- | A history of changes that you make to an accelerator in Global
-- Accelerator.
accelerator_events :: Lens.Lens' Accelerator (Prelude.Maybe [AcceleratorEvent])
accelerator_events :: Lens' Accelerator (Maybe [AcceleratorEvent])
accelerator_events = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe [AcceleratorEvent]
events :: Maybe [AcceleratorEvent]
$sel:events:Accelerator' :: Accelerator -> Maybe [AcceleratorEvent]
events} -> Maybe [AcceleratorEvent]
events) (\s :: Accelerator
s@Accelerator' {} Maybe [AcceleratorEvent]
a -> Accelerator
s {$sel:events:Accelerator' :: Maybe [AcceleratorEvent]
events = Maybe [AcceleratorEvent]
a} :: Accelerator) 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

-- | The IP address type that an accelerator supports. For a standard
-- accelerator, the value can be IPV4 or DUAL_STACK.
accelerator_ipAddressType :: Lens.Lens' Accelerator (Prelude.Maybe IpAddressType)
accelerator_ipAddressType :: Lens' Accelerator (Maybe IpAddressType)
accelerator_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe IpAddressType
ipAddressType :: Maybe IpAddressType
$sel:ipAddressType:Accelerator' :: Accelerator -> Maybe IpAddressType
ipAddressType} -> Maybe IpAddressType
ipAddressType) (\s :: Accelerator
s@Accelerator' {} Maybe IpAddressType
a -> Accelerator
s {$sel:ipAddressType:Accelerator' :: Maybe IpAddressType
ipAddressType = Maybe IpAddressType
a} :: Accelerator)

-- | The static IP addresses that Global Accelerator associates with the
-- accelerator.
accelerator_ipSets :: Lens.Lens' Accelerator (Prelude.Maybe [IpSet])
accelerator_ipSets :: Lens' Accelerator (Maybe [IpSet])
accelerator_ipSets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe [IpSet]
ipSets :: Maybe [IpSet]
$sel:ipSets:Accelerator' :: Accelerator -> Maybe [IpSet]
ipSets} -> Maybe [IpSet]
ipSets) (\s :: Accelerator
s@Accelerator' {} Maybe [IpSet]
a -> Accelerator
s {$sel:ipSets:Accelerator' :: Maybe [IpSet]
ipSets = Maybe [IpSet]
a} :: Accelerator) 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

-- | The date and time that the accelerator was last modified.
accelerator_lastModifiedTime :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.UTCTime)
accelerator_lastModifiedTime :: Lens' Accelerator (Maybe UTCTime)
accelerator_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:Accelerator' :: Accelerator -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: Accelerator
s@Accelerator' {} Maybe POSIX
a -> Accelerator
s {$sel:lastModifiedTime:Accelerator' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: Accelerator) 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 name of the accelerator. The name must contain only alphanumeric
-- characters or hyphens (-), and must not begin or end with a hyphen.
accelerator_name :: Lens.Lens' Accelerator (Prelude.Maybe Prelude.Text)
accelerator_name :: Lens' Accelerator (Maybe Text)
accelerator_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe Text
name :: Maybe Text
$sel:name:Accelerator' :: Accelerator -> Maybe Text
name} -> Maybe Text
name) (\s :: Accelerator
s@Accelerator' {} Maybe Text
a -> Accelerator
s {$sel:name:Accelerator' :: Maybe Text
name = Maybe Text
a} :: Accelerator)

-- | Describes the deployment status of the accelerator.
accelerator_status :: Lens.Lens' Accelerator (Prelude.Maybe AcceleratorStatus)
accelerator_status :: Lens' Accelerator (Maybe AcceleratorStatus)
accelerator_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Accelerator' {Maybe AcceleratorStatus
status :: Maybe AcceleratorStatus
$sel:status:Accelerator' :: Accelerator -> Maybe AcceleratorStatus
status} -> Maybe AcceleratorStatus
status) (\s :: Accelerator
s@Accelerator' {} Maybe AcceleratorStatus
a -> Accelerator
s {$sel:status:Accelerator' :: Maybe AcceleratorStatus
status = Maybe AcceleratorStatus
a} :: Accelerator)

instance Data.FromJSON Accelerator where
  parseJSON :: Value -> Parser Accelerator
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Accelerator"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe [AcceleratorEvent]
-> Maybe IpAddressType
-> Maybe [IpSet]
-> Maybe POSIX
-> Maybe Text
-> Maybe AcceleratorStatus
-> Accelerator
Accelerator'
            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
"AcceleratorArn")
            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
"CreatedTime")
            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
"DnsName")
            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
"DualStackDnsName")
            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
"Enabled")
            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
"Events" 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
"IpAddressType")
            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
"IpSets" 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
"LastModifiedTime")
            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
"Name")
            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")
      )

instance Prelude.Hashable Accelerator where
  hashWithSalt :: Int -> Accelerator -> Int
hashWithSalt Int
_salt Accelerator' {Maybe Bool
Maybe [AcceleratorEvent]
Maybe [IpSet]
Maybe Text
Maybe POSIX
Maybe AcceleratorStatus
Maybe IpAddressType
status :: Maybe AcceleratorStatus
name :: Maybe Text
lastModifiedTime :: Maybe POSIX
ipSets :: Maybe [IpSet]
ipAddressType :: Maybe IpAddressType
events :: Maybe [AcceleratorEvent]
enabled :: Maybe Bool
dualStackDnsName :: Maybe Text
dnsName :: Maybe Text
createdTime :: Maybe POSIX
acceleratorArn :: Maybe Text
$sel:status:Accelerator' :: Accelerator -> Maybe AcceleratorStatus
$sel:name:Accelerator' :: Accelerator -> Maybe Text
$sel:lastModifiedTime:Accelerator' :: Accelerator -> Maybe POSIX
$sel:ipSets:Accelerator' :: Accelerator -> Maybe [IpSet]
$sel:ipAddressType:Accelerator' :: Accelerator -> Maybe IpAddressType
$sel:events:Accelerator' :: Accelerator -> Maybe [AcceleratorEvent]
$sel:enabled:Accelerator' :: Accelerator -> Maybe Bool
$sel:dualStackDnsName:Accelerator' :: Accelerator -> Maybe Text
$sel:dnsName:Accelerator' :: Accelerator -> Maybe Text
$sel:createdTime:Accelerator' :: Accelerator -> Maybe POSIX
$sel:acceleratorArn:Accelerator' :: Accelerator -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
acceleratorArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dualStackDnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AcceleratorEvent]
events
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IpAddressType
ipAddressType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IpSet]
ipSets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastModifiedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AcceleratorStatus
status

instance Prelude.NFData Accelerator where
  rnf :: Accelerator -> ()
rnf Accelerator' {Maybe Bool
Maybe [AcceleratorEvent]
Maybe [IpSet]
Maybe Text
Maybe POSIX
Maybe AcceleratorStatus
Maybe IpAddressType
status :: Maybe AcceleratorStatus
name :: Maybe Text
lastModifiedTime :: Maybe POSIX
ipSets :: Maybe [IpSet]
ipAddressType :: Maybe IpAddressType
events :: Maybe [AcceleratorEvent]
enabled :: Maybe Bool
dualStackDnsName :: Maybe Text
dnsName :: Maybe Text
createdTime :: Maybe POSIX
acceleratorArn :: Maybe Text
$sel:status:Accelerator' :: Accelerator -> Maybe AcceleratorStatus
$sel:name:Accelerator' :: Accelerator -> Maybe Text
$sel:lastModifiedTime:Accelerator' :: Accelerator -> Maybe POSIX
$sel:ipSets:Accelerator' :: Accelerator -> Maybe [IpSet]
$sel:ipAddressType:Accelerator' :: Accelerator -> Maybe IpAddressType
$sel:events:Accelerator' :: Accelerator -> Maybe [AcceleratorEvent]
$sel:enabled:Accelerator' :: Accelerator -> Maybe Bool
$sel:dualStackDnsName:Accelerator' :: Accelerator -> Maybe Text
$sel:dnsName:Accelerator' :: Accelerator -> Maybe Text
$sel:createdTime:Accelerator' :: Accelerator -> Maybe POSIX
$sel:acceleratorArn:Accelerator' :: Accelerator -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
acceleratorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dualStackDnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AcceleratorEvent]
events
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IpAddressType
ipAddressType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [IpSet]
ipSets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AcceleratorStatus
status