{-# 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.EC2.CreateNetworkInsightsAccessScope
-- 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 Network Access Scope.
--
-- Amazon Web Services Network Access Analyzer enables cloud networking and
-- cloud operations teams to verify that their networks on Amazon Web
-- Services conform to their network security and governance objectives.
-- For more information, see the
-- <https://docs.aws.amazon.com/vpc/latest/network-access-analyzer/ Amazon Web Services Network Access Analyzer Guide>.
module Amazonka.EC2.CreateNetworkInsightsAccessScope
  ( -- * Creating a Request
    CreateNetworkInsightsAccessScope (..),
    newCreateNetworkInsightsAccessScope,

    -- * Request Lenses
    createNetworkInsightsAccessScope_dryRun,
    createNetworkInsightsAccessScope_excludePaths,
    createNetworkInsightsAccessScope_matchPaths,
    createNetworkInsightsAccessScope_tagSpecifications,
    createNetworkInsightsAccessScope_clientToken,

    -- * Destructuring the Response
    CreateNetworkInsightsAccessScopeResponse (..),
    newCreateNetworkInsightsAccessScopeResponse,

    -- * Response Lenses
    createNetworkInsightsAccessScopeResponse_networkInsightsAccessScope,
    createNetworkInsightsAccessScopeResponse_networkInsightsAccessScopeContent,
    createNetworkInsightsAccessScopeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateNetworkInsightsAccessScope' smart constructor.
data CreateNetworkInsightsAccessScope = CreateNetworkInsightsAccessScope'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateNetworkInsightsAccessScope -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The paths to exclude.
    CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
excludePaths :: Prelude.Maybe [AccessScopePathRequest],
    -- | The paths to match.
    CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
matchPaths :: Prelude.Maybe [AccessScopePathRequest],
    -- | The tags to apply.
    CreateNetworkInsightsAccessScope -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
    CreateNetworkInsightsAccessScope -> Text
clientToken :: Prelude.Text
  }
  deriving (CreateNetworkInsightsAccessScope
-> CreateNetworkInsightsAccessScope -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkInsightsAccessScope
-> CreateNetworkInsightsAccessScope -> Bool
$c/= :: CreateNetworkInsightsAccessScope
-> CreateNetworkInsightsAccessScope -> Bool
== :: CreateNetworkInsightsAccessScope
-> CreateNetworkInsightsAccessScope -> Bool
$c== :: CreateNetworkInsightsAccessScope
-> CreateNetworkInsightsAccessScope -> Bool
Prelude.Eq, ReadPrec [CreateNetworkInsightsAccessScope]
ReadPrec CreateNetworkInsightsAccessScope
Int -> ReadS CreateNetworkInsightsAccessScope
ReadS [CreateNetworkInsightsAccessScope]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkInsightsAccessScope]
$creadListPrec :: ReadPrec [CreateNetworkInsightsAccessScope]
readPrec :: ReadPrec CreateNetworkInsightsAccessScope
$creadPrec :: ReadPrec CreateNetworkInsightsAccessScope
readList :: ReadS [CreateNetworkInsightsAccessScope]
$creadList :: ReadS [CreateNetworkInsightsAccessScope]
readsPrec :: Int -> ReadS CreateNetworkInsightsAccessScope
$creadsPrec :: Int -> ReadS CreateNetworkInsightsAccessScope
Prelude.Read, Int -> CreateNetworkInsightsAccessScope -> ShowS
[CreateNetworkInsightsAccessScope] -> ShowS
CreateNetworkInsightsAccessScope -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkInsightsAccessScope] -> ShowS
$cshowList :: [CreateNetworkInsightsAccessScope] -> ShowS
show :: CreateNetworkInsightsAccessScope -> String
$cshow :: CreateNetworkInsightsAccessScope -> String
showsPrec :: Int -> CreateNetworkInsightsAccessScope -> ShowS
$cshowsPrec :: Int -> CreateNetworkInsightsAccessScope -> ShowS
Prelude.Show, forall x.
Rep CreateNetworkInsightsAccessScope x
-> CreateNetworkInsightsAccessScope
forall x.
CreateNetworkInsightsAccessScope
-> Rep CreateNetworkInsightsAccessScope x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNetworkInsightsAccessScope x
-> CreateNetworkInsightsAccessScope
$cfrom :: forall x.
CreateNetworkInsightsAccessScope
-> Rep CreateNetworkInsightsAccessScope x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkInsightsAccessScope' 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:
--
-- 'dryRun', 'createNetworkInsightsAccessScope_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'excludePaths', 'createNetworkInsightsAccessScope_excludePaths' - The paths to exclude.
--
-- 'matchPaths', 'createNetworkInsightsAccessScope_matchPaths' - The paths to match.
--
-- 'tagSpecifications', 'createNetworkInsightsAccessScope_tagSpecifications' - The tags to apply.
--
-- 'clientToken', 'createNetworkInsightsAccessScope_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
newCreateNetworkInsightsAccessScope ::
  -- | 'clientToken'
  Prelude.Text ->
  CreateNetworkInsightsAccessScope
newCreateNetworkInsightsAccessScope :: Text -> CreateNetworkInsightsAccessScope
newCreateNetworkInsightsAccessScope Text
pClientToken_ =
  CreateNetworkInsightsAccessScope'
    { $sel:dryRun:CreateNetworkInsightsAccessScope' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:excludePaths:CreateNetworkInsightsAccessScope' :: Maybe [AccessScopePathRequest]
excludePaths = forall a. Maybe a
Prelude.Nothing,
      $sel:matchPaths:CreateNetworkInsightsAccessScope' :: Maybe [AccessScopePathRequest]
matchPaths = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateNetworkInsightsAccessScope' :: Text
clientToken = Text
pClientToken_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createNetworkInsightsAccessScope_dryRun :: Lens.Lens' CreateNetworkInsightsAccessScope (Prelude.Maybe Prelude.Bool)
createNetworkInsightsAccessScope_dryRun :: Lens' CreateNetworkInsightsAccessScope (Maybe Bool)
createNetworkInsightsAccessScope_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScope' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateNetworkInsightsAccessScope
s@CreateNetworkInsightsAccessScope' {} Maybe Bool
a -> CreateNetworkInsightsAccessScope
s {$sel:dryRun:CreateNetworkInsightsAccessScope' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateNetworkInsightsAccessScope)

-- | The paths to exclude.
createNetworkInsightsAccessScope_excludePaths :: Lens.Lens' CreateNetworkInsightsAccessScope (Prelude.Maybe [AccessScopePathRequest])
createNetworkInsightsAccessScope_excludePaths :: Lens'
  CreateNetworkInsightsAccessScope (Maybe [AccessScopePathRequest])
createNetworkInsightsAccessScope_excludePaths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScope' {Maybe [AccessScopePathRequest]
excludePaths :: Maybe [AccessScopePathRequest]
$sel:excludePaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
excludePaths} -> Maybe [AccessScopePathRequest]
excludePaths) (\s :: CreateNetworkInsightsAccessScope
s@CreateNetworkInsightsAccessScope' {} Maybe [AccessScopePathRequest]
a -> CreateNetworkInsightsAccessScope
s {$sel:excludePaths:CreateNetworkInsightsAccessScope' :: Maybe [AccessScopePathRequest]
excludePaths = Maybe [AccessScopePathRequest]
a} :: CreateNetworkInsightsAccessScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The paths to match.
createNetworkInsightsAccessScope_matchPaths :: Lens.Lens' CreateNetworkInsightsAccessScope (Prelude.Maybe [AccessScopePathRequest])
createNetworkInsightsAccessScope_matchPaths :: Lens'
  CreateNetworkInsightsAccessScope (Maybe [AccessScopePathRequest])
createNetworkInsightsAccessScope_matchPaths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScope' {Maybe [AccessScopePathRequest]
matchPaths :: Maybe [AccessScopePathRequest]
$sel:matchPaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
matchPaths} -> Maybe [AccessScopePathRequest]
matchPaths) (\s :: CreateNetworkInsightsAccessScope
s@CreateNetworkInsightsAccessScope' {} Maybe [AccessScopePathRequest]
a -> CreateNetworkInsightsAccessScope
s {$sel:matchPaths:CreateNetworkInsightsAccessScope' :: Maybe [AccessScopePathRequest]
matchPaths = Maybe [AccessScopePathRequest]
a} :: CreateNetworkInsightsAccessScope) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The tags to apply.
createNetworkInsightsAccessScope_tagSpecifications :: Lens.Lens' CreateNetworkInsightsAccessScope (Prelude.Maybe [TagSpecification])
createNetworkInsightsAccessScope_tagSpecifications :: Lens' CreateNetworkInsightsAccessScope (Maybe [TagSpecification])
createNetworkInsightsAccessScope_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScope' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateNetworkInsightsAccessScope
s@CreateNetworkInsightsAccessScope' {} Maybe [TagSpecification]
a -> CreateNetworkInsightsAccessScope
s {$sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateNetworkInsightsAccessScope) 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

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/Run_Instance_Idempotency.html How to ensure idempotency>.
createNetworkInsightsAccessScope_clientToken :: Lens.Lens' CreateNetworkInsightsAccessScope Prelude.Text
createNetworkInsightsAccessScope_clientToken :: Lens' CreateNetworkInsightsAccessScope Text
createNetworkInsightsAccessScope_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScope' {Text
clientToken :: Text
$sel:clientToken:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Text
clientToken} -> Text
clientToken) (\s :: CreateNetworkInsightsAccessScope
s@CreateNetworkInsightsAccessScope' {} Text
a -> CreateNetworkInsightsAccessScope
s {$sel:clientToken:CreateNetworkInsightsAccessScope' :: Text
clientToken = Text
a} :: CreateNetworkInsightsAccessScope)

instance
  Core.AWSRequest
    CreateNetworkInsightsAccessScope
  where
  type
    AWSResponse CreateNetworkInsightsAccessScope =
      CreateNetworkInsightsAccessScopeResponse
  request :: (Service -> Service)
-> CreateNetworkInsightsAccessScope
-> Request CreateNetworkInsightsAccessScope
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateNetworkInsightsAccessScope
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateNetworkInsightsAccessScope)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe NetworkInsightsAccessScope
-> Maybe NetworkInsightsAccessScopeContent
-> Int
-> CreateNetworkInsightsAccessScopeResponse
CreateNetworkInsightsAccessScopeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"networkInsightsAccessScope")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"networkInsightsAccessScopeContent")
            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
    CreateNetworkInsightsAccessScope
  where
  hashWithSalt :: Int -> CreateNetworkInsightsAccessScope -> Int
hashWithSalt
    Int
_salt
    CreateNetworkInsightsAccessScope' {Maybe Bool
Maybe [TagSpecification]
Maybe [AccessScopePathRequest]
Text
clientToken :: Text
tagSpecifications :: Maybe [TagSpecification]
matchPaths :: Maybe [AccessScopePathRequest]
excludePaths :: Maybe [AccessScopePathRequest]
dryRun :: Maybe Bool
$sel:clientToken:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Text
$sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [TagSpecification]
$sel:matchPaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:excludePaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:dryRun:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AccessScopePathRequest]
excludePaths
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AccessScopePathRequest]
matchPaths
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken

instance
  Prelude.NFData
    CreateNetworkInsightsAccessScope
  where
  rnf :: CreateNetworkInsightsAccessScope -> ()
rnf CreateNetworkInsightsAccessScope' {Maybe Bool
Maybe [TagSpecification]
Maybe [AccessScopePathRequest]
Text
clientToken :: Text
tagSpecifications :: Maybe [TagSpecification]
matchPaths :: Maybe [AccessScopePathRequest]
excludePaths :: Maybe [AccessScopePathRequest]
dryRun :: Maybe Bool
$sel:clientToken:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Text
$sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [TagSpecification]
$sel:matchPaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:excludePaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:dryRun:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AccessScopePathRequest]
excludePaths
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AccessScopePathRequest]
matchPaths
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken

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

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

instance
  Data.ToQuery
    CreateNetworkInsightsAccessScope
  where
  toQuery :: CreateNetworkInsightsAccessScope -> QueryString
toQuery CreateNetworkInsightsAccessScope' {Maybe Bool
Maybe [TagSpecification]
Maybe [AccessScopePathRequest]
Text
clientToken :: Text
tagSpecifications :: Maybe [TagSpecification]
matchPaths :: Maybe [AccessScopePathRequest]
excludePaths :: Maybe [AccessScopePathRequest]
dryRun :: Maybe Bool
$sel:clientToken:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Text
$sel:tagSpecifications:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [TagSpecification]
$sel:matchPaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:excludePaths:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe [AccessScopePathRequest]
$sel:dryRun:CreateNetworkInsightsAccessScope' :: CreateNetworkInsightsAccessScope -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateNetworkInsightsAccessScope" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"ExcludePath"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [AccessScopePathRequest]
excludePaths
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"MatchPath"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [AccessScopePathRequest]
matchPaths
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientToken
      ]

-- | /See:/ 'newCreateNetworkInsightsAccessScopeResponse' smart constructor.
data CreateNetworkInsightsAccessScopeResponse = CreateNetworkInsightsAccessScopeResponse'
  { -- | The Network Access Scope.
    CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScope
networkInsightsAccessScope :: Prelude.Maybe NetworkInsightsAccessScope,
    -- | The Network Access Scope content.
    CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent :: Prelude.Maybe NetworkInsightsAccessScopeContent,
    -- | The response's http status code.
    CreateNetworkInsightsAccessScopeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateNetworkInsightsAccessScopeResponse
-> CreateNetworkInsightsAccessScopeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateNetworkInsightsAccessScopeResponse
-> CreateNetworkInsightsAccessScopeResponse -> Bool
$c/= :: CreateNetworkInsightsAccessScopeResponse
-> CreateNetworkInsightsAccessScopeResponse -> Bool
== :: CreateNetworkInsightsAccessScopeResponse
-> CreateNetworkInsightsAccessScopeResponse -> Bool
$c== :: CreateNetworkInsightsAccessScopeResponse
-> CreateNetworkInsightsAccessScopeResponse -> Bool
Prelude.Eq, ReadPrec [CreateNetworkInsightsAccessScopeResponse]
ReadPrec CreateNetworkInsightsAccessScopeResponse
Int -> ReadS CreateNetworkInsightsAccessScopeResponse
ReadS [CreateNetworkInsightsAccessScopeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateNetworkInsightsAccessScopeResponse]
$creadListPrec :: ReadPrec [CreateNetworkInsightsAccessScopeResponse]
readPrec :: ReadPrec CreateNetworkInsightsAccessScopeResponse
$creadPrec :: ReadPrec CreateNetworkInsightsAccessScopeResponse
readList :: ReadS [CreateNetworkInsightsAccessScopeResponse]
$creadList :: ReadS [CreateNetworkInsightsAccessScopeResponse]
readsPrec :: Int -> ReadS CreateNetworkInsightsAccessScopeResponse
$creadsPrec :: Int -> ReadS CreateNetworkInsightsAccessScopeResponse
Prelude.Read, Int -> CreateNetworkInsightsAccessScopeResponse -> ShowS
[CreateNetworkInsightsAccessScopeResponse] -> ShowS
CreateNetworkInsightsAccessScopeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateNetworkInsightsAccessScopeResponse] -> ShowS
$cshowList :: [CreateNetworkInsightsAccessScopeResponse] -> ShowS
show :: CreateNetworkInsightsAccessScopeResponse -> String
$cshow :: CreateNetworkInsightsAccessScopeResponse -> String
showsPrec :: Int -> CreateNetworkInsightsAccessScopeResponse -> ShowS
$cshowsPrec :: Int -> CreateNetworkInsightsAccessScopeResponse -> ShowS
Prelude.Show, forall x.
Rep CreateNetworkInsightsAccessScopeResponse x
-> CreateNetworkInsightsAccessScopeResponse
forall x.
CreateNetworkInsightsAccessScopeResponse
-> Rep CreateNetworkInsightsAccessScopeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateNetworkInsightsAccessScopeResponse x
-> CreateNetworkInsightsAccessScopeResponse
$cfrom :: forall x.
CreateNetworkInsightsAccessScopeResponse
-> Rep CreateNetworkInsightsAccessScopeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateNetworkInsightsAccessScopeResponse' 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:
--
-- 'networkInsightsAccessScope', 'createNetworkInsightsAccessScopeResponse_networkInsightsAccessScope' - The Network Access Scope.
--
-- 'networkInsightsAccessScopeContent', 'createNetworkInsightsAccessScopeResponse_networkInsightsAccessScopeContent' - The Network Access Scope content.
--
-- 'httpStatus', 'createNetworkInsightsAccessScopeResponse_httpStatus' - The response's http status code.
newCreateNetworkInsightsAccessScopeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateNetworkInsightsAccessScopeResponse
newCreateNetworkInsightsAccessScopeResponse :: Int -> CreateNetworkInsightsAccessScopeResponse
newCreateNetworkInsightsAccessScopeResponse
  Int
pHttpStatus_ =
    CreateNetworkInsightsAccessScopeResponse'
      { $sel:networkInsightsAccessScope:CreateNetworkInsightsAccessScopeResponse' :: Maybe NetworkInsightsAccessScope
networkInsightsAccessScope =
          forall a. Maybe a
Prelude.Nothing,
        $sel:networkInsightsAccessScopeContent:CreateNetworkInsightsAccessScopeResponse' :: Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateNetworkInsightsAccessScopeResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Network Access Scope.
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScope :: Lens.Lens' CreateNetworkInsightsAccessScopeResponse (Prelude.Maybe NetworkInsightsAccessScope)
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScope :: Lens'
  CreateNetworkInsightsAccessScopeResponse
  (Maybe NetworkInsightsAccessScope)
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScope = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScopeResponse' {Maybe NetworkInsightsAccessScope
networkInsightsAccessScope :: Maybe NetworkInsightsAccessScope
$sel:networkInsightsAccessScope:CreateNetworkInsightsAccessScopeResponse' :: CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScope
networkInsightsAccessScope} -> Maybe NetworkInsightsAccessScope
networkInsightsAccessScope) (\s :: CreateNetworkInsightsAccessScopeResponse
s@CreateNetworkInsightsAccessScopeResponse' {} Maybe NetworkInsightsAccessScope
a -> CreateNetworkInsightsAccessScopeResponse
s {$sel:networkInsightsAccessScope:CreateNetworkInsightsAccessScopeResponse' :: Maybe NetworkInsightsAccessScope
networkInsightsAccessScope = Maybe NetworkInsightsAccessScope
a} :: CreateNetworkInsightsAccessScopeResponse)

-- | The Network Access Scope content.
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScopeContent :: Lens.Lens' CreateNetworkInsightsAccessScopeResponse (Prelude.Maybe NetworkInsightsAccessScopeContent)
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScopeContent :: Lens'
  CreateNetworkInsightsAccessScopeResponse
  (Maybe NetworkInsightsAccessScopeContent)
createNetworkInsightsAccessScopeResponse_networkInsightsAccessScopeContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateNetworkInsightsAccessScopeResponse' {Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent :: Maybe NetworkInsightsAccessScopeContent
$sel:networkInsightsAccessScopeContent:CreateNetworkInsightsAccessScopeResponse' :: CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent} -> Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent) (\s :: CreateNetworkInsightsAccessScopeResponse
s@CreateNetworkInsightsAccessScopeResponse' {} Maybe NetworkInsightsAccessScopeContent
a -> CreateNetworkInsightsAccessScopeResponse
s {$sel:networkInsightsAccessScopeContent:CreateNetworkInsightsAccessScopeResponse' :: Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent = Maybe NetworkInsightsAccessScopeContent
a} :: CreateNetworkInsightsAccessScopeResponse)

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

instance
  Prelude.NFData
    CreateNetworkInsightsAccessScopeResponse
  where
  rnf :: CreateNetworkInsightsAccessScopeResponse -> ()
rnf CreateNetworkInsightsAccessScopeResponse' {Int
Maybe NetworkInsightsAccessScope
Maybe NetworkInsightsAccessScopeContent
httpStatus :: Int
networkInsightsAccessScopeContent :: Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScope :: Maybe NetworkInsightsAccessScope
$sel:httpStatus:CreateNetworkInsightsAccessScopeResponse' :: CreateNetworkInsightsAccessScopeResponse -> Int
$sel:networkInsightsAccessScopeContent:CreateNetworkInsightsAccessScopeResponse' :: CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScopeContent
$sel:networkInsightsAccessScope:CreateNetworkInsightsAccessScopeResponse' :: CreateNetworkInsightsAccessScopeResponse
-> Maybe NetworkInsightsAccessScope
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkInsightsAccessScope
networkInsightsAccessScope
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NetworkInsightsAccessScopeContent
networkInsightsAccessScopeContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus