{-# 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.GetMemberDetectors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes which data sources are enabled for the member account\'s
-- detector.
module Amazonka.GuardDuty.GetMemberDetectors
  ( -- * Creating a Request
    GetMemberDetectors (..),
    newGetMemberDetectors,

    -- * Request Lenses
    getMemberDetectors_detectorId,
    getMemberDetectors_accountIds,

    -- * Destructuring the Response
    GetMemberDetectorsResponse (..),
    newGetMemberDetectorsResponse,

    -- * Response Lenses
    getMemberDetectorsResponse_httpStatus,
    getMemberDetectorsResponse_memberDataSourceConfigurations,
    getMemberDetectorsResponse_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:/ 'newGetMemberDetectors' smart constructor.
data GetMemberDetectors = GetMemberDetectors'
  { -- | The detector ID for the administrator account.
    GetMemberDetectors -> Text
detectorId :: Prelude.Text,
    -- | The account ID of the member account.
    GetMemberDetectors -> NonEmpty Text
accountIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (GetMemberDetectors -> GetMemberDetectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMemberDetectors -> GetMemberDetectors -> Bool
$c/= :: GetMemberDetectors -> GetMemberDetectors -> Bool
== :: GetMemberDetectors -> GetMemberDetectors -> Bool
$c== :: GetMemberDetectors -> GetMemberDetectors -> Bool
Prelude.Eq, ReadPrec [GetMemberDetectors]
ReadPrec GetMemberDetectors
Int -> ReadS GetMemberDetectors
ReadS [GetMemberDetectors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMemberDetectors]
$creadListPrec :: ReadPrec [GetMemberDetectors]
readPrec :: ReadPrec GetMemberDetectors
$creadPrec :: ReadPrec GetMemberDetectors
readList :: ReadS [GetMemberDetectors]
$creadList :: ReadS [GetMemberDetectors]
readsPrec :: Int -> ReadS GetMemberDetectors
$creadsPrec :: Int -> ReadS GetMemberDetectors
Prelude.Read, Int -> GetMemberDetectors -> ShowS
[GetMemberDetectors] -> ShowS
GetMemberDetectors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMemberDetectors] -> ShowS
$cshowList :: [GetMemberDetectors] -> ShowS
show :: GetMemberDetectors -> String
$cshow :: GetMemberDetectors -> String
showsPrec :: Int -> GetMemberDetectors -> ShowS
$cshowsPrec :: Int -> GetMemberDetectors -> ShowS
Prelude.Show, forall x. Rep GetMemberDetectors x -> GetMemberDetectors
forall x. GetMemberDetectors -> Rep GetMemberDetectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMemberDetectors x -> GetMemberDetectors
$cfrom :: forall x. GetMemberDetectors -> Rep GetMemberDetectors x
Prelude.Generic)

-- |
-- Create a value of 'GetMemberDetectors' 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:
--
-- 'detectorId', 'getMemberDetectors_detectorId' - The detector ID for the administrator account.
--
-- 'accountIds', 'getMemberDetectors_accountIds' - The account ID of the member account.
newGetMemberDetectors ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'accountIds'
  Prelude.NonEmpty Prelude.Text ->
  GetMemberDetectors
newGetMemberDetectors :: Text -> NonEmpty Text -> GetMemberDetectors
newGetMemberDetectors Text
pDetectorId_ NonEmpty Text
pAccountIds_ =
  GetMemberDetectors'
    { $sel:detectorId:GetMemberDetectors' :: Text
detectorId = Text
pDetectorId_,
      $sel:accountIds:GetMemberDetectors' :: 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_
    }

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

-- | The account ID of the member account.
getMemberDetectors_accountIds :: Lens.Lens' GetMemberDetectors (Prelude.NonEmpty Prelude.Text)
getMemberDetectors_accountIds :: Lens' GetMemberDetectors (NonEmpty Text)
getMemberDetectors_accountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMemberDetectors' {NonEmpty Text
accountIds :: NonEmpty Text
$sel:accountIds:GetMemberDetectors' :: GetMemberDetectors -> NonEmpty Text
accountIds} -> NonEmpty Text
accountIds) (\s :: GetMemberDetectors
s@GetMemberDetectors' {} NonEmpty Text
a -> GetMemberDetectors
s {$sel:accountIds:GetMemberDetectors' :: NonEmpty Text
accountIds = NonEmpty Text
a} :: GetMemberDetectors) 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 GetMemberDetectors where
  type
    AWSResponse GetMemberDetectors =
      GetMemberDetectorsResponse
  request :: (Service -> Service)
-> GetMemberDetectors -> Request GetMemberDetectors
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 GetMemberDetectors
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetMemberDetectors)))
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
-> NonEmpty MemberDataSourceConfiguration
-> [UnprocessedAccount]
-> GetMemberDetectorsResponse
GetMemberDetectorsResponse'
            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
"members")
            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 GetMemberDetectors where
  hashWithSalt :: Int -> GetMemberDetectors -> Int
hashWithSalt Int
_salt GetMemberDetectors' {NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
$sel:accountIds:GetMemberDetectors' :: GetMemberDetectors -> NonEmpty Text
$sel:detectorId:GetMemberDetectors' :: GetMemberDetectors -> Text
..} =
    Int
_salt
      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 GetMemberDetectors where
  rnf :: GetMemberDetectors -> ()
rnf GetMemberDetectors' {NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
$sel:accountIds:GetMemberDetectors' :: GetMemberDetectors -> NonEmpty Text
$sel:detectorId:GetMemberDetectors' :: GetMemberDetectors -> Text
..} =
    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 GetMemberDetectors where
  toHeaders :: GetMemberDetectors -> 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 GetMemberDetectors where
  toJSON :: GetMemberDetectors -> Value
toJSON GetMemberDetectors' {NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
$sel:accountIds:GetMemberDetectors' :: GetMemberDetectors -> NonEmpty Text
$sel:detectorId:GetMemberDetectors' :: GetMemberDetectors -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 GetMemberDetectors where
  toPath :: GetMemberDetectors -> ByteString
toPath GetMemberDetectors' {NonEmpty Text
Text
accountIds :: NonEmpty Text
detectorId :: Text
$sel:accountIds:GetMemberDetectors' :: GetMemberDetectors -> NonEmpty Text
$sel:detectorId:GetMemberDetectors' :: GetMemberDetectors -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/detector/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId,
        ByteString
"/member/detector/get"
      ]

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

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

-- |
-- Create a value of 'GetMemberDetectorsResponse' 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', 'getMemberDetectorsResponse_httpStatus' - The response's http status code.
--
-- 'memberDataSourceConfigurations', 'getMemberDetectorsResponse_memberDataSourceConfigurations' - An object that describes which data sources are enabled for a member
-- account.
--
-- 'unprocessedAccounts', 'getMemberDetectorsResponse_unprocessedAccounts' - A list of member account IDs that were unable to be processed along with
-- an explanation for why they were not processed.
newGetMemberDetectorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'memberDataSourceConfigurations'
  Prelude.NonEmpty MemberDataSourceConfiguration ->
  GetMemberDetectorsResponse
newGetMemberDetectorsResponse :: Int
-> NonEmpty MemberDataSourceConfiguration
-> GetMemberDetectorsResponse
newGetMemberDetectorsResponse
  Int
pHttpStatus_
  NonEmpty MemberDataSourceConfiguration
pMemberDataSourceConfigurations_ =
    GetMemberDetectorsResponse'
      { $sel:httpStatus:GetMemberDetectorsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:memberDataSourceConfigurations:GetMemberDetectorsResponse' :: NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations =
          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 MemberDataSourceConfiguration
pMemberDataSourceConfigurations_,
        $sel:unprocessedAccounts:GetMemberDetectorsResponse' :: [UnprocessedAccount]
unprocessedAccounts = forall a. Monoid a => a
Prelude.mempty
      }

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

-- | An object that describes which data sources are enabled for a member
-- account.
getMemberDetectorsResponse_memberDataSourceConfigurations :: Lens.Lens' GetMemberDetectorsResponse (Prelude.NonEmpty MemberDataSourceConfiguration)
getMemberDetectorsResponse_memberDataSourceConfigurations :: Lens'
  GetMemberDetectorsResponse (NonEmpty MemberDataSourceConfiguration)
getMemberDetectorsResponse_memberDataSourceConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMemberDetectorsResponse' {NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations :: NonEmpty MemberDataSourceConfiguration
$sel:memberDataSourceConfigurations:GetMemberDetectorsResponse' :: GetMemberDetectorsResponse
-> NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations} -> NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations) (\s :: GetMemberDetectorsResponse
s@GetMemberDetectorsResponse' {} NonEmpty MemberDataSourceConfiguration
a -> GetMemberDetectorsResponse
s {$sel:memberDataSourceConfigurations:GetMemberDetectorsResponse' :: NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations = NonEmpty MemberDataSourceConfiguration
a} :: GetMemberDetectorsResponse) 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

-- | A list of member account IDs that were unable to be processed along with
-- an explanation for why they were not processed.
getMemberDetectorsResponse_unprocessedAccounts :: Lens.Lens' GetMemberDetectorsResponse [UnprocessedAccount]
getMemberDetectorsResponse_unprocessedAccounts :: Lens' GetMemberDetectorsResponse [UnprocessedAccount]
getMemberDetectorsResponse_unprocessedAccounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMemberDetectorsResponse' {[UnprocessedAccount]
unprocessedAccounts :: [UnprocessedAccount]
$sel:unprocessedAccounts:GetMemberDetectorsResponse' :: GetMemberDetectorsResponse -> [UnprocessedAccount]
unprocessedAccounts} -> [UnprocessedAccount]
unprocessedAccounts) (\s :: GetMemberDetectorsResponse
s@GetMemberDetectorsResponse' {} [UnprocessedAccount]
a -> GetMemberDetectorsResponse
s {$sel:unprocessedAccounts:GetMemberDetectorsResponse' :: [UnprocessedAccount]
unprocessedAccounts = [UnprocessedAccount]
a} :: GetMemberDetectorsResponse) 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 GetMemberDetectorsResponse where
  rnf :: GetMemberDetectorsResponse -> ()
rnf GetMemberDetectorsResponse' {Int
[UnprocessedAccount]
NonEmpty MemberDataSourceConfiguration
unprocessedAccounts :: [UnprocessedAccount]
memberDataSourceConfigurations :: NonEmpty MemberDataSourceConfiguration
httpStatus :: Int
$sel:unprocessedAccounts:GetMemberDetectorsResponse' :: GetMemberDetectorsResponse -> [UnprocessedAccount]
$sel:memberDataSourceConfigurations:GetMemberDetectorsResponse' :: GetMemberDetectorsResponse
-> NonEmpty MemberDataSourceConfiguration
$sel:httpStatus:GetMemberDetectorsResponse' :: GetMemberDetectorsResponse -> 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 NonEmpty MemberDataSourceConfiguration
memberDataSourceConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [UnprocessedAccount]
unprocessedAccounts