{-# 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.ListEndpoints
-- 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 endpoints.
--
-- This operation returns paginated results.
module Amazonka.SageMaker.ListEndpoints
  ( -- * Creating a Request
    ListEndpoints (..),
    newListEndpoints,

    -- * Request Lenses
    listEndpoints_creationTimeAfter,
    listEndpoints_creationTimeBefore,
    listEndpoints_lastModifiedTimeAfter,
    listEndpoints_lastModifiedTimeBefore,
    listEndpoints_maxResults,
    listEndpoints_nameContains,
    listEndpoints_nextToken,
    listEndpoints_sortBy,
    listEndpoints_sortOrder,
    listEndpoints_statusEquals,

    -- * Destructuring the Response
    ListEndpointsResponse (..),
    newListEndpointsResponse,

    -- * Response Lenses
    listEndpointsResponse_nextToken,
    listEndpointsResponse_httpStatus,
    listEndpointsResponse_endpoints,
  )
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:/ 'newListEndpoints' smart constructor.
data ListEndpoints = ListEndpoints'
  { -- | A filter that returns only endpoints with a creation time greater than
    -- or equal to the specified time (timestamp).
    ListEndpoints -> Maybe POSIX
creationTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | A filter that returns only endpoints that were created before the
    -- specified time (timestamp).
    ListEndpoints -> Maybe POSIX
creationTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | A filter that returns only endpoints that were modified after the
    -- specified timestamp.
    ListEndpoints -> Maybe POSIX
lastModifiedTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | A filter that returns only endpoints that were modified before the
    -- specified timestamp.
    ListEndpoints -> Maybe POSIX
lastModifiedTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | The maximum number of endpoints to return in the response. This value
    -- defaults to 10.
    ListEndpoints -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A string in endpoint names. This filter returns only endpoints whose
    -- name contains the specified string.
    ListEndpoints -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | If the result of a @ListEndpoints@ request was truncated, the response
    -- includes a @NextToken@. To retrieve the next set of endpoints, use the
    -- token in the next request.
    ListEndpoints -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Sorts the list of results. The default is @CreationTime@.
    ListEndpoints -> Maybe EndpointSortKey
sortBy :: Prelude.Maybe EndpointSortKey,
    -- | The sort order for results. The default is @Descending@.
    ListEndpoints -> Maybe OrderKey
sortOrder :: Prelude.Maybe OrderKey,
    -- | A filter that returns only endpoints with the specified status.
    ListEndpoints -> Maybe EndpointStatus
statusEquals :: Prelude.Maybe EndpointStatus
  }
  deriving (ListEndpoints -> ListEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListEndpoints -> ListEndpoints -> Bool
$c/= :: ListEndpoints -> ListEndpoints -> Bool
== :: ListEndpoints -> ListEndpoints -> Bool
$c== :: ListEndpoints -> ListEndpoints -> Bool
Prelude.Eq, ReadPrec [ListEndpoints]
ReadPrec ListEndpoints
Int -> ReadS ListEndpoints
ReadS [ListEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListEndpoints]
$creadListPrec :: ReadPrec [ListEndpoints]
readPrec :: ReadPrec ListEndpoints
$creadPrec :: ReadPrec ListEndpoints
readList :: ReadS [ListEndpoints]
$creadList :: ReadS [ListEndpoints]
readsPrec :: Int -> ReadS ListEndpoints
$creadsPrec :: Int -> ReadS ListEndpoints
Prelude.Read, Int -> ListEndpoints -> ShowS
[ListEndpoints] -> ShowS
ListEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListEndpoints] -> ShowS
$cshowList :: [ListEndpoints] -> ShowS
show :: ListEndpoints -> String
$cshow :: ListEndpoints -> String
showsPrec :: Int -> ListEndpoints -> ShowS
$cshowsPrec :: Int -> ListEndpoints -> ShowS
Prelude.Show, forall x. Rep ListEndpoints x -> ListEndpoints
forall x. ListEndpoints -> Rep ListEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListEndpoints x -> ListEndpoints
$cfrom :: forall x. ListEndpoints -> Rep ListEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'ListEndpoints' 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', 'listEndpoints_creationTimeAfter' - A filter that returns only endpoints with a creation time greater than
-- or equal to the specified time (timestamp).
--
-- 'creationTimeBefore', 'listEndpoints_creationTimeBefore' - A filter that returns only endpoints that were created before the
-- specified time (timestamp).
--
-- 'lastModifiedTimeAfter', 'listEndpoints_lastModifiedTimeAfter' - A filter that returns only endpoints that were modified after the
-- specified timestamp.
--
-- 'lastModifiedTimeBefore', 'listEndpoints_lastModifiedTimeBefore' - A filter that returns only endpoints that were modified before the
-- specified timestamp.
--
-- 'maxResults', 'listEndpoints_maxResults' - The maximum number of endpoints to return in the response. This value
-- defaults to 10.
--
-- 'nameContains', 'listEndpoints_nameContains' - A string in endpoint names. This filter returns only endpoints whose
-- name contains the specified string.
--
-- 'nextToken', 'listEndpoints_nextToken' - If the result of a @ListEndpoints@ request was truncated, the response
-- includes a @NextToken@. To retrieve the next set of endpoints, use the
-- token in the next request.
--
-- 'sortBy', 'listEndpoints_sortBy' - Sorts the list of results. The default is @CreationTime@.
--
-- 'sortOrder', 'listEndpoints_sortOrder' - The sort order for results. The default is @Descending@.
--
-- 'statusEquals', 'listEndpoints_statusEquals' - A filter that returns only endpoints with the specified status.
newListEndpoints ::
  ListEndpoints
newListEndpoints :: ListEndpoints
newListEndpoints =
  ListEndpoints'
    { $sel:creationTimeAfter:ListEndpoints' :: Maybe POSIX
creationTimeAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimeBefore:ListEndpoints' :: Maybe POSIX
creationTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTimeAfter:ListEndpoints' :: Maybe POSIX
lastModifiedTimeAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTimeBefore:ListEndpoints' :: Maybe POSIX
lastModifiedTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListEndpoints' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListEndpoints' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListEndpoints' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListEndpoints' :: Maybe EndpointSortKey
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListEndpoints' :: Maybe OrderKey
sortOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:statusEquals:ListEndpoints' :: Maybe EndpointStatus
statusEquals = forall a. Maybe a
Prelude.Nothing
    }

-- | A filter that returns only endpoints with a creation time greater than
-- or equal to the specified time (timestamp).
listEndpoints_creationTimeAfter :: Lens.Lens' ListEndpoints (Prelude.Maybe Prelude.UTCTime)
listEndpoints_creationTimeAfter :: Lens' ListEndpoints (Maybe UTCTime)
listEndpoints_creationTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:creationTimeAfter:ListEndpoints' :: ListEndpoints -> Maybe POSIX
creationTimeAfter} -> Maybe POSIX
creationTimeAfter) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe POSIX
a -> ListEndpoints
s {$sel:creationTimeAfter:ListEndpoints' :: Maybe POSIX
creationTimeAfter = Maybe POSIX
a} :: ListEndpoints) 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 endpoints that were created before the
-- specified time (timestamp).
listEndpoints_creationTimeBefore :: Lens.Lens' ListEndpoints (Prelude.Maybe Prelude.UTCTime)
listEndpoints_creationTimeBefore :: Lens' ListEndpoints (Maybe UTCTime)
listEndpoints_creationTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe POSIX
creationTimeBefore :: Maybe POSIX
$sel:creationTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
creationTimeBefore} -> Maybe POSIX
creationTimeBefore) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe POSIX
a -> ListEndpoints
s {$sel:creationTimeBefore:ListEndpoints' :: Maybe POSIX
creationTimeBefore = Maybe POSIX
a} :: ListEndpoints) 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 endpoints that were modified after the
-- specified timestamp.
listEndpoints_lastModifiedTimeAfter :: Lens.Lens' ListEndpoints (Prelude.Maybe Prelude.UTCTime)
listEndpoints_lastModifiedTimeAfter :: Lens' ListEndpoints (Maybe UTCTime)
listEndpoints_lastModifiedTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe POSIX
lastModifiedTimeAfter :: Maybe POSIX
$sel:lastModifiedTimeAfter:ListEndpoints' :: ListEndpoints -> Maybe POSIX
lastModifiedTimeAfter} -> Maybe POSIX
lastModifiedTimeAfter) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe POSIX
a -> ListEndpoints
s {$sel:lastModifiedTimeAfter:ListEndpoints' :: Maybe POSIX
lastModifiedTimeAfter = Maybe POSIX
a} :: ListEndpoints) 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 endpoints that were modified before the
-- specified timestamp.
listEndpoints_lastModifiedTimeBefore :: Lens.Lens' ListEndpoints (Prelude.Maybe Prelude.UTCTime)
listEndpoints_lastModifiedTimeBefore :: Lens' ListEndpoints (Maybe UTCTime)
listEndpoints_lastModifiedTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe POSIX
lastModifiedTimeBefore :: Maybe POSIX
$sel:lastModifiedTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
lastModifiedTimeBefore} -> Maybe POSIX
lastModifiedTimeBefore) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe POSIX
a -> ListEndpoints
s {$sel:lastModifiedTimeBefore:ListEndpoints' :: Maybe POSIX
lastModifiedTimeBefore = Maybe POSIX
a} :: ListEndpoints) 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 endpoints to return in the response. This value
-- defaults to 10.
listEndpoints_maxResults :: Lens.Lens' ListEndpoints (Prelude.Maybe Prelude.Natural)
listEndpoints_maxResults :: Lens' ListEndpoints (Maybe Natural)
listEndpoints_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListEndpoints' :: ListEndpoints -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe Natural
a -> ListEndpoints
s {$sel:maxResults:ListEndpoints' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListEndpoints)

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

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

-- | Sorts the list of results. The default is @CreationTime@.
listEndpoints_sortBy :: Lens.Lens' ListEndpoints (Prelude.Maybe EndpointSortKey)
listEndpoints_sortBy :: Lens' ListEndpoints (Maybe EndpointSortKey)
listEndpoints_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe EndpointSortKey
sortBy :: Maybe EndpointSortKey
$sel:sortBy:ListEndpoints' :: ListEndpoints -> Maybe EndpointSortKey
sortBy} -> Maybe EndpointSortKey
sortBy) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe EndpointSortKey
a -> ListEndpoints
s {$sel:sortBy:ListEndpoints' :: Maybe EndpointSortKey
sortBy = Maybe EndpointSortKey
a} :: ListEndpoints)

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

-- | A filter that returns only endpoints with the specified status.
listEndpoints_statusEquals :: Lens.Lens' ListEndpoints (Prelude.Maybe EndpointStatus)
listEndpoints_statusEquals :: Lens' ListEndpoints (Maybe EndpointStatus)
listEndpoints_statusEquals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpoints' {Maybe EndpointStatus
statusEquals :: Maybe EndpointStatus
$sel:statusEquals:ListEndpoints' :: ListEndpoints -> Maybe EndpointStatus
statusEquals} -> Maybe EndpointStatus
statusEquals) (\s :: ListEndpoints
s@ListEndpoints' {} Maybe EndpointStatus
a -> ListEndpoints
s {$sel:statusEquals:ListEndpoints' :: Maybe EndpointStatus
statusEquals = Maybe EndpointStatus
a} :: ListEndpoints)

instance Core.AWSPager ListEndpoints where
  page :: ListEndpoints -> AWSResponse ListEndpoints -> Maybe ListEndpoints
page ListEndpoints
rq AWSResponse ListEndpoints
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListEndpoints
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointsResponse (Maybe Text)
listEndpointsResponse_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 ListEndpoints
rs forall s a. s -> Getting a s a -> a
Lens.^. Lens' ListEndpointsResponse [EndpointSummary]
listEndpointsResponse_endpoints) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListEndpoints
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListEndpoints (Maybe Text)
listEndpoints_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListEndpoints
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListEndpointsResponse (Maybe Text)
listEndpointsResponse_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 ListEndpoints where
  type
    AWSResponse ListEndpoints =
      ListEndpointsResponse
  request :: (Service -> Service) -> ListEndpoints -> Request ListEndpoints
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 ListEndpoints
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListEndpoints)))
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 -> [EndpointSummary] -> ListEndpointsResponse
ListEndpointsResponse'
            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
"Endpoints" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ListEndpoints where
  hashWithSalt :: Int -> ListEndpoints -> Int
hashWithSalt Int
_salt ListEndpoints' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe EndpointSortKey
Maybe EndpointStatus
Maybe OrderKey
statusEquals :: Maybe EndpointStatus
sortOrder :: Maybe OrderKey
sortBy :: Maybe EndpointSortKey
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
lastModifiedTimeBefore :: Maybe POSIX
lastModifiedTimeAfter :: Maybe POSIX
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:statusEquals:ListEndpoints' :: ListEndpoints -> Maybe EndpointStatus
$sel:sortOrder:ListEndpoints' :: ListEndpoints -> Maybe OrderKey
$sel:sortBy:ListEndpoints' :: ListEndpoints -> Maybe EndpointSortKey
$sel:nextToken:ListEndpoints' :: ListEndpoints -> Maybe Text
$sel:nameContains:ListEndpoints' :: ListEndpoints -> Maybe Text
$sel:maxResults:ListEndpoints' :: ListEndpoints -> Maybe Natural
$sel:lastModifiedTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:lastModifiedTimeAfter:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:creationTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:creationTimeAfter:ListEndpoints' :: ListEndpoints -> 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 POSIX
lastModifiedTimeAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastModifiedTimeBefore
      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 EndpointSortKey
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OrderKey
sortOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointStatus
statusEquals

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

instance Data.ToHeaders ListEndpoints where
  toHeaders :: ListEndpoints -> 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.ListEndpoints" :: 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 ListEndpoints where
  toJSON :: ListEndpoints -> Value
toJSON ListEndpoints' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe EndpointSortKey
Maybe EndpointStatus
Maybe OrderKey
statusEquals :: Maybe EndpointStatus
sortOrder :: Maybe OrderKey
sortBy :: Maybe EndpointSortKey
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
lastModifiedTimeBefore :: Maybe POSIX
lastModifiedTimeAfter :: Maybe POSIX
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:statusEquals:ListEndpoints' :: ListEndpoints -> Maybe EndpointStatus
$sel:sortOrder:ListEndpoints' :: ListEndpoints -> Maybe OrderKey
$sel:sortBy:ListEndpoints' :: ListEndpoints -> Maybe EndpointSortKey
$sel:nextToken:ListEndpoints' :: ListEndpoints -> Maybe Text
$sel:nameContains:ListEndpoints' :: ListEndpoints -> Maybe Text
$sel:maxResults:ListEndpoints' :: ListEndpoints -> Maybe Natural
$sel:lastModifiedTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:lastModifiedTimeAfter:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:creationTimeBefore:ListEndpoints' :: ListEndpoints -> Maybe POSIX
$sel:creationTimeAfter:ListEndpoints' :: ListEndpoints -> 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
"LastModifiedTimeAfter" 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
lastModifiedTimeAfter,
            (Key
"LastModifiedTimeBefore" 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
lastModifiedTimeBefore,
            (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 EndpointSortKey
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,
            (Key
"StatusEquals" 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 EndpointStatus
statusEquals
          ]
      )

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

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

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

-- |
-- Create a value of 'ListEndpointsResponse' 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', 'listEndpointsResponse_nextToken' - If the response is truncated, SageMaker returns this token. To retrieve
-- the next set of training jobs, use it in the subsequent request.
--
-- 'httpStatus', 'listEndpointsResponse_httpStatus' - The response's http status code.
--
-- 'endpoints', 'listEndpointsResponse_endpoints' - An array or endpoint objects.
newListEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListEndpointsResponse
newListEndpointsResponse :: Int -> ListEndpointsResponse
newListEndpointsResponse Int
pHttpStatus_ =
  ListEndpointsResponse'
    { $sel:nextToken:ListEndpointsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListEndpointsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:endpoints:ListEndpointsResponse' :: [EndpointSummary]
endpoints = forall a. Monoid a => a
Prelude.mempty
    }

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

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

-- | An array or endpoint objects.
listEndpointsResponse_endpoints :: Lens.Lens' ListEndpointsResponse [EndpointSummary]
listEndpointsResponse_endpoints :: Lens' ListEndpointsResponse [EndpointSummary]
listEndpointsResponse_endpoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListEndpointsResponse' {[EndpointSummary]
endpoints :: [EndpointSummary]
$sel:endpoints:ListEndpointsResponse' :: ListEndpointsResponse -> [EndpointSummary]
endpoints} -> [EndpointSummary]
endpoints) (\s :: ListEndpointsResponse
s@ListEndpointsResponse' {} [EndpointSummary]
a -> ListEndpointsResponse
s {$sel:endpoints:ListEndpointsResponse' :: [EndpointSummary]
endpoints = [EndpointSummary]
a} :: ListEndpointsResponse) 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 ListEndpointsResponse where
  rnf :: ListEndpointsResponse -> ()
rnf ListEndpointsResponse' {Int
[EndpointSummary]
Maybe Text
endpoints :: [EndpointSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:endpoints:ListEndpointsResponse' :: ListEndpointsResponse -> [EndpointSummary]
$sel:httpStatus:ListEndpointsResponse' :: ListEndpointsResponse -> Int
$sel:nextToken:ListEndpointsResponse' :: ListEndpointsResponse -> 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 [EndpointSummary]
endpoints