{-# 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.CreateConnection
-- 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 connection between a customer network and a specific Direct
-- Connect location.
--
-- A connection links your internal network to an Direct Connect location
-- over a standard Ethernet fiber-optic cable. One end of the cable is
-- connected to your router, the other to an Direct Connect router.
--
-- To find the locations for your Region, use DescribeLocations.
--
-- You can automatically add the new connection to a link aggregation group
-- (LAG) by specifying a LAG ID in the request. This ensures that the new
-- connection is allocated on the same Direct Connect endpoint that hosts
-- the specified LAG. If there are no available ports on the endpoint, the
-- request fails and no connection is created.
module Amazonka.DirectConnect.CreateConnection
  ( -- * Creating a Request
    CreateConnection (..),
    newCreateConnection,

    -- * Request Lenses
    createConnection_lagId,
    createConnection_providerName,
    createConnection_requestMACSec,
    createConnection_tags,
    createConnection_location,
    createConnection_bandwidth,
    createConnection_connectionName,

    -- * Destructuring the Response
    Connection (..),
    newConnection,

    -- * Response Lenses
    connection_awsDevice,
    connection_awsDeviceV2,
    connection_awsLogicalDeviceId,
    connection_bandwidth,
    connection_connectionId,
    connection_connectionName,
    connection_connectionState,
    connection_encryptionMode,
    connection_hasLogicalRedundancy,
    connection_jumboFrameCapable,
    connection_lagId,
    connection_loaIssueTime,
    connection_location,
    connection_macSecCapable,
    connection_macSecKeys,
    connection_ownerAccount,
    connection_partnerName,
    connection_portEncryptionStatus,
    connection_providerName,
    connection_region,
    connection_tags,
    connection_vlan,
  )
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:/ 'newCreateConnection' smart constructor.
data CreateConnection = CreateConnection'
  { -- | The ID of the LAG.
    CreateConnection -> Maybe Text
lagId :: Prelude.Maybe Prelude.Text,
    -- | The name of the service provider associated with the requested
    -- connection.
    CreateConnection -> Maybe Text
providerName :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether you want the connection to support MAC Security
    -- (MACsec).
    --
    -- MAC Security (MACsec) is only available on dedicated connections. 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/.
    CreateConnection -> Maybe Bool
requestMACSec :: Prelude.Maybe Prelude.Bool,
    -- | The tags to associate with the lag.
    CreateConnection -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The location of the connection.
    CreateConnection -> Text
location :: Prelude.Text,
    -- | The bandwidth of the connection.
    CreateConnection -> Text
bandwidth :: Prelude.Text,
    -- | The name of the connection.
    CreateConnection -> Text
connectionName :: Prelude.Text
  }
  deriving (CreateConnection -> CreateConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnection -> CreateConnection -> Bool
$c/= :: CreateConnection -> CreateConnection -> Bool
== :: CreateConnection -> CreateConnection -> Bool
$c== :: CreateConnection -> CreateConnection -> Bool
Prelude.Eq, ReadPrec [CreateConnection]
ReadPrec CreateConnection
Int -> ReadS CreateConnection
ReadS [CreateConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnection]
$creadListPrec :: ReadPrec [CreateConnection]
readPrec :: ReadPrec CreateConnection
$creadPrec :: ReadPrec CreateConnection
readList :: ReadS [CreateConnection]
$creadList :: ReadS [CreateConnection]
readsPrec :: Int -> ReadS CreateConnection
$creadsPrec :: Int -> ReadS CreateConnection
Prelude.Read, Int -> CreateConnection -> ShowS
[CreateConnection] -> ShowS
CreateConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnection] -> ShowS
$cshowList :: [CreateConnection] -> ShowS
show :: CreateConnection -> String
$cshow :: CreateConnection -> String
showsPrec :: Int -> CreateConnection -> ShowS
$cshowsPrec :: Int -> CreateConnection -> ShowS
Prelude.Show, forall x. Rep CreateConnection x -> CreateConnection
forall x. CreateConnection -> Rep CreateConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnection x -> CreateConnection
$cfrom :: forall x. CreateConnection -> Rep CreateConnection x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnection' 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:
--
-- 'lagId', 'createConnection_lagId' - The ID of the LAG.
--
-- 'providerName', 'createConnection_providerName' - The name of the service provider associated with the requested
-- connection.
--
-- 'requestMACSec', 'createConnection_requestMACSec' - Indicates whether you want the connection to support MAC Security
-- (MACsec).
--
-- MAC Security (MACsec) is only available on dedicated connections. 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', 'createConnection_tags' - The tags to associate with the lag.
--
-- 'location', 'createConnection_location' - The location of the connection.
--
-- 'bandwidth', 'createConnection_bandwidth' - The bandwidth of the connection.
--
-- 'connectionName', 'createConnection_connectionName' - The name of the connection.
newCreateConnection ::
  -- | 'location'
  Prelude.Text ->
  -- | 'bandwidth'
  Prelude.Text ->
  -- | 'connectionName'
  Prelude.Text ->
  CreateConnection
newCreateConnection :: Text -> Text -> Text -> CreateConnection
newCreateConnection
  Text
pLocation_
  Text
pBandwidth_
  Text
pConnectionName_ =
    CreateConnection'
      { $sel:lagId:CreateConnection' :: Maybe Text
lagId = forall a. Maybe a
Prelude.Nothing,
        $sel:providerName:CreateConnection' :: Maybe Text
providerName = forall a. Maybe a
Prelude.Nothing,
        $sel:requestMACSec:CreateConnection' :: Maybe Bool
requestMACSec = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateConnection' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:location:CreateConnection' :: Text
location = Text
pLocation_,
        $sel:bandwidth:CreateConnection' :: Text
bandwidth = Text
pBandwidth_,
        $sel:connectionName:CreateConnection' :: Text
connectionName = Text
pConnectionName_
      }

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

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

-- | Indicates whether you want the connection to support MAC Security
-- (MACsec).
--
-- MAC Security (MACsec) is only available on dedicated connections. 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/.
createConnection_requestMACSec :: Lens.Lens' CreateConnection (Prelude.Maybe Prelude.Bool)
createConnection_requestMACSec :: Lens' CreateConnection (Maybe Bool)
createConnection_requestMACSec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Maybe Bool
requestMACSec :: Maybe Bool
$sel:requestMACSec:CreateConnection' :: CreateConnection -> Maybe Bool
requestMACSec} -> Maybe Bool
requestMACSec) (\s :: CreateConnection
s@CreateConnection' {} Maybe Bool
a -> CreateConnection
s {$sel:requestMACSec:CreateConnection' :: Maybe Bool
requestMACSec = Maybe Bool
a} :: CreateConnection)

-- | The tags to associate with the lag.
createConnection_tags :: Lens.Lens' CreateConnection (Prelude.Maybe (Prelude.NonEmpty Tag))
createConnection_tags :: Lens' CreateConnection (Maybe (NonEmpty Tag))
createConnection_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateConnection' :: CreateConnection -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateConnection
s@CreateConnection' {} Maybe (NonEmpty Tag)
a -> CreateConnection
s {$sel:tags:CreateConnection' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateConnection) 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 location of the connection.
createConnection_location :: Lens.Lens' CreateConnection Prelude.Text
createConnection_location :: Lens' CreateConnection Text
createConnection_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Text
location :: Text
$sel:location:CreateConnection' :: CreateConnection -> Text
location} -> Text
location) (\s :: CreateConnection
s@CreateConnection' {} Text
a -> CreateConnection
s {$sel:location:CreateConnection' :: Text
location = Text
a} :: CreateConnection)

-- | The bandwidth of the connection.
createConnection_bandwidth :: Lens.Lens' CreateConnection Prelude.Text
createConnection_bandwidth :: Lens' CreateConnection Text
createConnection_bandwidth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Text
bandwidth :: Text
$sel:bandwidth:CreateConnection' :: CreateConnection -> Text
bandwidth} -> Text
bandwidth) (\s :: CreateConnection
s@CreateConnection' {} Text
a -> CreateConnection
s {$sel:bandwidth:CreateConnection' :: Text
bandwidth = Text
a} :: CreateConnection)

-- | The name of the connection.
createConnection_connectionName :: Lens.Lens' CreateConnection Prelude.Text
createConnection_connectionName :: Lens' CreateConnection Text
createConnection_connectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnection' {Text
connectionName :: Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
connectionName} -> Text
connectionName) (\s :: CreateConnection
s@CreateConnection' {} Text
a -> CreateConnection
s {$sel:connectionName:CreateConnection' :: Text
connectionName = Text
a} :: CreateConnection)

instance Core.AWSRequest CreateConnection where
  type AWSResponse CreateConnection = Connection
  request :: (Service -> Service)
-> CreateConnection -> Request CreateConnection
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 CreateConnection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateConnection)))
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 CreateConnection where
  hashWithSalt :: Int -> CreateConnection -> Int
hashWithSalt Int
_salt CreateConnection' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
connectionName :: Text
bandwidth :: Text
location :: Text
tags :: Maybe (NonEmpty Tag)
requestMACSec :: Maybe Bool
providerName :: Maybe Text
lagId :: Maybe Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
$sel:bandwidth:CreateConnection' :: CreateConnection -> Text
$sel:location:CreateConnection' :: CreateConnection -> Text
$sel:tags:CreateConnection' :: CreateConnection -> Maybe (NonEmpty Tag)
$sel:requestMACSec:CreateConnection' :: CreateConnection -> Maybe Bool
$sel:providerName:CreateConnection' :: CreateConnection -> Maybe Text
$sel:lagId:CreateConnection' :: CreateConnection -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lagId
      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` Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionName

instance Prelude.NFData CreateConnection where
  rnf :: CreateConnection -> ()
rnf CreateConnection' {Maybe Bool
Maybe (NonEmpty Tag)
Maybe Text
Text
connectionName :: Text
bandwidth :: Text
location :: Text
tags :: Maybe (NonEmpty Tag)
requestMACSec :: Maybe Bool
providerName :: Maybe Text
lagId :: Maybe Text
$sel:connectionName:CreateConnection' :: CreateConnection -> Text
$sel:bandwidth:CreateConnection' :: CreateConnection -> Text
$sel:location:CreateConnection' :: CreateConnection -> Text
$sel:tags:CreateConnection' :: CreateConnection -> Maybe (NonEmpty Tag)
$sel:requestMACSec:CreateConnection' :: CreateConnection -> Maybe Bool
$sel:providerName:CreateConnection' :: CreateConnection -> Maybe Text
$sel:lagId:CreateConnection' :: CreateConnection -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lagId
      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 Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionName

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

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

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