{-# 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.UpdateMemberDetectors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Contains information on member accounts to be updated.
module Amazonka.GuardDuty.UpdateMemberDetectors
  ( -- * Creating a Request
    UpdateMemberDetectors (..),
    newUpdateMemberDetectors,

    -- * Request Lenses
    updateMemberDetectors_dataSources,
    updateMemberDetectors_detectorId,
    updateMemberDetectors_accountIds,

    -- * Destructuring the Response
    UpdateMemberDetectorsResponse (..),
    newUpdateMemberDetectorsResponse,

    -- * Response Lenses
    updateMemberDetectorsResponse_httpStatus,
    updateMemberDetectorsResponse_unprocessedAccounts,
  )
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:/ 'newUpdateMemberDetectors' smart constructor.
data UpdateMemberDetectors = UpdateMemberDetectors'
  { -- | Describes which data sources will be updated.
    UpdateMemberDetectors -> Maybe DataSourceConfigurations
dataSources :: Prelude.Maybe DataSourceConfigurations,
    -- | The detector ID of the administrator account.
    UpdateMemberDetectors -> Text
detectorId :: Prelude.Text,
    -- | A list of member account IDs to be updated.
    UpdateMemberDetectors -> NonEmpty Text
accountIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (UpdateMemberDetectors -> UpdateMemberDetectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMemberDetectors -> UpdateMemberDetectors -> Bool
$c/= :: UpdateMemberDetectors -> UpdateMemberDetectors -> Bool
== :: UpdateMemberDetectors -> UpdateMemberDetectors -> Bool
$c== :: UpdateMemberDetectors -> UpdateMemberDetectors -> Bool
Prelude.Eq, ReadPrec [UpdateMemberDetectors]
ReadPrec UpdateMemberDetectors
Int -> ReadS UpdateMemberDetectors
ReadS [UpdateMemberDetectors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMemberDetectors]
$creadListPrec :: ReadPrec [UpdateMemberDetectors]
readPrec :: ReadPrec UpdateMemberDetectors
$creadPrec :: ReadPrec UpdateMemberDetectors
readList :: ReadS [UpdateMemberDetectors]
$creadList :: ReadS [UpdateMemberDetectors]
readsPrec :: Int -> ReadS UpdateMemberDetectors
$creadsPrec :: Int -> ReadS UpdateMemberDetectors
Prelude.Read, Int -> UpdateMemberDetectors -> ShowS
[UpdateMemberDetectors] -> ShowS
UpdateMemberDetectors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMemberDetectors] -> ShowS
$cshowList :: [UpdateMemberDetectors] -> ShowS
show :: UpdateMemberDetectors -> String
$cshow :: UpdateMemberDetectors -> String
showsPrec :: Int -> UpdateMemberDetectors -> ShowS
$cshowsPrec :: Int -> UpdateMemberDetectors -> ShowS
Prelude.Show, forall x. Rep UpdateMemberDetectors x -> UpdateMemberDetectors
forall x. UpdateMemberDetectors -> Rep UpdateMemberDetectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateMemberDetectors x -> UpdateMemberDetectors
$cfrom :: forall x. UpdateMemberDetectors -> Rep UpdateMemberDetectors x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMemberDetectors' 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:
--
-- 'dataSources', 'updateMemberDetectors_dataSources' - Describes which data sources will be updated.
--
-- 'detectorId', 'updateMemberDetectors_detectorId' - The detector ID of the administrator account.
--
-- 'accountIds', 'updateMemberDetectors_accountIds' - A list of member account IDs to be updated.
newUpdateMemberDetectors ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'accountIds'
  Prelude.NonEmpty Prelude.Text ->
  UpdateMemberDetectors
newUpdateMemberDetectors :: Text -> NonEmpty Text -> UpdateMemberDetectors
newUpdateMemberDetectors Text
pDetectorId_ NonEmpty Text
pAccountIds_ =
  UpdateMemberDetectors'
    { $sel:dataSources:UpdateMemberDetectors' :: Maybe DataSourceConfigurations
dataSources =
        forall a. Maybe a
Prelude.Nothing,
      $sel:detectorId:UpdateMemberDetectors' :: Text
detectorId = Text
pDetectorId_,
      $sel:accountIds:UpdateMemberDetectors' :: NonEmpty Text
accountIds = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pAccountIds_
    }

-- | Describes which data sources will be updated.
updateMemberDetectors_dataSources :: Lens.Lens' UpdateMemberDetectors (Prelude.Maybe DataSourceConfigurations)
updateMemberDetectors_dataSources :: Lens' UpdateMemberDetectors (Maybe DataSourceConfigurations)
updateMemberDetectors_dataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMemberDetectors' {Maybe DataSourceConfigurations
dataSources :: Maybe DataSourceConfigurations
$sel:dataSources:UpdateMemberDetectors' :: UpdateMemberDetectors -> Maybe DataSourceConfigurations
dataSources} -> Maybe DataSourceConfigurations
dataSources) (\s :: UpdateMemberDetectors
s@UpdateMemberDetectors' {} Maybe DataSourceConfigurations
a -> UpdateMemberDetectors
s {$sel:dataSources:UpdateMemberDetectors' :: Maybe DataSourceConfigurations
dataSources = Maybe DataSourceConfigurations
a} :: UpdateMemberDetectors)

-- | The detector ID of the administrator account.
updateMemberDetectors_detectorId :: Lens.Lens' UpdateMemberDetectors Prelude.Text
updateMemberDetectors_detectorId :: Lens' UpdateMemberDetectors Text
updateMemberDetectors_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMemberDetectors' {Text
detectorId :: Text
$sel:detectorId:UpdateMemberDetectors' :: UpdateMemberDetectors -> Text
detectorId} -> Text
detectorId) (\s :: UpdateMemberDetectors
s@UpdateMemberDetectors' {} Text
a -> UpdateMemberDetectors
s {$sel:detectorId:UpdateMemberDetectors' :: Text
detectorId = Text
a} :: UpdateMemberDetectors)

-- | A list of member account IDs to be updated.
updateMemberDetectors_accountIds :: Lens.Lens' UpdateMemberDetectors (Prelude.NonEmpty Prelude.Text)
updateMemberDetectors_accountIds :: Lens' UpdateMemberDetectors (NonEmpty Text)
updateMemberDetectors_accountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMemberDetectors' {NonEmpty Text
accountIds :: NonEmpty Text
$sel:accountIds:UpdateMemberDetectors' :: UpdateMemberDetectors -> NonEmpty Text
accountIds} -> NonEmpty Text
accountIds) (\s :: UpdateMemberDetectors
s@UpdateMemberDetectors' {} NonEmpty Text
a -> UpdateMemberDetectors
s {$sel:accountIds:UpdateMemberDetectors' :: NonEmpty Text
accountIds = NonEmpty Text
a} :: UpdateMemberDetectors) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateMemberDetectors where
  type
    AWSResponse UpdateMemberDetectors =
      UpdateMemberDetectorsResponse
  request :: (Service -> Service)
-> UpdateMemberDetectors -> Request UpdateMemberDetectors
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 UpdateMemberDetectors
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateMemberDetectors)))
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 -> [UnprocessedAccount] -> UpdateMemberDetectorsResponse
UpdateMemberDetectorsResponse'
            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 (Maybe a)
Data..?> Key
"unprocessedAccounts"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable UpdateMemberDetectors where
  hashWithSalt :: Int -> UpdateMemberDetectors -> Int
hashWithSalt Int
_salt UpdateMemberDetectors' {Maybe DataSourceConfigurations
NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
dataSources :: Maybe DataSourceConfigurations
$sel:accountIds:UpdateMemberDetectors' :: UpdateMemberDetectors -> NonEmpty Text
$sel:detectorId:UpdateMemberDetectors' :: UpdateMemberDetectors -> Text
$sel:dataSources:UpdateMemberDetectors' :: UpdateMemberDetectors -> Maybe DataSourceConfigurations
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSourceConfigurations
dataSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
detectorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
accountIds

instance Prelude.NFData UpdateMemberDetectors where
  rnf :: UpdateMemberDetectors -> ()
rnf UpdateMemberDetectors' {Maybe DataSourceConfigurations
NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
dataSources :: Maybe DataSourceConfigurations
$sel:accountIds:UpdateMemberDetectors' :: UpdateMemberDetectors -> NonEmpty Text
$sel:detectorId:UpdateMemberDetectors' :: UpdateMemberDetectors -> Text
$sel:dataSources:UpdateMemberDetectors' :: UpdateMemberDetectors -> Maybe DataSourceConfigurations
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSourceConfigurations
dataSources
      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 NonEmpty Text
accountIds

instance Data.ToHeaders UpdateMemberDetectors where
  toHeaders :: UpdateMemberDetectors -> 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 UpdateMemberDetectors where
  toJSON :: UpdateMemberDetectors -> Value
toJSON UpdateMemberDetectors' {Maybe DataSourceConfigurations
NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
dataSources :: Maybe DataSourceConfigurations
$sel:accountIds:UpdateMemberDetectors' :: UpdateMemberDetectors -> NonEmpty Text
$sel:detectorId:UpdateMemberDetectors' :: UpdateMemberDetectors -> Text
$sel:dataSources:UpdateMemberDetectors' :: UpdateMemberDetectors -> Maybe DataSourceConfigurations
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"dataSources" 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 DataSourceConfigurations
dataSources,
            forall a. a -> Maybe a
Prelude.Just (Key
"accountIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
accountIds)
          ]
      )

instance Data.ToPath UpdateMemberDetectors where
  toPath :: UpdateMemberDetectors -> ByteString
toPath UpdateMemberDetectors' {Maybe DataSourceConfigurations
NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
dataSources :: Maybe DataSourceConfigurations
$sel:accountIds:UpdateMemberDetectors' :: UpdateMemberDetectors -> NonEmpty Text
$sel:detectorId:UpdateMemberDetectors' :: UpdateMemberDetectors -> Text
$sel:dataSources:UpdateMemberDetectors' :: UpdateMemberDetectors -> Maybe DataSourceConfigurations
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/detector/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId,
        ByteString
"/member/detector/update"
      ]

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

-- | /See:/ 'newUpdateMemberDetectorsResponse' smart constructor.
data UpdateMemberDetectorsResponse = UpdateMemberDetectorsResponse'
  { -- | The response's http status code.
    UpdateMemberDetectorsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of member account IDs that were unable to be processed along with
    -- an explanation for why they were not processed.
    UpdateMemberDetectorsResponse -> [UnprocessedAccount]
unprocessedAccounts :: [UnprocessedAccount]
  }
  deriving (UpdateMemberDetectorsResponse
-> UpdateMemberDetectorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMemberDetectorsResponse
-> UpdateMemberDetectorsResponse -> Bool
$c/= :: UpdateMemberDetectorsResponse
-> UpdateMemberDetectorsResponse -> Bool
== :: UpdateMemberDetectorsResponse
-> UpdateMemberDetectorsResponse -> Bool
$c== :: UpdateMemberDetectorsResponse
-> UpdateMemberDetectorsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateMemberDetectorsResponse]
ReadPrec UpdateMemberDetectorsResponse
Int -> ReadS UpdateMemberDetectorsResponse
ReadS [UpdateMemberDetectorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMemberDetectorsResponse]
$creadListPrec :: ReadPrec [UpdateMemberDetectorsResponse]
readPrec :: ReadPrec UpdateMemberDetectorsResponse
$creadPrec :: ReadPrec UpdateMemberDetectorsResponse
readList :: ReadS [UpdateMemberDetectorsResponse]
$creadList :: ReadS [UpdateMemberDetectorsResponse]
readsPrec :: Int -> ReadS UpdateMemberDetectorsResponse
$creadsPrec :: Int -> ReadS UpdateMemberDetectorsResponse
Prelude.Read, Int -> UpdateMemberDetectorsResponse -> ShowS
[UpdateMemberDetectorsResponse] -> ShowS
UpdateMemberDetectorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMemberDetectorsResponse] -> ShowS
$cshowList :: [UpdateMemberDetectorsResponse] -> ShowS
show :: UpdateMemberDetectorsResponse -> String
$cshow :: UpdateMemberDetectorsResponse -> String
showsPrec :: Int -> UpdateMemberDetectorsResponse -> ShowS
$cshowsPrec :: Int -> UpdateMemberDetectorsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateMemberDetectorsResponse x
-> UpdateMemberDetectorsResponse
forall x.
UpdateMemberDetectorsResponse
-> Rep UpdateMemberDetectorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMemberDetectorsResponse x
-> UpdateMemberDetectorsResponse
$cfrom :: forall x.
UpdateMemberDetectorsResponse
-> Rep UpdateMemberDetectorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMemberDetectorsResponse' 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', 'updateMemberDetectorsResponse_httpStatus' - The response's http status code.
--
-- 'unprocessedAccounts', 'updateMemberDetectorsResponse_unprocessedAccounts' - A list of member account IDs that were unable to be processed along with
-- an explanation for why they were not processed.
newUpdateMemberDetectorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateMemberDetectorsResponse
newUpdateMemberDetectorsResponse :: Int -> UpdateMemberDetectorsResponse
newUpdateMemberDetectorsResponse Int
pHttpStatus_ =
  UpdateMemberDetectorsResponse'
    { $sel:httpStatus:UpdateMemberDetectorsResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:unprocessedAccounts:UpdateMemberDetectorsResponse' :: [UnprocessedAccount]
unprocessedAccounts = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | A list of member account IDs that were unable to be processed along with
-- an explanation for why they were not processed.
updateMemberDetectorsResponse_unprocessedAccounts :: Lens.Lens' UpdateMemberDetectorsResponse [UnprocessedAccount]
updateMemberDetectorsResponse_unprocessedAccounts :: Lens' UpdateMemberDetectorsResponse [UnprocessedAccount]
updateMemberDetectorsResponse_unprocessedAccounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMemberDetectorsResponse' {[UnprocessedAccount]
unprocessedAccounts :: [UnprocessedAccount]
$sel:unprocessedAccounts:UpdateMemberDetectorsResponse' :: UpdateMemberDetectorsResponse -> [UnprocessedAccount]
unprocessedAccounts} -> [UnprocessedAccount]
unprocessedAccounts) (\s :: UpdateMemberDetectorsResponse
s@UpdateMemberDetectorsResponse' {} [UnprocessedAccount]
a -> UpdateMemberDetectorsResponse
s {$sel:unprocessedAccounts:UpdateMemberDetectorsResponse' :: [UnprocessedAccount]
unprocessedAccounts = [UnprocessedAccount]
a} :: UpdateMemberDetectorsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData UpdateMemberDetectorsResponse where
  rnf :: UpdateMemberDetectorsResponse -> ()
rnf UpdateMemberDetectorsResponse' {Int
[UnprocessedAccount]
unprocessedAccounts :: [UnprocessedAccount]
httpStatus :: Int
$sel:unprocessedAccounts:UpdateMemberDetectorsResponse' :: UpdateMemberDetectorsResponse -> [UnprocessedAccount]
$sel:httpStatus:UpdateMemberDetectorsResponse' :: UpdateMemberDetectorsResponse -> 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 [UnprocessedAccount]
unprocessedAccounts