{-# 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.ConfirmConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Confirms the creation of the specified hosted connection on an
-- interconnect.
--
-- Upon creation, the hosted connection is initially in the @Ordering@
-- state, and remains in this state until the owner confirms creation of
-- the hosted connection.
module Amazonka.DirectConnect.ConfirmConnection
  ( -- * Creating a Request
    ConfirmConnection (..),
    newConfirmConnection,

    -- * Request Lenses
    confirmConnection_connectionId,

    -- * Destructuring the Response
    ConfirmConnectionResponse (..),
    newConfirmConnectionResponse,

    -- * Response Lenses
    confirmConnectionResponse_connectionState,
    confirmConnectionResponse_httpStatus,
  )
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:/ 'newConfirmConnection' smart constructor.
data ConfirmConnection = ConfirmConnection'
  { -- | The ID of the hosted connection.
    ConfirmConnection -> Text
connectionId :: Prelude.Text
  }
  deriving (ConfirmConnection -> ConfirmConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmConnection -> ConfirmConnection -> Bool
$c/= :: ConfirmConnection -> ConfirmConnection -> Bool
== :: ConfirmConnection -> ConfirmConnection -> Bool
$c== :: ConfirmConnection -> ConfirmConnection -> Bool
Prelude.Eq, ReadPrec [ConfirmConnection]
ReadPrec ConfirmConnection
Int -> ReadS ConfirmConnection
ReadS [ConfirmConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmConnection]
$creadListPrec :: ReadPrec [ConfirmConnection]
readPrec :: ReadPrec ConfirmConnection
$creadPrec :: ReadPrec ConfirmConnection
readList :: ReadS [ConfirmConnection]
$creadList :: ReadS [ConfirmConnection]
readsPrec :: Int -> ReadS ConfirmConnection
$creadsPrec :: Int -> ReadS ConfirmConnection
Prelude.Read, Int -> ConfirmConnection -> ShowS
[ConfirmConnection] -> ShowS
ConfirmConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmConnection] -> ShowS
$cshowList :: [ConfirmConnection] -> ShowS
show :: ConfirmConnection -> String
$cshow :: ConfirmConnection -> String
showsPrec :: Int -> ConfirmConnection -> ShowS
$cshowsPrec :: Int -> ConfirmConnection -> ShowS
Prelude.Show, forall x. Rep ConfirmConnection x -> ConfirmConnection
forall x. ConfirmConnection -> Rep ConfirmConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfirmConnection x -> ConfirmConnection
$cfrom :: forall x. ConfirmConnection -> Rep ConfirmConnection x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmConnection' 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:
--
-- 'connectionId', 'confirmConnection_connectionId' - The ID of the hosted connection.
newConfirmConnection ::
  -- | 'connectionId'
  Prelude.Text ->
  ConfirmConnection
newConfirmConnection :: Text -> ConfirmConnection
newConfirmConnection Text
pConnectionId_ =
  ConfirmConnection' {$sel:connectionId:ConfirmConnection' :: Text
connectionId = Text
pConnectionId_}

-- | The ID of the hosted connection.
confirmConnection_connectionId :: Lens.Lens' ConfirmConnection Prelude.Text
confirmConnection_connectionId :: Lens' ConfirmConnection Text
confirmConnection_connectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmConnection' {Text
connectionId :: Text
$sel:connectionId:ConfirmConnection' :: ConfirmConnection -> Text
connectionId} -> Text
connectionId) (\s :: ConfirmConnection
s@ConfirmConnection' {} Text
a -> ConfirmConnection
s {$sel:connectionId:ConfirmConnection' :: Text
connectionId = Text
a} :: ConfirmConnection)

instance Core.AWSRequest ConfirmConnection where
  type
    AWSResponse ConfirmConnection =
      ConfirmConnectionResponse
  request :: (Service -> Service)
-> ConfirmConnection -> Request ConfirmConnection
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 ConfirmConnection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ConfirmConnection)))
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 ConnectionState -> Int -> ConfirmConnectionResponse
ConfirmConnectionResponse'
            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
"connectionState")
            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 ConfirmConnection where
  hashWithSalt :: Int -> ConfirmConnection -> Int
hashWithSalt Int
_salt ConfirmConnection' {Text
connectionId :: Text
$sel:connectionId:ConfirmConnection' :: ConfirmConnection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionId

instance Prelude.NFData ConfirmConnection where
  rnf :: ConfirmConnection -> ()
rnf ConfirmConnection' {Text
connectionId :: Text
$sel:connectionId:ConfirmConnection' :: ConfirmConnection -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
connectionId

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

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

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

-- | /See:/ 'newConfirmConnectionResponse' smart constructor.
data ConfirmConnectionResponse = ConfirmConnectionResponse'
  { -- | The state of the connection. The following are the possible values:
    --
    -- -   @ordering@: The initial state of a hosted connection provisioned on
    --     an interconnect. The connection stays in the ordering state until
    --     the owner of the hosted connection confirms or declines the
    --     connection order.
    --
    -- -   @requested@: The initial state of a standard connection. The
    --     connection stays in the requested state until the Letter of
    --     Authorization (LOA) is sent to the customer.
    --
    -- -   @pending@: The connection has been approved and is being
    --     initialized.
    --
    -- -   @available@: The network link is up and the connection is ready for
    --     use.
    --
    -- -   @down@: The network link is down.
    --
    -- -   @deleting@: The connection is being deleted.
    --
    -- -   @deleted@: The connection has been deleted.
    --
    -- -   @rejected@: A hosted connection in the @ordering@ state enters the
    --     @rejected@ state if it is deleted by the customer.
    --
    -- -   @unknown@: The state of the connection is not available.
    ConfirmConnectionResponse -> Maybe ConnectionState
connectionState :: Prelude.Maybe ConnectionState,
    -- | The response's http status code.
    ConfirmConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ConfirmConnectionResponse -> ConfirmConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmConnectionResponse -> ConfirmConnectionResponse -> Bool
$c/= :: ConfirmConnectionResponse -> ConfirmConnectionResponse -> Bool
== :: ConfirmConnectionResponse -> ConfirmConnectionResponse -> Bool
$c== :: ConfirmConnectionResponse -> ConfirmConnectionResponse -> Bool
Prelude.Eq, ReadPrec [ConfirmConnectionResponse]
ReadPrec ConfirmConnectionResponse
Int -> ReadS ConfirmConnectionResponse
ReadS [ConfirmConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfirmConnectionResponse]
$creadListPrec :: ReadPrec [ConfirmConnectionResponse]
readPrec :: ReadPrec ConfirmConnectionResponse
$creadPrec :: ReadPrec ConfirmConnectionResponse
readList :: ReadS [ConfirmConnectionResponse]
$creadList :: ReadS [ConfirmConnectionResponse]
readsPrec :: Int -> ReadS ConfirmConnectionResponse
$creadsPrec :: Int -> ReadS ConfirmConnectionResponse
Prelude.Read, Int -> ConfirmConnectionResponse -> ShowS
[ConfirmConnectionResponse] -> ShowS
ConfirmConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmConnectionResponse] -> ShowS
$cshowList :: [ConfirmConnectionResponse] -> ShowS
show :: ConfirmConnectionResponse -> String
$cshow :: ConfirmConnectionResponse -> String
showsPrec :: Int -> ConfirmConnectionResponse -> ShowS
$cshowsPrec :: Int -> ConfirmConnectionResponse -> ShowS
Prelude.Show, forall x.
Rep ConfirmConnectionResponse x -> ConfirmConnectionResponse
forall x.
ConfirmConnectionResponse -> Rep ConfirmConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConfirmConnectionResponse x -> ConfirmConnectionResponse
$cfrom :: forall x.
ConfirmConnectionResponse -> Rep ConfirmConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'ConfirmConnectionResponse' 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:
--
-- 'connectionState', 'confirmConnectionResponse_connectionState' - The state of the connection. The following are the possible values:
--
-- -   @ordering@: The initial state of a hosted connection provisioned on
--     an interconnect. The connection stays in the ordering state until
--     the owner of the hosted connection confirms or declines the
--     connection order.
--
-- -   @requested@: The initial state of a standard connection. The
--     connection stays in the requested state until the Letter of
--     Authorization (LOA) is sent to the customer.
--
-- -   @pending@: The connection has been approved and is being
--     initialized.
--
-- -   @available@: The network link is up and the connection is ready for
--     use.
--
-- -   @down@: The network link is down.
--
-- -   @deleting@: The connection is being deleted.
--
-- -   @deleted@: The connection has been deleted.
--
-- -   @rejected@: A hosted connection in the @ordering@ state enters the
--     @rejected@ state if it is deleted by the customer.
--
-- -   @unknown@: The state of the connection is not available.
--
-- 'httpStatus', 'confirmConnectionResponse_httpStatus' - The response's http status code.
newConfirmConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ConfirmConnectionResponse
newConfirmConnectionResponse :: Int -> ConfirmConnectionResponse
newConfirmConnectionResponse Int
pHttpStatus_ =
  ConfirmConnectionResponse'
    { $sel:connectionState:ConfirmConnectionResponse' :: Maybe ConnectionState
connectionState =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ConfirmConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The state of the connection. The following are the possible values:
--
-- -   @ordering@: The initial state of a hosted connection provisioned on
--     an interconnect. The connection stays in the ordering state until
--     the owner of the hosted connection confirms or declines the
--     connection order.
--
-- -   @requested@: The initial state of a standard connection. The
--     connection stays in the requested state until the Letter of
--     Authorization (LOA) is sent to the customer.
--
-- -   @pending@: The connection has been approved and is being
--     initialized.
--
-- -   @available@: The network link is up and the connection is ready for
--     use.
--
-- -   @down@: The network link is down.
--
-- -   @deleting@: The connection is being deleted.
--
-- -   @deleted@: The connection has been deleted.
--
-- -   @rejected@: A hosted connection in the @ordering@ state enters the
--     @rejected@ state if it is deleted by the customer.
--
-- -   @unknown@: The state of the connection is not available.
confirmConnectionResponse_connectionState :: Lens.Lens' ConfirmConnectionResponse (Prelude.Maybe ConnectionState)
confirmConnectionResponse_connectionState :: Lens' ConfirmConnectionResponse (Maybe ConnectionState)
confirmConnectionResponse_connectionState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfirmConnectionResponse' {Maybe ConnectionState
connectionState :: Maybe ConnectionState
$sel:connectionState:ConfirmConnectionResponse' :: ConfirmConnectionResponse -> Maybe ConnectionState
connectionState} -> Maybe ConnectionState
connectionState) (\s :: ConfirmConnectionResponse
s@ConfirmConnectionResponse' {} Maybe ConnectionState
a -> ConfirmConnectionResponse
s {$sel:connectionState:ConfirmConnectionResponse' :: Maybe ConnectionState
connectionState = Maybe ConnectionState
a} :: ConfirmConnectionResponse)

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

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