{-# 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.Outposts.StartConnection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Amazon Web Services uses this action to install Outpost servers.
--
-- Starts the connection required for Outpost server installation.
--
-- Use CloudTrail to monitor this action or Amazon Web Services managed
-- policy for Amazon Web Services Outposts to secure it. For more
-- information, see
-- <https://docs.aws.amazon.com/outposts/latest/userguide/security-iam-awsmanpol.html Amazon Web Services managed policies for Amazon Web Services Outposts>
-- and
-- <https://docs.aws.amazon.com/outposts/latest/userguide/logging-using-cloudtrail.html Logging Amazon Web Services Outposts API calls with Amazon Web Services CloudTrail>
-- in the /Amazon Web Services Outposts User Guide/.
module Amazonka.Outposts.StartConnection
  ( -- * Creating a Request
    StartConnection (..),
    newStartConnection,

    -- * Request Lenses
    startConnection_deviceSerialNumber,
    startConnection_assetId,
    startConnection_clientPublicKey,
    startConnection_networkInterfaceDeviceIndex,

    -- * Destructuring the Response
    StartConnectionResponse (..),
    newStartConnectionResponse,

    -- * Response Lenses
    startConnectionResponse_connectionId,
    startConnectionResponse_underlayIpAddress,
    startConnectionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartConnection' smart constructor.
data StartConnection = StartConnection'
  { -- | The serial number of the dongle.
    StartConnection -> Text
deviceSerialNumber :: Prelude.Text,
    -- | The ID of the Outpost server.
    StartConnection -> Text
assetId :: Prelude.Text,
    -- | The public key of the client.
    StartConnection -> Text
clientPublicKey :: Prelude.Text,
    -- | The device index of the network interface on the Outpost server.
    StartConnection -> Natural
networkInterfaceDeviceIndex :: Prelude.Natural
  }
  deriving (StartConnection -> StartConnection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConnection -> StartConnection -> Bool
$c/= :: StartConnection -> StartConnection -> Bool
== :: StartConnection -> StartConnection -> Bool
$c== :: StartConnection -> StartConnection -> Bool
Prelude.Eq, ReadPrec [StartConnection]
ReadPrec StartConnection
Int -> ReadS StartConnection
ReadS [StartConnection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConnection]
$creadListPrec :: ReadPrec [StartConnection]
readPrec :: ReadPrec StartConnection
$creadPrec :: ReadPrec StartConnection
readList :: ReadS [StartConnection]
$creadList :: ReadS [StartConnection]
readsPrec :: Int -> ReadS StartConnection
$creadsPrec :: Int -> ReadS StartConnection
Prelude.Read, Int -> StartConnection -> ShowS
[StartConnection] -> ShowS
StartConnection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConnection] -> ShowS
$cshowList :: [StartConnection] -> ShowS
show :: StartConnection -> String
$cshow :: StartConnection -> String
showsPrec :: Int -> StartConnection -> ShowS
$cshowsPrec :: Int -> StartConnection -> ShowS
Prelude.Show, forall x. Rep StartConnection x -> StartConnection
forall x. StartConnection -> Rep StartConnection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartConnection x -> StartConnection
$cfrom :: forall x. StartConnection -> Rep StartConnection x
Prelude.Generic)

-- |
-- Create a value of 'StartConnection' 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:
--
-- 'deviceSerialNumber', 'startConnection_deviceSerialNumber' - The serial number of the dongle.
--
-- 'assetId', 'startConnection_assetId' - The ID of the Outpost server.
--
-- 'clientPublicKey', 'startConnection_clientPublicKey' - The public key of the client.
--
-- 'networkInterfaceDeviceIndex', 'startConnection_networkInterfaceDeviceIndex' - The device index of the network interface on the Outpost server.
newStartConnection ::
  -- | 'deviceSerialNumber'
  Prelude.Text ->
  -- | 'assetId'
  Prelude.Text ->
  -- | 'clientPublicKey'
  Prelude.Text ->
  -- | 'networkInterfaceDeviceIndex'
  Prelude.Natural ->
  StartConnection
newStartConnection :: Text -> Text -> Text -> Natural -> StartConnection
newStartConnection
  Text
pDeviceSerialNumber_
  Text
pAssetId_
  Text
pClientPublicKey_
  Natural
pNetworkInterfaceDeviceIndex_ =
    StartConnection'
      { $sel:deviceSerialNumber:StartConnection' :: Text
deviceSerialNumber =
          Text
pDeviceSerialNumber_,
        $sel:assetId:StartConnection' :: Text
assetId = Text
pAssetId_,
        $sel:clientPublicKey:StartConnection' :: Text
clientPublicKey = Text
pClientPublicKey_,
        $sel:networkInterfaceDeviceIndex:StartConnection' :: Natural
networkInterfaceDeviceIndex =
          Natural
pNetworkInterfaceDeviceIndex_
      }

-- | The serial number of the dongle.
startConnection_deviceSerialNumber :: Lens.Lens' StartConnection Prelude.Text
startConnection_deviceSerialNumber :: Lens' StartConnection Text
startConnection_deviceSerialNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConnection' {Text
deviceSerialNumber :: Text
$sel:deviceSerialNumber:StartConnection' :: StartConnection -> Text
deviceSerialNumber} -> Text
deviceSerialNumber) (\s :: StartConnection
s@StartConnection' {} Text
a -> StartConnection
s {$sel:deviceSerialNumber:StartConnection' :: Text
deviceSerialNumber = Text
a} :: StartConnection)

-- | The ID of the Outpost server.
startConnection_assetId :: Lens.Lens' StartConnection Prelude.Text
startConnection_assetId :: Lens' StartConnection Text
startConnection_assetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConnection' {Text
assetId :: Text
$sel:assetId:StartConnection' :: StartConnection -> Text
assetId} -> Text
assetId) (\s :: StartConnection
s@StartConnection' {} Text
a -> StartConnection
s {$sel:assetId:StartConnection' :: Text
assetId = Text
a} :: StartConnection)

-- | The public key of the client.
startConnection_clientPublicKey :: Lens.Lens' StartConnection Prelude.Text
startConnection_clientPublicKey :: Lens' StartConnection Text
startConnection_clientPublicKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConnection' {Text
clientPublicKey :: Text
$sel:clientPublicKey:StartConnection' :: StartConnection -> Text
clientPublicKey} -> Text
clientPublicKey) (\s :: StartConnection
s@StartConnection' {} Text
a -> StartConnection
s {$sel:clientPublicKey:StartConnection' :: Text
clientPublicKey = Text
a} :: StartConnection)

-- | The device index of the network interface on the Outpost server.
startConnection_networkInterfaceDeviceIndex :: Lens.Lens' StartConnection Prelude.Natural
startConnection_networkInterfaceDeviceIndex :: Lens' StartConnection Natural
startConnection_networkInterfaceDeviceIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConnection' {Natural
networkInterfaceDeviceIndex :: Natural
$sel:networkInterfaceDeviceIndex:StartConnection' :: StartConnection -> Natural
networkInterfaceDeviceIndex} -> Natural
networkInterfaceDeviceIndex) (\s :: StartConnection
s@StartConnection' {} Natural
a -> StartConnection
s {$sel:networkInterfaceDeviceIndex:StartConnection' :: Natural
networkInterfaceDeviceIndex = Natural
a} :: StartConnection)

instance Core.AWSRequest StartConnection where
  type
    AWSResponse StartConnection =
      StartConnectionResponse
  request :: (Service -> Service) -> StartConnection -> Request StartConnection
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 StartConnection
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartConnection)))
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 Text -> Maybe Text -> Int -> StartConnectionResponse
StartConnectionResponse'
            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
"ConnectionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UnderlayIpAddress")
            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 StartConnection where
  hashWithSalt :: Int -> StartConnection -> Int
hashWithSalt Int
_salt StartConnection' {Natural
Text
networkInterfaceDeviceIndex :: Natural
clientPublicKey :: Text
assetId :: Text
deviceSerialNumber :: Text
$sel:networkInterfaceDeviceIndex:StartConnection' :: StartConnection -> Natural
$sel:clientPublicKey:StartConnection' :: StartConnection -> Text
$sel:assetId:StartConnection' :: StartConnection -> Text
$sel:deviceSerialNumber:StartConnection' :: StartConnection -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceSerialNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
assetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientPublicKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
networkInterfaceDeviceIndex

instance Prelude.NFData StartConnection where
  rnf :: StartConnection -> ()
rnf StartConnection' {Natural
Text
networkInterfaceDeviceIndex :: Natural
clientPublicKey :: Text
assetId :: Text
deviceSerialNumber :: Text
$sel:networkInterfaceDeviceIndex:StartConnection' :: StartConnection -> Natural
$sel:clientPublicKey:StartConnection' :: StartConnection -> Text
$sel:assetId:StartConnection' :: StartConnection -> Text
$sel:deviceSerialNumber:StartConnection' :: StartConnection -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
deviceSerialNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
assetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientPublicKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
networkInterfaceDeviceIndex

instance Data.ToHeaders StartConnection where
  toHeaders :: StartConnection -> 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 StartConnection where
  toJSON :: StartConnection -> Value
toJSON StartConnection' {Natural
Text
networkInterfaceDeviceIndex :: Natural
clientPublicKey :: Text
assetId :: Text
deviceSerialNumber :: Text
$sel:networkInterfaceDeviceIndex:StartConnection' :: StartConnection -> Natural
$sel:clientPublicKey:StartConnection' :: StartConnection -> Text
$sel:assetId:StartConnection' :: StartConnection -> Text
$sel:deviceSerialNumber:StartConnection' :: StartConnection -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"DeviceSerialNumber" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deviceSerialNumber),
            forall a. a -> Maybe a
Prelude.Just (Key
"AssetId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
assetId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ClientPublicKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientPublicKey),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"NetworkInterfaceDeviceIndex"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
networkInterfaceDeviceIndex
              )
          ]
      )

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

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

-- | /See:/ 'newStartConnectionResponse' smart constructor.
data StartConnectionResponse = StartConnectionResponse'
  { -- | The ID of the connection.
    StartConnectionResponse -> Maybe Text
connectionId :: Prelude.Maybe Prelude.Text,
    -- | The underlay IP address.
    StartConnectionResponse -> Maybe Text
underlayIpAddress :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartConnectionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartConnectionResponse -> StartConnectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartConnectionResponse -> StartConnectionResponse -> Bool
$c/= :: StartConnectionResponse -> StartConnectionResponse -> Bool
== :: StartConnectionResponse -> StartConnectionResponse -> Bool
$c== :: StartConnectionResponse -> StartConnectionResponse -> Bool
Prelude.Eq, ReadPrec [StartConnectionResponse]
ReadPrec StartConnectionResponse
Int -> ReadS StartConnectionResponse
ReadS [StartConnectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartConnectionResponse]
$creadListPrec :: ReadPrec [StartConnectionResponse]
readPrec :: ReadPrec StartConnectionResponse
$creadPrec :: ReadPrec StartConnectionResponse
readList :: ReadS [StartConnectionResponse]
$creadList :: ReadS [StartConnectionResponse]
readsPrec :: Int -> ReadS StartConnectionResponse
$creadsPrec :: Int -> ReadS StartConnectionResponse
Prelude.Read, Int -> StartConnectionResponse -> ShowS
[StartConnectionResponse] -> ShowS
StartConnectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartConnectionResponse] -> ShowS
$cshowList :: [StartConnectionResponse] -> ShowS
show :: StartConnectionResponse -> String
$cshow :: StartConnectionResponse -> String
showsPrec :: Int -> StartConnectionResponse -> ShowS
$cshowsPrec :: Int -> StartConnectionResponse -> ShowS
Prelude.Show, forall x. Rep StartConnectionResponse x -> StartConnectionResponse
forall x. StartConnectionResponse -> Rep StartConnectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartConnectionResponse x -> StartConnectionResponse
$cfrom :: forall x. StartConnectionResponse -> Rep StartConnectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartConnectionResponse' 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', 'startConnectionResponse_connectionId' - The ID of the connection.
--
-- 'underlayIpAddress', 'startConnectionResponse_underlayIpAddress' - The underlay IP address.
--
-- 'httpStatus', 'startConnectionResponse_httpStatus' - The response's http status code.
newStartConnectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartConnectionResponse
newStartConnectionResponse :: Int -> StartConnectionResponse
newStartConnectionResponse Int
pHttpStatus_ =
  StartConnectionResponse'
    { $sel:connectionId:StartConnectionResponse' :: Maybe Text
connectionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:underlayIpAddress:StartConnectionResponse' :: Maybe Text
underlayIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartConnectionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | The underlay IP address.
startConnectionResponse_underlayIpAddress :: Lens.Lens' StartConnectionResponse (Prelude.Maybe Prelude.Text)
startConnectionResponse_underlayIpAddress :: Lens' StartConnectionResponse (Maybe Text)
startConnectionResponse_underlayIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartConnectionResponse' {Maybe Text
underlayIpAddress :: Maybe Text
$sel:underlayIpAddress:StartConnectionResponse' :: StartConnectionResponse -> Maybe Text
underlayIpAddress} -> Maybe Text
underlayIpAddress) (\s :: StartConnectionResponse
s@StartConnectionResponse' {} Maybe Text
a -> StartConnectionResponse
s {$sel:underlayIpAddress:StartConnectionResponse' :: Maybe Text
underlayIpAddress = Maybe Text
a} :: StartConnectionResponse)

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

instance Prelude.NFData StartConnectionResponse where
  rnf :: StartConnectionResponse -> ()
rnf StartConnectionResponse' {Int
Maybe Text
httpStatus :: Int
underlayIpAddress :: Maybe Text
connectionId :: Maybe Text
$sel:httpStatus:StartConnectionResponse' :: StartConnectionResponse -> Int
$sel:underlayIpAddress:StartConnectionResponse' :: StartConnectionResponse -> Maybe Text
$sel:connectionId:StartConnectionResponse' :: StartConnectionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
underlayIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus