{-# 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.SageMaker.ListEndpointConfigs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists endpoint configurations.
--
-- This operation returns paginated results.
module Amazonka.SageMaker.ListEndpointConfigs
  ( -- * Creating a Request
    ListEndpointConfigs (..),
    newListEndpointConfigs,

    -- * Request Lenses
    listEndpointConfigs_creationTimeAfter,
    listEndpointConfigs_creationTimeBefore,
    listEndpointConfigs_maxResults,
    listEndpointConfigs_nameContains,
    listEndpointConfigs_nextToken,
    listEndpointConfigs_sortBy,
    listEndpointConfigs_sortOrder,

    -- * Destructuring the Response
    ListEndpointConfigsResponse (..),
    newListEndpointConfigsResponse,

    -- * Response Lenses
    listEndpointConfigsResponse_nextToken,
    listEndpointConfigsResponse_httpStatus,
    listEndpointConfigsResponse_endpointConfigs,
  )
where

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

-- | /See:/ 'newListEndpointConfigs' smart constructor.
data ListEndpointConfigs = ListEndpointConfigs'
  { -- | A filter that returns only endpoint configurations with a creation time
    -- greater than or equal to the specified time (timestamp).
    ListEndpointConfigs -> Maybe POSIX
creationTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | A filter that returns only endpoint configurations created before the
    -- specified time (timestamp).
    ListEndpointConfigs -> Maybe POSIX
creationTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | The maximum number of training jobs to return in the response.
    ListEndpointConfigs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A string in the endpoint configuration name. This filter returns only
    -- endpoint configurations whose name contains the specified string.
    ListEndpointConfigs -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | If the result of the previous @ListEndpointConfig@ request was
    -- truncated, the response includes a @NextToken@. To retrieve the next set
    -- of endpoint configurations, use the token in the next request.
    ListEndpointConfigs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The field to sort results by. The default is @CreationTime@.
    ListEndpointConfigs -> Maybe EndpointConfigSortKey
sortBy :: Prelude.Maybe EndpointConfigSortKey,
    -- | The sort order for results. The default is @Descending@.
    ListEndpointConfigs -> Maybe OrderKey
sortOrder :: Prelude.Maybe OrderKey
  }
  deriving (ListEndpointConfigs -> ListEndpointConfigs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEndpointConfigs -> ListEndpointConfigs -> Bool
$c/= :: ListEndpointConfigs -> ListEndpointConfigs -> Bool
== :: ListEndpointConfigs -> ListEndpointConfigs -> Bool
$c== :: ListEndpointConfigs -> ListEndpointConfigs -> Bool
Prelude.Eq, ReadPrec [ListEndpointConfigs]
ReadPrec ListEndpointConfigs
Int -> ReadS ListEndpointConfigs
ReadS [ListEndpointConfigs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEndpointConfigs]
$creadListPrec :: ReadPrec [ListEndpointConfigs]
readPrec :: ReadPrec ListEndpointConfigs
$creadPrec :: ReadPrec ListEndpointConfigs
readList :: ReadS [ListEndpointConfigs]
$creadList :: ReadS [ListEndpointConfigs]
readsPrec :: Int -> ReadS ListEndpointConfigs
$creadsPrec :: Int -> ReadS ListEndpointConfigs
Prelude.Read, Int -> ListEndpointConfigs -> ShowS
[ListEndpointConfigs] -> ShowS
ListEndpointConfigs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEndpointConfigs] -> ShowS
$cshowList :: [ListEndpointConfigs] -> ShowS
show :: ListEndpointConfigs -> String
$cshow :: ListEndpointConfigs -> String
showsPrec :: Int -> ListEndpointConfigs -> ShowS
$cshowsPrec :: Int -> ListEndpointConfigs -> ShowS
Prelude.Show, forall x. Rep ListEndpointConfigs x -> ListEndpointConfigs
forall x. ListEndpointConfigs -> Rep ListEndpointConfigs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListEndpointConfigs x -> ListEndpointConfigs
$cfrom :: forall x. ListEndpointConfigs -> Rep ListEndpointConfigs x
Prelude.Generic)

