{-# 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.CreateLink
-- 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 new link for a specified site.
module Amazonka.NetworkManager.CreateLink
  ( -- * Creating a Request
    CreateLink (..),
    newCreateLink,

    -- * Request Lenses
    createLink_description,
    createLink_provider,
    createLink_tags,
    createLink_type,
    createLink_globalNetworkId,
    createLink_bandwidth,
    createLink_siteId,

    -- * Destructuring the Response
    CreateLinkResponse (..),
    newCreateLinkResponse,

    -- * Response Lenses
    createLinkResponse_link,
    createLinkResponse_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:/ 'newCreateLink' smart constructor.
data CreateLink = CreateLink'
  { -- | A description of the link.
    --
    -- Constraints: Maximum length of 256 characters.
    CreateLink -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The provider of the link.
    --
    -- Constraints: Maximum length of 128 characters. Cannot include the
    -- following characters: | \\ ^
    CreateLink -> Maybe Text
provider :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply to the resource during creation.
    CreateLink -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The type of the link.
    --
    -- Constraints: Maximum length of 128 characters. Cannot include the
    -- following characters: | \\ ^
    CreateLink -> Maybe Text
type' :: Prelude.Maybe Prelude.Text,
    -- | The ID of the global network.
    CreateLink -> Text
globalNetworkId :: Prelude.Text,
    -- | The upload speed and download speed in Mbps.
    CreateLink -> Bandwidth
bandwidth :: Bandwidth,
    -- | The ID of the site.
    CreateLink -> Text
siteId :: Prelude.Text
  }
  deriving (CreateLink -> CreateLink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLink -> CreateLink -> Bool
$c/= :: CreateLink -> CreateLink -> Bool
== :: CreateLink -> CreateLink -> Bool
$c== :: CreateLink -> CreateLink -> Bool
Prelude.Eq, ReadPrec [CreateLink]
ReadPrec CreateLink
Int -> ReadS CreateLink
ReadS [CreateLink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLink]
$creadListPrec :: ReadPrec [CreateLink]
readPrec :: ReadPrec CreateLink
$creadPrec :: ReadPrec CreateLink
readList :: ReadS [CreateLink]
$creadList :: ReadS [CreateLink]
readsPrec :: Int -> ReadS CreateLink
$creadsPrec :: Int -> ReadS CreateLink
Prelude.Read, Int -> CreateLink -> ShowS
[CreateLink] -> ShowS
CreateLink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLink] -> ShowS
$cshowList :: [CreateLink] -> ShowS
show :: CreateLink -> String
$cshow :: CreateLink -> String
showsPrec :: Int -> CreateLink -> ShowS
$cshowsPrec :: Int -> CreateLink -> ShowS
Prelude.Show, forall x. Rep CreateLink x -> CreateLink
forall x. CreateLink -> Rep CreateLink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLink x -> CreateLink
$cfrom :: forall x. CreateLink -> Rep CreateLink x
Prelude.Generic)

-- |
-- Create a value of 'CreateLink' 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:
--
-- 'description', 'createLink_description' - A description of the link.
--
-- Constraints: Maximum length of 256 characters.
--
-- 'provider', 'createLink_provider' - The provider of the link.
--
-- Constraints: Maximum length of 128 characters. Cannot include the
-- following characters: | \\ ^
--
-- 'tags', 'createLink_tags' - The tags to apply to the resource during creation.
--
-- 'type'', 'createLink_type' - The type of the link.
--
-- Constraints: Maximum length of 128 characters. Cannot include the
-- following characters: | \\ ^
--
-- 'globalNetworkId', 'createLink_globalNetworkId' - The ID of the global network.
--
-- 'bandwidth', 'createLink_bandwidth' - The upload speed and download speed in Mbps.
--
-- 'siteId', 'createLink_siteId' - The ID of the site.
newCreateLink ::
  -- | 'globalNetworkId'
  Prelude.Text ->
  -- | 'bandwidth'
  Bandwidth ->
  -- | 'siteId'
  Prelude.Text ->
  CreateLink
newCreateLink :: Text -> Bandwidth -> Text -> CreateLink
newCreateLink Text
pGlobalNetworkId_ Bandwidth
pBandwidth_ Text
pSiteId_ =
  CreateLink'
    { $sel:description:CreateLink' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:provider:CreateLink' :: Maybe Text
provider = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLink' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':CreateLink' :: Maybe Text
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:globalNetworkId:CreateLink' :: Text
globalNetworkId = Text
pGlobalNetworkId_,
      $sel:bandwidth:CreateLink' :: Bandwidth
bandwidth = Bandwidth
pBandwidth_,
      $sel:siteId:CreateLink' :: Text
siteId = Text
pSiteId_
    }

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

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

-- | The tags to apply to the resource during creation.
createLink_tags :: Lens.Lens' CreateLink (Prelude.Maybe [Tag])
createLink_tags :: Lens' CreateLink (Maybe [Tag])
createLink_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLink' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateLink' :: CreateLink -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateLink
s@CreateLink' {} Maybe [Tag]
a -> CreateLink
s {$sel:tags:CreateLink' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateLink) 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 type of the link.
--
-- Constraints: Maximum length of 128 characters. Cannot include the
-- following characters: | \\ ^
createLink_type :: Lens.Lens' CreateLink (Prelude.Maybe Prelude.Text)
createLink_type :: Lens' CreateLink (Maybe Text)
createLink_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLink' {Maybe Text
type' :: Maybe Text
$sel:type':CreateLink' :: CreateLink -> Maybe Text
type'} -> Maybe Text
type') (\s :: CreateLink
s@CreateLink' {} Maybe Text
a -> CreateLink
s {$sel:type':CreateLink' :: Maybe Text
type' = Maybe Text
a} :: CreateLink)

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

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

-- | The ID of the site.
createLink_siteId :: Lens.Lens' CreateLink Prelude.Text
createLink_siteId :: Lens' CreateLink Text
createLink_siteId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLink' {Text
siteId :: Text
$sel:siteId:CreateLink' :: CreateLink -> Text
siteId} -> Text
siteId) (\s :: CreateLink
s@CreateLink' {} Text
a -> CreateLink
s {$sel:siteId:CreateLink' :: Text
siteId = Text
a} :: CreateLink)

instance Core.AWSRequest CreateLink where
  type AWSResponse CreateLink = CreateLinkResponse
  request :: (Service -> Service) -> CreateLink -> Request CreateLink
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 CreateLink
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLink)))
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 -> CreateLinkResponse
CreateLinkResponse'
            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 CreateLink where
  hashWithSalt :: Int -> CreateLink -> Int
hashWithSalt Int
_salt CreateLink' {Maybe [Tag]
Maybe Text
Text
Bandwidth
siteId :: Text
bandwidth :: Bandwidth
globalNetworkId :: Text
type' :: Maybe Text
tags :: Maybe [Tag]
provider :: Maybe Text
description :: Maybe Text
$sel:siteId:CreateLink' :: CreateLink -> Text
$sel:bandwidth:CreateLink' :: CreateLink -> Bandwidth
$sel:globalNetworkId:CreateLink' :: CreateLink -> Text
$sel:type':CreateLink' :: CreateLink -> Maybe Text
$sel:tags:CreateLink' :: CreateLink -> Maybe [Tag]
$sel:provider:CreateLink' :: CreateLink -> Maybe Text
$sel:description:CreateLink' :: CreateLink -> Maybe Text
..} =
    Int
_salt
      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 [Tag]
tags
      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` Bandwidth
bandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
siteId

instance Prelude.NFData CreateLink where
  rnf :: CreateLink -> ()
rnf CreateLink' {Maybe [Tag]
Maybe Text
Text
Bandwidth
siteId :: Text
bandwidth :: Bandwidth
globalNetworkId :: Text
type' :: Maybe Text
tags :: Maybe [Tag]
provider :: Maybe Text
description :: Maybe Text
$sel:siteId:CreateLink' :: CreateLink -> Text
$sel:bandwidth:CreateLink' :: CreateLink -> Bandwidth
$sel:globalNetworkId:CreateLink' :: CreateLink -> Text
$sel:type':CreateLink' :: CreateLink -> Maybe Text
$sel:tags:CreateLink' :: CreateLink -> Maybe [Tag]
$sel:provider:CreateLink' :: CreateLink -> Maybe Text
$sel:description:CreateLink' :: CreateLink -> Maybe Text
..} =
    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 [Tag]
tags
      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 Bandwidth
bandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
siteId

instance Data.ToHeaders CreateLink where
  toHeaders :: CreateLink -> 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 CreateLink where
  toJSON :: CreateLink -> Value
toJSON CreateLink' {Maybe [Tag]
Maybe Text
Text
Bandwidth
siteId :: Text
bandwidth :: Bandwidth
globalNetworkId :: Text
type' :: Maybe Text
tags :: Maybe [Tag]
provider :: Maybe Text
description :: Maybe Text
$sel:siteId:CreateLink' :: CreateLink -> Text
$sel:bandwidth:CreateLink' :: CreateLink -> Bandwidth
$sel:globalNetworkId:CreateLink' :: CreateLink -> Text
$sel:type':CreateLink' :: CreateLink -> Maybe Text
$sel:tags:CreateLink' :: CreateLink -> Maybe [Tag]
$sel:provider:CreateLink' :: CreateLink -> Maybe Text
$sel:description:CreateLink' :: CreateLink -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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 [Tag]
tags,
            (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',
            forall a. a -> Maybe a
Prelude.Just (Key
"Bandwidth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bandwidth
bandwidth),
            forall a. a -> Maybe a
Prelude.Just (Key
"SiteId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
siteId)
          ]
      )

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

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

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

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

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

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

instance Prelude.NFData CreateLinkResponse where
  rnf :: CreateLinkResponse -> ()
rnf CreateLinkResponse' {Int
Maybe Link
httpStatus :: Int
link :: Maybe Link
$sel:httpStatus:CreateLinkResponse' :: CreateLinkResponse -> Int
$sel:link:CreateLinkResponse' :: CreateLinkResponse -> 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