{-# 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.IoTWireless.CreateNetworkAnalyzerConfiguration
-- 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 network analyzer configuration.
module Amazonka.IoTWireless.CreateNetworkAnalyzerConfiguration
  ( -- * Creating a Request
    CreateNetworkAnalyzerConfiguration (..),
    newCreateNetworkAnalyzerConfiguration,

    -- * Request Lenses
    createNetworkAnalyzerConfiguration_clientRequestToken,
    createNetworkAnalyzerConfiguration_description,
    createNetworkAnalyzerConfiguration_tags,
    createNetworkAnalyzerConfiguration_traceContent,
    createNetworkAnalyzerConfiguration_wirelessDevices,
    createNetworkAnalyzerConfiguration_wirelessGateways,
    createNetworkAnalyzerConfiguration_name,

    -- * Destructuring the Response
    CreateNetworkAnalyzerConfigurationResponse (..),
    newCreateNetworkAnalyzerConfigurationResponse,

    -- * Response Lenses
    createNetworkAnalyzerConfigurationResponse_arn,
    createNetworkAnalyzerConfigurationResponse_name,
    createNetworkAnalyzerConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateNetworkAnalyzerConfiguration' smart constructor.
data CreateNetworkAnalyzerConfiguration = CreateNetworkAnalyzerConfiguration'
  { CreateNetworkAnalyzerConfiguration -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    CreateNetworkAnalyzerConfiguration -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    CreateNetworkAnalyzerConfiguration -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    CreateNetworkAnalyzerConfiguration -> Maybe TraceContent
traceContent :: Prelude.Maybe TraceContent,
    -- | Wireless device resources to add to the network analyzer configuration.
    -- Provide the @WirelessDeviceId@ of the resource to add in the input
    -- array.
    CreateNetworkAnalyzerConfiguration -> Maybe [Text]
wirelessDevices :: Prelude.Maybe [Prelude.Text],
    -- | Wireless gateway resources to add to the network analyzer configuration.
    -- Provide the @WirelessGatewayId@ of the resource to add in the input
    -- array.
    CreateNetworkAnalyzerConfiguration -> Maybe [Text]
wirelessGateways :: Prelude.Maybe [Prelude.Text],
    CreateNetworkAnalyzerConfiguration -> Text
name :: Prelude.Text
  }
  deriving (CreateNetworkAnalyzerConfiguration
-> CreateNetworkAnalyzerConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkAnalyzerConfiguration
-> CreateNetworkAnalyzerConfiguration -> Bool
$c/= :: CreateNetworkAnalyzerConfiguration
-> CreateNetworkAnalyzerConfiguration -> Bool
== :: CreateNetworkAnalyzerConfiguration
-> CreateNetworkAnalyzerConfiguration -> Bool
$c== :: CreateNetworkAnalyzerConfiguration
-> CreateNetworkAnalyzerConfiguration -> Bool
Prelude.Eq, ReadPrec [CreateNetworkAnalyzerConfiguration]
ReadPrec CreateNetworkAnalyzerConfiguration
Int -> ReadS CreateNetworkAnalyzerConfiguration
ReadS [CreateNetworkAnalyzerConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkAnalyzerConfiguration]
$creadListPrec :: ReadPrec [CreateNetworkAnalyzerConfiguration]
readPrec :: ReadPrec CreateNetworkAnalyzerConfiguration
$creadPrec :: ReadPrec CreateNetworkAnalyzerConfiguration
readList :: ReadS [CreateNetworkAnalyzerConfiguration]
$creadList :: ReadS [CreateNetworkAnalyzerConfiguration]
readsPrec :: Int -> ReadS CreateNetworkAnalyzerConfiguration
$creadsPrec :: Int -> ReadS CreateNetworkAnalyzerConfiguration
Prelude.Read, Int -> CreateNetworkAnalyzerConfiguration -> ShowS
[CreateNetworkAnalyzerConfiguration] -> ShowS
CreateNetworkAnalyzerConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkAnalyzerConfiguration] -> ShowS
$cshowList :: [CreateNetworkAnalyzerConfiguration] -> ShowS
show :: CreateNetworkAnalyzerConfiguration -> String
$cshow :: CreateNetworkAnalyzerConfiguration -> String
showsPrec :: Int -> CreateNetworkAnalyzerConfiguration -> ShowS
$cshowsPrec :: Int -> CreateNetworkAnalyzerConfiguration -> ShowS
Prelude.Show, forall x.
Rep CreateNetworkAnalyzerConfiguration x
-> CreateNetworkAnalyzerConfiguration
forall x.
CreateNetworkAnalyzerConfiguration
-> Rep CreateNetworkAnalyzerConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNetworkAnalyzerConfiguration x
-> CreateNetworkAnalyzerConfiguration
$cfrom :: forall x.
CreateNetworkAnalyzerConfiguration
-> Rep CreateNetworkAnalyzerConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkAnalyzerConfiguration' 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:
--
-- 'clientRequestToken', 'createNetworkAnalyzerConfiguration_clientRequestToken' - Undocumented member.
--
-- 'description', 'createNetworkAnalyzerConfiguration_description' - Undocumented member.
--
-- 'tags', 'createNetworkAnalyzerConfiguration_tags' - Undocumented member.
--
-- 'traceContent', 'createNetworkAnalyzerConfiguration_traceContent' - Undocumented member.
--
-- 'wirelessDevices', 'createNetworkAnalyzerConfiguration_wirelessDevices' - Wireless device resources to add to the network analyzer configuration.
-- Provide the @WirelessDeviceId@ of the resource to add in the input
-- array.
--
-- 'wirelessGateways', 'createNetworkAnalyzerConfiguration_wirelessGateways' - Wireless gateway resources to add to the network analyzer configuration.
-- Provide the @WirelessGatewayId@ of the resource to add in the input
-- array.
--
-- 'name', 'createNetworkAnalyzerConfiguration_name' - Undocumented member.
newCreateNetworkAnalyzerConfiguration ::
  -- | 'name'
  Prelude.Text ->
  CreateNetworkAnalyzerConfiguration
newCreateNetworkAnalyzerConfiguration :: Text -> CreateNetworkAnalyzerConfiguration
newCreateNetworkAnalyzerConfiguration Text
pName_ =
  CreateNetworkAnalyzerConfiguration'
    { $sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateNetworkAnalyzerConfiguration' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateNetworkAnalyzerConfiguration' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:traceContent:CreateNetworkAnalyzerConfiguration' :: Maybe TraceContent
traceContent = forall a. Maybe a
Prelude.Nothing,
      $sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: Maybe [Text]
wirelessDevices = forall a. Maybe a
Prelude.Nothing,
      $sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: Maybe [Text]
wirelessGateways = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateNetworkAnalyzerConfiguration' :: Text
name = Text
pName_
    }

-- | Undocumented member.
createNetworkAnalyzerConfiguration_clientRequestToken :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe Prelude.Text)
createNetworkAnalyzerConfiguration_clientRequestToken :: Lens' CreateNetworkAnalyzerConfiguration (Maybe Text)
createNetworkAnalyzerConfiguration_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe Text
a -> CreateNetworkAnalyzerConfiguration
s {$sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: Maybe Text
clientRequestToken = Maybe Text
a} :: CreateNetworkAnalyzerConfiguration)

-- | Undocumented member.
createNetworkAnalyzerConfiguration_description :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe Prelude.Text)
createNetworkAnalyzerConfiguration_description :: Lens' CreateNetworkAnalyzerConfiguration (Maybe Text)
createNetworkAnalyzerConfiguration_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe Text
description :: Maybe Text
$sel:description:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe Text
a -> CreateNetworkAnalyzerConfiguration
s {$sel:description:CreateNetworkAnalyzerConfiguration' :: Maybe Text
description = Maybe Text
a} :: CreateNetworkAnalyzerConfiguration)

-- | Undocumented member.
createNetworkAnalyzerConfiguration_tags :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe [Tag])
createNetworkAnalyzerConfiguration_tags :: Lens' CreateNetworkAnalyzerConfiguration (Maybe [Tag])
createNetworkAnalyzerConfiguration_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe [Tag]
a -> CreateNetworkAnalyzerConfiguration
s {$sel:tags:CreateNetworkAnalyzerConfiguration' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateNetworkAnalyzerConfiguration) 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

-- | Undocumented member.
createNetworkAnalyzerConfiguration_traceContent :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe TraceContent)
createNetworkAnalyzerConfiguration_traceContent :: Lens' CreateNetworkAnalyzerConfiguration (Maybe TraceContent)
createNetworkAnalyzerConfiguration_traceContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe TraceContent
traceContent :: Maybe TraceContent
$sel:traceContent:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe TraceContent
traceContent} -> Maybe TraceContent
traceContent) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe TraceContent
a -> CreateNetworkAnalyzerConfiguration
s {$sel:traceContent:CreateNetworkAnalyzerConfiguration' :: Maybe TraceContent
traceContent = Maybe TraceContent
a} :: CreateNetworkAnalyzerConfiguration)

-- | Wireless device resources to add to the network analyzer configuration.
-- Provide the @WirelessDeviceId@ of the resource to add in the input
-- array.
createNetworkAnalyzerConfiguration_wirelessDevices :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe [Prelude.Text])
createNetworkAnalyzerConfiguration_wirelessDevices :: Lens' CreateNetworkAnalyzerConfiguration (Maybe [Text])
createNetworkAnalyzerConfiguration_wirelessDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe [Text]
wirelessDevices :: Maybe [Text]
$sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
wirelessDevices} -> Maybe [Text]
wirelessDevices) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe [Text]
a -> CreateNetworkAnalyzerConfiguration
s {$sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: Maybe [Text]
wirelessDevices = Maybe [Text]
a} :: CreateNetworkAnalyzerConfiguration) 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

-- | Wireless gateway resources to add to the network analyzer configuration.
-- Provide the @WirelessGatewayId@ of the resource to add in the input
-- array.
createNetworkAnalyzerConfiguration_wirelessGateways :: Lens.Lens' CreateNetworkAnalyzerConfiguration (Prelude.Maybe [Prelude.Text])
createNetworkAnalyzerConfiguration_wirelessGateways :: Lens' CreateNetworkAnalyzerConfiguration (Maybe [Text])
createNetworkAnalyzerConfiguration_wirelessGateways = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Maybe [Text]
wirelessGateways :: Maybe [Text]
$sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
wirelessGateways} -> Maybe [Text]
wirelessGateways) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Maybe [Text]
a -> CreateNetworkAnalyzerConfiguration
s {$sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: Maybe [Text]
wirelessGateways = Maybe [Text]
a} :: CreateNetworkAnalyzerConfiguration) 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

-- | Undocumented member.
createNetworkAnalyzerConfiguration_name :: Lens.Lens' CreateNetworkAnalyzerConfiguration Prelude.Text
createNetworkAnalyzerConfiguration_name :: Lens' CreateNetworkAnalyzerConfiguration Text
createNetworkAnalyzerConfiguration_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfiguration' {Text
name :: Text
$sel:name:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Text
name} -> Text
name) (\s :: CreateNetworkAnalyzerConfiguration
s@CreateNetworkAnalyzerConfiguration' {} Text
a -> CreateNetworkAnalyzerConfiguration
s {$sel:name:CreateNetworkAnalyzerConfiguration' :: Text
name = Text
a} :: CreateNetworkAnalyzerConfiguration)

instance
  Core.AWSRequest
    CreateNetworkAnalyzerConfiguration
  where
  type
    AWSResponse CreateNetworkAnalyzerConfiguration =
      CreateNetworkAnalyzerConfigurationResponse
  request :: (Service -> Service)
-> CreateNetworkAnalyzerConfiguration
-> Request CreateNetworkAnalyzerConfiguration
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 CreateNetworkAnalyzerConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateNetworkAnalyzerConfiguration)))
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 -> CreateNetworkAnalyzerConfigurationResponse
CreateNetworkAnalyzerConfigurationResponse'
            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
"Arn")
            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
"Name")
            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
    CreateNetworkAnalyzerConfiguration
  where
  hashWithSalt :: Int -> CreateNetworkAnalyzerConfiguration -> Int
hashWithSalt
    Int
_salt
    CreateNetworkAnalyzerConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe TraceContent
Text
name :: Text
wirelessGateways :: Maybe [Text]
wirelessDevices :: Maybe [Text]
traceContent :: Maybe TraceContent
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:name:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Text
$sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:traceContent:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe TraceContent
$sel:tags:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Tag]
$sel:description:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
$sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TraceContent
traceContent
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
wirelessDevices
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
wirelessGateways
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance
  Prelude.NFData
    CreateNetworkAnalyzerConfiguration
  where
  rnf :: CreateNetworkAnalyzerConfiguration -> ()
rnf CreateNetworkAnalyzerConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe TraceContent
Text
name :: Text
wirelessGateways :: Maybe [Text]
wirelessDevices :: Maybe [Text]
traceContent :: Maybe TraceContent
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:name:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Text
$sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:traceContent:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe TraceContent
$sel:tags:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Tag]
$sel:description:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
$sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TraceContent
traceContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
wirelessDevices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
wirelessGateways
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance
  Data.ToHeaders
    CreateNetworkAnalyzerConfiguration
  where
  toHeaders :: CreateNetworkAnalyzerConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance
  Data.ToJSON
    CreateNetworkAnalyzerConfiguration
  where
  toJSON :: CreateNetworkAnalyzerConfiguration -> Value
toJSON CreateNetworkAnalyzerConfiguration' {Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe TraceContent
Text
name :: Text
wirelessGateways :: Maybe [Text]
wirelessDevices :: Maybe [Text]
traceContent :: Maybe TraceContent
tags :: Maybe [Tag]
description :: Maybe Text
clientRequestToken :: Maybe Text
$sel:name:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Text
$sel:wirelessGateways:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:wirelessDevices:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Text]
$sel:traceContent:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe TraceContent
$sel:tags:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe [Tag]
$sel:description:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
$sel:clientRequestToken:CreateNetworkAnalyzerConfiguration' :: CreateNetworkAnalyzerConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (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
"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
"TraceContent" 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 TraceContent
traceContent,
            (Key
"WirelessDevices" 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]
wirelessDevices,
            (Key
"WirelessGateways" 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]
wirelessGateways,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance
  Data.ToPath
    CreateNetworkAnalyzerConfiguration
  where
  toPath :: CreateNetworkAnalyzerConfiguration -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/network-analyzer-configurations"

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

-- | /See:/ 'newCreateNetworkAnalyzerConfigurationResponse' smart constructor.
data CreateNetworkAnalyzerConfigurationResponse = CreateNetworkAnalyzerConfigurationResponse'
  { -- | The Amazon Resource Name of the new resource.
    CreateNetworkAnalyzerConfigurationResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    CreateNetworkAnalyzerConfigurationResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateNetworkAnalyzerConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateNetworkAnalyzerConfigurationResponse
-> CreateNetworkAnalyzerConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkAnalyzerConfigurationResponse
-> CreateNetworkAnalyzerConfigurationResponse -> Bool
$c/= :: CreateNetworkAnalyzerConfigurationResponse
-> CreateNetworkAnalyzerConfigurationResponse -> Bool
== :: CreateNetworkAnalyzerConfigurationResponse
-> CreateNetworkAnalyzerConfigurationResponse -> Bool
$c== :: CreateNetworkAnalyzerConfigurationResponse
-> CreateNetworkAnalyzerConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [CreateNetworkAnalyzerConfigurationResponse]
ReadPrec CreateNetworkAnalyzerConfigurationResponse
Int -> ReadS CreateNetworkAnalyzerConfigurationResponse
ReadS [CreateNetworkAnalyzerConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkAnalyzerConfigurationResponse]
$creadListPrec :: ReadPrec [CreateNetworkAnalyzerConfigurationResponse]
readPrec :: ReadPrec CreateNetworkAnalyzerConfigurationResponse
$creadPrec :: ReadPrec CreateNetworkAnalyzerConfigurationResponse
readList :: ReadS [CreateNetworkAnalyzerConfigurationResponse]
$creadList :: ReadS [CreateNetworkAnalyzerConfigurationResponse]
readsPrec :: Int -> ReadS CreateNetworkAnalyzerConfigurationResponse
$creadsPrec :: Int -> ReadS CreateNetworkAnalyzerConfigurationResponse
Prelude.Read, Int -> CreateNetworkAnalyzerConfigurationResponse -> ShowS
[CreateNetworkAnalyzerConfigurationResponse] -> ShowS
CreateNetworkAnalyzerConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkAnalyzerConfigurationResponse] -> ShowS
$cshowList :: [CreateNetworkAnalyzerConfigurationResponse] -> ShowS
show :: CreateNetworkAnalyzerConfigurationResponse -> String
$cshow :: CreateNetworkAnalyzerConfigurationResponse -> String
showsPrec :: Int -> CreateNetworkAnalyzerConfigurationResponse -> ShowS
$cshowsPrec :: Int -> CreateNetworkAnalyzerConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep CreateNetworkAnalyzerConfigurationResponse x
-> CreateNetworkAnalyzerConfigurationResponse
forall x.
CreateNetworkAnalyzerConfigurationResponse
-> Rep CreateNetworkAnalyzerConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNetworkAnalyzerConfigurationResponse x
-> CreateNetworkAnalyzerConfigurationResponse
$cfrom :: forall x.
CreateNetworkAnalyzerConfigurationResponse
-> Rep CreateNetworkAnalyzerConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkAnalyzerConfigurationResponse' 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:
--
-- 'arn', 'createNetworkAnalyzerConfigurationResponse_arn' - The Amazon Resource Name of the new resource.
--
-- 'name', 'createNetworkAnalyzerConfigurationResponse_name' - Undocumented member.
--
-- 'httpStatus', 'createNetworkAnalyzerConfigurationResponse_httpStatus' - The response's http status code.
newCreateNetworkAnalyzerConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateNetworkAnalyzerConfigurationResponse
newCreateNetworkAnalyzerConfigurationResponse :: Int -> CreateNetworkAnalyzerConfigurationResponse
newCreateNetworkAnalyzerConfigurationResponse
  Int
pHttpStatus_ =
    CreateNetworkAnalyzerConfigurationResponse'
      { $sel:arn:CreateNetworkAnalyzerConfigurationResponse' :: Maybe Text
arn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateNetworkAnalyzerConfigurationResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateNetworkAnalyzerConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Amazon Resource Name of the new resource.
createNetworkAnalyzerConfigurationResponse_arn :: Lens.Lens' CreateNetworkAnalyzerConfigurationResponse (Prelude.Maybe Prelude.Text)
createNetworkAnalyzerConfigurationResponse_arn :: Lens' CreateNetworkAnalyzerConfigurationResponse (Maybe Text)
createNetworkAnalyzerConfigurationResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfigurationResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateNetworkAnalyzerConfigurationResponse' :: CreateNetworkAnalyzerConfigurationResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateNetworkAnalyzerConfigurationResponse
s@CreateNetworkAnalyzerConfigurationResponse' {} Maybe Text
a -> CreateNetworkAnalyzerConfigurationResponse
s {$sel:arn:CreateNetworkAnalyzerConfigurationResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateNetworkAnalyzerConfigurationResponse)

-- | Undocumented member.
createNetworkAnalyzerConfigurationResponse_name :: Lens.Lens' CreateNetworkAnalyzerConfigurationResponse (Prelude.Maybe Prelude.Text)
createNetworkAnalyzerConfigurationResponse_name :: Lens' CreateNetworkAnalyzerConfigurationResponse (Maybe Text)
createNetworkAnalyzerConfigurationResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkAnalyzerConfigurationResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateNetworkAnalyzerConfigurationResponse' :: CreateNetworkAnalyzerConfigurationResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateNetworkAnalyzerConfigurationResponse
s@CreateNetworkAnalyzerConfigurationResponse' {} Maybe Text
a -> CreateNetworkAnalyzerConfigurationResponse
s {$sel:name:CreateNetworkAnalyzerConfigurationResponse' :: Maybe Text
name = Maybe Text
a} :: CreateNetworkAnalyzerConfigurationResponse)

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

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