{-# 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.FSx.DescribeDataRepositoryAssociations
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the description of specific Amazon FSx for Lustre or Amazon File
-- Cache data repository associations, if one or more @AssociationIds@
-- values are provided in the request, or if filters are used in the
-- request. Data repository associations are supported only for Amazon FSx
-- for Lustre file systems with the @Persistent_2@ deployment type and for
-- Amazon File Cache resources.
--
-- You can use filters to narrow the response to include just data
-- repository associations for specific file systems (use the
-- @file-system-id@ filter with the ID of the file system) or caches (use
-- the @file-cache-id@ filter with the ID of the cache), or data repository
-- associations for a specific repository type (use the
-- @data-repository-type@ filter with a value of @S3@ or @NFS@). If you
-- don\'t use filters, the response returns all data repository
-- associations owned by your Amazon Web Services account in the Amazon Web
-- Services Region of the endpoint that you\'re calling.
--
-- When retrieving all data repository associations, you can paginate the
-- response by using the optional @MaxResults@ parameter to limit the
-- number of data repository associations returned in a response. If more
-- data repository associations remain, a @NextToken@ value is returned in
-- the response. In this case, send a later request with the @NextToken@
-- request parameter set to the value of @NextToken@ from the last
-- response.
module Amazonka.FSx.DescribeDataRepositoryAssociations
  ( -- * Creating a Request
    DescribeDataRepositoryAssociations (..),
    newDescribeDataRepositoryAssociations,

    -- * Request Lenses
    describeDataRepositoryAssociations_associationIds,
    describeDataRepositoryAssociations_filters,
    describeDataRepositoryAssociations_maxResults,
    describeDataRepositoryAssociations_nextToken,

    -- * Destructuring the Response
    DescribeDataRepositoryAssociationsResponse (..),
    newDescribeDataRepositoryAssociationsResponse,

    -- * Response Lenses
    describeDataRepositoryAssociationsResponse_associations,
    describeDataRepositoryAssociationsResponse_nextToken,
    describeDataRepositoryAssociationsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeDataRepositoryAssociations' smart constructor.
data DescribeDataRepositoryAssociations = DescribeDataRepositoryAssociations'
  { -- | IDs of the data repository associations whose descriptions you want to
    -- retrieve (String).
    DescribeDataRepositoryAssociations -> Maybe [Text]
associationIds :: Prelude.Maybe [Prelude.Text],
    DescribeDataRepositoryAssociations -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The maximum number of resources to return in the response. This value
    -- must be an integer greater than zero.
    DescribeDataRepositoryAssociations -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    DescribeDataRepositoryAssociations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeDataRepositoryAssociations
-> DescribeDataRepositoryAssociations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDataRepositoryAssociations
-> DescribeDataRepositoryAssociations -> Bool
$c/= :: DescribeDataRepositoryAssociations
-> DescribeDataRepositoryAssociations -> Bool
== :: DescribeDataRepositoryAssociations
-> DescribeDataRepositoryAssociations -> Bool
$c== :: DescribeDataRepositoryAssociations
-> DescribeDataRepositoryAssociations -> Bool
Prelude.Eq, ReadPrec [DescribeDataRepositoryAssociations]
ReadPrec DescribeDataRepositoryAssociations
Int -> ReadS DescribeDataRepositoryAssociations
ReadS [DescribeDataRepositoryAssociations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDataRepositoryAssociations]
$creadListPrec :: ReadPrec [DescribeDataRepositoryAssociations]
readPrec :: ReadPrec DescribeDataRepositoryAssociations
$creadPrec :: ReadPrec DescribeDataRepositoryAssociations
readList :: ReadS [DescribeDataRepositoryAssociations]
$creadList :: ReadS [DescribeDataRepositoryAssociations]
readsPrec :: Int -> ReadS DescribeDataRepositoryAssociations
$creadsPrec :: Int -> ReadS DescribeDataRepositoryAssociations
Prelude.Read, Int -> DescribeDataRepositoryAssociations -> ShowS
[DescribeDataRepositoryAssociations] -> ShowS
DescribeDataRepositoryAssociations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDataRepositoryAssociations] -> ShowS
$cshowList :: [DescribeDataRepositoryAssociations] -> ShowS
show :: DescribeDataRepositoryAssociations -> String
$cshow :: DescribeDataRepositoryAssociations -> String
showsPrec :: Int -> DescribeDataRepositoryAssociations -> ShowS
$cshowsPrec :: Int -> DescribeDataRepositoryAssociations -> ShowS
Prelude.Show, forall x.
Rep DescribeDataRepositoryAssociations x
-> DescribeDataRepositoryAssociations
forall x.
DescribeDataRepositoryAssociations
-> Rep DescribeDataRepositoryAssociations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDataRepositoryAssociations x
-> DescribeDataRepositoryAssociations
$cfrom :: forall x.
DescribeDataRepositoryAssociations
-> Rep DescribeDataRepositoryAssociations x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDataRepositoryAssociations' 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:
--
-- 'associationIds', 'describeDataRepositoryAssociations_associationIds' - IDs of the data repository associations whose descriptions you want to
-- retrieve (String).
--
-- 'filters', 'describeDataRepositoryAssociations_filters' - Undocumented member.
--
-- 'maxResults', 'describeDataRepositoryAssociations_maxResults' - The maximum number of resources to return in the response. This value
-- must be an integer greater than zero.
--
-- 'nextToken', 'describeDataRepositoryAssociations_nextToken' - Undocumented member.
newDescribeDataRepositoryAssociations ::
  DescribeDataRepositoryAssociations
newDescribeDataRepositoryAssociations :: DescribeDataRepositoryAssociations
newDescribeDataRepositoryAssociations =
  DescribeDataRepositoryAssociations'
    { $sel:associationIds:DescribeDataRepositoryAssociations' :: Maybe [Text]
associationIds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeDataRepositoryAssociations' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeDataRepositoryAssociations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeDataRepositoryAssociations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | IDs of the data repository associations whose descriptions you want to
-- retrieve (String).
describeDataRepositoryAssociations_associationIds :: Lens.Lens' DescribeDataRepositoryAssociations (Prelude.Maybe [Prelude.Text])
describeDataRepositoryAssociations_associationIds :: Lens' DescribeDataRepositoryAssociations (Maybe [Text])
describeDataRepositoryAssociations_associationIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociations' {Maybe [Text]
associationIds :: Maybe [Text]
$sel:associationIds:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Text]
associationIds} -> Maybe [Text]
associationIds) (\s :: DescribeDataRepositoryAssociations
s@DescribeDataRepositoryAssociations' {} Maybe [Text]
a -> DescribeDataRepositoryAssociations
s {$sel:associationIds:DescribeDataRepositoryAssociations' :: Maybe [Text]
associationIds = Maybe [Text]
a} :: DescribeDataRepositoryAssociations) 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

-- | Undocumented member.
describeDataRepositoryAssociations_filters :: Lens.Lens' DescribeDataRepositoryAssociations (Prelude.Maybe [Filter])
describeDataRepositoryAssociations_filters :: Lens' DescribeDataRepositoryAssociations (Maybe [Filter])
describeDataRepositoryAssociations_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociations' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeDataRepositoryAssociations
s@DescribeDataRepositoryAssociations' {} Maybe [Filter]
a -> DescribeDataRepositoryAssociations
s {$sel:filters:DescribeDataRepositoryAssociations' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeDataRepositoryAssociations) 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 maximum number of resources to return in the response. This value
-- must be an integer greater than zero.
describeDataRepositoryAssociations_maxResults :: Lens.Lens' DescribeDataRepositoryAssociations (Prelude.Maybe Prelude.Natural)
describeDataRepositoryAssociations_maxResults :: Lens' DescribeDataRepositoryAssociations (Maybe Natural)
describeDataRepositoryAssociations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociations' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeDataRepositoryAssociations
s@DescribeDataRepositoryAssociations' {} Maybe Natural
a -> DescribeDataRepositoryAssociations
s {$sel:maxResults:DescribeDataRepositoryAssociations' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeDataRepositoryAssociations)

-- | Undocumented member.
describeDataRepositoryAssociations_nextToken :: Lens.Lens' DescribeDataRepositoryAssociations (Prelude.Maybe Prelude.Text)
describeDataRepositoryAssociations_nextToken :: Lens' DescribeDataRepositoryAssociations (Maybe Text)
describeDataRepositoryAssociations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeDataRepositoryAssociations
s@DescribeDataRepositoryAssociations' {} Maybe Text
a -> DescribeDataRepositoryAssociations
s {$sel:nextToken:DescribeDataRepositoryAssociations' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeDataRepositoryAssociations)

instance
  Core.AWSRequest
    DescribeDataRepositoryAssociations
  where
  type
    AWSResponse DescribeDataRepositoryAssociations =
      DescribeDataRepositoryAssociationsResponse
  request :: (Service -> Service)
-> DescribeDataRepositoryAssociations
-> Request DescribeDataRepositoryAssociations
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 DescribeDataRepositoryAssociations
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeDataRepositoryAssociations)))
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 [DataRepositoryAssociation]
-> Maybe Text -> Int -> DescribeDataRepositoryAssociationsResponse
DescribeDataRepositoryAssociationsResponse'
            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
"Associations" 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
"NextToken")
            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
    DescribeDataRepositoryAssociations
  where
  hashWithSalt :: Int -> DescribeDataRepositoryAssociations -> Int
hashWithSalt
    Int
_salt
    DescribeDataRepositoryAssociations' {Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
associationIds :: Maybe [Text]
$sel:nextToken:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Text
$sel:maxResults:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Natural
$sel:filters:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Filter]
$sel:associationIds:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Text]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
associationIds
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance
  Prelude.NFData
    DescribeDataRepositoryAssociations
  where
  rnf :: DescribeDataRepositoryAssociations -> ()
rnf DescribeDataRepositoryAssociations' {Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
associationIds :: Maybe [Text]
$sel:nextToken:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Text
$sel:maxResults:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Natural
$sel:filters:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Filter]
$sel:associationIds:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
associationIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance
  Data.ToHeaders
    DescribeDataRepositoryAssociations
  where
  toHeaders :: DescribeDataRepositoryAssociations -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSSimbaAPIService_v20180301.DescribeDataRepositoryAssociations" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance
  Data.ToJSON
    DescribeDataRepositoryAssociations
  where
  toJSON :: DescribeDataRepositoryAssociations -> Value
toJSON DescribeDataRepositoryAssociations' {Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [Filter]
associationIds :: Maybe [Text]
$sel:nextToken:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Text
$sel:maxResults:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe Natural
$sel:filters:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Filter]
$sel:associationIds:DescribeDataRepositoryAssociations' :: DescribeDataRepositoryAssociations -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AssociationIds" 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]
associationIds,
            (Key
"Filters" 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 [Filter]
filters,
            (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken
          ]
      )

instance
  Data.ToPath
    DescribeDataRepositoryAssociations
  where
  toPath :: DescribeDataRepositoryAssociations -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDescribeDataRepositoryAssociationsResponse' smart constructor.
data DescribeDataRepositoryAssociationsResponse = DescribeDataRepositoryAssociationsResponse'
  { -- | An array of one or more data repository association descriptions.
    DescribeDataRepositoryAssociationsResponse
-> Maybe [DataRepositoryAssociation]
associations :: Prelude.Maybe [DataRepositoryAssociation],
    DescribeDataRepositoryAssociationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeDataRepositoryAssociationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDataRepositoryAssociationsResponse
-> DescribeDataRepositoryAssociationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDataRepositoryAssociationsResponse
-> DescribeDataRepositoryAssociationsResponse -> Bool
$c/= :: DescribeDataRepositoryAssociationsResponse
-> DescribeDataRepositoryAssociationsResponse -> Bool
== :: DescribeDataRepositoryAssociationsResponse
-> DescribeDataRepositoryAssociationsResponse -> Bool
$c== :: DescribeDataRepositoryAssociationsResponse
-> DescribeDataRepositoryAssociationsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDataRepositoryAssociationsResponse]
ReadPrec DescribeDataRepositoryAssociationsResponse
Int -> ReadS DescribeDataRepositoryAssociationsResponse
ReadS [DescribeDataRepositoryAssociationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDataRepositoryAssociationsResponse]
$creadListPrec :: ReadPrec [DescribeDataRepositoryAssociationsResponse]
readPrec :: ReadPrec DescribeDataRepositoryAssociationsResponse
$creadPrec :: ReadPrec DescribeDataRepositoryAssociationsResponse
readList :: ReadS [DescribeDataRepositoryAssociationsResponse]
$creadList :: ReadS [DescribeDataRepositoryAssociationsResponse]
readsPrec :: Int -> ReadS DescribeDataRepositoryAssociationsResponse
$creadsPrec :: Int -> ReadS DescribeDataRepositoryAssociationsResponse
Prelude.Read, Int -> DescribeDataRepositoryAssociationsResponse -> ShowS
[DescribeDataRepositoryAssociationsResponse] -> ShowS
DescribeDataRepositoryAssociationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDataRepositoryAssociationsResponse] -> ShowS
$cshowList :: [DescribeDataRepositoryAssociationsResponse] -> ShowS
show :: DescribeDataRepositoryAssociationsResponse -> String
$cshow :: DescribeDataRepositoryAssociationsResponse -> String
showsPrec :: Int -> DescribeDataRepositoryAssociationsResponse -> ShowS
$cshowsPrec :: Int -> DescribeDataRepositoryAssociationsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDataRepositoryAssociationsResponse x
-> DescribeDataRepositoryAssociationsResponse
forall x.
DescribeDataRepositoryAssociationsResponse
-> Rep DescribeDataRepositoryAssociationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDataRepositoryAssociationsResponse x
-> DescribeDataRepositoryAssociationsResponse
$cfrom :: forall x.
DescribeDataRepositoryAssociationsResponse
-> Rep DescribeDataRepositoryAssociationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDataRepositoryAssociationsResponse' 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:
--
-- 'associations', 'describeDataRepositoryAssociationsResponse_associations' - An array of one or more data repository association descriptions.
--
-- 'nextToken', 'describeDataRepositoryAssociationsResponse_nextToken' - Undocumented member.
--
-- 'httpStatus', 'describeDataRepositoryAssociationsResponse_httpStatus' - The response's http status code.
newDescribeDataRepositoryAssociationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDataRepositoryAssociationsResponse
newDescribeDataRepositoryAssociationsResponse :: Int -> DescribeDataRepositoryAssociationsResponse
newDescribeDataRepositoryAssociationsResponse
  Int
pHttpStatus_ =
    DescribeDataRepositoryAssociationsResponse'
      { $sel:associations:DescribeDataRepositoryAssociationsResponse' :: Maybe [DataRepositoryAssociation]
associations =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:DescribeDataRepositoryAssociationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeDataRepositoryAssociationsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An array of one or more data repository association descriptions.
describeDataRepositoryAssociationsResponse_associations :: Lens.Lens' DescribeDataRepositoryAssociationsResponse (Prelude.Maybe [DataRepositoryAssociation])
describeDataRepositoryAssociationsResponse_associations :: Lens'
  DescribeDataRepositoryAssociationsResponse
  (Maybe [DataRepositoryAssociation])
describeDataRepositoryAssociationsResponse_associations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociationsResponse' {Maybe [DataRepositoryAssociation]
associations :: Maybe [DataRepositoryAssociation]
$sel:associations:DescribeDataRepositoryAssociationsResponse' :: DescribeDataRepositoryAssociationsResponse
-> Maybe [DataRepositoryAssociation]
associations} -> Maybe [DataRepositoryAssociation]
associations) (\s :: DescribeDataRepositoryAssociationsResponse
s@DescribeDataRepositoryAssociationsResponse' {} Maybe [DataRepositoryAssociation]
a -> DescribeDataRepositoryAssociationsResponse
s {$sel:associations:DescribeDataRepositoryAssociationsResponse' :: Maybe [DataRepositoryAssociation]
associations = Maybe [DataRepositoryAssociation]
a} :: DescribeDataRepositoryAssociationsResponse) 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

-- | Undocumented member.
describeDataRepositoryAssociationsResponse_nextToken :: Lens.Lens' DescribeDataRepositoryAssociationsResponse (Prelude.Maybe Prelude.Text)
describeDataRepositoryAssociationsResponse_nextToken :: Lens' DescribeDataRepositoryAssociationsResponse (Maybe Text)
describeDataRepositoryAssociationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDataRepositoryAssociationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeDataRepositoryAssociationsResponse' :: DescribeDataRepositoryAssociationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeDataRepositoryAssociationsResponse
s@DescribeDataRepositoryAssociationsResponse' {} Maybe Text
a -> DescribeDataRepositoryAssociationsResponse
s {$sel:nextToken:DescribeDataRepositoryAssociationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeDataRepositoryAssociationsResponse)

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

instance
  Prelude.NFData
    DescribeDataRepositoryAssociationsResponse
  where
  rnf :: DescribeDataRepositoryAssociationsResponse -> ()
rnf DescribeDataRepositoryAssociationsResponse' {Int
Maybe [DataRepositoryAssociation]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
associations :: Maybe [DataRepositoryAssociation]
$sel:httpStatus:DescribeDataRepositoryAssociationsResponse' :: DescribeDataRepositoryAssociationsResponse -> Int
$sel:nextToken:DescribeDataRepositoryAssociationsResponse' :: DescribeDataRepositoryAssociationsResponse -> Maybe Text
$sel:associations:DescribeDataRepositoryAssociationsResponse' :: DescribeDataRepositoryAssociationsResponse
-> Maybe [DataRepositoryAssociation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataRepositoryAssociation]
associations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus