{-# 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.AllocateTransitVirtualInterface
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provisions a transit virtual interface to be owned by the specified
-- Amazon Web Services account. Use this type of interface to connect a
-- transit gateway to your Direct Connect gateway.
--
-- The owner of a connection provisions a transit virtual interface to be
-- owned by the specified Amazon Web Services account.
--
-- After you create a transit virtual interface, it must be confirmed by
-- the owner using ConfirmTransitVirtualInterface. Until this step has been
-- completed, the transit virtual interface is in the @requested@ state and
-- is not available to handle traffic.
module Amazonka.DirectConnect.AllocateTransitVirtualInterface
  ( -- * Creating a Request
    AllocateTransitVirtualInterface (..),
    newAllocateTransitVirtualInterface,

    -- * Request Lenses
    allocateTransitVirtualInterface_connectionId,
    allocateTransitVirtualInterface_ownerAccount,
    allocateTransitVirtualInterface_newTransitVirtualInterfaceAllocation,

    -- * Destructuring the Response
    AllocateTransitVirtualInterfaceResponse (..),
    newAllocateTransitVirtualInterfaceResponse,

    -- * Response Lenses
    allocateTransitVirtualInterfaceResponse_virtualInterface,
    allocateTransitVirtualInterfaceResponse_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:/ 'newAllocateTransitVirtualInterface' smart constructor.
data AllocateTransitVirtualInterface = AllocateTransitVirtualInterface'
  { -- | The ID of the connection on which the transit virtual interface is
    -- provisioned.
    AllocateTransitVirtualInterface -> Text
connectionId :: Prelude.Text,
    -- | The ID of the Amazon Web Services account that owns the transit virtual
    -- interface.
    AllocateTransitVirtualInterface -> Text
ownerAccount :: Prelude.Text,
    -- | Information about the transit virtual interface.
    AllocateTransitVirtualInterface
-> NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' :: NewTransitVirtualInterfaceAllocation
  }
  deriving (AllocateTransitVirtualInterface
-> AllocateTransitVirtualInterface -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllocateTransitVirtualInterface
-> AllocateTransitVirtualInterface -> Bool
$c/= :: AllocateTransitVirtualInterface
-> AllocateTransitVirtualInterface -> Bool
== :: AllocateTransitVirtualInterface
-> AllocateTransitVirtualInterface -> Bool
$c== :: AllocateTransitVirtualInterface
-> AllocateTransitVirtualInterface -> Bool
Prelude.Eq, ReadPrec [AllocateTransitVirtualInterface]
ReadPrec AllocateTransitVirtualInterface
Int -> ReadS AllocateTransitVirtualInterface
ReadS [AllocateTransitVirtualInterface]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllocateTransitVirtualInterface]
$creadListPrec :: ReadPrec [AllocateTransitVirtualInterface]
readPrec :: ReadPrec AllocateTransitVirtualInterface
$creadPrec :: ReadPrec AllocateTransitVirtualInterface
readList :: ReadS [AllocateTransitVirtualInterface]
$creadList :: ReadS [AllocateTransitVirtualInterface]
readsPrec :: Int -> ReadS AllocateTransitVirtualInterface
$creadsPrec :: Int -> ReadS AllocateTransitVirtualInterface
Prelude.Read, Int -> AllocateTransitVirtualInterface -> ShowS
[AllocateTransitVirtualInterface] -> ShowS
AllocateTransitVirtualInterface -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllocateTransitVirtualInterface] -> ShowS
$cshowList :: [AllocateTransitVirtualInterface] -> ShowS
show :: AllocateTransitVirtualInterface -> String
$cshow :: AllocateTransitVirtualInterface -> String
showsPrec :: Int -> AllocateTransitVirtualInterface -> ShowS
$cshowsPrec :: Int -> AllocateTransitVirtualInterface -> ShowS
Prelude.Show, forall x.
Rep AllocateTransitVirtualInterface x
-> AllocateTransitVirtualInterface
forall x.
AllocateTransitVirtualInterface
-> Rep AllocateTransitVirtualInterface x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AllocateTransitVirtualInterface x
-> AllocateTransitVirtualInterface
$cfrom :: forall x.
AllocateTransitVirtualInterface
-> Rep AllocateTransitVirtualInterface x
Prelude.Generic)

-- |
-- Create a value of 'AllocateTransitVirtualInterface' 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:
--
-- 'connectionId', 'allocateTransitVirtualInterface_connectionId' - The ID of the connection on which the transit virtual interface is
-- provisioned.
--
-- 'ownerAccount', 'allocateTransitVirtualInterface_ownerAccount' - The ID of the Amazon Web Services account that owns the transit virtual
-- interface.
--
-- 'newTransitVirtualInterfaceAllocation'', 'allocateTransitVirtualInterface_newTransitVirtualInterfaceAllocation' - Information about the transit virtual interface.
newAllocateTransitVirtualInterface ::
  -- | 'connectionId'
  Prelude.Text ->
  -- | 'ownerAccount'
  Prelude.Text ->
  -- | 'newTransitVirtualInterfaceAllocation''
  NewTransitVirtualInterfaceAllocation ->
  AllocateTransitVirtualInterface
newAllocateTransitVirtualInterface :: Text
-> Text
-> NewTransitVirtualInterfaceAllocation
-> AllocateTransitVirtualInterface
newAllocateTransitVirtualInterface
  Text
pConnectionId_
  Text
pOwnerAccount_
  NewTransitVirtualInterfaceAllocation
pNewTransitVirtualInterfaceAllocation_ =
    AllocateTransitVirtualInterface'
      { $sel:connectionId:AllocateTransitVirtualInterface' :: Text
connectionId =
          Text
pConnectionId_,
        $sel:ownerAccount:AllocateTransitVirtualInterface' :: Text
ownerAccount = Text
pOwnerAccount_,
        $sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' =
          NewTransitVirtualInterfaceAllocation
pNewTransitVirtualInterfaceAllocation_
      }

-- | The ID of the connection on which the transit virtual interface is
-- provisioned.
allocateTransitVirtualInterface_connectionId :: Lens.Lens' AllocateTransitVirtualInterface Prelude.Text
allocateTransitVirtualInterface_connectionId :: Lens' AllocateTransitVirtualInterface Text
allocateTransitVirtualInterface_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateTransitVirtualInterface' {Text
connectionId :: Text
$sel:connectionId:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
connectionId} -> Text
connectionId) (\s :: AllocateTransitVirtualInterface
s@AllocateTransitVirtualInterface' {} Text
a -> AllocateTransitVirtualInterface
s {$sel:connectionId:AllocateTransitVirtualInterface' :: Text
connectionId = Text
a} :: AllocateTransitVirtualInterface)

-- | The ID of the Amazon Web Services account that owns the transit virtual
-- interface.
allocateTransitVirtualInterface_ownerAccount :: Lens.Lens' AllocateTransitVirtualInterface Prelude.Text
allocateTransitVirtualInterface_ownerAccount :: Lens' AllocateTransitVirtualInterface Text
allocateTransitVirtualInterface_ownerAccount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateTransitVirtualInterface' {Text
ownerAccount :: Text
$sel:ownerAccount:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
ownerAccount} -> Text
ownerAccount) (\s :: AllocateTransitVirtualInterface
s@AllocateTransitVirtualInterface' {} Text
a -> AllocateTransitVirtualInterface
s {$sel:ownerAccount:AllocateTransitVirtualInterface' :: Text
ownerAccount = Text
a} :: AllocateTransitVirtualInterface)

-- | Information about the transit virtual interface.
allocateTransitVirtualInterface_newTransitVirtualInterfaceAllocation :: Lens.Lens' AllocateTransitVirtualInterface NewTransitVirtualInterfaceAllocation
allocateTransitVirtualInterface_newTransitVirtualInterfaceAllocation :: Lens'
  AllocateTransitVirtualInterface
  NewTransitVirtualInterfaceAllocation
allocateTransitVirtualInterface_newTransitVirtualInterfaceAllocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateTransitVirtualInterface' {NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' :: NewTransitVirtualInterfaceAllocation
$sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface
-> NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation'} -> NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation') (\s :: AllocateTransitVirtualInterface
s@AllocateTransitVirtualInterface' {} NewTransitVirtualInterfaceAllocation
a -> AllocateTransitVirtualInterface
s {$sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' = NewTransitVirtualInterfaceAllocation
a} :: AllocateTransitVirtualInterface)

instance
  Core.AWSRequest
    AllocateTransitVirtualInterface
  where
  type
    AWSResponse AllocateTransitVirtualInterface =
      AllocateTransitVirtualInterfaceResponse
  request :: (Service -> Service)
-> AllocateTransitVirtualInterface
-> Request AllocateTransitVirtualInterface
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 AllocateTransitVirtualInterface
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AllocateTransitVirtualInterface)))
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 VirtualInterface
-> Int -> AllocateTransitVirtualInterfaceResponse
AllocateTransitVirtualInterfaceResponse'
            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
"virtualInterface")
            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
    AllocateTransitVirtualInterface
  where
  hashWithSalt :: Int -> AllocateTransitVirtualInterface -> Int
hashWithSalt
    Int
_salt
    AllocateTransitVirtualInterface' {Text
NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' :: NewTransitVirtualInterfaceAllocation
ownerAccount :: Text
connectionId :: Text
$sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface
-> NewTransitVirtualInterfaceAllocation
$sel:ownerAccount:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
$sel:connectionId:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ownerAccount
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation'

instance
  Prelude.NFData
    AllocateTransitVirtualInterface
  where
  rnf :: AllocateTransitVirtualInterface -> ()
rnf AllocateTransitVirtualInterface' {Text
NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' :: NewTransitVirtualInterfaceAllocation
ownerAccount :: Text
connectionId :: Text
$sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface
-> NewTransitVirtualInterfaceAllocation
$sel:ownerAccount:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
$sel:connectionId:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
connectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ownerAccount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation'

instance
  Data.ToHeaders
    AllocateTransitVirtualInterface
  where
  toHeaders :: AllocateTransitVirtualInterface -> 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.AllocateTransitVirtualInterface" ::
                          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 AllocateTransitVirtualInterface where
  toJSON :: AllocateTransitVirtualInterface -> Value
toJSON AllocateTransitVirtualInterface' {Text
NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation' :: NewTransitVirtualInterfaceAllocation
ownerAccount :: Text
connectionId :: Text
$sel:newTransitVirtualInterfaceAllocation':AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface
-> NewTransitVirtualInterfaceAllocation
$sel:ownerAccount:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
$sel:connectionId:AllocateTransitVirtualInterface' :: AllocateTransitVirtualInterface -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"connectionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectionId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ownerAccount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
ownerAccount),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"newTransitVirtualInterfaceAllocation"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NewTransitVirtualInterfaceAllocation
newTransitVirtualInterfaceAllocation'
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'AllocateTransitVirtualInterfaceResponse' 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:
--
-- 'virtualInterface', 'allocateTransitVirtualInterfaceResponse_virtualInterface' - Undocumented member.
--
-- 'httpStatus', 'allocateTransitVirtualInterfaceResponse_httpStatus' - The response's http status code.
newAllocateTransitVirtualInterfaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AllocateTransitVirtualInterfaceResponse
newAllocateTransitVirtualInterfaceResponse :: Int -> AllocateTransitVirtualInterfaceResponse
newAllocateTransitVirtualInterfaceResponse
  Int
pHttpStatus_ =
    AllocateTransitVirtualInterfaceResponse'
      { $sel:virtualInterface:AllocateTransitVirtualInterfaceResponse' :: Maybe VirtualInterface
virtualInterface =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:AllocateTransitVirtualInterfaceResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Undocumented member.
allocateTransitVirtualInterfaceResponse_virtualInterface :: Lens.Lens' AllocateTransitVirtualInterfaceResponse (Prelude.Maybe VirtualInterface)
allocateTransitVirtualInterfaceResponse_virtualInterface :: Lens'
  AllocateTransitVirtualInterfaceResponse (Maybe VirtualInterface)
allocateTransitVirtualInterfaceResponse_virtualInterface = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllocateTransitVirtualInterfaceResponse' {Maybe VirtualInterface
virtualInterface :: Maybe VirtualInterface
$sel:virtualInterface:AllocateTransitVirtualInterfaceResponse' :: AllocateTransitVirtualInterfaceResponse -> Maybe VirtualInterface
virtualInterface} -> Maybe VirtualInterface
virtualInterface) (\s :: AllocateTransitVirtualInterfaceResponse
s@AllocateTransitVirtualInterfaceResponse' {} Maybe VirtualInterface
a -> AllocateTransitVirtualInterfaceResponse
s {$sel:virtualInterface:AllocateTransitVirtualInterfaceResponse' :: Maybe VirtualInterface
virtualInterface = Maybe VirtualInterface
a} :: AllocateTransitVirtualInterfaceResponse)

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

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