{-# 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.GuardDuty.CreateIPSet
-- 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 IPSet, which is called a trusted IP list in the console
-- user interface. An IPSet is a list of IP addresses that are trusted for
-- secure communication with Amazon Web Services infrastructure and
-- applications. GuardDuty doesn\'t generate findings for IP addresses that
-- are included in IPSets. Only users from the administrator account can
-- use this operation.
module Amazonka.GuardDuty.CreateIPSet
  ( -- * Creating a Request
    CreateIPSet (..),
    newCreateIPSet,

    -- * Request Lenses
    createIPSet_clientToken,
    createIPSet_tags,
    createIPSet_detectorId,
    createIPSet_name,
    createIPSet_format,
    createIPSet_location,
    createIPSet_activate,

    -- * Destructuring the Response
    CreateIPSetResponse (..),
    newCreateIPSetResponse,

    -- * Response Lenses
    createIPSetResponse_httpStatus,
    createIPSetResponse_ipSetId,
  )
where

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

-- | /See:/ 'newCreateIPSet' smart constructor.
data CreateIPSet = CreateIPSet'
  { -- | The idempotency token for the create request.
    CreateIPSet -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The tags to be added to a new IP set resource.
    CreateIPSet -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The unique ID of the detector of the GuardDuty account that you want to
    -- create an IPSet for.
    CreateIPSet -> Text
detectorId :: Prelude.Text,
    -- | The user-friendly name to identify the IPSet.
    --
    -- Allowed characters are alphanumerics, spaces, hyphens (-), and
    -- underscores (_).
    CreateIPSet -> Text
name :: Prelude.Text,
    -- | The format of the file that contains the IPSet.
    CreateIPSet -> IpSetFormat
format :: IpSetFormat,
    -- | The URI of the file that contains the IPSet.
    CreateIPSet -> Text
location :: Prelude.Text,
    -- | A Boolean value that indicates whether GuardDuty is to start using the
    -- uploaded IPSet.
    CreateIPSet -> Bool
activate :: Prelude.Bool
  }
  deriving (CreateIPSet -> CreateIPSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIPSet -> CreateIPSet -> Bool
$c/= :: CreateIPSet -> CreateIPSet -> Bool
== :: CreateIPSet -> CreateIPSet -> Bool
$c== :: CreateIPSet -> CreateIPSet -> Bool
Prelude.Eq, ReadPrec [CreateIPSet]
ReadPrec CreateIPSet
Int -> ReadS CreateIPSet
ReadS [CreateIPSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIPSet]
$creadListPrec :: ReadPrec [CreateIPSet]
readPrec :: ReadPrec CreateIPSet
$creadPrec :: ReadPrec CreateIPSet
readList :: ReadS [CreateIPSet]
$creadList :: ReadS [CreateIPSet]
readsPrec :: Int -> ReadS CreateIPSet
$creadsPrec :: Int -> ReadS CreateIPSet
Prelude.Read, Int -> CreateIPSet -> ShowS
[CreateIPSet] -> ShowS
CreateIPSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIPSet] -> ShowS
$cshowList :: [CreateIPSet] -> ShowS
show :: CreateIPSet -> String
$cshow :: CreateIPSet -> String
showsPrec :: Int -> CreateIPSet -> ShowS
$cshowsPrec :: Int -> CreateIPSet -> ShowS
Prelude.Show, forall x. Rep CreateIPSet x -> CreateIPSet
forall x. CreateIPSet -> Rep CreateIPSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIPSet x -> CreateIPSet
$cfrom :: forall x. CreateIPSet -> Rep CreateIPSet x
Prelude.Generic)

-- |
-- Create a value of 'CreateIPSet' 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:
--
-- 'clientToken', 'createIPSet_clientToken' - The idempotency token for the create request.
--
-- 'tags', 'createIPSet_tags' - The tags to be added to a new IP set resource.
--
-- 'detectorId', 'createIPSet_detectorId' - The unique ID of the detector of the GuardDuty account that you want to
-- create an IPSet for.
--
-- 'name', 'createIPSet_name' - The user-friendly name to identify the IPSet.
--
-- Allowed characters are alphanumerics, spaces, hyphens (-), and
-- underscores (_).
--
-- 'format', 'createIPSet_format' - The format of the file that contains the IPSet.
--
-- 'location', 'createIPSet_location' - The URI of the file that contains the IPSet.
--
-- 'activate', 'createIPSet_activate' - A Boolean value that indicates whether GuardDuty is to start using the
-- uploaded IPSet.
newCreateIPSet ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'format'
  IpSetFormat ->
  -- | 'location'
  Prelude.Text ->
  -- | 'activate'
  Prelude.Bool ->
  CreateIPSet
newCreateIPSet :: Text -> Text -> IpSetFormat -> Text -> Bool -> CreateIPSet
newCreateIPSet
  Text
pDetectorId_
  Text
pName_
  IpSetFormat
pFormat_
  Text
pLocation_
  Bool
pActivate_ =
    CreateIPSet'
      { $sel:clientToken:CreateIPSet' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateIPSet' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:detectorId:CreateIPSet' :: Text
detectorId = Text
pDetectorId_,
        $sel:name:CreateIPSet' :: Text
name = Text
pName_,
        $sel:format:CreateIPSet' :: IpSetFormat
format = IpSetFormat
pFormat_,
        $sel:location:CreateIPSet' :: Text
location = Text
pLocation_,
        $sel:activate:CreateIPSet' :: Bool
activate = Bool
pActivate_
      }

-- | The idempotency token for the create request.
createIPSet_clientToken :: Lens.Lens' CreateIPSet (Prelude.Maybe Prelude.Text)
createIPSet_clientToken :: Lens' CreateIPSet (Maybe Text)
createIPSet_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateIPSet' :: CreateIPSet -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateIPSet
s@CreateIPSet' {} Maybe Text
a -> CreateIPSet
s {$sel:clientToken:CreateIPSet' :: Maybe Text
clientToken = Maybe Text
a} :: CreateIPSet)

-- | The tags to be added to a new IP set resource.
createIPSet_tags :: Lens.Lens' CreateIPSet (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createIPSet_tags :: Lens' CreateIPSet (Maybe (HashMap Text Text))
createIPSet_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateIPSet
s@CreateIPSet' {} Maybe (HashMap Text Text)
a -> CreateIPSet
s {$sel:tags:CreateIPSet' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateIPSet) 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 unique ID of the detector of the GuardDuty account that you want to
-- create an IPSet for.
createIPSet_detectorId :: Lens.Lens' CreateIPSet Prelude.Text
createIPSet_detectorId :: Lens' CreateIPSet Text
createIPSet_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Text
detectorId :: Text
$sel:detectorId:CreateIPSet' :: CreateIPSet -> Text
detectorId} -> Text
detectorId) (\s :: CreateIPSet
s@CreateIPSet' {} Text
a -> CreateIPSet
s {$sel:detectorId:CreateIPSet' :: Text
detectorId = Text
a} :: CreateIPSet)

-- | The user-friendly name to identify the IPSet.
--
-- Allowed characters are alphanumerics, spaces, hyphens (-), and
-- underscores (_).
createIPSet_name :: Lens.Lens' CreateIPSet Prelude.Text
createIPSet_name :: Lens' CreateIPSet Text
createIPSet_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Text
name :: Text
$sel:name:CreateIPSet' :: CreateIPSet -> Text
name} -> Text
name) (\s :: CreateIPSet
s@CreateIPSet' {} Text
a -> CreateIPSet
s {$sel:name:CreateIPSet' :: Text
name = Text
a} :: CreateIPSet)

-- | The format of the file that contains the IPSet.
createIPSet_format :: Lens.Lens' CreateIPSet IpSetFormat
createIPSet_format :: Lens' CreateIPSet IpSetFormat
createIPSet_format = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {IpSetFormat
format :: IpSetFormat
$sel:format:CreateIPSet' :: CreateIPSet -> IpSetFormat
format} -> IpSetFormat
format) (\s :: CreateIPSet
s@CreateIPSet' {} IpSetFormat
a -> CreateIPSet
s {$sel:format:CreateIPSet' :: IpSetFormat
format = IpSetFormat
a} :: CreateIPSet)

-- | The URI of the file that contains the IPSet.
createIPSet_location :: Lens.Lens' CreateIPSet Prelude.Text
createIPSet_location :: Lens' CreateIPSet Text
createIPSet_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Text
location :: Text
$sel:location:CreateIPSet' :: CreateIPSet -> Text
location} -> Text
location) (\s :: CreateIPSet
s@CreateIPSet' {} Text
a -> CreateIPSet
s {$sel:location:CreateIPSet' :: Text
location = Text
a} :: CreateIPSet)

-- | A Boolean value that indicates whether GuardDuty is to start using the
-- uploaded IPSet.
createIPSet_activate :: Lens.Lens' CreateIPSet Prelude.Bool
createIPSet_activate :: Lens' CreateIPSet Bool
createIPSet_activate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSet' {Bool
activate :: Bool
$sel:activate:CreateIPSet' :: CreateIPSet -> Bool
activate} -> Bool
activate) (\s :: CreateIPSet
s@CreateIPSet' {} Bool
a -> CreateIPSet
s {$sel:activate:CreateIPSet' :: Bool
activate = Bool
a} :: CreateIPSet)

instance Core.AWSRequest CreateIPSet where
  type AWSResponse CreateIPSet = CreateIPSetResponse
  request :: (Service -> Service) -> CreateIPSet -> Request CreateIPSet
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 CreateIPSet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIPSet)))
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 -> Text -> CreateIPSetResponse
CreateIPSetResponse'
            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
"ipSetId")
      )

instance Prelude.Hashable CreateIPSet where
  hashWithSalt :: Int -> CreateIPSet -> Int
hashWithSalt Int
_salt CreateIPSet' {Bool
Maybe Text
Maybe (HashMap Text Text)
Text
IpSetFormat
activate :: Bool
location :: Text
format :: IpSetFormat
name :: Text
detectorId :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:activate:CreateIPSet' :: CreateIPSet -> Bool
$sel:location:CreateIPSet' :: CreateIPSet -> Text
$sel:format:CreateIPSet' :: CreateIPSet -> IpSetFormat
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:detectorId:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
detectorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IpSetFormat
format
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Bool
activate

instance Prelude.NFData CreateIPSet where
  rnf :: CreateIPSet -> ()
rnf CreateIPSet' {Bool
Maybe Text
Maybe (HashMap Text Text)
Text
IpSetFormat
activate :: Bool
location :: Text
format :: IpSetFormat
name :: Text
detectorId :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:activate:CreateIPSet' :: CreateIPSet -> Bool
$sel:location:CreateIPSet' :: CreateIPSet -> Text
$sel:format:CreateIPSet' :: CreateIPSet -> IpSetFormat
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:detectorId:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
detectorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf IpSetFormat
format
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
activate

instance Data.ToHeaders CreateIPSet where
  toHeaders :: CreateIPSet -> 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 CreateIPSet where
  toJSON :: CreateIPSet -> Value
toJSON CreateIPSet' {Bool
Maybe Text
Maybe (HashMap Text Text)
Text
IpSetFormat
activate :: Bool
location :: Text
format :: IpSetFormat
name :: Text
detectorId :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:activate:CreateIPSet' :: CreateIPSet -> Bool
$sel:location:CreateIPSet' :: CreateIPSet -> Text
$sel:format:CreateIPSet' :: CreateIPSet -> IpSetFormat
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:detectorId:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            (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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"format" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IpSetFormat
format),
            forall a. a -> Maybe a
Prelude.Just (Key
"location" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
location),
            forall a. a -> Maybe a
Prelude.Just (Key
"activate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Bool
activate)
          ]
      )

instance Data.ToPath CreateIPSet where
  toPath :: CreateIPSet -> ByteString
toPath CreateIPSet' {Bool
Maybe Text
Maybe (HashMap Text Text)
Text
IpSetFormat
activate :: Bool
location :: Text
format :: IpSetFormat
name :: Text
detectorId :: Text
tags :: Maybe (HashMap Text Text)
clientToken :: Maybe Text
$sel:activate:CreateIPSet' :: CreateIPSet -> Bool
$sel:location:CreateIPSet' :: CreateIPSet -> Text
$sel:format:CreateIPSet' :: CreateIPSet -> IpSetFormat
$sel:name:CreateIPSet' :: CreateIPSet -> Text
$sel:detectorId:CreateIPSet' :: CreateIPSet -> Text
$sel:tags:CreateIPSet' :: CreateIPSet -> Maybe (HashMap Text Text)
$sel:clientToken:CreateIPSet' :: CreateIPSet -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/detector/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId, ByteString
"/ipset"]

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

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

-- |
-- Create a value of 'CreateIPSetResponse' 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', 'createIPSetResponse_httpStatus' - The response's http status code.
--
-- 'ipSetId', 'createIPSetResponse_ipSetId' - The ID of the IPSet resource.
newCreateIPSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'ipSetId'
  Prelude.Text ->
  CreateIPSetResponse
newCreateIPSetResponse :: Int -> Text -> CreateIPSetResponse
newCreateIPSetResponse Int
pHttpStatus_ Text
pIpSetId_ =
  CreateIPSetResponse'
    { $sel:httpStatus:CreateIPSetResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:ipSetId:CreateIPSetResponse' :: Text
ipSetId = Text
pIpSetId_
    }

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

-- | The ID of the IPSet resource.
createIPSetResponse_ipSetId :: Lens.Lens' CreateIPSetResponse Prelude.Text
createIPSetResponse_ipSetId :: Lens' CreateIPSetResponse Text
createIPSetResponse_ipSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIPSetResponse' {Text
ipSetId :: Text
$sel:ipSetId:CreateIPSetResponse' :: CreateIPSetResponse -> Text
ipSetId} -> Text
ipSetId) (\s :: CreateIPSetResponse
s@CreateIPSetResponse' {} Text
a -> CreateIPSetResponse
s {$sel:ipSetId:CreateIPSetResponse' :: Text
ipSetId = Text
a} :: CreateIPSetResponse)

instance Prelude.NFData CreateIPSetResponse where
  rnf :: CreateIPSetResponse -> ()
rnf CreateIPSetResponse' {Int
Text
ipSetId :: Text
httpStatus :: Int
$sel:ipSetId:CreateIPSetResponse' :: CreateIPSetResponse -> Text
$sel:httpStatus:CreateIPSetResponse' :: CreateIPSetResponse -> 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 Text
ipSetId