{-# 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.Route53.Types.TrafficPolicyInstance
-- 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.Route53.Types.TrafficPolicyInstance 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.Route53.Internal
import Amazonka.Route53.Types.RRType

-- | A complex type that contains settings for the new traffic policy
-- instance.
--
-- /See:/ 'newTrafficPolicyInstance' smart constructor.
data TrafficPolicyInstance = TrafficPolicyInstance'
  { -- | The ID that Amazon Route 53 assigned to the new traffic policy instance.
    TrafficPolicyInstance -> Text
id :: Prelude.Text,
    -- | The ID of the hosted zone that Amazon Route 53 created resource record
    -- sets in.
    TrafficPolicyInstance -> ResourceId
hostedZoneId :: ResourceId,
    -- | The DNS name, such as www.example.com, for which Amazon Route 53
    -- responds to queries by using the resource record sets that are
    -- associated with this traffic policy instance.
    TrafficPolicyInstance -> Text
name :: Prelude.Text,
    -- | The TTL that Amazon Route 53 assigned to all of the resource record sets
    -- that it created in the specified hosted zone.
    TrafficPolicyInstance -> Natural
ttl :: Prelude.Natural,
    -- | The value of @State@ is one of the following values:
    --
    -- [Applied]
    --     Amazon Route 53 has finished creating resource record sets, and
    --     changes have propagated to all Route 53 edge locations.
    --
    -- [Creating]
    --     Route 53 is creating the resource record sets. Use
    --     @GetTrafficPolicyInstance@ to confirm that the
    --     @CreateTrafficPolicyInstance@ request completed successfully.
    --
    -- [Failed]
    --     Route 53 wasn\'t able to create or update the resource record sets.
    --     When the value of @State@ is @Failed@, see @Message@ for an
    --     explanation of what caused the request to fail.
    TrafficPolicyInstance -> Text
state :: Prelude.Text,
    -- | If @State@ is @Failed@, an explanation of the reason for the failure. If
    -- @State@ is another value, @Message@ is empty.
    TrafficPolicyInstance -> Text
message :: Prelude.Text,
    -- | The ID of the traffic policy that Amazon Route 53 used to create
    -- resource record sets in the specified hosted zone.
    TrafficPolicyInstance -> Text
trafficPolicyId :: Prelude.Text,
    -- | The version of the traffic policy that Amazon Route 53 used to create
    -- resource record sets in the specified hosted zone.
    TrafficPolicyInstance -> Natural
trafficPolicyVersion :: Prelude.Natural,
    -- | The DNS type that Amazon Route 53 assigned to all of the resource record
    -- sets that it created for this traffic policy instance.
    TrafficPolicyInstance -> RRType
trafficPolicyType :: RRType
  }
  deriving (TrafficPolicyInstance -> TrafficPolicyInstance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrafficPolicyInstance -> TrafficPolicyInstance -> Bool
$c/= :: TrafficPolicyInstance -> TrafficPolicyInstance -> Bool
== :: TrafficPolicyInstance -> TrafficPolicyInstance -> Bool
$c== :: TrafficPolicyInstance -> TrafficPolicyInstance -> Bool
Prelude.Eq, ReadPrec [TrafficPolicyInstance]
ReadPrec TrafficPolicyInstance
Int -> ReadS TrafficPolicyInstance
ReadS [TrafficPolicyInstance]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TrafficPolicyInstance]
$creadListPrec :: ReadPrec [TrafficPolicyInstance]
readPrec :: ReadPrec TrafficPolicyInstance
$creadPrec :: ReadPrec TrafficPolicyInstance
readList :: ReadS [TrafficPolicyInstance]
$creadList :: ReadS [TrafficPolicyInstance]
readsPrec :: Int -> ReadS TrafficPolicyInstance
$creadsPrec :: Int -> ReadS TrafficPolicyInstance
Prelude.Read, Int -> TrafficPolicyInstance -> ShowS
[TrafficPolicyInstance] -> ShowS
TrafficPolicyInstance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrafficPolicyInstance] -> ShowS
$cshowList :: [TrafficPolicyInstance] -> ShowS
show :: TrafficPolicyInstance -> String
$cshow :: TrafficPolicyInstance -> String
showsPrec :: Int -> TrafficPolicyInstance -> ShowS
$cshowsPrec :: Int -> TrafficPolicyInstance -> ShowS
Prelude.Show, forall x. Rep TrafficPolicyInstance x -> TrafficPolicyInstance
forall x. TrafficPolicyInstance -> Rep TrafficPolicyInstance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrafficPolicyInstance x -> TrafficPolicyInstance
$cfrom :: forall x. TrafficPolicyInstance -> Rep TrafficPolicyInstance x
Prelude.Generic)

-- |
-- Create a value of 'TrafficPolicyInstance' 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:
--
-- 'id', 'trafficPolicyInstance_id' - The ID that Amazon Route 53 assigned to the new traffic policy instance.
--
-- 'hostedZoneId', 'trafficPolicyInstance_hostedZoneId' - The ID of the hosted zone that Amazon Route 53 created resource record
-- sets in.
--
-- 'name', 'trafficPolicyInstance_name' - The DNS name, such as www.example.com, for which Amazon Route 53
-- responds to queries by using the resource record sets that are
-- associated with this traffic policy instance.
--
-- 'ttl', 'trafficPolicyInstance_ttl' - The TTL that Amazon Route 53 assigned to all of the resource record sets
-- that it created in the specified hosted zone.
--
-- 'state', 'trafficPolicyInstance_state' - The value of @State@ is one of the following values:
--
-- [Applied]
--     Amazon Route 53 has finished creating resource record sets, and
--     changes have propagated to all Route 53 edge locations.
--
-- [Creating]
--     Route 53 is creating the resource record sets. Use
--     @GetTrafficPolicyInstance@ to confirm that the
--     @CreateTrafficPolicyInstance@ request completed successfully.
--
-- [Failed]
--     Route 53 wasn\'t able to create or update the resource record sets.
--     When the value of @State@ is @Failed@, see @Message@ for an
--     explanation of what caused the request to fail.
--
-- 'message', 'trafficPolicyInstance_message' - If @State@ is @Failed@, an explanation of the reason for the failure. If
-- @State@ is another value, @Message@ is empty.
--
-- 'trafficPolicyId', 'trafficPolicyInstance_trafficPolicyId' - The ID of the traffic policy that Amazon Route 53 used to create
-- resource record sets in the specified hosted zone.
--
-- 'trafficPolicyVersion', 'trafficPolicyInstance_trafficPolicyVersion' - The version of the traffic policy that Amazon Route 53 used to create
-- resource record sets in the specified hosted zone.
--
-- 'trafficPolicyType', 'trafficPolicyInstance_trafficPolicyType' - The DNS type that Amazon Route 53 assigned to all of the resource record
-- sets that it created for this traffic policy instance.
newTrafficPolicyInstance ::
  -- | 'id'
  Prelude.Text ->
  -- | 'hostedZoneId'
  ResourceId ->
  -- | 'name'
  Prelude.Text ->
  -- | 'ttl'
  Prelude.Natural ->
  -- | 'state'
  Prelude.Text ->
  -- | 'message'
  Prelude.Text ->
  -- | 'trafficPolicyId'
  Prelude.Text ->
  -- | 'trafficPolicyVersion'
  Prelude.Natural ->
  -- | 'trafficPolicyType'
  RRType ->
  TrafficPolicyInstance
newTrafficPolicyInstance :: Text
-> ResourceId
-> Text
-> Natural
-> Text
-> Text
-> Text
-> Natural
-> RRType
-> TrafficPolicyInstance
newTrafficPolicyInstance
  Text
pId_
  ResourceId
pHostedZoneId_
  Text
pName_
  Natural
pTTL_
  Text
pState_
  Text
pMessage_
  Text
pTrafficPolicyId_
  Natural
pTrafficPolicyVersion_
  RRType
pTrafficPolicyType_ =
    TrafficPolicyInstance'
      { $sel:id:TrafficPolicyInstance' :: Text
id = Text
pId_,
        $sel:hostedZoneId:TrafficPolicyInstance' :: ResourceId
hostedZoneId = ResourceId
pHostedZoneId_,
        $sel:name:TrafficPolicyInstance' :: Text
name = Text
pName_,
        $sel:ttl:TrafficPolicyInstance' :: Natural
ttl = Natural
pTTL_,
        $sel:state:TrafficPolicyInstance' :: Text
state = Text
pState_,
        $sel:message:TrafficPolicyInstance' :: Text
message = Text
pMessage_,
        $sel:trafficPolicyId:TrafficPolicyInstance' :: Text
trafficPolicyId = Text
pTrafficPolicyId_,
        $sel:trafficPolicyVersion:TrafficPolicyInstance' :: Natural
trafficPolicyVersion = Natural
pTrafficPolicyVersion_,
        $sel:trafficPolicyType:TrafficPolicyInstance' :: RRType
trafficPolicyType = RRType
pTrafficPolicyType_
      }

-- | The ID that Amazon Route 53 assigned to the new traffic policy instance.
trafficPolicyInstance_id :: Lens.Lens' TrafficPolicyInstance Prelude.Text
trafficPolicyInstance_id :: Lens' TrafficPolicyInstance Text
trafficPolicyInstance_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Text
id :: Text
$sel:id:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
id} -> Text
id) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Text
a -> TrafficPolicyInstance
s {$sel:id:TrafficPolicyInstance' :: Text
id = Text
a} :: TrafficPolicyInstance)

-- | The ID of the hosted zone that Amazon Route 53 created resource record
-- sets in.
trafficPolicyInstance_hostedZoneId :: Lens.Lens' TrafficPolicyInstance ResourceId
trafficPolicyInstance_hostedZoneId :: Lens' TrafficPolicyInstance ResourceId
trafficPolicyInstance_hostedZoneId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {ResourceId
hostedZoneId :: ResourceId
$sel:hostedZoneId:TrafficPolicyInstance' :: TrafficPolicyInstance -> ResourceId
hostedZoneId} -> ResourceId
hostedZoneId) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} ResourceId
a -> TrafficPolicyInstance
s {$sel:hostedZoneId:TrafficPolicyInstance' :: ResourceId
hostedZoneId = ResourceId
a} :: TrafficPolicyInstance)

-- | The DNS name, such as www.example.com, for which Amazon Route 53
-- responds to queries by using the resource record sets that are
-- associated with this traffic policy instance.
trafficPolicyInstance_name :: Lens.Lens' TrafficPolicyInstance Prelude.Text
trafficPolicyInstance_name :: Lens' TrafficPolicyInstance Text
trafficPolicyInstance_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Text
name :: Text
$sel:name:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
name} -> Text
name) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Text
a -> TrafficPolicyInstance
s {$sel:name:TrafficPolicyInstance' :: Text
name = Text
a} :: TrafficPolicyInstance)

-- | The TTL that Amazon Route 53 assigned to all of the resource record sets
-- that it created in the specified hosted zone.
trafficPolicyInstance_ttl :: Lens.Lens' TrafficPolicyInstance Prelude.Natural
trafficPolicyInstance_ttl :: Lens' TrafficPolicyInstance Natural
trafficPolicyInstance_ttl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Natural
ttl :: Natural
$sel:ttl:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
ttl} -> Natural
ttl) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Natural
a -> TrafficPolicyInstance
s {$sel:ttl:TrafficPolicyInstance' :: Natural
ttl = Natural
a} :: TrafficPolicyInstance)

-- | The value of @State@ is one of the following values:
--
-- [Applied]
--     Amazon Route 53 has finished creating resource record sets, and
--     changes have propagated to all Route 53 edge locations.
--
-- [Creating]
--     Route 53 is creating the resource record sets. Use
--     @GetTrafficPolicyInstance@ to confirm that the
--     @CreateTrafficPolicyInstance@ request completed successfully.
--
-- [Failed]
--     Route 53 wasn\'t able to create or update the resource record sets.
--     When the value of @State@ is @Failed@, see @Message@ for an
--     explanation of what caused the request to fail.
trafficPolicyInstance_state :: Lens.Lens' TrafficPolicyInstance Prelude.Text
trafficPolicyInstance_state :: Lens' TrafficPolicyInstance Text
trafficPolicyInstance_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Text
state :: Text
$sel:state:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
state} -> Text
state) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Text
a -> TrafficPolicyInstance
s {$sel:state:TrafficPolicyInstance' :: Text
state = Text
a} :: TrafficPolicyInstance)

-- | If @State@ is @Failed@, an explanation of the reason for the failure. If
-- @State@ is another value, @Message@ is empty.
trafficPolicyInstance_message :: Lens.Lens' TrafficPolicyInstance Prelude.Text
trafficPolicyInstance_message :: Lens' TrafficPolicyInstance Text
trafficPolicyInstance_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Text
message :: Text
$sel:message:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
message} -> Text
message) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Text
a -> TrafficPolicyInstance
s {$sel:message:TrafficPolicyInstance' :: Text
message = Text
a} :: TrafficPolicyInstance)

-- | The ID of the traffic policy that Amazon Route 53 used to create
-- resource record sets in the specified hosted zone.
trafficPolicyInstance_trafficPolicyId :: Lens.Lens' TrafficPolicyInstance Prelude.Text
trafficPolicyInstance_trafficPolicyId :: Lens' TrafficPolicyInstance Text
trafficPolicyInstance_trafficPolicyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Text
trafficPolicyId :: Text
$sel:trafficPolicyId:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
trafficPolicyId} -> Text
trafficPolicyId) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Text
a -> TrafficPolicyInstance
s {$sel:trafficPolicyId:TrafficPolicyInstance' :: Text
trafficPolicyId = Text
a} :: TrafficPolicyInstance)

-- | The version of the traffic policy that Amazon Route 53 used to create
-- resource record sets in the specified hosted zone.
trafficPolicyInstance_trafficPolicyVersion :: Lens.Lens' TrafficPolicyInstance Prelude.Natural
trafficPolicyInstance_trafficPolicyVersion :: Lens' TrafficPolicyInstance Natural
trafficPolicyInstance_trafficPolicyVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {Natural
trafficPolicyVersion :: Natural
$sel:trafficPolicyVersion:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
trafficPolicyVersion} -> Natural
trafficPolicyVersion) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} Natural
a -> TrafficPolicyInstance
s {$sel:trafficPolicyVersion:TrafficPolicyInstance' :: Natural
trafficPolicyVersion = Natural
a} :: TrafficPolicyInstance)

-- | The DNS type that Amazon Route 53 assigned to all of the resource record
-- sets that it created for this traffic policy instance.
trafficPolicyInstance_trafficPolicyType :: Lens.Lens' TrafficPolicyInstance RRType
trafficPolicyInstance_trafficPolicyType :: Lens' TrafficPolicyInstance RRType
trafficPolicyInstance_trafficPolicyType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrafficPolicyInstance' {RRType
trafficPolicyType :: RRType
$sel:trafficPolicyType:TrafficPolicyInstance' :: TrafficPolicyInstance -> RRType
trafficPolicyType} -> RRType
trafficPolicyType) (\s :: TrafficPolicyInstance
s@TrafficPolicyInstance' {} RRType
a -> TrafficPolicyInstance
s {$sel:trafficPolicyType:TrafficPolicyInstance' :: RRType
trafficPolicyType = RRType
a} :: TrafficPolicyInstance)

instance Data.FromXML TrafficPolicyInstance where
  parseXML :: [Node] -> Either String TrafficPolicyInstance
parseXML [Node]
x =
    Text
-> ResourceId
-> Text
-> Natural
-> Text
-> Text
-> Text
-> Natural
-> RRType
-> TrafficPolicyInstance
TrafficPolicyInstance'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"HostedZoneId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"TTL")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"State")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Message")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"TrafficPolicyId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"TrafficPolicyVersion")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"TrafficPolicyType")

instance Prelude.Hashable TrafficPolicyInstance where
  hashWithSalt :: Int -> TrafficPolicyInstance -> Int
hashWithSalt Int
_salt TrafficPolicyInstance' {Natural
Text
ResourceId
RRType
trafficPolicyType :: RRType
trafficPolicyVersion :: Natural
trafficPolicyId :: Text
message :: Text
state :: Text
ttl :: Natural
name :: Text
hostedZoneId :: ResourceId
id :: Text
$sel:trafficPolicyType:TrafficPolicyInstance' :: TrafficPolicyInstance -> RRType
$sel:trafficPolicyVersion:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
$sel:trafficPolicyId:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:message:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:state:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:ttl:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
$sel:name:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:hostedZoneId:TrafficPolicyInstance' :: TrafficPolicyInstance -> ResourceId
$sel:id:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceId
hostedZoneId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
ttl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trafficPolicyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
trafficPolicyVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RRType
trafficPolicyType

instance Prelude.NFData TrafficPolicyInstance where
  rnf :: TrafficPolicyInstance -> ()
rnf TrafficPolicyInstance' {Natural
Text
ResourceId
RRType
trafficPolicyType :: RRType
trafficPolicyVersion :: Natural
trafficPolicyId :: Text
message :: Text
state :: Text
ttl :: Natural
name :: Text
hostedZoneId :: ResourceId
id :: Text
$sel:trafficPolicyType:TrafficPolicyInstance' :: TrafficPolicyInstance -> RRType
$sel:trafficPolicyVersion:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
$sel:trafficPolicyId:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:message:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:state:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:ttl:TrafficPolicyInstance' :: TrafficPolicyInstance -> Natural
$sel:name:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
$sel:hostedZoneId:TrafficPolicyInstance' :: TrafficPolicyInstance -> ResourceId
$sel:id:TrafficPolicyInstance' :: TrafficPolicyInstance -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceId
hostedZoneId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
ttl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trafficPolicyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
trafficPolicyVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RRType
trafficPolicyType