{-# 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.CreateLag
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a link aggregation group (LAG) with the specified number of
-- bundled physical dedicated connections between the customer network and
-- a specific Direct Connect location. A LAG is a logical interface that
-- uses the Link Aggregation Control Protocol (LACP) to aggregate multiple
-- interfaces, enabling you to treat them as a single interface.
--
-- All connections in a LAG must use the same bandwidth (either 1Gbps or
-- 10Gbps) and must terminate at the same Direct Connect endpoint.
--
-- You can have up to 10 dedicated connections per LAG. Regardless of this
-- limit, if you request more connections for the LAG than Direct Connect
-- can allocate on a single endpoint, no LAG is created.
--
-- You can specify an existing physical dedicated connection or
-- interconnect to include in the LAG (which counts towards the total
-- number of connections). Doing so interrupts the current physical
-- dedicated connection, and re-establishes them as a member of the LAG.
-- The LAG will be created on the same Direct Connect endpoint to which the
-- dedicated connection terminates. Any virtual interfaces associated with
-- the dedicated connection are automatically disassociated and
-- re-associated with the LAG. The connection ID does not change.
--
-- If the Amazon Web Services account used to create a LAG is a registered
-- Direct Connect Partner, the LAG is automatically enabled to host
-- sub-connections. For a LAG owned by a partner, any associated virtual
-- interfaces cannot be directly configured.
module Amazonka.DirectConnect.CreateLag
  ( -- * Creating a Request
    CreateLag (..),
    newCreateLag,

    -- * Request Lenses
    createLag_childConnectionTags,
    createLag_connectionId,
    createLag_providerName,
    createLag_requestMACSec,
    createLag_tags,
    createLag_numberOfConnections,
    createLag_location,
    createLag_connectionsBandwidth,
    createLag_lagName,

    -- * Destructuring the Response
    Lag (..),
    newLag,

    -- * Response Lenses
    lag_allowsHostedConnections,
    lag_awsDevice,
    lag_awsDeviceV2,
    lag_awsLogicalDeviceId,
    lag_connections,
    lag_connectionsBandwidth,
    lag_encryptionMode,
    lag_hasLogicalRedundancy,
    lag_jumboFrameCapable,
    lag_lagId,
    lag_lagName,
    lag_lagState,
    lag_location,
    lag_macSecCapable,
    lag_macSecKeys,
    lag_minimumLinks,
    lag_numberOfConnections,
    lag_ownerAccount,
    lag_providerName,
    lag_region,
    lag_tags,
  )
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:/ 'newCreateLag' smart constructor.
data CreateLag = CreateLag'
  { -- | The tags to associate with the automtically created LAGs.
    CreateLag -> Maybe (NonEmpty Tag)
childConnectionTags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The ID of an existing dedicated connection to migrate to the LAG.
    CreateLag -> Maybe Text
connectionId :: Prelude.Maybe Prelude.Text,
    -- | The name of the service provider associated with the LAG.
    CreateLag -> Maybe Text
providerName :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the connection will support MAC Security (MACsec).
    --
    -- All connections in the LAG must be capable of supporting MAC Security
    -- (MACsec). For information about MAC Security (MACsec) prerequisties, see
    -- <https://docs.aws.amazon.com/directconnect/latest/UserGuide/direct-connect-mac-sec-getting-started.html#mac-sec-prerequisites MACsec prerequisties>
    -- in the /Direct Connect User Guide/.
    CreateLag -> Maybe Bool
requestMACSec :: Prelude.Maybe Prelude.Bool,
    -- | The tags to associate with the LAG.
    CreateLag -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The number of physical dedicated connections initially provisioned and
    -- bundled by the LAG.
    CreateLag -> Int
numberOfConnections :: Prelude.Int,
    -- | The location for the LAG.
    CreateLag -> Text
location :: Prelude.Text,
    -- | The bandwidth of the individual physical dedicated connections bundled
    -- by the LAG. The possible values are 1Gbps and 10Gbps.
    CreateLag -> Text
connectionsBandwidth :: Prelude.Text,
    -- | The name of the LAG.
    CreateLag -> Text
lagName :: Prelude.Text
  }
  deriving (CreateLag -> CreateLag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLag -> CreateLag -> Bool
$c/= :: CreateLag -> CreateLag -> Bool
== :: CreateLag -> CreateLag -> Bool
$c== :: CreateLag -> CreateLag -> Bool
Prelude.Eq, ReadPrec [CreateLag]
ReadPrec CreateLag
Int -> ReadS CreateLag
ReadS [CreateLag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLag]
$creadListPrec :: ReadPrec [CreateLag]
readPrec :: ReadPrec CreateLag
$creadPrec :: ReadPrec CreateLag
readList :: ReadS [CreateLag]
$creadList :: ReadS [CreateLag]
readsPrec :: Int -> ReadS CreateLag
$creadsPrec :: Int -> ReadS CreateLag
Prelude.Read, Int -> CreateLag -> ShowS
[CreateLag] -> ShowS
CreateLag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLag] -> ShowS
$cshowList :: [CreateLag] -> ShowS
show :: CreateLag -> String
$cshow :: CreateLag -> String
showsPrec :: Int -> CreateLag -> ShowS
$cshowsPrec :: Int -> CreateLag -> ShowS
Prelude.Show, forall x. Rep CreateLag x -> CreateLag
forall x. CreateLag -> Rep CreateLag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLag x -> CreateLag
$cfrom :: forall x. CreateLag -> Rep CreateLag x
Prelude.Generic)

-- |
-- Create a value of 'CreateLag' 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:
--
-- 'childConnectionTags', 'createLag_childConnectionTags' - The tags to associate with the automtically created LAGs.
--
-- 'connectionId', 'createLag_connectionId' - The ID of an existing dedicated connection to migrate to the LAG.
--
-- 'providerName', 'createLag_providerName' - The name of the service provider associated with the LAG.
--
-- 'requestMACSec', 'createLag_requestMACSec' - Indicates whether the connection will support MAC Security (MACsec).
--
-- All connections in the LAG must be capable of supporting MAC Security
-- (MACsec). For information about MAC Security (MACsec) prerequisties, see
-- <https://docs.aws.amazon.com/directconnect/latest/UserGuide/direct-connect-mac-sec-getting-started.html#mac-sec-prerequisites MACsec prerequisties>
-- in the /Direct Connect User Guide/.
--
-- 'tags', 'createLag_tags' - The tags to associate with the LAG.
--
-- 'numberOfConnections', 'createLag_numberOfConnections' - The number of physical dedicated connections initially provisioned and
-- bundled by the LAG.
--
-- 'location', 'createLag_location' - The location for the LAG.
--
-- 'connectionsBandwidth', 'createLag_connectionsBandwidth' - The bandwidth of the individual physical dedicated connections bundled
-- by the LAG. The possible values are 1Gbps and 10Gbps.
--
-- 'lagName', 'createLag_lagName' - The name of the LAG.
newCreateLag ::
  -- | 'numberOfConnections'
  Prelude.Int ->
  -- | 'location'
  Prelude.Text ->
  -- | 'connectionsBandwidth'
  Prelude.Text ->
  -- | 'lagName'
  Prelude.Text ->
  CreateLag
newCreateLag :: Int -> Text -> Text -> Text -> CreateLag
newCreateLag
  Int
pNumberOfConnections_
  Text
pLocation_
  Text
pConnectionsBandwidth_
  Text
pLagName_ =
    CreateLag'
      { $sel:childConnectionTags:CreateLag' :: Maybe (NonEmpty Tag)
childConnectionTags = forall a. Maybe a
Prelude.Nothing,
        $sel:connectionId:CreateLag' :: Maybe Text
connectionId = forall a. Maybe a
Prelude.Nothing,
        $sel:providerName:CreateLag' :: Maybe Text
providerName = forall a. Maybe a
Prelude.Nothing,
        $sel:requestMACSec:CreateLag' :: Maybe Bool
requestMACSec = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLag' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:numberOfConnections:CreateLag' :: Int
numberOfConnections = Int
pNumberOfConnections_,
        $sel:location:CreateLag' :: Text
location = Text
pLocation_,
        $sel:connectionsBandwidth:CreateLag' :: Text
connectionsBandwidth = Text
pConnectionsBandwidth_,
        $sel:lagName:CreateLag' :: Text
lagName = Text
pLagName_
      }

-- | The tags to associate with the automtically created LAGs.
createLag_childConnectionTags :: Lens.Lens' CreateLag (Prelude.Maybe (Prelude.NonEmpty Tag))
createLag_childConnectionTags :: Lens' CreateLag (Maybe (NonEmpty Tag))
createLag_childConnectionTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Maybe (NonEmpty Tag)
childConnectionTags :: Maybe (NonEmpty Tag)
$sel:childConnectionTags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
childConnectionTags} -> Maybe (NonEmpty Tag)
childConnectionTags) (\s :: CreateLag
s@CreateLag' {} Maybe (NonEmpty Tag)
a -> CreateLag
s {$sel:childConnectionTags:CreateLag' :: Maybe (NonEmpty Tag)
childConnectionTags = Maybe (NonEmpty Tag)
a} :: CreateLag) 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 ID of an existing dedicated connection to migrate to the LAG.
createLag_connectionId :: Lens.Lens' CreateLag (Prelude.Maybe Prelude.Text)
createLag_connectionId :: Lens' CreateLag (Maybe Text)
createLag_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Maybe Text
connectionId :: Maybe Text
$sel:connectionId:CreateLag' :: CreateLag -> Maybe Text
connectionId} -> Maybe Text
connectionId) (\s :: CreateLag
s@CreateLag' {} Maybe Text
a -> CreateLag
s {$sel:connectionId:CreateLag' :: Maybe Text
connectionId = Maybe Text
a} :: CreateLag)

-- | The name of the service provider associated with the LAG.
createLag_providerName :: Lens.Lens' CreateLag (Prelude.Maybe Prelude.Text)
createLag_providerName :: Lens' CreateLag (Maybe Text)
createLag_providerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Maybe Text
providerName :: Maybe Text
$sel:providerName:CreateLag' :: CreateLag -> Maybe Text
providerName} -> Maybe Text
providerName) (\s :: CreateLag
s@CreateLag' {} Maybe Text
a -> CreateLag
s {$sel:providerName:CreateLag' :: Maybe Text
providerName = Maybe Text
a} :: CreateLag)

-- | Indicates whether the connection will support MAC Security (MACsec).
--
-- All connections in the LAG must be capable of supporting MAC Security
-- (MACsec). For information about MAC Security (MACsec) prerequisties, see
-- <https://docs.aws.amazon.com/directconnect/latest/UserGuide/direct-connect-mac-sec-getting-started.html#mac-sec-prerequisites MACsec prerequisties>
-- in the /Direct Connect User Guide/.
createLag_requestMACSec :: Lens.Lens' CreateLag (Prelude.Maybe Prelude.Bool)
createLag_requestMACSec :: Lens' CreateLag (Maybe Bool)
createLag_requestMACSec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Maybe Bool
requestMACSec :: Maybe Bool
$sel:requestMACSec:CreateLag' :: CreateLag -> Maybe Bool
requestMACSec} -> Maybe Bool
requestMACSec) (\s :: CreateLag
s@CreateLag' {} Maybe Bool
a -> CreateLag
s {$sel:requestMACSec:CreateLag' :: Maybe Bool
requestMACSec = Maybe Bool
a} :: CreateLag)

-- | The tags to associate with the LAG.
createLag_tags :: Lens.Lens' CreateLag (Prelude.Maybe (Prelude.NonEmpty Tag))
createLag_tags :: Lens' CreateLag (Maybe (NonEmpty Tag))
createLag_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateLag
s@CreateLag' {} Maybe (NonEmpty Tag)
a -> CreateLag
s {$sel:tags:CreateLag' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateLag) 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 number of physical dedicated connections initially provisioned and
-- bundled by the LAG.
createLag_numberOfConnections :: Lens.Lens' CreateLag Prelude.Int
createLag_numberOfConnections :: Lens' CreateLag Int
createLag_numberOfConnections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Int
numberOfConnections :: Int
$sel:numberOfConnections:CreateLag' :: CreateLag -> Int
numberOfConnections} -> Int
numberOfConnections) (\s :: CreateLag
s@CreateLag' {} Int
a -> CreateLag
s {$sel:numberOfConnections:CreateLag' :: Int
numberOfConnections = Int
a} :: CreateLag)

-- | The location for the LAG.
createLag_location :: Lens.Lens' CreateLag Prelude.Text
createLag_location :: Lens' CreateLag Text
createLag_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Text
location :: Text
$sel:location:CreateLag' :: CreateLag -> Text
location} -> Text
location) (\s :: CreateLag
s@CreateLag' {} Text
a -> CreateLag
s {$sel:location:CreateLag' :: Text
location = Text
a} :: CreateLag)

-- | The bandwidth of the individual physical dedicated connections bundled
-- by the LAG. The possible values are 1Gbps and 10Gbps.
createLag_connectionsBandwidth :: Lens.Lens' CreateLag Prelude.Text
createLag_connectionsBandwidth :: Lens' CreateLag Text
createLag_connectionsBandwidth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Text
connectionsBandwidth :: Text
$sel:connectionsBandwidth:CreateLag' :: CreateLag -> Text
connectionsBandwidth} -> Text
connectionsBandwidth) (\s :: CreateLag
s@CreateLag' {} Text
a -> CreateLag
s {$sel:connectionsBandwidth:CreateLag' :: Text
connectionsBandwidth = Text
a} :: CreateLag)

-- | The name of the LAG.
createLag_lagName :: Lens.Lens' CreateLag Prelude.Text
createLag_lagName :: Lens' CreateLag Text
createLag_lagName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLag' {Text
lagName :: Text
$sel:lagName:CreateLag' :: CreateLag -> Text
lagName} -> Text
lagName) (\s :: CreateLag
s@CreateLag' {} Text
a -> CreateLag
s {$sel:lagName:CreateLag' :: Text
lagName = Text
a} :: CreateLag)

instance Core.AWSRequest CreateLag where
  type AWSResponse CreateLag = Lag
  request :: (Service -> Service) -> CreateLag -> Request CreateLag
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 CreateLag
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLag)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable CreateLag where
  hashWithSalt :: Int -> CreateLag -> Int
hashWithSalt Int
_salt CreateLag' {Int
Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
lagName :: Text
connectionsBandwidth :: Text
location :: Text
numberOfConnections :: Int
tags :: Maybe (NonEmpty Tag)
requestMACSec :: Maybe Bool
providerName :: Maybe Text
connectionId :: Maybe Text
childConnectionTags :: Maybe (NonEmpty Tag)
$sel:lagName:CreateLag' :: CreateLag -> Text
$sel:connectionsBandwidth:CreateLag' :: CreateLag -> Text
$sel:location:CreateLag' :: CreateLag -> Text
$sel:numberOfConnections:CreateLag' :: CreateLag -> Int
$sel:tags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
$sel:requestMACSec:CreateLag' :: CreateLag -> Maybe Bool
$sel:providerName:CreateLag' :: CreateLag -> Maybe Text
$sel:connectionId:CreateLag' :: CreateLag -> Maybe Text
$sel:childConnectionTags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
childConnectionTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
providerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
requestMACSec
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
numberOfConnections
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionsBandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lagName

instance Prelude.NFData CreateLag where
  rnf :: CreateLag -> ()
rnf CreateLag' {Int
Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
lagName :: Text
connectionsBandwidth :: Text
location :: Text
numberOfConnections :: Int
tags :: Maybe (NonEmpty Tag)
requestMACSec :: Maybe Bool
providerName :: Maybe Text
connectionId :: Maybe Text
childConnectionTags :: Maybe (NonEmpty Tag)
$sel:lagName:CreateLag' :: CreateLag -> Text
$sel:connectionsBandwidth:CreateLag' :: CreateLag -> Text
$sel:location:CreateLag' :: CreateLag -> Text
$sel:numberOfConnections:CreateLag' :: CreateLag -> Int
$sel:tags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
$sel:requestMACSec:CreateLag' :: CreateLag -> Maybe Bool
$sel:providerName:CreateLag' :: CreateLag -> Maybe Text
$sel:connectionId:CreateLag' :: CreateLag -> Maybe Text
$sel:childConnectionTags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
childConnectionTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
providerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
requestMACSec
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
numberOfConnections
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionsBandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lagName

instance Data.ToHeaders CreateLag where
  toHeaders :: CreateLag -> 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.CreateLag" :: 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 CreateLag where
  toJSON :: CreateLag -> Value
toJSON CreateLag' {Int
Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
lagName :: Text
connectionsBandwidth :: Text
location :: Text
numberOfConnections :: Int
tags :: Maybe (NonEmpty Tag)
requestMACSec :: Maybe Bool
providerName :: Maybe Text
connectionId :: Maybe Text
childConnectionTags :: Maybe (NonEmpty Tag)
$sel:lagName:CreateLag' :: CreateLag -> Text
$sel:connectionsBandwidth:CreateLag' :: CreateLag -> Text
$sel:location:CreateLag' :: CreateLag -> Text
$sel:numberOfConnections:CreateLag' :: CreateLag -> Int
$sel:tags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
$sel:requestMACSec:CreateLag' :: CreateLag -> Maybe Bool
$sel:providerName:CreateLag' :: CreateLag -> Maybe Text
$sel:connectionId:CreateLag' :: CreateLag -> Maybe Text
$sel:childConnectionTags:CreateLag' :: CreateLag -> Maybe (NonEmpty Tag)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"childConnectionTags" 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 (NonEmpty Tag)
childConnectionTags,
            (Key
"connectionId" 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
connectionId,
            (Key
"providerName" 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
providerName,
            (Key
"requestMACSec" 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 Bool
requestMACSec,
            (Key
"tags" 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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"numberOfConnections" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
numberOfConnections),
            forall a. a -> Maybe a
Prelude.Just (Key
"location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
location),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"connectionsBandwidth"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectionsBandwidth
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"lagName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
lagName)
          ]
      )

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

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