-- |
-- Create a value of 'ListEndpointConfigs' 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:
--
-- 'creationTimeAfter', 'listEndpointConfigs_creationTimeAfter' - A filter that returns only endpoint configurations with a creation time
-- greater than or equal to the specified time (timestamp).
--
-- 'creationTimeBefore', 'listEndpointConfigs_creationTimeBefore' - A filter that returns only endpoint configurations created before the
-- specified time (timestamp).
--
-- 'maxResults', 'listEndpointConfigs_maxResults' - The maximum number of training jobs to return in the response.
--
-- 'nameContains', 'listEndpointConfigs_nameContains' - A string in the endpoint configuration name. This filter returns only
-- endpoint configurations whose name contains the specified string.
--
-- 'nextToken', 'listEndpointConfigs_nextToken' - If the result of the previous @ListEndpointConfig@ request was
-- truncated, the response includes a @NextToken@. To retrieve the next set
-- of endpoint configurations, use the token in the next request.
--
-- 'sortBy', 'listEndpointConfigs_sortBy' - The field to sort results by. The default is @CreationTime@.
--
-- 'sortOrder', 'listEndpointConfigs_sortOrder' - The sort order for results. The default is @Descending@.
newListEndpointConfigs ::
  ListEndpointConfigs
newListEndpointConfigs :: ListEndpointConfigs
newListEndpointConfigs =
  ListEndpointConfigs'
    { $sel:creationTimeAfter:ListEndpointConfigs' :: Maybe POSIX
creationTimeAfter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimeBefore:ListEndpointConfigs' :: Maybe POSIX
creationTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListEndpointConfigs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListEndpointConfigs' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListEndpointConfigs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListEndpointConfigs' :: Maybe EndpointConfigSortKey
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListEndpointConfigs' :: Maybe OrderKey
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | A filter that returns only endpoint configurations with a creation time
-- greater than or equal to the specified time (timestamp).
listEndpointConfigs_creationTimeAfter :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe Prelude.UTCTime)
listEndpointConfigs_creationTimeAfter :: Lens' ListEndpointConfigs (Maybe UTCTime)
listEndpointConfigs_creationTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:creationTimeAfter:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
creationTimeAfter} -> Maybe POSIX
creationTimeAfter) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe POSIX
a -> ListEndpointConfigs
s {$sel:creationTimeAfter:ListEndpointConfigs' :: Maybe POSIX
creationTimeAfter = Maybe POSIX
a} :: ListEndpointConfigs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A filter that returns only endpoint configurations created before the
-- specified time (timestamp).
listEndpointConfigs_creationTimeBefore :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe Prelude.UTCTime)
listEndpointConfigs_creationTimeBefore :: Lens' ListEndpointConfigs (Maybe UTCTime)
listEndpointConfigs_creationTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe POSIX
creationTimeBefore :: Maybe POSIX
$sel:creationTimeBefore:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
creationTimeBefore} -> Maybe POSIX
creationTimeBefore) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe POSIX
a -> ListEndpointConfigs
s {$sel:creationTimeBefore:ListEndpointConfigs' :: Maybe POSIX
creationTimeBefore = Maybe POSIX
a} :: ListEndpointConfigs) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The maximum number of training jobs to return in the response.
listEndpointConfigs_maxResults :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe Prelude.Natural)
listEndpointConfigs_maxResults :: Lens' ListEndpointConfigs (Maybe Natural)
listEndpointConfigs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe Natural
a -> ListEndpointConfigs
s {$sel:maxResults:ListEndpointConfigs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListEndpointConfigs)

-- | A string in the endpoint configuration name. This filter returns only
-- endpoint configurations whose name contains the specified string.
listEndpointConfigs_nameContains :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe Prelude.Text)
listEndpointConfigs_nameContains :: Lens' ListEndpointConfigs (Maybe Text)
listEndpointConfigs_nameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe Text
nameContains :: Maybe Text
$sel:nameContains:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
nameContains} -> Maybe Text
nameContains) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe Text
a -> ListEndpointConfigs
s {$sel:nameContains:ListEndpointConfigs' :: Maybe Text
nameContains = Maybe Text
a} :: ListEndpointConfigs)

-- | If the result of the previous @ListEndpointConfig@ request was
-- truncated, the response includes a @NextToken@. To retrieve the next set
-- of endpoint configurations, use the token in the next request.
listEndpointConfigs_nextToken :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe Prelude.Text)
listEndpointConfigs_nextToken :: Lens' ListEndpointConfigs (Maybe Text)
listEndpointConfigs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe Text
a -> ListEndpointConfigs
s {$sel:nextToken:ListEndpointConfigs' :: Maybe Text
nextToken = Maybe Text
a} :: ListEndpointConfigs)

-- | The field to sort results by. The default is @CreationTime@.
listEndpointConfigs_sortBy :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe EndpointConfigSortKey)
listEndpointConfigs_sortBy :: Lens' ListEndpointConfigs (Maybe EndpointConfigSortKey)
listEndpointConfigs_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe EndpointConfigSortKey
sortBy :: Maybe EndpointConfigSortKey
$sel:sortBy:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe EndpointConfigSortKey
sortBy} -> Maybe EndpointConfigSortKey
sortBy) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe EndpointConfigSortKey
a -> ListEndpointConfigs
s {$sel:sortBy:ListEndpointConfigs' :: Maybe EndpointConfigSortKey
sortBy = Maybe EndpointConfigSortKey
a} :: ListEndpointConfigs)

-- | The sort order for results. The default is @Descending@.
listEndpointConfigs_sortOrder :: Lens.Lens' ListEndpointConfigs (Prelude.Maybe OrderKey)
listEndpointConfigs_sortOrder :: Lens' ListEndpointConfigs (Maybe OrderKey)
listEndpointConfigs_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigs' {Maybe OrderKey
sortOrder :: Maybe OrderKey
$sel:sortOrder:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe OrderKey
sortOrder} -> Maybe OrderKey
sortOrder) (\s :: ListEndpointConfigs
s@ListEndpointConfigs' {} Maybe OrderKey
a -> ListEndpointConfigs
s {$sel:sortOrder:ListEndpointConfigs' :: Maybe OrderKey
sortOrder = Maybe OrderKey
a} :: ListEndpointConfigs)

instance Core.AWSPager ListEndpointConfigs where
  page :: ListEndpointConfigs
-> AWSResponse ListEndpointConfigs -> Maybe ListEndpointConfigs
page ListEndpointConfigs
rq AWSResponse ListEndpointConfigs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListEndpointConfigs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointConfigsResponse (Maybe Text)
listEndpointConfigsResponse_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 ListEndpointConfigs
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListEndpointConfigsResponse [EndpointConfigSummary]
listEndpointConfigsResponse_endpointConfigs
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListEndpointConfigs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListEndpointConfigs (Maybe Text)
listEndpointConfigs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListEndpointConfigs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointConfigsResponse (Maybe Text)
listEndpointConfigsResponse_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 ListEndpointConfigs where
  type
    AWSResponse ListEndpointConfigs =
      ListEndpointConfigsResponse
  request :: (Service -> Service)
-> ListEndpointConfigs -> Request ListEndpointConfigs
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 ListEndpointConfigs
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListEndpointConfigs)))
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
-> Int -> [EndpointConfigSummary] -> ListEndpointConfigsResponse
ListEndpointConfigsResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EndpointConfigs"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable ListEndpointConfigs where
  hashWithSalt :: Int -> ListEndpointConfigs -> Int
hashWithSalt Int
_salt ListEndpointConfigs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe EndpointConfigSortKey
Maybe OrderKey
sortOrder :: Maybe OrderKey
sortBy :: Maybe EndpointConfigSortKey
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe OrderKey
$sel:sortBy:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe EndpointConfigSortKey
$sel:nextToken:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:nameContains:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:maxResults:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Natural
$sel:creationTimeBefore:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
$sel:creationTimeAfter:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTimeAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTimeBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nameContains
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointConfigSortKey
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrderKey
sortOrder

instance Prelude.NFData ListEndpointConfigs where
  rnf :: ListEndpointConfigs -> ()
rnf ListEndpointConfigs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe EndpointConfigSortKey
Maybe OrderKey
sortOrder :: Maybe OrderKey
sortBy :: Maybe EndpointConfigSortKey
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe OrderKey
$sel:sortBy:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe EndpointConfigSortKey
$sel:nextToken:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:nameContains:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:maxResults:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Natural
$sel:creationTimeBefore:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
$sel:creationTimeAfter:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimeAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimeBefore
      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
nameContains
      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 EndpointConfigSortKey
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OrderKey
sortOrder

instance Data.ToHeaders ListEndpointConfigs where
  toHeaders :: ListEndpointConfigs -> 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
"SageMaker.ListEndpointConfigs" ::
                          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 ListEndpointConfigs where
  toJSON :: ListEndpointConfigs -> Value
toJSON ListEndpointConfigs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe EndpointConfigSortKey
Maybe OrderKey
sortOrder :: Maybe OrderKey
sortBy :: Maybe EndpointConfigSortKey
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe OrderKey
$sel:sortBy:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe EndpointConfigSortKey
$sel:nextToken:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:nameContains:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Text
$sel:maxResults:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe Natural
$sel:creationTimeBefore:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
$sel:creationTimeAfter:ListEndpointConfigs' :: ListEndpointConfigs -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CreationTimeAfter" 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 POSIX
creationTimeAfter,
            (Key
"CreationTimeBefore" 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 POSIX
creationTimeBefore,
            (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
"NameContains" 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
nameContains,
            (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
"SortBy" 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 EndpointConfigSortKey
sortBy,
            (Key
"SortOrder" 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 OrderKey
sortOrder
          ]
      )

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

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

-- | /See:/ 'newListEndpointConfigsResponse' smart constructor.
data ListEndpointConfigsResponse = ListEndpointConfigsResponse'
  { -- | If the response is truncated, SageMaker returns this token. To retrieve
    -- the next set of endpoint configurations, use it in the subsequent
    -- request
    ListEndpointConfigsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListEndpointConfigsResponse -> Int
httpStatus :: Prelude.Int,
    -- | An array of endpoint configurations.
    ListEndpointConfigsResponse -> [EndpointConfigSummary]
endpointConfigs :: [EndpointConfigSummary]
  }
  deriving (ListEndpointConfigsResponse -> ListEndpointConfigsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEndpointConfigsResponse -> ListEndpointConfigsResponse -> Bool
$c/= :: ListEndpointConfigsResponse -> ListEndpointConfigsResponse -> Bool
== :: ListEndpointConfigsResponse -> ListEndpointConfigsResponse -> Bool
$c== :: ListEndpointConfigsResponse -> ListEndpointConfigsResponse -> Bool
Prelude.Eq, ReadPrec [ListEndpointConfigsResponse]
ReadPrec ListEndpointConfigsResponse
Int -> ReadS ListEndpointConfigsResponse
ReadS [ListEndpointConfigsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEndpointConfigsResponse]
$creadListPrec :: ReadPrec [ListEndpointConfigsResponse]
readPrec :: ReadPrec ListEndpointConfigsResponse
$creadPrec :: ReadPrec ListEndpointConfigsResponse
readList :: ReadS [ListEndpointConfigsResponse]
$creadList :: ReadS [ListEndpointConfigsResponse]
readsPrec :: Int -> ReadS ListEndpointConfigsResponse
$creadsPrec :: Int -> ReadS ListEndpointConfigsResponse
Prelude.Read, Int -> ListEndpointConfigsResponse -> ShowS
[ListEndpointConfigsResponse] -> ShowS
ListEndpointConfigsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEndpointConfigsResponse] -> ShowS
$cshowList :: [ListEndpointConfigsResponse] -> ShowS
show :: ListEndpointConfigsResponse -> String
$cshow :: ListEndpointConfigsResponse -> String
showsPrec :: Int -> ListEndpointConfigsResponse -> ShowS
$cshowsPrec :: Int -> ListEndpointConfigsResponse -> ShowS
Prelude.Show, forall x.
Rep ListEndpointConfigsResponse x -> ListEndpointConfigsResponse
forall x.
ListEndpointConfigsResponse -> Rep ListEndpointConfigsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListEndpointConfigsResponse x -> ListEndpointConfigsResponse
$cfrom :: forall x.
ListEndpointConfigsResponse -> Rep ListEndpointConfigsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListEndpointConfigsResponse' 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', 'listEndpointConfigsResponse_nextToken' - If the response is truncated, SageMaker returns this token. To retrieve
-- the next set of endpoint configurations, use it in the subsequent
-- request
--
-- 'httpStatus', 'listEndpointConfigsResponse_httpStatus' - The response's http status code.
--
-- 'endpointConfigs', 'listEndpointConfigsResponse_endpointConfigs' - An array of endpoint configurations.
newListEndpointConfigsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListEndpointConfigsResponse
newListEndpointConfigsResponse :: Int -> ListEndpointConfigsResponse
newListEndpointConfigsResponse Int
pHttpStatus_ =
  ListEndpointConfigsResponse'
    { $sel:nextToken:ListEndpointConfigsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListEndpointConfigsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:endpointConfigs:ListEndpointConfigsResponse' :: [EndpointConfigSummary]
endpointConfigs = forall a. Monoid a => a
Prelude.mempty
    }

-- | If the response is truncated, SageMaker returns this token. To retrieve
-- the next set of endpoint configurations, use it in the subsequent
-- request
listEndpointConfigsResponse_nextToken :: Lens.Lens' ListEndpointConfigsResponse (Prelude.Maybe Prelude.Text)
listEndpointConfigsResponse_nextToken :: Lens' ListEndpointConfigsResponse (Maybe Text)
listEndpointConfigsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListEndpointConfigsResponse' :: ListEndpointConfigsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListEndpointConfigsResponse
s@ListEndpointConfigsResponse' {} Maybe Text
a -> ListEndpointConfigsResponse
s {$sel:nextToken:ListEndpointConfigsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListEndpointConfigsResponse)

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

-- | An array of endpoint configurations.
listEndpointConfigsResponse_endpointConfigs :: Lens.Lens' ListEndpointConfigsResponse [EndpointConfigSummary]
listEndpointConfigsResponse_endpointConfigs :: Lens' ListEndpointConfigsResponse [EndpointConfigSummary]
listEndpointConfigsResponse_endpointConfigs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointConfigsResponse' {[EndpointConfigSummary]
endpointConfigs :: [EndpointConfigSummary]
$sel:endpointConfigs:ListEndpointConfigsResponse' :: ListEndpointConfigsResponse -> [EndpointConfigSummary]
endpointConfigs} -> [EndpointConfigSummary]
endpointConfigs) (\s :: ListEndpointConfigsResponse
s@ListEndpointConfigsResponse' {} [EndpointConfigSummary]
a -> ListEndpointConfigsResponse
s {$sel:endpointConfigs:ListEndpointConfigsResponse' :: [EndpointConfigSummary]
endpointConfigs = [EndpointConfigSummary]
a} :: ListEndpointConfigsResponse) 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 ListEndpointConfigsResponse where
  rnf :: ListEndpointConfigsResponse -> ()
rnf ListEndpointConfigsResponse' {Int
[EndpointConfigSummary]
Maybe Text
endpointConfigs :: [EndpointConfigSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:endpointConfigs:ListEndpointConfigsResponse' :: ListEndpointConfigsResponse -> [EndpointConfigSummary]
$sel:httpStatus:ListEndpointConfigsResponse' :: ListEndpointConfigsResponse -> Int
$sel:nextToken:ListEndpointConfigsResponse' :: ListEndpointConfigsResponse -> 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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [EndpointConfigSummary]
endpointConfigs