{-# 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.UpdateIPSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the IPSet specified by the IPSet ID.
module Amazonka.GuardDuty.UpdateIPSet
  ( -- * Creating a Request
    UpdateIPSet (..),
    newUpdateIPSet,

    -- * Request Lenses
    updateIPSet_activate,
    updateIPSet_location,
    updateIPSet_name,
    updateIPSet_detectorId,
    updateIPSet_ipSetId,

    -- * Destructuring the Response
    UpdateIPSetResponse (..),
    newUpdateIPSetResponse,

    -- * Response Lenses
    updateIPSetResponse_httpStatus,
  )
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:/ 'newUpdateIPSet' smart constructor.
data UpdateIPSet = UpdateIPSet'
  { -- | The updated Boolean value that specifies whether the IPSet is active or
    -- not.
    UpdateIPSet -> Maybe Bool
activate :: Prelude.Maybe Prelude.Bool,
    -- | The updated URI of the file that contains the IPSet.
    UpdateIPSet -> Maybe Text
location :: Prelude.Maybe Prelude.Text,
    -- | The unique ID that specifies the IPSet that you want to update.
    UpdateIPSet -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The detectorID that specifies the GuardDuty service whose IPSet you want
    -- to update.
    UpdateIPSet -> Text
detectorId :: Prelude.Text,
    -- | The unique ID that specifies the IPSet that you want to update.
    UpdateIPSet -> Text
ipSetId :: Prelude.Text
  }
  deriving (UpdateIPSet -> UpdateIPSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIPSet -> UpdateIPSet -> Bool
$c/= :: UpdateIPSet -> UpdateIPSet -> Bool
== :: UpdateIPSet -> UpdateIPSet -> Bool
$c== :: UpdateIPSet -> UpdateIPSet -> Bool
Prelude.Eq, ReadPrec [UpdateIPSet]
ReadPrec UpdateIPSet
Int -> ReadS UpdateIPSet
ReadS [UpdateIPSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIPSet]
$creadListPrec :: ReadPrec [UpdateIPSet]
readPrec :: ReadPrec UpdateIPSet
$creadPrec :: ReadPrec UpdateIPSet
readList :: ReadS [UpdateIPSet]
$creadList :: ReadS [UpdateIPSet]
readsPrec :: Int -> ReadS UpdateIPSet
$creadsPrec :: Int -> ReadS UpdateIPSet
Prelude.Read, Int -> UpdateIPSet -> ShowS
[UpdateIPSet] -> ShowS
UpdateIPSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIPSet] -> ShowS
$cshowList :: [UpdateIPSet] -> ShowS
show :: UpdateIPSet -> String
$cshow :: UpdateIPSet -> String
showsPrec :: Int -> UpdateIPSet -> ShowS
$cshowsPrec :: Int -> UpdateIPSet -> ShowS
Prelude.Show, forall x. Rep UpdateIPSet x -> UpdateIPSet
forall x. UpdateIPSet -> Rep UpdateIPSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIPSet x -> UpdateIPSet
$cfrom :: forall x. UpdateIPSet -> Rep UpdateIPSet x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIPSet' 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:
--
-- 'activate', 'updateIPSet_activate' - The updated Boolean value that specifies whether the IPSet is active or
-- not.
--
-- 'location', 'updateIPSet_location' - The updated URI of the file that contains the IPSet.
--
-- 'name', 'updateIPSet_name' - The unique ID that specifies the IPSet that you want to update.
--
-- 'detectorId', 'updateIPSet_detectorId' - The detectorID that specifies the GuardDuty service whose IPSet you want
-- to update.
--
-- 'ipSetId', 'updateIPSet_ipSetId' - The unique ID that specifies the IPSet that you want to update.
newUpdateIPSet ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'ipSetId'
  Prelude.Text ->
  UpdateIPSet
newUpdateIPSet :: Text -> Text -> UpdateIPSet
newUpdateIPSet Text
pDetectorId_ Text
pIpSetId_ =
  UpdateIPSet'
    { $sel:activate:UpdateIPSet' :: Maybe Bool
activate = forall a. Maybe a
Prelude.Nothing,
      $sel:location:UpdateIPSet' :: Maybe Text
location = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateIPSet' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:detectorId:UpdateIPSet' :: Text
detectorId = Text
pDetectorId_,
      $sel:ipSetId:UpdateIPSet' :: Text
ipSetId = Text
pIpSetId_
    }

-- | The updated Boolean value that specifies whether the IPSet is active or
-- not.
updateIPSet_activate :: Lens.Lens' UpdateIPSet (Prelude.Maybe Prelude.Bool)
updateIPSet_activate :: Lens' UpdateIPSet (Maybe Bool)
updateIPSet_activate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIPSet' {Maybe Bool
activate :: Maybe Bool
$sel:activate:UpdateIPSet' :: UpdateIPSet -> Maybe Bool
activate} -> Maybe Bool
activate) (\s :: UpdateIPSet
s@UpdateIPSet' {} Maybe Bool
a -> UpdateIPSet
s {$sel:activate:UpdateIPSet' :: Maybe Bool
activate = Maybe Bool
a} :: UpdateIPSet)

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

-- | The unique ID that specifies the IPSet that you want to update.
updateIPSet_name :: Lens.Lens' UpdateIPSet (Prelude.Maybe Prelude.Text)
updateIPSet_name :: Lens' UpdateIPSet (Maybe Text)
updateIPSet_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIPSet' {Maybe Text
name :: Maybe Text
$sel:name:UpdateIPSet' :: UpdateIPSet -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateIPSet
s@UpdateIPSet' {} Maybe Text
a -> UpdateIPSet
s {$sel:name:UpdateIPSet' :: Maybe Text
name = Maybe Text
a} :: UpdateIPSet)

-- | The detectorID that specifies the GuardDuty service whose IPSet you want
-- to update.
updateIPSet_detectorId :: Lens.Lens' UpdateIPSet Prelude.Text
updateIPSet_detectorId :: Lens' UpdateIPSet Text
updateIPSet_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIPSet' {Text
detectorId :: Text
$sel:detectorId:UpdateIPSet' :: UpdateIPSet -> Text
detectorId} -> Text
detectorId) (\s :: UpdateIPSet
s@UpdateIPSet' {} Text
a -> UpdateIPSet
s {$sel:detectorId:UpdateIPSet' :: Text
detectorId = Text
a} :: UpdateIPSet)

-- | The unique ID that specifies the IPSet that you want to update.
updateIPSet_ipSetId :: Lens.Lens' UpdateIPSet Prelude.Text
updateIPSet_ipSetId :: Lens' UpdateIPSet Text
updateIPSet_ipSetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIPSet' {Text
ipSetId :: Text
$sel:ipSetId:UpdateIPSet' :: UpdateIPSet -> Text
ipSetId} -> Text
ipSetId) (\s :: UpdateIPSet
s@UpdateIPSet' {} Text
a -> UpdateIPSet
s {$sel:ipSetId:UpdateIPSet' :: Text
ipSetId = Text
a} :: UpdateIPSet)

instance Core.AWSRequest UpdateIPSet where
  type AWSResponse UpdateIPSet = UpdateIPSetResponse
  request :: (Service -> Service) -> UpdateIPSet -> Request UpdateIPSet
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 UpdateIPSet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateIPSet)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateIPSetResponse
UpdateIPSetResponse'
            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))
      )

instance Prelude.Hashable UpdateIPSet where
  hashWithSalt :: Int -> UpdateIPSet -> Int
hashWithSalt Int
_salt UpdateIPSet' {Maybe Bool
Maybe Text
Text
ipSetId :: Text
detectorId :: Text
name :: Maybe Text
location :: Maybe Text
activate :: Maybe Bool
$sel:ipSetId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:detectorId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:name:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:location:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:activate:UpdateIPSet' :: UpdateIPSet -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
activate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
detectorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipSetId

instance Prelude.NFData UpdateIPSet where
  rnf :: UpdateIPSet -> ()
rnf UpdateIPSet' {Maybe Bool
Maybe Text
Text
ipSetId :: Text
detectorId :: Text
name :: Maybe Text
location :: Maybe Text
activate :: Maybe Bool
$sel:ipSetId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:detectorId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:name:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:location:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:activate:UpdateIPSet' :: UpdateIPSet -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
activate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
location
      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 Text
detectorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ipSetId

instance Data.ToHeaders UpdateIPSet where
  toHeaders :: UpdateIPSet -> 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 UpdateIPSet where
  toJSON :: UpdateIPSet -> Value
toJSON UpdateIPSet' {Maybe Bool
Maybe Text
Text
ipSetId :: Text
detectorId :: Text
name :: Maybe Text
location :: Maybe Text
activate :: Maybe Bool
$sel:ipSetId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:detectorId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:name:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:location:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:activate:UpdateIPSet' :: UpdateIPSet -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"activate" 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 Bool
activate,
            (Key
"location" 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
location,
            (Key
"name" 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
name
          ]
      )

instance Data.ToPath UpdateIPSet where
  toPath :: UpdateIPSet -> ByteString
toPath UpdateIPSet' {Maybe Bool
Maybe Text
Text
ipSetId :: Text
detectorId :: Text
name :: Maybe Text
location :: Maybe Text
activate :: Maybe Bool
$sel:ipSetId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:detectorId:UpdateIPSet' :: UpdateIPSet -> Text
$sel:name:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:location:UpdateIPSet' :: UpdateIPSet -> Maybe Text
$sel:activate:UpdateIPSet' :: UpdateIPSet -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/detector/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId,
        ByteString
"/ipset/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
ipSetId
      ]

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

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

-- |
-- Create a value of 'UpdateIPSetResponse' 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', 'updateIPSetResponse_httpStatus' - The response's http status code.
newUpdateIPSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateIPSetResponse
newUpdateIPSetResponse :: Int -> UpdateIPSetResponse
newUpdateIPSetResponse Int
pHttpStatus_ =
  UpdateIPSetResponse' {$sel:httpStatus:UpdateIPSetResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateIPSetResponse where
  rnf :: UpdateIPSetResponse -> ()
rnf UpdateIPSetResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateIPSetResponse' :: UpdateIPSetResponse -> Int
..} = forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus