{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DirectConnect.StartBgpFailoverTest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts the virtual interface failover test that verifies your
-- configuration meets your resiliency requirements by placing the BGP
-- peering session in the DOWN state. You can then send traffic to verify
-- that there are no outages.
--
-- You can run the test on public, private, transit, and hosted virtual
-- interfaces.
--
-- You can use
-- <https://docs.aws.amazon.com/directconnect/latest/APIReference/API_ListVirtualInterfaceTestHistory.html ListVirtualInterfaceTestHistory>
-- to view the virtual interface test history.
--
-- If you need to stop the test before the test interval completes, use
-- <https://docs.aws.amazon.com/directconnect/latest/APIReference/API_StopBgpFailoverTest.html StopBgpFailoverTest>.
module Amazonka.DirectConnect.StartBgpFailoverTest
  ( -- * Creating a Request
    StartBgpFailoverTest (..),
    newStartBgpFailoverTest,

    -- * Request Lenses
    startBgpFailoverTest_bgpPeers,
    startBgpFailoverTest_testDurationInMinutes,
    startBgpFailoverTest_virtualInterfaceId,

    -- * Destructuring the Response
    StartBgpFailoverTestResponse (..),
    newStartBgpFailoverTestResponse,

    -- * Response Lenses
    startBgpFailoverTestResponse_virtualInterfaceTest,
    startBgpFailoverTestResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DirectConnect.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newStartBgpFailoverTest' smart constructor.
data StartBgpFailoverTest = StartBgpFailoverTest'
  { -- | The BGP peers to place in the DOWN state.
    StartBgpFailoverTest -> Maybe [Text]
bgpPeers :: Prelude.Maybe [Prelude.Text],
    -- | The time in minutes that the virtual interface failover test will last.
    --
    -- Maximum value: 180 minutes (3 hours).
    --
    -- Default: 180 minutes (3 hours).
    StartBgpFailoverTest -> Maybe Int
testDurationInMinutes :: Prelude.Maybe Prelude.Int,
    -- | The ID of the virtual interface you want to test.
    StartBgpFailoverTest -> Text
virtualInterfaceId :: Prelude.Text
  }
  deriving (StartBgpFailoverTest -> StartBgpFailoverTest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBgpFailoverTest -> StartBgpFailoverTest -> Bool
$c/= :: StartBgpFailoverTest -> StartBgpFailoverTest -> Bool
== :: StartBgpFailoverTest -> StartBgpFailoverTest -> Bool
$c== :: StartBgpFailoverTest -> StartBgpFailoverTest -> Bool
Prelude.Eq, ReadPrec [StartBgpFailoverTest]
ReadPrec StartBgpFailoverTest
Int -> ReadS StartBgpFailoverTest
ReadS [StartBgpFailoverTest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBgpFailoverTest]
$creadListPrec :: ReadPrec [StartBgpFailoverTest]
readPrec :: ReadPrec StartBgpFailoverTest
$creadPrec :: ReadPrec StartBgpFailoverTest
readList :: ReadS [StartBgpFailoverTest]
$creadList :: ReadS [StartBgpFailoverTest]
readsPrec :: Int -> ReadS StartBgpFailoverTest
$creadsPrec :: Int -> ReadS StartBgpFailoverTest
Prelude.Read, Int -> StartBgpFailoverTest -> ShowS
[StartBgpFailoverTest] -> ShowS
StartBgpFailoverTest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBgpFailoverTest] -> ShowS
$cshowList :: [StartBgpFailoverTest] -> ShowS
show :: StartBgpFailoverTest -> String
$cshow :: StartBgpFailoverTest -> String
showsPrec :: Int -> StartBgpFailoverTest -> ShowS
$cshowsPrec :: Int -> StartBgpFailoverTest -> ShowS
Prelude.Show, forall x. Rep StartBgpFailoverTest x -> StartBgpFailoverTest
forall x. StartBgpFailoverTest -> Rep StartBgpFailoverTest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBgpFailoverTest x -> StartBgpFailoverTest
$cfrom :: forall x. StartBgpFailoverTest -> Rep StartBgpFailoverTest x
Prelude.Generic)

-- |
-- Create a value of 'StartBgpFailoverTest' 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:
--
-- 'bgpPeers', 'startBgpFailoverTest_bgpPeers' - The BGP peers to place in the DOWN state.
--
-- 'testDurationInMinutes', 'startBgpFailoverTest_testDurationInMinutes' - The time in minutes that the virtual interface failover test will last.
--
-- Maximum value: 180 minutes (3 hours).
--
-- Default: 180 minutes (3 hours).
--
-- 'virtualInterfaceId', 'startBgpFailoverTest_virtualInterfaceId' - The ID of the virtual interface you want to test.
newStartBgpFailoverTest ::
  -- | 'virtualInterfaceId'
  Prelude.Text ->
  StartBgpFailoverTest
newStartBgpFailoverTest :: Text -> StartBgpFailoverTest
newStartBgpFailoverTest Text
pVirtualInterfaceId_ =
  StartBgpFailoverTest'
    { $sel:bgpPeers:StartBgpFailoverTest' :: Maybe [Text]
bgpPeers = forall a. Maybe a
Prelude.Nothing,
      $sel:testDurationInMinutes:StartBgpFailoverTest' :: Maybe Int
testDurationInMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:virtualInterfaceId:StartBgpFailoverTest' :: Text
virtualInterfaceId = Text
pVirtualInterfaceId_
    }

-- | The BGP peers to place in the DOWN state.
startBgpFailoverTest_bgpPeers :: Lens.Lens' StartBgpFailoverTest (Prelude.Maybe [Prelude.Text])
startBgpFailoverTest_bgpPeers :: Lens' StartBgpFailoverTest (Maybe [Text])
startBgpFailoverTest_bgpPeers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBgpFailoverTest' {Maybe [Text]
bgpPeers :: Maybe [Text]
$sel:bgpPeers:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe [Text]
bgpPeers} -> Maybe [Text]
bgpPeers) (\s :: StartBgpFailoverTest
s@StartBgpFailoverTest' {} Maybe [Text]
a -> StartBgpFailoverTest
s {$sel:bgpPeers:StartBgpFailoverTest' :: Maybe [Text]
bgpPeers = Maybe [Text]
a} :: StartBgpFailoverTest) 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 time in minutes that the virtual interface failover test will last.
--
-- Maximum value: 180 minutes (3 hours).
--
-- Default: 180 minutes (3 hours).
startBgpFailoverTest_testDurationInMinutes :: Lens.Lens' StartBgpFailoverTest (Prelude.Maybe Prelude.Int)
startBgpFailoverTest_testDurationInMinutes :: Lens' StartBgpFailoverTest (Maybe Int)
startBgpFailoverTest_testDurationInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBgpFailoverTest' {Maybe Int
testDurationInMinutes :: Maybe Int
$sel:testDurationInMinutes:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe Int
testDurationInMinutes} -> Maybe Int
testDurationInMinutes) (\s :: StartBgpFailoverTest
s@StartBgpFailoverTest' {} Maybe Int
a -> StartBgpFailoverTest
s {$sel:testDurationInMinutes:StartBgpFailoverTest' :: Maybe Int
testDurationInMinutes = Maybe Int
a} :: StartBgpFailoverTest)

-- | The ID of the virtual interface you want to test.
startBgpFailoverTest_virtualInterfaceId :: Lens.Lens' StartBgpFailoverTest Prelude.Text
startBgpFailoverTest_virtualInterfaceId :: Lens' StartBgpFailoverTest Text
startBgpFailoverTest_virtualInterfaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBgpFailoverTest' {Text
virtualInterfaceId :: Text
$sel:virtualInterfaceId:StartBgpFailoverTest' :: StartBgpFailoverTest -> Text
virtualInterfaceId} -> Text
virtualInterfaceId) (\s :: StartBgpFailoverTest
s@StartBgpFailoverTest' {} Text
a -> StartBgpFailoverTest
s {$sel:virtualInterfaceId:StartBgpFailoverTest' :: Text
virtualInterfaceId = Text
a} :: StartBgpFailoverTest)

instance Core.AWSRequest StartBgpFailoverTest where
  type
    AWSResponse StartBgpFailoverTest =
      StartBgpFailoverTestResponse
  request :: (Service -> Service)
-> StartBgpFailoverTest -> Request StartBgpFailoverTest
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartBgpFailoverTest
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartBgpFailoverTest)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe VirtualInterfaceTestHistory
-> Int -> StartBgpFailoverTestResponse
StartBgpFailoverTestResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"virtualInterfaceTest")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable StartBgpFailoverTest where
  hashWithSalt :: Int -> StartBgpFailoverTest -> Int
hashWithSalt Int
_salt StartBgpFailoverTest' {Maybe Int
Maybe [Text]
Text
virtualInterfaceId :: Text
testDurationInMinutes :: Maybe Int
bgpPeers :: Maybe [Text]
$sel:virtualInterfaceId:StartBgpFailoverTest' :: StartBgpFailoverTest -> Text
$sel:testDurationInMinutes:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe Int
$sel:bgpPeers:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
bgpPeers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
testDurationInMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
virtualInterfaceId

instance Prelude.NFData StartBgpFailoverTest where
  rnf :: StartBgpFailoverTest -> ()
rnf StartBgpFailoverTest' {Maybe Int
Maybe [Text]
Text
virtualInterfaceId :: Text
testDurationInMinutes :: Maybe Int
bgpPeers :: Maybe [Text]
$sel:virtualInterfaceId:StartBgpFailoverTest' :: StartBgpFailoverTest -> Text
$sel:testDurationInMinutes:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe Int
$sel:bgpPeers:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
bgpPeers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
testDurationInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
virtualInterfaceId

instance Data.ToHeaders StartBgpFailoverTest where
  toHeaders :: StartBgpFailoverTest -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"OvertureService.StartBgpFailoverTest" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartBgpFailoverTest where
  toJSON :: StartBgpFailoverTest -> Value
toJSON StartBgpFailoverTest' {Maybe Int
Maybe [Text]
Text
virtualInterfaceId :: Text
testDurationInMinutes :: Maybe Int
bgpPeers :: Maybe [Text]
$sel:virtualInterfaceId:StartBgpFailoverTest' :: StartBgpFailoverTest -> Text
$sel:testDurationInMinutes:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe Int
$sel:bgpPeers:StartBgpFailoverTest' :: StartBgpFailoverTest -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"bgpPeers" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
bgpPeers,
            (Key
"testDurationInMinutes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
testDurationInMinutes,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"virtualInterfaceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
virtualInterfaceId)
          ]
      )

instance Data.ToPath StartBgpFailoverTest where
  toPath :: StartBgpFailoverTest -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery StartBgpFailoverTest where
  toQuery :: StartBgpFailoverTest -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newStartBgpFailoverTestResponse' smart constructor.
data StartBgpFailoverTestResponse = StartBgpFailoverTestResponse'
  { -- | Information about the virtual interface failover test.
    StartBgpFailoverTestResponse -> Maybe VirtualInterfaceTestHistory
virtualInterfaceTest :: Prelude.Maybe VirtualInterfaceTestHistory,
    -- | The response's http status code.
    StartBgpFailoverTestResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartBgpFailoverTestResponse
-> StartBgpFailoverTestResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBgpFailoverTestResponse
-> StartBgpFailoverTestResponse -> Bool
$c/= :: StartBgpFailoverTestResponse
-> StartBgpFailoverTestResponse -> Bool
== :: StartBgpFailoverTestResponse
-> StartBgpFailoverTestResponse -> Bool
$c== :: StartBgpFailoverTestResponse
-> StartBgpFailoverTestResponse -> Bool
Prelude.Eq, ReadPrec [StartBgpFailoverTestResponse]
ReadPrec StartBgpFailoverTestResponse
Int -> ReadS StartBgpFailoverTestResponse
ReadS [StartBgpFailoverTestResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBgpFailoverTestResponse]
$creadListPrec :: ReadPrec [StartBgpFailoverTestResponse]
readPrec :: ReadPrec StartBgpFailoverTestResponse
$creadPrec :: ReadPrec StartBgpFailoverTestResponse
readList :: ReadS [StartBgpFailoverTestResponse]
$creadList :: ReadS [StartBgpFailoverTestResponse]
readsPrec :: Int -> ReadS StartBgpFailoverTestResponse
$creadsPrec :: Int -> ReadS StartBgpFailoverTestResponse
Prelude.Read, Int -> StartBgpFailoverTestResponse -> ShowS
[StartBgpFailoverTestResponse] -> ShowS
StartBgpFailoverTestResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBgpFailoverTestResponse] -> ShowS
$cshowList :: [StartBgpFailoverTestResponse] -> ShowS
show :: StartBgpFailoverTestResponse -> String
$cshow :: StartBgpFailoverTestResponse -> String
showsPrec :: Int -> StartBgpFailoverTestResponse -> ShowS
$cshowsPrec :: Int -> StartBgpFailoverTestResponse -> ShowS
Prelude.Show, forall x.
Rep StartBgpFailoverTestResponse x -> StartBgpFailoverTestResponse
forall x.
StartBgpFailoverTestResponse -> Rep StartBgpFailoverTestResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartBgpFailoverTestResponse x -> StartBgpFailoverTestResponse
$cfrom :: forall x.
StartBgpFailoverTestResponse -> Rep StartBgpFailoverTestResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartBgpFailoverTestResponse' 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:
--
-- 'virtualInterfaceTest', 'startBgpFailoverTestResponse_virtualInterfaceTest' - Information about the virtual interface failover test.
--
-- 'httpStatus', 'startBgpFailoverTestResponse_httpStatus' - The response's http status code.
newStartBgpFailoverTestResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartBgpFailoverTestResponse
newStartBgpFailoverTestResponse :: Int -> StartBgpFailoverTestResponse
newStartBgpFailoverTestResponse Int
pHttpStatus_ =
  StartBgpFailoverTestResponse'
    { $sel:virtualInterfaceTest:StartBgpFailoverTestResponse' :: Maybe VirtualInterfaceTestHistory
virtualInterfaceTest =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartBgpFailoverTestResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the virtual interface failover test.
startBgpFailoverTestResponse_virtualInterfaceTest :: Lens.Lens' StartBgpFailoverTestResponse (Prelude.Maybe VirtualInterfaceTestHistory)
startBgpFailoverTestResponse_virtualInterfaceTest :: Lens'
  StartBgpFailoverTestResponse (Maybe VirtualInterfaceTestHistory)
startBgpFailoverTestResponse_virtualInterfaceTest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBgpFailoverTestResponse' {Maybe VirtualInterfaceTestHistory
virtualInterfaceTest :: Maybe VirtualInterfaceTestHistory
$sel:virtualInterfaceTest:StartBgpFailoverTestResponse' :: StartBgpFailoverTestResponse -> Maybe VirtualInterfaceTestHistory
virtualInterfaceTest} -> Maybe VirtualInterfaceTestHistory
virtualInterfaceTest) (\s :: StartBgpFailoverTestResponse
s@StartBgpFailoverTestResponse' {} Maybe VirtualInterfaceTestHistory
a -> StartBgpFailoverTestResponse
s {$sel:virtualInterfaceTest:StartBgpFailoverTestResponse' :: Maybe VirtualInterfaceTestHistory
virtualInterfaceTest = Maybe VirtualInterfaceTestHistory
a} :: StartBgpFailoverTestResponse)

-- | The response's http status code.
startBgpFailoverTestResponse_httpStatus :: Lens.Lens' StartBgpFailoverTestResponse Prelude.Int
startBgpFailoverTestResponse_httpStatus :: Lens' StartBgpFailoverTestResponse Int
startBgpFailoverTestResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBgpFailoverTestResponse' {Int
httpStatus :: Int
$sel:httpStatus:StartBgpFailoverTestResponse' :: StartBgpFailoverTestResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: StartBgpFailoverTestResponse
s@StartBgpFailoverTestResponse' {} Int
a -> StartBgpFailoverTestResponse
s {$sel:httpStatus:StartBgpFailoverTestResponse' :: Int
httpStatus = Int
a} :: StartBgpFailoverTestResponse)

instance Prelude.NFData StartBgpFailoverTestResponse where
  rnf :: StartBgpFailoverTestResponse -> ()
rnf StartBgpFailoverTestResponse' {Int
Maybe VirtualInterfaceTestHistory
httpStatus :: Int
virtualInterfaceTest :: Maybe VirtualInterfaceTestHistory
$sel:httpStatus:StartBgpFailoverTestResponse' :: StartBgpFailoverTestResponse -> Int
$sel:virtualInterfaceTest:StartBgpFailoverTestResponse' :: StartBgpFailoverTestResponse -> Maybe VirtualInterfaceTestHistory
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe VirtualInterfaceTestHistory
virtualInterfaceTest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus