{-# 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.PrivateNetworks.ConfigureAccessPoint
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Configures the specified network resource.
--
-- Use this action to specify the geographic position of the hardware. You
-- must provide Certified Professional Installer (CPI) credentials in the
-- request so that we can obtain spectrum grants. For more information, see
-- <https://docs.aws.amazon.com/private-networks/latest/userguide/radio-units.html Radio units>
-- in the /Amazon Web Services Private 5G User Guide/.
module Amazonka.PrivateNetworks.ConfigureAccessPoint
  ( -- * Creating a Request
    ConfigureAccessPoint (..),
    newConfigureAccessPoint,

    -- * Request Lenses
    configureAccessPoint_cpiSecretKey,
    configureAccessPoint_cpiUserId,
    configureAccessPoint_cpiUserPassword,
    configureAccessPoint_cpiUsername,
    configureAccessPoint_position,
    configureAccessPoint_accessPointArn,

    -- * Destructuring the Response
    ConfigureAccessPointResponse (..),
    newConfigureAccessPointResponse,

    -- * Response Lenses
    configureAccessPointResponse_httpStatus,
    configureAccessPointResponse_accessPoint,
  )
where

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

-- | /See:/ 'newConfigureAccessPoint' smart constructor.
data ConfigureAccessPoint = ConfigureAccessPoint'
  { -- | A Base64 encoded string of the CPI certificate associated with the CPI
    -- user who is certifying the coordinates of the network resource.
    ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiSecretKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The CPI user ID of the CPI user who is certifying the coordinates of the
    -- network resource.
    ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUserId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The CPI password associated with the CPI certificate in @cpiSecretKey@.
    ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUserPassword :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The CPI user name of the CPI user who is certifying the coordinates of
    -- the radio unit.
    ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUsername :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The position of the network resource.
    ConfigureAccessPoint -> Maybe Position
position :: Prelude.Maybe Position,
    -- | The Amazon Resource Name (ARN) of the network resource.
    ConfigureAccessPoint -> Text
accessPointArn :: Prelude.Text
  }
  deriving (ConfigureAccessPoint -> ConfigureAccessPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigureAccessPoint -> ConfigureAccessPoint -> Bool
$c/= :: ConfigureAccessPoint -> ConfigureAccessPoint -> Bool
== :: ConfigureAccessPoint -> ConfigureAccessPoint -> Bool
$c== :: ConfigureAccessPoint -> ConfigureAccessPoint -> Bool
Prelude.Eq, Int -> ConfigureAccessPoint -> ShowS
[ConfigureAccessPoint] -> ShowS
ConfigureAccessPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigureAccessPoint] -> ShowS
$cshowList :: [ConfigureAccessPoint] -> ShowS
show :: ConfigureAccessPoint -> String
$cshow :: ConfigureAccessPoint -> String
showsPrec :: Int -> ConfigureAccessPoint -> ShowS
$cshowsPrec :: Int -> ConfigureAccessPoint -> ShowS
Prelude.Show, forall x. Rep ConfigureAccessPoint x -> ConfigureAccessPoint
forall x. ConfigureAccessPoint -> Rep ConfigureAccessPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConfigureAccessPoint x -> ConfigureAccessPoint
$cfrom :: forall x. ConfigureAccessPoint -> Rep ConfigureAccessPoint x
Prelude.Generic)

-- |
-- Create a value of 'ConfigureAccessPoint' 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:
--
-- 'cpiSecretKey', 'configureAccessPoint_cpiSecretKey' - A Base64 encoded string of the CPI certificate associated with the CPI
-- user who is certifying the coordinates of the network resource.
--
-- 'cpiUserId', 'configureAccessPoint_cpiUserId' - The CPI user ID of the CPI user who is certifying the coordinates of the
-- network resource.
--
-- 'cpiUserPassword', 'configureAccessPoint_cpiUserPassword' - The CPI password associated with the CPI certificate in @cpiSecretKey@.
--
-- 'cpiUsername', 'configureAccessPoint_cpiUsername' - The CPI user name of the CPI user who is certifying the coordinates of
-- the radio unit.
--
-- 'position', 'configureAccessPoint_position' - The position of the network resource.
--
-- 'accessPointArn', 'configureAccessPoint_accessPointArn' - The Amazon Resource Name (ARN) of the network resource.
newConfigureAccessPoint ::
  -- | 'accessPointArn'
  Prelude.Text ->
  ConfigureAccessPoint
newConfigureAccessPoint :: Text -> ConfigureAccessPoint
newConfigureAccessPoint Text
pAccessPointArn_ =
  ConfigureAccessPoint'
    { $sel:cpiSecretKey:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiSecretKey =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cpiUserId:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUserId = forall a. Maybe a
Prelude.Nothing,
      $sel:cpiUserPassword:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUserPassword = forall a. Maybe a
Prelude.Nothing,
      $sel:cpiUsername:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUsername = forall a. Maybe a
Prelude.Nothing,
      $sel:position:ConfigureAccessPoint' :: Maybe Position
position = forall a. Maybe a
Prelude.Nothing,
      $sel:accessPointArn:ConfigureAccessPoint' :: Text
accessPointArn = Text
pAccessPointArn_
    }

-- | A Base64 encoded string of the CPI certificate associated with the CPI
-- user who is certifying the coordinates of the network resource.
configureAccessPoint_cpiSecretKey :: Lens.Lens' ConfigureAccessPoint (Prelude.Maybe Prelude.Text)
configureAccessPoint_cpiSecretKey :: Lens' ConfigureAccessPoint (Maybe Text)
configureAccessPoint_cpiSecretKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Maybe (Sensitive Text)
cpiSecretKey :: Maybe (Sensitive Text)
$sel:cpiSecretKey:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiSecretKey} -> Maybe (Sensitive Text)
cpiSecretKey) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Maybe (Sensitive Text)
a -> ConfigureAccessPoint
s {$sel:cpiSecretKey:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiSecretKey = Maybe (Sensitive Text)
a} :: ConfigureAccessPoint) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The CPI user ID of the CPI user who is certifying the coordinates of the
-- network resource.
configureAccessPoint_cpiUserId :: Lens.Lens' ConfigureAccessPoint (Prelude.Maybe Prelude.Text)
configureAccessPoint_cpiUserId :: Lens' ConfigureAccessPoint (Maybe Text)
configureAccessPoint_cpiUserId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Maybe (Sensitive Text)
cpiUserId :: Maybe (Sensitive Text)
$sel:cpiUserId:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUserId} -> Maybe (Sensitive Text)
cpiUserId) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Maybe (Sensitive Text)
a -> ConfigureAccessPoint
s {$sel:cpiUserId:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUserId = Maybe (Sensitive Text)
a} :: ConfigureAccessPoint) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The CPI password associated with the CPI certificate in @cpiSecretKey@.
configureAccessPoint_cpiUserPassword :: Lens.Lens' ConfigureAccessPoint (Prelude.Maybe Prelude.Text)
configureAccessPoint_cpiUserPassword :: Lens' ConfigureAccessPoint (Maybe Text)
configureAccessPoint_cpiUserPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Maybe (Sensitive Text)
cpiUserPassword :: Maybe (Sensitive Text)
$sel:cpiUserPassword:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUserPassword} -> Maybe (Sensitive Text)
cpiUserPassword) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Maybe (Sensitive Text)
a -> ConfigureAccessPoint
s {$sel:cpiUserPassword:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUserPassword = Maybe (Sensitive Text)
a} :: ConfigureAccessPoint) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The CPI user name of the CPI user who is certifying the coordinates of
-- the radio unit.
configureAccessPoint_cpiUsername :: Lens.Lens' ConfigureAccessPoint (Prelude.Maybe Prelude.Text)
configureAccessPoint_cpiUsername :: Lens' ConfigureAccessPoint (Maybe Text)
configureAccessPoint_cpiUsername = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Maybe (Sensitive Text)
cpiUsername :: Maybe (Sensitive Text)
$sel:cpiUsername:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
cpiUsername} -> Maybe (Sensitive Text)
cpiUsername) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Maybe (Sensitive Text)
a -> ConfigureAccessPoint
s {$sel:cpiUsername:ConfigureAccessPoint' :: Maybe (Sensitive Text)
cpiUsername = Maybe (Sensitive Text)
a} :: ConfigureAccessPoint) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The position of the network resource.
configureAccessPoint_position :: Lens.Lens' ConfigureAccessPoint (Prelude.Maybe Position)
configureAccessPoint_position :: Lens' ConfigureAccessPoint (Maybe Position)
configureAccessPoint_position = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Maybe Position
position :: Maybe Position
$sel:position:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe Position
position} -> Maybe Position
position) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Maybe Position
a -> ConfigureAccessPoint
s {$sel:position:ConfigureAccessPoint' :: Maybe Position
position = Maybe Position
a} :: ConfigureAccessPoint)

-- | The Amazon Resource Name (ARN) of the network resource.
configureAccessPoint_accessPointArn :: Lens.Lens' ConfigureAccessPoint Prelude.Text
configureAccessPoint_accessPointArn :: Lens' ConfigureAccessPoint Text
configureAccessPoint_accessPointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPoint' {Text
accessPointArn :: Text
$sel:accessPointArn:ConfigureAccessPoint' :: ConfigureAccessPoint -> Text
accessPointArn} -> Text
accessPointArn) (\s :: ConfigureAccessPoint
s@ConfigureAccessPoint' {} Text
a -> ConfigureAccessPoint
s {$sel:accessPointArn:ConfigureAccessPoint' :: Text
accessPointArn = Text
a} :: ConfigureAccessPoint)

instance Core.AWSRequest ConfigureAccessPoint where
  type
    AWSResponse ConfigureAccessPoint =
      ConfigureAccessPointResponse
  request :: (Service -> Service)
-> ConfigureAccessPoint -> Request ConfigureAccessPoint
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 ConfigureAccessPoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ConfigureAccessPoint)))
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 ->
          Int -> NetworkResource -> ConfigureAccessPointResponse
ConfigureAccessPointResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"accessPoint")
      )

instance Prelude.Hashable ConfigureAccessPoint where
  hashWithSalt :: Int -> ConfigureAccessPoint -> Int
hashWithSalt Int
_salt ConfigureAccessPoint' {Maybe (Sensitive Text)
Maybe Position
Text
accessPointArn :: Text
position :: Maybe Position
cpiUsername :: Maybe (Sensitive Text)
cpiUserPassword :: Maybe (Sensitive Text)
cpiUserId :: Maybe (Sensitive Text)
cpiSecretKey :: Maybe (Sensitive Text)
$sel:accessPointArn:ConfigureAccessPoint' :: ConfigureAccessPoint -> Text
$sel:position:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe Position
$sel:cpiUsername:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserPassword:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserId:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiSecretKey:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
cpiSecretKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
cpiUserId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
cpiUserPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
cpiUsername
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Position
position
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accessPointArn

instance Prelude.NFData ConfigureAccessPoint where
  rnf :: ConfigureAccessPoint -> ()
rnf ConfigureAccessPoint' {Maybe (Sensitive Text)
Maybe Position
Text
accessPointArn :: Text
position :: Maybe Position
cpiUsername :: Maybe (Sensitive Text)
cpiUserPassword :: Maybe (Sensitive Text)
cpiUserId :: Maybe (Sensitive Text)
cpiSecretKey :: Maybe (Sensitive Text)
$sel:accessPointArn:ConfigureAccessPoint' :: ConfigureAccessPoint -> Text
$sel:position:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe Position
$sel:cpiUsername:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserPassword:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserId:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiSecretKey:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
cpiSecretKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
cpiUserId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
cpiUserPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
cpiUsername
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Position
position
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accessPointArn

instance Data.ToHeaders ConfigureAccessPoint where
  toHeaders :: ConfigureAccessPoint -> 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 ConfigureAccessPoint where
  toJSON :: ConfigureAccessPoint -> Value
toJSON ConfigureAccessPoint' {Maybe (Sensitive Text)
Maybe Position
Text
accessPointArn :: Text
position :: Maybe Position
cpiUsername :: Maybe (Sensitive Text)
cpiUserPassword :: Maybe (Sensitive Text)
cpiUserId :: Maybe (Sensitive Text)
cpiSecretKey :: Maybe (Sensitive Text)
$sel:accessPointArn:ConfigureAccessPoint' :: ConfigureAccessPoint -> Text
$sel:position:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe Position
$sel:cpiUsername:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserPassword:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiUserId:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
$sel:cpiSecretKey:ConfigureAccessPoint' :: ConfigureAccessPoint -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cpiSecretKey" 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 (Sensitive Text)
cpiSecretKey,
            (Key
"cpiUserId" 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 (Sensitive Text)
cpiUserId,
            (Key
"cpiUserPassword" 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 (Sensitive Text)
cpiUserPassword,
            (Key
"cpiUsername" 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 (Sensitive Text)
cpiUsername,
            (Key
"position" 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 Position
position,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"accessPointArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
accessPointArn)
          ]
      )

instance Data.ToPath ConfigureAccessPoint where
  toPath :: ConfigureAccessPoint -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/v1/network-resources/configure"

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

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

-- |
-- Create a value of 'ConfigureAccessPointResponse' 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:
--
-- 'httpStatus', 'configureAccessPointResponse_httpStatus' - The response's http status code.
--
-- 'accessPoint', 'configureAccessPointResponse_accessPoint' - Information about the network resource.
newConfigureAccessPointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'accessPoint'
  NetworkResource ->
  ConfigureAccessPointResponse
newConfigureAccessPointResponse :: Int -> NetworkResource -> ConfigureAccessPointResponse
newConfigureAccessPointResponse
  Int
pHttpStatus_
  NetworkResource
pAccessPoint_ =
    ConfigureAccessPointResponse'
      { $sel:httpStatus:ConfigureAccessPointResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:accessPoint:ConfigureAccessPointResponse' :: NetworkResource
accessPoint = NetworkResource
pAccessPoint_
      }

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

-- | Information about the network resource.
configureAccessPointResponse_accessPoint :: Lens.Lens' ConfigureAccessPointResponse NetworkResource
configureAccessPointResponse_accessPoint :: Lens' ConfigureAccessPointResponse NetworkResource
configureAccessPointResponse_accessPoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConfigureAccessPointResponse' {NetworkResource
accessPoint :: NetworkResource
$sel:accessPoint:ConfigureAccessPointResponse' :: ConfigureAccessPointResponse -> NetworkResource
accessPoint} -> NetworkResource
accessPoint) (\s :: ConfigureAccessPointResponse
s@ConfigureAccessPointResponse' {} NetworkResource
a -> ConfigureAccessPointResponse
s {$sel:accessPoint:ConfigureAccessPointResponse' :: NetworkResource
accessPoint = NetworkResource
a} :: ConfigureAccessPointResponse)

instance Prelude.NFData ConfigureAccessPointResponse where
  rnf :: ConfigureAccessPointResponse -> ()
rnf ConfigureAccessPointResponse' {Int
NetworkResource
accessPoint :: NetworkResource
httpStatus :: Int
$sel:accessPoint:ConfigureAccessPointResponse' :: ConfigureAccessPointResponse -> NetworkResource
$sel:httpStatus:ConfigureAccessPointResponse' :: ConfigureAccessPointResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NetworkResource
accessPoint