{-# 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.ECR.DescribePullThroughCacheRules
-- 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 pull through cache rules for a registry.
--
-- This operation returns paginated results.
module Amazonka.ECR.DescribePullThroughCacheRules
  ( -- * Creating a Request
    DescribePullThroughCacheRules (..),
    newDescribePullThroughCacheRules,

    -- * Request Lenses
    describePullThroughCacheRules_ecrRepositoryPrefixes,
    describePullThroughCacheRules_maxResults,
    describePullThroughCacheRules_nextToken,
    describePullThroughCacheRules_registryId,

    -- * Destructuring the Response
    DescribePullThroughCacheRulesResponse (..),
    newDescribePullThroughCacheRulesResponse,

    -- * Response Lenses
    describePullThroughCacheRulesResponse_nextToken,
    describePullThroughCacheRulesResponse_pullThroughCacheRules,
    describePullThroughCacheRulesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribePullThroughCacheRules' smart constructor.
data DescribePullThroughCacheRules = DescribePullThroughCacheRules'
  { -- | The Amazon ECR repository prefixes associated with the pull through
    -- cache rules to return. If no repository prefix value is specified, all
    -- pull through cache rules are returned.
    DescribePullThroughCacheRules -> Maybe (NonEmpty Text)
ecrRepositoryPrefixes :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The maximum number of pull through cache rules returned by
    -- @DescribePullThroughCacheRulesRequest@ in paginated output. When this
    -- parameter is used, @DescribePullThroughCacheRulesRequest@ only returns
    -- @maxResults@ results in a single page along with a @nextToken@ response
    -- element. The remaining results of the initial request can be seen by
    -- sending another @DescribePullThroughCacheRulesRequest@ request with the
    -- returned @nextToken@ value. This value can be between 1 and 1000. If
    -- this parameter is not used, then @DescribePullThroughCacheRulesRequest@
    -- returns up to 100 results and a @nextToken@ value, if applicable.
    DescribePullThroughCacheRules -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The @nextToken@ value returned from a previous paginated
    -- @DescribePullThroughCacheRulesRequest@ request where @maxResults@ was
    -- used and the results exceeded the value of that parameter. Pagination
    -- continues from the end of the previous results that returned the
    -- @nextToken@ value. This value is null when there are no more results to
    -- return.
    DescribePullThroughCacheRules -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services account ID associated with the registry to
    -- return the pull through cache rules for. If you do not specify a
    -- registry, the default registry is assumed.
    DescribePullThroughCacheRules -> Maybe Text
registryId :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribePullThroughCacheRules
-> DescribePullThroughCacheRules -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePullThroughCacheRules
-> DescribePullThroughCacheRules -> Bool
$c/= :: DescribePullThroughCacheRules
-> DescribePullThroughCacheRules -> Bool
== :: DescribePullThroughCacheRules
-> DescribePullThroughCacheRules -> Bool
$c== :: DescribePullThroughCacheRules
-> DescribePullThroughCacheRules -> Bool
Prelude.Eq, ReadPrec [DescribePullThroughCacheRules]
ReadPrec DescribePullThroughCacheRules
Int -> ReadS DescribePullThroughCacheRules
ReadS [DescribePullThroughCacheRules]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePullThroughCacheRules]
$creadListPrec :: ReadPrec [DescribePullThroughCacheRules]
readPrec :: ReadPrec DescribePullThroughCacheRules
$creadPrec :: ReadPrec DescribePullThroughCacheRules
readList :: ReadS [DescribePullThroughCacheRules]
$creadList :: ReadS [DescribePullThroughCacheRules]
readsPrec :: Int -> ReadS DescribePullThroughCacheRules
$creadsPrec :: Int -> ReadS DescribePullThroughCacheRules
Prelude.Read, Int -> DescribePullThroughCacheRules -> ShowS
[DescribePullThroughCacheRules] -> ShowS
DescribePullThroughCacheRules -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePullThroughCacheRules] -> ShowS
$cshowList :: [DescribePullThroughCacheRules] -> ShowS
show :: DescribePullThroughCacheRules -> String
$cshow :: DescribePullThroughCacheRules -> String
showsPrec :: Int -> DescribePullThroughCacheRules -> ShowS
$cshowsPrec :: Int -> DescribePullThroughCacheRules -> ShowS
Prelude.Show, forall x.
Rep DescribePullThroughCacheRules x
-> DescribePullThroughCacheRules
forall x.
DescribePullThroughCacheRules
-> Rep DescribePullThroughCacheRules x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePullThroughCacheRules x
-> DescribePullThroughCacheRules
$cfrom :: forall x.
DescribePullThroughCacheRules
-> Rep DescribePullThroughCacheRules x
Prelude.Generic)

-- |
-- Create a value of 'DescribePullThroughCacheRules' 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:
--
-- 'ecrRepositoryPrefixes', 'describePullThroughCacheRules_ecrRepositoryPrefixes' - The Amazon ECR repository prefixes associated with the pull through
-- cache rules to return. If no repository prefix value is specified, all
-- pull through cache rules are returned.
--
-- 'maxResults', 'describePullThroughCacheRules_maxResults' - The maximum number of pull through cache rules returned by
-- @DescribePullThroughCacheRulesRequest@ in paginated output. When this
-- parameter is used, @DescribePullThroughCacheRulesRequest@ only returns
-- @maxResults@ results in a single page along with a @nextToken@ response
-- element. The remaining results of the initial request can be seen by
-- sending another @DescribePullThroughCacheRulesRequest@ request with the
-- returned @nextToken@ value. This value can be between 1 and 1000. If
-- this parameter is not used, then @DescribePullThroughCacheRulesRequest@
-- returns up to 100 results and a @nextToken@ value, if applicable.
--
-- 'nextToken', 'describePullThroughCacheRules_nextToken' - The @nextToken@ value returned from a previous paginated
-- @DescribePullThroughCacheRulesRequest@ request where @maxResults@ was
-- used and the results exceeded the value of that parameter. Pagination
-- continues from the end of the previous results that returned the
-- @nextToken@ value. This value is null when there are no more results to
-- return.
--
-- 'registryId', 'describePullThroughCacheRules_registryId' - The Amazon Web Services account ID associated with the registry to
-- return the pull through cache rules for. If you do not specify a
-- registry, the default registry is assumed.
newDescribePullThroughCacheRules ::
  DescribePullThroughCacheRules
newDescribePullThroughCacheRules :: DescribePullThroughCacheRules
newDescribePullThroughCacheRules =
  DescribePullThroughCacheRules'
    { $sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: Maybe (NonEmpty Text)
ecrRepositoryPrefixes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribePullThroughCacheRules' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribePullThroughCacheRules' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:registryId:DescribePullThroughCacheRules' :: Maybe Text
registryId = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon ECR repository prefixes associated with the pull through
-- cache rules to return. If no repository prefix value is specified, all
-- pull through cache rules are returned.
describePullThroughCacheRules_ecrRepositoryPrefixes :: Lens.Lens' DescribePullThroughCacheRules (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
describePullThroughCacheRules_ecrRepositoryPrefixes :: Lens' DescribePullThroughCacheRules (Maybe (NonEmpty Text))
describePullThroughCacheRules_ecrRepositoryPrefixes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRules' {Maybe (NonEmpty Text)
ecrRepositoryPrefixes :: Maybe (NonEmpty Text)
$sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe (NonEmpty Text)
ecrRepositoryPrefixes} -> Maybe (NonEmpty Text)
ecrRepositoryPrefixes) (\s :: DescribePullThroughCacheRules
s@DescribePullThroughCacheRules' {} Maybe (NonEmpty Text)
a -> DescribePullThroughCacheRules
s {$sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: Maybe (NonEmpty Text)
ecrRepositoryPrefixes = Maybe (NonEmpty Text)
a} :: DescribePullThroughCacheRules) 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 pull through cache rules returned by
-- @DescribePullThroughCacheRulesRequest@ in paginated output. When this
-- parameter is used, @DescribePullThroughCacheRulesRequest@ only returns
-- @maxResults@ results in a single page along with a @nextToken@ response
-- element. The remaining results of the initial request can be seen by
-- sending another @DescribePullThroughCacheRulesRequest@ request with the
-- returned @nextToken@ value. This value can be between 1 and 1000. If
-- this parameter is not used, then @DescribePullThroughCacheRulesRequest@
-- returns up to 100 results and a @nextToken@ value, if applicable.
describePullThroughCacheRules_maxResults :: Lens.Lens' DescribePullThroughCacheRules (Prelude.Maybe Prelude.Natural)
describePullThroughCacheRules_maxResults :: Lens' DescribePullThroughCacheRules (Maybe Natural)
describePullThroughCacheRules_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRules' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribePullThroughCacheRules
s@DescribePullThroughCacheRules' {} Maybe Natural
a -> DescribePullThroughCacheRules
s {$sel:maxResults:DescribePullThroughCacheRules' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribePullThroughCacheRules)

-- | The @nextToken@ value returned from a previous paginated
-- @DescribePullThroughCacheRulesRequest@ request where @maxResults@ was
-- used and the results exceeded the value of that parameter. Pagination
-- continues from the end of the previous results that returned the
-- @nextToken@ value. This value is null when there are no more results to
-- return.
describePullThroughCacheRules_nextToken :: Lens.Lens' DescribePullThroughCacheRules (Prelude.Maybe Prelude.Text)
describePullThroughCacheRules_nextToken :: Lens' DescribePullThroughCacheRules (Maybe Text)
describePullThroughCacheRules_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRules' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribePullThroughCacheRules
s@DescribePullThroughCacheRules' {} Maybe Text
a -> DescribePullThroughCacheRules
s {$sel:nextToken:DescribePullThroughCacheRules' :: Maybe Text
nextToken = Maybe Text
a} :: DescribePullThroughCacheRules)

-- | The Amazon Web Services account ID associated with the registry to
-- return the pull through cache rules for. If you do not specify a
-- registry, the default registry is assumed.
describePullThroughCacheRules_registryId :: Lens.Lens' DescribePullThroughCacheRules (Prelude.Maybe Prelude.Text)
describePullThroughCacheRules_registryId :: Lens' DescribePullThroughCacheRules (Maybe Text)
describePullThroughCacheRules_registryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRules' {Maybe Text
registryId :: Maybe Text
$sel:registryId:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
registryId} -> Maybe Text
registryId) (\s :: DescribePullThroughCacheRules
s@DescribePullThroughCacheRules' {} Maybe Text
a -> DescribePullThroughCacheRules
s {$sel:registryId:DescribePullThroughCacheRules' :: Maybe Text
registryId = Maybe Text
a} :: DescribePullThroughCacheRules)

instance Core.AWSPager DescribePullThroughCacheRules where
  page :: DescribePullThroughCacheRules
-> AWSResponse DescribePullThroughCacheRules
-> Maybe DescribePullThroughCacheRules
page DescribePullThroughCacheRules
rq AWSResponse DescribePullThroughCacheRules
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribePullThroughCacheRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePullThroughCacheRulesResponse (Maybe Text)
describePullThroughCacheRulesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribePullThroughCacheRules
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  DescribePullThroughCacheRulesResponse
  (Maybe [PullThroughCacheRule])
describePullThroughCacheRulesResponse_pullThroughCacheRules
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribePullThroughCacheRules
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribePullThroughCacheRules (Maybe Text)
describePullThroughCacheRules_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribePullThroughCacheRules
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePullThroughCacheRulesResponse (Maybe Text)
describePullThroughCacheRulesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance
  Core.AWSRequest
    DescribePullThroughCacheRules
  where
  type
    AWSResponse DescribePullThroughCacheRules =
      DescribePullThroughCacheRulesResponse
  request :: (Service -> Service)
-> DescribePullThroughCacheRules
-> Request DescribePullThroughCacheRules
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 DescribePullThroughCacheRules
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribePullThroughCacheRules)))
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 Text
-> Maybe [PullThroughCacheRule]
-> Int
-> DescribePullThroughCacheRulesResponse
DescribePullThroughCacheRulesResponse'
            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
"nextToken")
            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
"pullThroughCacheRules"
                            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
    DescribePullThroughCacheRules
  where
  hashWithSalt :: Int -> DescribePullThroughCacheRules -> Int
hashWithSalt Int
_salt DescribePullThroughCacheRules' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
ecrRepositoryPrefixes :: Maybe (NonEmpty Text)
$sel:registryId:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:nextToken:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:maxResults:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Natural
$sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe (NonEmpty Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
ecrRepositoryPrefixes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
registryId

instance Prelude.NFData DescribePullThroughCacheRules where
  rnf :: DescribePullThroughCacheRules -> ()
rnf DescribePullThroughCacheRules' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
ecrRepositoryPrefixes :: Maybe (NonEmpty Text)
$sel:registryId:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:nextToken:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:maxResults:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Natural
$sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
ecrRepositoryPrefixes
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
registryId

instance Data.ToHeaders DescribePullThroughCacheRules where
  toHeaders :: DescribePullThroughCacheRules -> 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
"AmazonEC2ContainerRegistry_V20150921.DescribePullThroughCacheRules" ::
                          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 DescribePullThroughCacheRules where
  toJSON :: DescribePullThroughCacheRules -> Value
toJSON DescribePullThroughCacheRules' {Maybe Natural
Maybe (NonEmpty Text)
Maybe Text
registryId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
ecrRepositoryPrefixes :: Maybe (NonEmpty Text)
$sel:registryId:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:nextToken:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Text
$sel:maxResults:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe Natural
$sel:ecrRepositoryPrefixes:DescribePullThroughCacheRules' :: DescribePullThroughCacheRules -> Maybe (NonEmpty Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ecrRepositoryPrefixes" 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 (NonEmpty Text)
ecrRepositoryPrefixes,
            (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,
            (Key
"registryId" 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
registryId
          ]
      )

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

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

-- | /See:/ 'newDescribePullThroughCacheRulesResponse' smart constructor.
data DescribePullThroughCacheRulesResponse = DescribePullThroughCacheRulesResponse'
  { -- | The @nextToken@ value to include in a future
    -- @DescribePullThroughCacheRulesRequest@ request. When the results of a
    -- @DescribePullThroughCacheRulesRequest@ request exceed @maxResults@, this
    -- value can be used to retrieve the next page of results. This value is
    -- null when there are no more results to return.
    DescribePullThroughCacheRulesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The details of the pull through cache rules.
    DescribePullThroughCacheRulesResponse
-> Maybe [PullThroughCacheRule]
pullThroughCacheRules :: Prelude.Maybe [PullThroughCacheRule],
    -- | The response's http status code.
    DescribePullThroughCacheRulesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePullThroughCacheRulesResponse
-> DescribePullThroughCacheRulesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePullThroughCacheRulesResponse
-> DescribePullThroughCacheRulesResponse -> Bool
$c/= :: DescribePullThroughCacheRulesResponse
-> DescribePullThroughCacheRulesResponse -> Bool
== :: DescribePullThroughCacheRulesResponse
-> DescribePullThroughCacheRulesResponse -> Bool
$c== :: DescribePullThroughCacheRulesResponse
-> DescribePullThroughCacheRulesResponse -> Bool
Prelude.Eq, ReadPrec [DescribePullThroughCacheRulesResponse]
ReadPrec DescribePullThroughCacheRulesResponse
Int -> ReadS DescribePullThroughCacheRulesResponse
ReadS [DescribePullThroughCacheRulesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePullThroughCacheRulesResponse]
$creadListPrec :: ReadPrec [DescribePullThroughCacheRulesResponse]
readPrec :: ReadPrec DescribePullThroughCacheRulesResponse
$creadPrec :: ReadPrec DescribePullThroughCacheRulesResponse
readList :: ReadS [DescribePullThroughCacheRulesResponse]
$creadList :: ReadS [DescribePullThroughCacheRulesResponse]
readsPrec :: Int -> ReadS DescribePullThroughCacheRulesResponse
$creadsPrec :: Int -> ReadS DescribePullThroughCacheRulesResponse
Prelude.Read, Int -> DescribePullThroughCacheRulesResponse -> ShowS
[DescribePullThroughCacheRulesResponse] -> ShowS
DescribePullThroughCacheRulesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePullThroughCacheRulesResponse] -> ShowS
$cshowList :: [DescribePullThroughCacheRulesResponse] -> ShowS
show :: DescribePullThroughCacheRulesResponse -> String
$cshow :: DescribePullThroughCacheRulesResponse -> String
showsPrec :: Int -> DescribePullThroughCacheRulesResponse -> ShowS
$cshowsPrec :: Int -> DescribePullThroughCacheRulesResponse -> ShowS
Prelude.Show, forall x.
Rep DescribePullThroughCacheRulesResponse x
-> DescribePullThroughCacheRulesResponse
forall x.
DescribePullThroughCacheRulesResponse
-> Rep DescribePullThroughCacheRulesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePullThroughCacheRulesResponse x
-> DescribePullThroughCacheRulesResponse
$cfrom :: forall x.
DescribePullThroughCacheRulesResponse
-> Rep DescribePullThroughCacheRulesResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePullThroughCacheRulesResponse' 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:
--
-- 'nextToken', 'describePullThroughCacheRulesResponse_nextToken' - The @nextToken@ value to include in a future
-- @DescribePullThroughCacheRulesRequest@ request. When the results of a
-- @DescribePullThroughCacheRulesRequest@ request exceed @maxResults@, this
-- value can be used to retrieve the next page of results. This value is
-- null when there are no more results to return.
--
-- 'pullThroughCacheRules', 'describePullThroughCacheRulesResponse_pullThroughCacheRules' - The details of the pull through cache rules.
--
-- 'httpStatus', 'describePullThroughCacheRulesResponse_httpStatus' - The response's http status code.
newDescribePullThroughCacheRulesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePullThroughCacheRulesResponse
newDescribePullThroughCacheRulesResponse :: Int -> DescribePullThroughCacheRulesResponse
newDescribePullThroughCacheRulesResponse Int
pHttpStatus_ =
  DescribePullThroughCacheRulesResponse'
    { $sel:nextToken:DescribePullThroughCacheRulesResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:pullThroughCacheRules:DescribePullThroughCacheRulesResponse' :: Maybe [PullThroughCacheRule]
pullThroughCacheRules =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePullThroughCacheRulesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @nextToken@ value to include in a future
-- @DescribePullThroughCacheRulesRequest@ request. When the results of a
-- @DescribePullThroughCacheRulesRequest@ request exceed @maxResults@, this
-- value can be used to retrieve the next page of results. This value is
-- null when there are no more results to return.
describePullThroughCacheRulesResponse_nextToken :: Lens.Lens' DescribePullThroughCacheRulesResponse (Prelude.Maybe Prelude.Text)
describePullThroughCacheRulesResponse_nextToken :: Lens' DescribePullThroughCacheRulesResponse (Maybe Text)
describePullThroughCacheRulesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRulesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribePullThroughCacheRulesResponse
s@DescribePullThroughCacheRulesResponse' {} Maybe Text
a -> DescribePullThroughCacheRulesResponse
s {$sel:nextToken:DescribePullThroughCacheRulesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribePullThroughCacheRulesResponse)

-- | The details of the pull through cache rules.
describePullThroughCacheRulesResponse_pullThroughCacheRules :: Lens.Lens' DescribePullThroughCacheRulesResponse (Prelude.Maybe [PullThroughCacheRule])
describePullThroughCacheRulesResponse_pullThroughCacheRules :: Lens'
  DescribePullThroughCacheRulesResponse
  (Maybe [PullThroughCacheRule])
describePullThroughCacheRulesResponse_pullThroughCacheRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRulesResponse' {Maybe [PullThroughCacheRule]
pullThroughCacheRules :: Maybe [PullThroughCacheRule]
$sel:pullThroughCacheRules:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse
-> Maybe [PullThroughCacheRule]
pullThroughCacheRules} -> Maybe [PullThroughCacheRule]
pullThroughCacheRules) (\s :: DescribePullThroughCacheRulesResponse
s@DescribePullThroughCacheRulesResponse' {} Maybe [PullThroughCacheRule]
a -> DescribePullThroughCacheRulesResponse
s {$sel:pullThroughCacheRules:DescribePullThroughCacheRulesResponse' :: Maybe [PullThroughCacheRule]
pullThroughCacheRules = Maybe [PullThroughCacheRule]
a} :: DescribePullThroughCacheRulesResponse) 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.
describePullThroughCacheRulesResponse_httpStatus :: Lens.Lens' DescribePullThroughCacheRulesResponse Prelude.Int
describePullThroughCacheRulesResponse_httpStatus :: Lens' DescribePullThroughCacheRulesResponse Int
describePullThroughCacheRulesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePullThroughCacheRulesResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribePullThroughCacheRulesResponse
s@DescribePullThroughCacheRulesResponse' {} Int
a -> DescribePullThroughCacheRulesResponse
s {$sel:httpStatus:DescribePullThroughCacheRulesResponse' :: Int
httpStatus = Int
a} :: DescribePullThroughCacheRulesResponse)

instance
  Prelude.NFData
    DescribePullThroughCacheRulesResponse
  where
  rnf :: DescribePullThroughCacheRulesResponse -> ()
rnf DescribePullThroughCacheRulesResponse' {Int
Maybe [PullThroughCacheRule]
Maybe Text
httpStatus :: Int
pullThroughCacheRules :: Maybe [PullThroughCacheRule]
nextToken :: Maybe Text
$sel:httpStatus:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse -> Int
$sel:pullThroughCacheRules:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse
-> Maybe [PullThroughCacheRule]
$sel:nextToken:DescribePullThroughCacheRulesResponse' :: DescribePullThroughCacheRulesResponse -> Maybe Text
..} =
    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 Maybe [PullThroughCacheRule]
pullThroughCacheRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus