{-# 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.UpdateLag
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the attributes of the specified link aggregation group (LAG).
--
-- You can update the following LAG attributes:
--
-- -   The name of the LAG.
--
-- -   The value for the minimum number of connections that must be
--     operational for the LAG itself to be operational.
--
-- -   The LAG\'s MACsec encryption mode.
--
--     Amazon Web Services assigns this value to each connection which is
--     part of the LAG.
--
-- -   The tags
--
-- If you adjust the threshold value for the minimum number of operational
-- connections, ensure that the new value does not cause the LAG to fall
-- below the threshold and become non-operational.
module Amazonka.DirectConnect.UpdateLag
  ( -- * Creating a Request
    UpdateLag (..),
    newUpdateLag,

    -- * Request Lenses
    updateLag_encryptionMode,
    updateLag_lagName,
    updateLag_minimumLinks,
    updateLag_lagId,

    -- * 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:/ 'newUpdateLag' smart constructor.
data UpdateLag = UpdateLag'
  { -- | The LAG MAC Security (MACsec) encryption mode.
    --
    -- Amazon Web Services applies the value to all connections which are part
    -- of the LAG.
    UpdateLag -> Maybe Text
encryptionMode :: Prelude.Maybe Prelude.Text,
    -- | The name of the LAG.
    UpdateLag -> Maybe Text
lagName :: Prelude.Maybe Prelude.Text,
    -- | The minimum number of physical connections that must be operational for
    -- the LAG itself to be operational.
    UpdateLag -> Maybe Int
minimumLinks :: Prelude.Maybe Prelude.Int,
    -- | The ID of the LAG.
    UpdateLag -> Text
lagId :: Prelude.Text
  }
  deriving (UpdateLag -> UpdateLag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLag -> UpdateLag -> Bool
$c/= :: UpdateLag -> UpdateLag -> Bool
== :: UpdateLag -> UpdateLag -> Bool
$c== :: UpdateLag -> UpdateLag -> Bool
Prelude.Eq, ReadPrec [UpdateLag]
ReadPrec UpdateLag
Int -> ReadS UpdateLag
ReadS [UpdateLag]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLag]
$creadListPrec :: ReadPrec [UpdateLag]
readPrec :: ReadPrec UpdateLag
$creadPrec :: ReadPrec UpdateLag
readList :: ReadS [UpdateLag]
$creadList :: ReadS [UpdateLag]
readsPrec :: Int -> ReadS UpdateLag
$creadsPrec :: Int -> ReadS UpdateLag
Prelude.Read, Int -> UpdateLag -> ShowS
[UpdateLag] -> ShowS
UpdateLag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLag] -> ShowS
$cshowList :: [UpdateLag] -> ShowS
show :: UpdateLag -> String
$cshow :: UpdateLag -> String
showsPrec :: Int -> UpdateLag -> ShowS
$cshowsPrec :: Int -> UpdateLag -> ShowS
Prelude.Show, forall x. Rep UpdateLag x -> UpdateLag
forall x. UpdateLag -> Rep UpdateLag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLag x -> UpdateLag
$cfrom :: forall x. UpdateLag -> Rep UpdateLag x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLag' 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:
--
-- 'encryptionMode', 'updateLag_encryptionMode' - The LAG MAC Security (MACsec) encryption mode.
--
-- Amazon Web Services applies the value to all connections which are part
-- of the LAG.
--
-- 'lagName', 'updateLag_lagName' - The name of the LAG.
--
-- 'minimumLinks', 'updateLag_minimumLinks' - The minimum number of physical connections that must be operational for
-- the LAG itself to be operational.
--
-- 'lagId', 'updateLag_lagId' - The ID of the LAG.
newUpdateLag ::
  -- | 'lagId'
  Prelude.Text ->
  UpdateLag
newUpdateLag :: Text -> UpdateLag
newUpdateLag Text
pLagId_ =
  UpdateLag'
    { $sel:encryptionMode:UpdateLag' :: Maybe Text
encryptionMode = forall a. Maybe a
Prelude.Nothing,
      $sel:lagName:UpdateLag' :: Maybe Text
lagName = forall a. Maybe a
Prelude.Nothing,
      $sel:minimumLinks:UpdateLag' :: Maybe Int
minimumLinks = forall a. Maybe a
Prelude.Nothing,
      $sel:lagId:UpdateLag' :: Text
lagId = Text
pLagId_
    }

-- | The LAG MAC Security (MACsec) encryption mode.
--
-- Amazon Web Services applies the value to all connections which are part
-- of the LAG.
updateLag_encryptionMode :: Lens.Lens' UpdateLag (Prelude.Maybe Prelude.Text)
updateLag_encryptionMode :: Lens' UpdateLag (Maybe Text)
updateLag_encryptionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLag' {Maybe Text
encryptionMode :: Maybe Text
$sel:encryptionMode:UpdateLag' :: UpdateLag -> Maybe Text
encryptionMode} -> Maybe Text
encryptionMode) (\s :: UpdateLag
s@UpdateLag' {} Maybe Text
a -> UpdateLag
s {$sel:encryptionMode:UpdateLag' :: Maybe Text
encryptionMode = Maybe Text
a} :: UpdateLag)

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

-- | The minimum number of physical connections that must be operational for
-- the LAG itself to be operational.
updateLag_minimumLinks :: Lens.Lens' UpdateLag (Prelude.Maybe Prelude.Int)
updateLag_minimumLinks :: Lens' UpdateLag (Maybe Int)
updateLag_minimumLinks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLag' {Maybe Int
minimumLinks :: Maybe Int
$sel:minimumLinks:UpdateLag' :: UpdateLag -> Maybe Int
minimumLinks} -> Maybe Int
minimumLinks) (\s :: UpdateLag
s@UpdateLag' {} Maybe Int
a -> UpdateLag
s {$sel:minimumLinks:UpdateLag' :: Maybe Int
minimumLinks = Maybe Int
a} :: UpdateLag)

-- | The ID of the LAG.
updateLag_lagId :: Lens.Lens' UpdateLag Prelude.Text
updateLag_lagId :: Lens' UpdateLag Text
updateLag_lagId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLag' {Text
lagId :: Text
$sel:lagId:UpdateLag' :: UpdateLag -> Text
lagId} -> Text
lagId) (\s :: UpdateLag
s@UpdateLag' {} Text
a -> UpdateLag
s {$sel:lagId:UpdateLag' :: Text
lagId = Text
a} :: UpdateLag)

instance Core.AWSRequest UpdateLag where
  type AWSResponse UpdateLag = Lag
  request :: (Service -> Service) -> UpdateLag -> Request UpdateLag
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 UpdateLag
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLag)))
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 UpdateLag where
  hashWithSalt :: Int -> UpdateLag -> Int
hashWithSalt Int
_salt UpdateLag' {Maybe Int
Maybe Text
Text
lagId :: Text
minimumLinks :: Maybe Int
lagName :: Maybe Text
encryptionMode :: Maybe Text
$sel:lagId:UpdateLag' :: UpdateLag -> Text
$sel:minimumLinks:UpdateLag' :: UpdateLag -> Maybe Int
$sel:lagName:UpdateLag' :: UpdateLag -> Maybe Text
$sel:encryptionMode:UpdateLag' :: UpdateLag -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
encryptionMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lagName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minimumLinks
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lagId

instance Prelude.NFData UpdateLag where
  rnf :: UpdateLag -> ()
rnf UpdateLag' {Maybe Int
Maybe Text
Text
lagId :: Text
minimumLinks :: Maybe Int
lagName :: Maybe Text
encryptionMode :: Maybe Text
$sel:lagId:UpdateLag' :: UpdateLag -> Text
$sel:minimumLinks:UpdateLag' :: UpdateLag -> Maybe Int
$sel:lagName:UpdateLag' :: UpdateLag -> Maybe Text
$sel:encryptionMode:UpdateLag' :: UpdateLag -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
encryptionMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lagName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minimumLinks
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lagId

instance Data.ToHeaders UpdateLag where
  toHeaders :: UpdateLag -> 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.UpdateLag" :: 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 UpdateLag where
  toJSON :: UpdateLag -> Value
toJSON UpdateLag' {Maybe Int
Maybe Text
Text
lagId :: Text
minimumLinks :: Maybe Int
lagName :: Maybe Text
encryptionMode :: Maybe Text
$sel:lagId:UpdateLag' :: UpdateLag -> Text
$sel:minimumLinks:UpdateLag' :: UpdateLag -> Maybe Int
$sel:lagName:UpdateLag' :: UpdateLag -> Maybe Text
$sel:encryptionMode:UpdateLag' :: UpdateLag -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"encryptionMode" 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
encryptionMode,
            (Key
"lagName" 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
lagName,
            (Key
"minimumLinks" 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
minimumLinks,
            forall a. a -> Maybe a
Prelude.Just (Key
"lagId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
lagId)
          ]
      )

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

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