{-# 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.Detective.BatchGetGraphMemberDatasources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets data source package information for the behavior graph.
module Amazonka.Detective.BatchGetGraphMemberDatasources
  ( -- * Creating a Request
    BatchGetGraphMemberDatasources (..),
    newBatchGetGraphMemberDatasources,

    -- * Request Lenses
    batchGetGraphMemberDatasources_graphArn,
    batchGetGraphMemberDatasources_accountIds,

    -- * Destructuring the Response
    BatchGetGraphMemberDatasourcesResponse (..),
    newBatchGetGraphMemberDatasourcesResponse,

    -- * Response Lenses
    batchGetGraphMemberDatasourcesResponse_memberDatasources,
    batchGetGraphMemberDatasourcesResponse_unprocessedAccounts,
    batchGetGraphMemberDatasourcesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newBatchGetGraphMemberDatasources' smart constructor.
data BatchGetGraphMemberDatasources = BatchGetGraphMemberDatasources'
  { -- | The ARN of the behavior graph.
    BatchGetGraphMemberDatasources -> Text
graphArn :: Prelude.Text,
    -- | The list of Amazon Web Services accounts to get data source package
    -- information on.
    BatchGetGraphMemberDatasources -> NonEmpty Text
accountIds :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetGraphMemberDatasources
-> BatchGetGraphMemberDatasources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetGraphMemberDatasources
-> BatchGetGraphMemberDatasources -> Bool
$c/= :: BatchGetGraphMemberDatasources
-> BatchGetGraphMemberDatasources -> Bool
== :: BatchGetGraphMemberDatasources
-> BatchGetGraphMemberDatasources -> Bool
$c== :: BatchGetGraphMemberDatasources
-> BatchGetGraphMemberDatasources -> Bool
Prelude.Eq, ReadPrec [BatchGetGraphMemberDatasources]
ReadPrec BatchGetGraphMemberDatasources
Int -> ReadS BatchGetGraphMemberDatasources
ReadS [BatchGetGraphMemberDatasources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetGraphMemberDatasources]
$creadListPrec :: ReadPrec [BatchGetGraphMemberDatasources]
readPrec :: ReadPrec BatchGetGraphMemberDatasources
$creadPrec :: ReadPrec BatchGetGraphMemberDatasources
readList :: ReadS [BatchGetGraphMemberDatasources]
$creadList :: ReadS [BatchGetGraphMemberDatasources]
readsPrec :: Int -> ReadS BatchGetGraphMemberDatasources
$creadsPrec :: Int -> ReadS BatchGetGraphMemberDatasources
Prelude.Read, Int -> BatchGetGraphMemberDatasources -> ShowS
[BatchGetGraphMemberDatasources] -> ShowS
BatchGetGraphMemberDatasources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetGraphMemberDatasources] -> ShowS
$cshowList :: [BatchGetGraphMemberDatasources] -> ShowS
show :: BatchGetGraphMemberDatasources -> String
$cshow :: BatchGetGraphMemberDatasources -> String
showsPrec :: Int -> BatchGetGraphMemberDatasources -> ShowS
$cshowsPrec :: Int -> BatchGetGraphMemberDatasources -> ShowS
Prelude.Show, forall x.
Rep BatchGetGraphMemberDatasources x
-> BatchGetGraphMemberDatasources
forall x.
BatchGetGraphMemberDatasources
-> Rep BatchGetGraphMemberDatasources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetGraphMemberDatasources x
-> BatchGetGraphMemberDatasources
$cfrom :: forall x.
BatchGetGraphMemberDatasources
-> Rep BatchGetGraphMemberDatasources x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetGraphMemberDatasources' 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:
--
-- 'graphArn', 'batchGetGraphMemberDatasources_graphArn' - The ARN of the behavior graph.
--
-- 'accountIds', 'batchGetGraphMemberDatasources_accountIds' - The list of Amazon Web Services accounts to get data source package
-- information on.
newBatchGetGraphMemberDatasources ::
  -- | 'graphArn'
  Prelude.Text ->
  -- | 'accountIds'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetGraphMemberDatasources
newBatchGetGraphMemberDatasources :: Text -> NonEmpty Text -> BatchGetGraphMemberDatasources
newBatchGetGraphMemberDatasources
  Text
pGraphArn_
  NonEmpty Text
pAccountIds_ =
    BatchGetGraphMemberDatasources'
      { $sel:graphArn:BatchGetGraphMemberDatasources' :: Text
graphArn =
          Text
pGraphArn_,
        $sel:accountIds:BatchGetGraphMemberDatasources' :: 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 ARN of the behavior graph.
batchGetGraphMemberDatasources_graphArn :: Lens.Lens' BatchGetGraphMemberDatasources Prelude.Text
batchGetGraphMemberDatasources_graphArn :: Lens' BatchGetGraphMemberDatasources Text
batchGetGraphMemberDatasources_graphArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetGraphMemberDatasources' {Text
graphArn :: Text
$sel:graphArn:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> Text
graphArn} -> Text
graphArn) (\s :: BatchGetGraphMemberDatasources
s@BatchGetGraphMemberDatasources' {} Text
a -> BatchGetGraphMemberDatasources
s {$sel:graphArn:BatchGetGraphMemberDatasources' :: Text
graphArn = Text
a} :: BatchGetGraphMemberDatasources)

-- | The list of Amazon Web Services accounts to get data source package
-- information on.
batchGetGraphMemberDatasources_accountIds :: Lens.Lens' BatchGetGraphMemberDatasources (Prelude.NonEmpty Prelude.Text)
batchGetGraphMemberDatasources_accountIds :: Lens' BatchGetGraphMemberDatasources (NonEmpty Text)
batchGetGraphMemberDatasources_accountIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetGraphMemberDatasources' {NonEmpty Text
accountIds :: NonEmpty Text
$sel:accountIds:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> NonEmpty Text
accountIds} -> NonEmpty Text
accountIds) (\s :: BatchGetGraphMemberDatasources
s@BatchGetGraphMemberDatasources' {} NonEmpty Text
a -> BatchGetGraphMemberDatasources
s {$sel:accountIds:BatchGetGraphMemberDatasources' :: NonEmpty Text
accountIds = NonEmpty Text
a} :: BatchGetGraphMemberDatasources) 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
    BatchGetGraphMemberDatasources
  where
  type
    AWSResponse BatchGetGraphMemberDatasources =
      BatchGetGraphMemberDatasourcesResponse
  request :: (Service -> Service)
-> BatchGetGraphMemberDatasources
-> Request BatchGetGraphMemberDatasources
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 BatchGetGraphMemberDatasources
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse BatchGetGraphMemberDatasources)))
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 ->
          Maybe [MembershipDatasources]
-> Maybe [UnprocessedAccount]
-> Int
-> BatchGetGraphMemberDatasourcesResponse
BatchGetGraphMemberDatasourcesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MemberDatasources"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
                        )
            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
    BatchGetGraphMemberDatasources
  where
  hashWithSalt :: Int -> BatchGetGraphMemberDatasources -> Int
hashWithSalt
    Int
_salt
    BatchGetGraphMemberDatasources' {NonEmpty Text
Text
accountIds :: NonEmpty Text
graphArn :: Text
$sel:accountIds:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> NonEmpty Text
$sel:graphArn:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
graphArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
accountIds

instance
  Prelude.NFData
    BatchGetGraphMemberDatasources
  where
  rnf :: BatchGetGraphMemberDatasources -> ()
rnf BatchGetGraphMemberDatasources' {NonEmpty Text
Text
accountIds :: NonEmpty Text
graphArn :: Text
$sel:accountIds:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> NonEmpty Text
$sel:graphArn:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
graphArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
accountIds

instance
  Data.ToHeaders
    BatchGetGraphMemberDatasources
  where
  toHeaders :: BatchGetGraphMemberDatasources -> 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 BatchGetGraphMemberDatasources where
  toJSON :: BatchGetGraphMemberDatasources -> Value
toJSON BatchGetGraphMemberDatasources' {NonEmpty Text
Text
accountIds :: NonEmpty Text
graphArn :: Text
$sel:accountIds:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> NonEmpty Text
$sel:graphArn:BatchGetGraphMemberDatasources' :: BatchGetGraphMemberDatasources -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"GraphArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
graphArn),
            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 BatchGetGraphMemberDatasources where
  toPath :: BatchGetGraphMemberDatasources -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/graph/datasources/get"

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

-- | /See:/ 'newBatchGetGraphMemberDatasourcesResponse' smart constructor.
data BatchGetGraphMemberDatasourcesResponse = BatchGetGraphMemberDatasourcesResponse'
  { -- | Details on the status of data source packages for members of the
    -- behavior graph.
    BatchGetGraphMemberDatasourcesResponse
-> Maybe [MembershipDatasources]
memberDatasources :: Prelude.Maybe [MembershipDatasources],
    -- | Accounts that data source package information could not be retrieved
    -- for.
    BatchGetGraphMemberDatasourcesResponse
-> Maybe [UnprocessedAccount]
unprocessedAccounts :: Prelude.Maybe [UnprocessedAccount],
    -- | The response's http status code.
    BatchGetGraphMemberDatasourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetGraphMemberDatasourcesResponse
-> BatchGetGraphMemberDatasourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetGraphMemberDatasourcesResponse
-> BatchGetGraphMemberDatasourcesResponse -> Bool
$c/= :: BatchGetGraphMemberDatasourcesResponse
-> BatchGetGraphMemberDatasourcesResponse -> Bool
== :: BatchGetGraphMemberDatasourcesResponse
-> BatchGetGraphMemberDatasourcesResponse -> Bool
$c== :: BatchGetGraphMemberDatasourcesResponse
-> BatchGetGraphMemberDatasourcesResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetGraphMemberDatasourcesResponse]
ReadPrec BatchGetGraphMemberDatasourcesResponse
Int -> ReadS BatchGetGraphMemberDatasourcesResponse
ReadS [BatchGetGraphMemberDatasourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetGraphMemberDatasourcesResponse]
$creadListPrec :: ReadPrec [BatchGetGraphMemberDatasourcesResponse]
readPrec :: ReadPrec BatchGetGraphMemberDatasourcesResponse
$creadPrec :: ReadPrec BatchGetGraphMemberDatasourcesResponse
readList :: ReadS [BatchGetGraphMemberDatasourcesResponse]
$creadList :: ReadS [BatchGetGraphMemberDatasourcesResponse]
readsPrec :: Int -> ReadS BatchGetGraphMemberDatasourcesResponse
$creadsPrec :: Int -> ReadS BatchGetGraphMemberDatasourcesResponse
Prelude.Read, Int -> BatchGetGraphMemberDatasourcesResponse -> ShowS
[BatchGetGraphMemberDatasourcesResponse] -> ShowS
BatchGetGraphMemberDatasourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetGraphMemberDatasourcesResponse] -> ShowS
$cshowList :: [BatchGetGraphMemberDatasourcesResponse] -> ShowS
show :: BatchGetGraphMemberDatasourcesResponse -> String
$cshow :: BatchGetGraphMemberDatasourcesResponse -> String
showsPrec :: Int -> BatchGetGraphMemberDatasourcesResponse -> ShowS
$cshowsPrec :: Int -> BatchGetGraphMemberDatasourcesResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetGraphMemberDatasourcesResponse x
-> BatchGetGraphMemberDatasourcesResponse
forall x.
BatchGetGraphMemberDatasourcesResponse
-> Rep BatchGetGraphMemberDatasourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetGraphMemberDatasourcesResponse x
-> BatchGetGraphMemberDatasourcesResponse
$cfrom :: forall x.
BatchGetGraphMemberDatasourcesResponse
-> Rep BatchGetGraphMemberDatasourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetGraphMemberDatasourcesResponse' 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:
--
-- 'memberDatasources', 'batchGetGraphMemberDatasourcesResponse_memberDatasources' - Details on the status of data source packages for members of the
-- behavior graph.
--
-- 'unprocessedAccounts', 'batchGetGraphMemberDatasourcesResponse_unprocessedAccounts' - Accounts that data source package information could not be retrieved
-- for.
--
-- 'httpStatus', 'batchGetGraphMemberDatasourcesResponse_httpStatus' - The response's http status code.
newBatchGetGraphMemberDatasourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetGraphMemberDatasourcesResponse
newBatchGetGraphMemberDatasourcesResponse :: Int -> BatchGetGraphMemberDatasourcesResponse
newBatchGetGraphMemberDatasourcesResponse
  Int
pHttpStatus_ =
    BatchGetGraphMemberDatasourcesResponse'
      { $sel:memberDatasources:BatchGetGraphMemberDatasourcesResponse' :: Maybe [MembershipDatasources]
memberDatasources =
          forall a. Maybe a
Prelude.Nothing,
        $sel:unprocessedAccounts:BatchGetGraphMemberDatasourcesResponse' :: Maybe [UnprocessedAccount]
unprocessedAccounts =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:BatchGetGraphMemberDatasourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Details on the status of data source packages for members of the
-- behavior graph.
batchGetGraphMemberDatasourcesResponse_memberDatasources :: Lens.Lens' BatchGetGraphMemberDatasourcesResponse (Prelude.Maybe [MembershipDatasources])
batchGetGraphMemberDatasourcesResponse_memberDatasources :: Lens'
  BatchGetGraphMemberDatasourcesResponse
  (Maybe [MembershipDatasources])
batchGetGraphMemberDatasourcesResponse_memberDatasources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetGraphMemberDatasourcesResponse' {Maybe [MembershipDatasources]
memberDatasources :: Maybe [MembershipDatasources]
$sel:memberDatasources:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse
-> Maybe [MembershipDatasources]
memberDatasources} -> Maybe [MembershipDatasources]
memberDatasources) (\s :: BatchGetGraphMemberDatasourcesResponse
s@BatchGetGraphMemberDatasourcesResponse' {} Maybe [MembershipDatasources]
a -> BatchGetGraphMemberDatasourcesResponse
s {$sel:memberDatasources:BatchGetGraphMemberDatasourcesResponse' :: Maybe [MembershipDatasources]
memberDatasources = Maybe [MembershipDatasources]
a} :: BatchGetGraphMemberDatasourcesResponse) 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

-- | Accounts that data source package information could not be retrieved
-- for.
batchGetGraphMemberDatasourcesResponse_unprocessedAccounts :: Lens.Lens' BatchGetGraphMemberDatasourcesResponse (Prelude.Maybe [UnprocessedAccount])
batchGetGraphMemberDatasourcesResponse_unprocessedAccounts :: Lens'
  BatchGetGraphMemberDatasourcesResponse (Maybe [UnprocessedAccount])
batchGetGraphMemberDatasourcesResponse_unprocessedAccounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetGraphMemberDatasourcesResponse' {Maybe [UnprocessedAccount]
unprocessedAccounts :: Maybe [UnprocessedAccount]
$sel:unprocessedAccounts:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse
-> Maybe [UnprocessedAccount]
unprocessedAccounts} -> Maybe [UnprocessedAccount]
unprocessedAccounts) (\s :: BatchGetGraphMemberDatasourcesResponse
s@BatchGetGraphMemberDatasourcesResponse' {} Maybe [UnprocessedAccount]
a -> BatchGetGraphMemberDatasourcesResponse
s {$sel:unprocessedAccounts:BatchGetGraphMemberDatasourcesResponse' :: Maybe [UnprocessedAccount]
unprocessedAccounts = Maybe [UnprocessedAccount]
a} :: BatchGetGraphMemberDatasourcesResponse) 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 response's http status code.
batchGetGraphMemberDatasourcesResponse_httpStatus :: Lens.Lens' BatchGetGraphMemberDatasourcesResponse Prelude.Int
batchGetGraphMemberDatasourcesResponse_httpStatus :: Lens' BatchGetGraphMemberDatasourcesResponse Int
batchGetGraphMemberDatasourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetGraphMemberDatasourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetGraphMemberDatasourcesResponse
s@BatchGetGraphMemberDatasourcesResponse' {} Int
a -> BatchGetGraphMemberDatasourcesResponse
s {$sel:httpStatus:BatchGetGraphMemberDatasourcesResponse' :: Int
httpStatus = Int
a} :: BatchGetGraphMemberDatasourcesResponse)

instance
  Prelude.NFData
    BatchGetGraphMemberDatasourcesResponse
  where
  rnf :: BatchGetGraphMemberDatasourcesResponse -> ()
rnf BatchGetGraphMemberDatasourcesResponse' {Int
Maybe [MembershipDatasources]
Maybe [UnprocessedAccount]
httpStatus :: Int
unprocessedAccounts :: Maybe [UnprocessedAccount]
memberDatasources :: Maybe [MembershipDatasources]
$sel:httpStatus:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse -> Int
$sel:unprocessedAccounts:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse
-> Maybe [UnprocessedAccount]
$sel:memberDatasources:BatchGetGraphMemberDatasourcesResponse' :: BatchGetGraphMemberDatasourcesResponse
-> Maybe [MembershipDatasources]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MembershipDatasources]
memberDatasources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnprocessedAccount]
unprocessedAccounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus