{-# 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.NetworkManager.UpdateLink
-- 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 details for an existing link. To remove information for any
-- of the parameters, specify an empty string.
module Amazonka.NetworkManager.UpdateLink
  ( -- * Creating a Request
    UpdateLink (..),
    newUpdateLink,

    -- * Request Lenses
    updateLink_bandwidth,
    updateLink_description,
    updateLink_provider,
    updateLink_type,
    updateLink_globalNetworkId,
    updateLink_linkId,

    -- * Destructuring the Response
    UpdateLinkResponse (..),
    newUpdateLinkResponse,

    -- * Response Lenses
    updateLinkResponse_link,
    updateLinkResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateLink' smart constructor.
data UpdateLink = UpdateLink'
  { -- | The upload and download speed in Mbps.
    UpdateLink -> Maybe Bandwidth
bandwidth :: Prelude.Maybe Bandwidth,
    -- | A description of the link.
    --
    -- Constraints: Maximum length of 256 characters.
    UpdateLink -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The provider of the link.
    --
    -- Constraints: Maximum length of 128 characters.
    UpdateLink -> Maybe Text
provider :: Prelude.Maybe Prelude.Text,
    -- | The type of the link.
    --
    -- Constraints: Maximum length of 128 characters.
    UpdateLink -> Maybe Text
type' :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    UpdateLink -> Text
globalNetworkId :: Prelude.Text,
    -- | The ID of the link.
    UpdateLink -> Text
linkId :: Prelude.Text
  }
  deriving (UpdateLink -> UpdateLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLink -> UpdateLink -> Bool
$c/= :: UpdateLink -> UpdateLink -> Bool
== :: UpdateLink -> UpdateLink -> Bool
$c== :: UpdateLink -> UpdateLink -> Bool
Prelude.Eq, ReadPrec [UpdateLink]
ReadPrec UpdateLink
Int -> ReadS UpdateLink
ReadS [UpdateLink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLink]
$creadListPrec :: ReadPrec [UpdateLink]
readPrec :: ReadPrec UpdateLink
$creadPrec :: ReadPrec UpdateLink
readList :: ReadS [UpdateLink]
$creadList :: ReadS [UpdateLink]
readsPrec :: Int -> ReadS UpdateLink
$creadsPrec :: Int -> ReadS UpdateLink
Prelude.Read, Int -> UpdateLink -> ShowS
[UpdateLink] -> ShowS
UpdateLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLink] -> ShowS
$cshowList :: [UpdateLink] -> ShowS
show :: UpdateLink -> String
$cshow :: UpdateLink -> String
showsPrec :: Int -> UpdateLink -> ShowS
$cshowsPrec :: Int -> UpdateLink -> ShowS
Prelude.Show, forall x. Rep UpdateLink x -> UpdateLink
forall x. UpdateLink -> Rep UpdateLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLink x -> UpdateLink
$cfrom :: forall x. UpdateLink -> Rep UpdateLink x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLink' 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:
--
-- 'bandwidth', 'updateLink_bandwidth' - The upload and download speed in Mbps.
--
-- 'description', 'updateLink_description' - A description of the link.
--
-- Constraints: Maximum length of 256 characters.
--
-- 'provider', 'updateLink_provider' - The provider of the link.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'type'', 'updateLink_type' - The type of the link.
--
-- Constraints: Maximum length of 128 characters.
--
-- 'globalNetworkId', 'updateLink_globalNetworkId' - The ID of the global network.
--
-- 'linkId', 'updateLink_linkId' - The ID of the link.
newUpdateLink ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'linkId'
  Prelude.Text ->
  UpdateLink
newUpdateLink :: Text -> Text -> UpdateLink
newUpdateLink Text
pGlobalNetworkId_ Text
pLinkId_ =
  UpdateLink'
    { $sel:bandwidth:UpdateLink' :: Maybe Bandwidth
bandwidth = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateLink' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:provider:UpdateLink' :: Maybe Text
provider = forall a. Maybe a
Prelude.Nothing,
      $sel:type':UpdateLink' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:UpdateLink' :: Text
globalNetworkId = Text
pGlobalNetworkId_,
      $sel:linkId:UpdateLink' :: Text
linkId = Text
pLinkId_
    }

-- | The upload and download speed in Mbps.
updateLink_bandwidth :: Lens.Lens' UpdateLink (Prelude.Maybe Bandwidth)
updateLink_bandwidth :: Lens' UpdateLink (Maybe Bandwidth)
updateLink_bandwidth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Maybe Bandwidth
bandwidth :: Maybe Bandwidth
$sel:bandwidth:UpdateLink' :: UpdateLink -> Maybe Bandwidth
bandwidth} -> Maybe Bandwidth
bandwidth) (\s :: UpdateLink
s@UpdateLink' {} Maybe Bandwidth
a -> UpdateLink
s {$sel:bandwidth:UpdateLink' :: Maybe Bandwidth
bandwidth = Maybe Bandwidth
a} :: UpdateLink)

-- | A description of the link.
--
-- Constraints: Maximum length of 256 characters.
updateLink_description :: Lens.Lens' UpdateLink (Prelude.Maybe Prelude.Text)
updateLink_description :: Lens' UpdateLink (Maybe Text)
updateLink_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Maybe Text
description :: Maybe Text
$sel:description:UpdateLink' :: UpdateLink -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateLink
s@UpdateLink' {} Maybe Text
a -> UpdateLink
s {$sel:description:UpdateLink' :: Maybe Text
description = Maybe Text
a} :: UpdateLink)

-- | The provider of the link.
--
-- Constraints: Maximum length of 128 characters.
updateLink_provider :: Lens.Lens' UpdateLink (Prelude.Maybe Prelude.Text)
updateLink_provider :: Lens' UpdateLink (Maybe Text)
updateLink_provider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Maybe Text
provider :: Maybe Text
$sel:provider:UpdateLink' :: UpdateLink -> Maybe Text
provider} -> Maybe Text
provider) (\s :: UpdateLink
s@UpdateLink' {} Maybe Text
a -> UpdateLink
s {$sel:provider:UpdateLink' :: Maybe Text
provider = Maybe Text
a} :: UpdateLink)

-- | The type of the link.
--
-- Constraints: Maximum length of 128 characters.
updateLink_type :: Lens.Lens' UpdateLink (Prelude.Maybe Prelude.Text)
updateLink_type :: Lens' UpdateLink (Maybe Text)
updateLink_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Maybe Text
type' :: Maybe Text
$sel:type':UpdateLink' :: UpdateLink -> Maybe Text
type'} -> Maybe Text
type') (\s :: UpdateLink
s@UpdateLink' {} Maybe Text
a -> UpdateLink
s {$sel:type':UpdateLink' :: Maybe Text
type' = Maybe Text
a} :: UpdateLink)

-- | The ID of the global network.
updateLink_globalNetworkId :: Lens.Lens' UpdateLink Prelude.Text
updateLink_globalNetworkId :: Lens' UpdateLink Text
updateLink_globalNetworkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Text
globalNetworkId :: Text
$sel:globalNetworkId:UpdateLink' :: UpdateLink -> Text
globalNetworkId} -> Text
globalNetworkId) (\s :: UpdateLink
s@UpdateLink' {} Text
a -> UpdateLink
s {$sel:globalNetworkId:UpdateLink' :: Text
globalNetworkId = Text
a} :: UpdateLink)

-- | The ID of the link.
updateLink_linkId :: Lens.Lens' UpdateLink Prelude.Text
updateLink_linkId :: Lens' UpdateLink Text
updateLink_linkId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLink' {Text
linkId :: Text
$sel:linkId:UpdateLink' :: UpdateLink -> Text
linkId} -> Text
linkId) (\s :: UpdateLink
s@UpdateLink' {} Text
a -> UpdateLink
s {$sel:linkId:UpdateLink' :: Text
linkId = Text
a} :: UpdateLink)

instance Core.AWSRequest UpdateLink where
  type AWSResponse UpdateLink = UpdateLinkResponse
  request :: (Service -> Service) -> UpdateLink -> Request UpdateLink
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLink
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLink)))
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 Link -> Int -> UpdateLinkResponse
UpdateLinkResponse'
            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
"Link")
            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 UpdateLink where
  hashWithSalt :: Int -> UpdateLink -> Int
hashWithSalt Int
_salt UpdateLink' {Maybe Text
Maybe Bandwidth
Text
linkId :: Text
globalNetworkId :: Text
type' :: Maybe Text
provider :: Maybe Text
description :: Maybe Text
bandwidth :: Maybe Bandwidth
$sel:linkId:UpdateLink' :: UpdateLink -> Text
$sel:globalNetworkId:UpdateLink' :: UpdateLink -> Text
$sel:type':UpdateLink' :: UpdateLink -> Maybe Text
$sel:provider:UpdateLink' :: UpdateLink -> Maybe Text
$sel:description:UpdateLink' :: UpdateLink -> Maybe Text
$sel:bandwidth:UpdateLink' :: UpdateLink -> Maybe Bandwidth
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bandwidth
bandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
provider
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalNetworkId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
linkId

instance Prelude.NFData UpdateLink where
  rnf :: UpdateLink -> ()
rnf UpdateLink' {Maybe Text
Maybe Bandwidth
Text
linkId :: Text
globalNetworkId :: Text
type' :: Maybe Text
provider :: Maybe Text
description :: Maybe Text
bandwidth :: Maybe Bandwidth
$sel:linkId:UpdateLink' :: UpdateLink -> Text
$sel:globalNetworkId:UpdateLink' :: UpdateLink -> Text
$sel:type':UpdateLink' :: UpdateLink -> Maybe Text
$sel:provider:UpdateLink' :: UpdateLink -> Maybe Text
$sel:description:UpdateLink' :: UpdateLink -> Maybe Text
$sel:bandwidth:UpdateLink' :: UpdateLink -> Maybe Bandwidth
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bandwidth
bandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
provider
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
globalNetworkId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
linkId

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

instance Data.ToJSON UpdateLink where
  toJSON :: UpdateLink -> Value
toJSON UpdateLink' {Maybe Text
Maybe Bandwidth
Text
linkId :: Text
globalNetworkId :: Text
type' :: Maybe Text
provider :: Maybe Text
description :: Maybe Text
bandwidth :: Maybe Bandwidth
$sel:linkId:UpdateLink' :: UpdateLink -> Text
$sel:globalNetworkId:UpdateLink' :: UpdateLink -> Text
$sel:type':UpdateLink' :: UpdateLink -> Maybe Text
$sel:provider:UpdateLink' :: UpdateLink -> Maybe Text
$sel:description:UpdateLink' :: UpdateLink -> Maybe Text
$sel:bandwidth:UpdateLink' :: UpdateLink -> Maybe Bandwidth
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Bandwidth" 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 Bandwidth
bandwidth,
            (Key
"Description" 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
description,
            (Key
"Provider" 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
provider,
            (Key
"Type" 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
type'
          ]
      )

instance Data.ToPath UpdateLink where
  toPath :: UpdateLink -> ByteString
toPath UpdateLink' {Maybe Text
Maybe Bandwidth
Text
linkId :: Text
globalNetworkId :: Text
type' :: Maybe Text
provider :: Maybe Text
description :: Maybe Text
bandwidth :: Maybe Bandwidth
$sel:linkId:UpdateLink' :: UpdateLink -> Text
$sel:globalNetworkId:UpdateLink' :: UpdateLink -> Text
$sel:type':UpdateLink' :: UpdateLink -> Maybe Text
$sel:provider:UpdateLink' :: UpdateLink -> Maybe Text
$sel:description:UpdateLink' :: UpdateLink -> Maybe Text
$sel:bandwidth:UpdateLink' :: UpdateLink -> Maybe Bandwidth
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/global-networks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
globalNetworkId,
        ByteString
"/links/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
linkId
      ]

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

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

-- |
-- Create a value of 'UpdateLinkResponse' 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:
--
-- 'link', 'updateLinkResponse_link' - Information about the link.
--
-- 'httpStatus', 'updateLinkResponse_httpStatus' - The response's http status code.
newUpdateLinkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLinkResponse
newUpdateLinkResponse :: Int -> UpdateLinkResponse
newUpdateLinkResponse Int
pHttpStatus_ =
  UpdateLinkResponse'
    { $sel:link:UpdateLinkResponse' :: Maybe Link
link = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateLinkResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the link.
updateLinkResponse_link :: Lens.Lens' UpdateLinkResponse (Prelude.Maybe Link)
updateLinkResponse_link :: Lens' UpdateLinkResponse (Maybe Link)
updateLinkResponse_link = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLinkResponse' {Maybe Link
link :: Maybe Link
$sel:link:UpdateLinkResponse' :: UpdateLinkResponse -> Maybe Link
link} -> Maybe Link
link) (\s :: UpdateLinkResponse
s@UpdateLinkResponse' {} Maybe Link
a -> UpdateLinkResponse
s {$sel:link:UpdateLinkResponse' :: Maybe Link
link = Maybe Link
a} :: UpdateLinkResponse)

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

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