{-# 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.ListHubs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List all existing hubs.
module Amazonka.SageMaker.ListHubs
  ( -- * Creating a Request
    ListHubs (..),
    newListHubs,

    -- * Request Lenses
    listHubs_creationTimeAfter,
    listHubs_creationTimeBefore,
    listHubs_lastModifiedTimeAfter,
    listHubs_lastModifiedTimeBefore,
    listHubs_maxResults,
    listHubs_nameContains,
    listHubs_nextToken,
    listHubs_sortBy,
    listHubs_sortOrder,

    -- * Destructuring the Response
    ListHubsResponse (..),
    newListHubsResponse,

    -- * Response Lenses
    listHubsResponse_nextToken,
    listHubsResponse_httpStatus,
    listHubsResponse_hubSummaries,
  )
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:/ 'newListHubs' smart constructor.
data ListHubs = ListHubs'
  { -- | Only list hubs that were created after the time specified.
    ListHubs -> Maybe POSIX
creationTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | Only list hubs that were created before the time specified.
    ListHubs -> Maybe POSIX
creationTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | Only list hubs that were last modified after the time specified.
    ListHubs -> Maybe POSIX
lastModifiedTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | Only list hubs that were last modified before the time specified.
    ListHubs -> Maybe POSIX
lastModifiedTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | The maximum number of hubs to list.
    ListHubs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Only list hubs with names that contain the specified string.
    ListHubs -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | If the response to a previous @ListHubs@ request was truncated, the
    -- response includes a @NextToken@. To retrieve the next set of hubs, use
    -- the token in the next request.
    ListHubs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Sort hubs by either name or creation time.
    ListHubs -> Maybe HubSortBy
sortBy :: Prelude.Maybe HubSortBy,
    -- | Sort hubs by ascending or descending order.
    ListHubs -> Maybe SortOrder
sortOrder :: Prelude.Maybe SortOrder
  }
  deriving (ListHubs -> ListHubs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListHubs -> ListHubs -> Bool
$c/= :: ListHubs -> ListHubs -> Bool
== :: ListHubs -> ListHubs -> Bool
$c== :: ListHubs -> ListHubs -> Bool
Prelude.Eq, ReadPrec [ListHubs]
ReadPrec ListHubs
Int -> ReadS ListHubs
ReadS [ListHubs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListHubs]
$creadListPrec :: ReadPrec [ListHubs]
readPrec :: ReadPrec ListHubs
$creadPrec :: ReadPrec ListHubs
readList :: ReadS [ListHubs]
$creadList :: ReadS [ListHubs]
readsPrec :: Int -> ReadS ListHubs
$creadsPrec :: Int -> ReadS ListHubs
Prelude.Read, Int -> ListHubs -> ShowS
[ListHubs] -> ShowS
ListHubs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListHubs] -> ShowS
$cshowList :: [ListHubs] -> ShowS
show :: ListHubs -> String
$cshow :: ListHubs -> String
showsPrec :: Int -> ListHubs -> ShowS
$cshowsPrec :: Int -> ListHubs -> ShowS
Prelude.Show, forall x. Rep ListHubs x -> ListHubs
forall x. ListHubs -> Rep ListHubs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListHubs x -> ListHubs
$cfrom :: forall x. ListHubs -> Rep ListHubs x
Prelude.Generic)

-- |
-- Create a value of 'ListHubs' 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', 'listHubs_creationTimeAfter' - Only list hubs that were created after the time specified.
--
-- 'creationTimeBefore', 'listHubs_creationTimeBefore' - Only list hubs that were created before the time specified.
--
-- 'lastModifiedTimeAfter', 'listHubs_lastModifiedTimeAfter' - Only list hubs that were last modified after the time specified.
--
-- 'lastModifiedTimeBefore', 'listHubs_lastModifiedTimeBefore' - Only list hubs that were last modified before the time specified.
--
-- 'maxResults', 'listHubs_maxResults' - The maximum number of hubs to list.
--
-- 'nameContains', 'listHubs_nameContains' - Only list hubs with names that contain the specified string.
--
-- 'nextToken', 'listHubs_nextToken' - If the response to a previous @ListHubs@ request was truncated, the
-- response includes a @NextToken@. To retrieve the next set of hubs, use
-- the token in the next request.
--
-- 'sortBy', 'listHubs_sortBy' - Sort hubs by either name or creation time.
--
-- 'sortOrder', 'listHubs_sortOrder' - Sort hubs by ascending or descending order.
newListHubs ::
  ListHubs
newListHubs :: ListHubs
newListHubs =
  ListHubs'
    { $sel:creationTimeAfter:ListHubs' :: Maybe POSIX
creationTimeAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimeBefore:ListHubs' :: Maybe POSIX
creationTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTimeAfter:ListHubs' :: Maybe POSIX
lastModifiedTimeAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTimeBefore:ListHubs' :: Maybe POSIX
lastModifiedTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListHubs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListHubs' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListHubs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListHubs' :: Maybe HubSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListHubs' :: Maybe SortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | Only list hubs that were created after the time specified.
listHubs_creationTimeAfter :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.UTCTime)
listHubs_creationTimeAfter :: Lens' ListHubs (Maybe UTCTime)
listHubs_creationTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:creationTimeAfter:ListHubs' :: ListHubs -> Maybe POSIX
creationTimeAfter} -> Maybe POSIX
creationTimeAfter) (\s :: ListHubs
s@ListHubs' {} Maybe POSIX
a -> ListHubs
s {$sel:creationTimeAfter:ListHubs' :: Maybe POSIX
creationTimeAfter = Maybe POSIX
a} :: ListHubs) 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

-- | Only list hubs that were created before the time specified.
listHubs_creationTimeBefore :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.UTCTime)
listHubs_creationTimeBefore :: Lens' ListHubs (Maybe UTCTime)
listHubs_creationTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe POSIX
creationTimeBefore :: Maybe POSIX
$sel:creationTimeBefore:ListHubs' :: ListHubs -> Maybe POSIX
creationTimeBefore} -> Maybe POSIX
creationTimeBefore) (\s :: ListHubs
s@ListHubs' {} Maybe POSIX
a -> ListHubs
s {$sel:creationTimeBefore:ListHubs' :: Maybe POSIX
creationTimeBefore = Maybe POSIX
a} :: ListHubs) 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

-- | Only list hubs that were last modified after the time specified.
listHubs_lastModifiedTimeAfter :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.UTCTime)
listHubs_lastModifiedTimeAfter :: Lens' ListHubs (Maybe UTCTime)
listHubs_lastModifiedTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe POSIX
lastModifiedTimeAfter :: Maybe POSIX
$sel:lastModifiedTimeAfter:ListHubs' :: ListHubs -> Maybe POSIX
lastModifiedTimeAfter} -> Maybe POSIX
lastModifiedTimeAfter) (\s :: ListHubs
s@ListHubs' {} Maybe POSIX
a -> ListHubs
s {$sel:lastModifiedTimeAfter:ListHubs' :: Maybe POSIX
lastModifiedTimeAfter = Maybe POSIX
a} :: ListHubs) 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

-- | Only list hubs that were last modified before the time specified.
listHubs_lastModifiedTimeBefore :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.UTCTime)
listHubs_lastModifiedTimeBefore :: Lens' ListHubs (Maybe UTCTime)
listHubs_lastModifiedTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe POSIX
lastModifiedTimeBefore :: Maybe POSIX
$sel:lastModifiedTimeBefore:ListHubs' :: ListHubs -> Maybe POSIX
lastModifiedTimeBefore} -> Maybe POSIX
lastModifiedTimeBefore) (\s :: ListHubs
s@ListHubs' {} Maybe POSIX
a -> ListHubs
s {$sel:lastModifiedTimeBefore:ListHubs' :: Maybe POSIX
lastModifiedTimeBefore = Maybe POSIX
a} :: ListHubs) 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 hubs to list.
listHubs_maxResults :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.Natural)
listHubs_maxResults :: Lens' ListHubs (Maybe Natural)
listHubs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListHubs' :: ListHubs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListHubs
s@ListHubs' {} Maybe Natural
a -> ListHubs
s {$sel:maxResults:ListHubs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListHubs)

-- | Only list hubs with names that contain the specified string.
listHubs_nameContains :: Lens.Lens' ListHubs (Prelude.Maybe Prelude.Text)
listHubs_nameContains :: Lens' ListHubs (Maybe Text)
listHubs_nameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe Text
nameContains :: Maybe Text
$sel:nameContains:ListHubs' :: ListHubs -> Maybe Text
nameContains} -> Maybe Text
nameContains) (\s :: ListHubs
s@ListHubs' {} Maybe Text
a -> ListHubs
s {$sel:nameContains:ListHubs' :: Maybe Text
nameContains = Maybe Text
a} :: ListHubs)

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

-- | Sort hubs by either name or creation time.
listHubs_sortBy :: Lens.Lens' ListHubs (Prelude.Maybe HubSortBy)
listHubs_sortBy :: Lens' ListHubs (Maybe HubSortBy)
listHubs_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe HubSortBy
sortBy :: Maybe HubSortBy
$sel:sortBy:ListHubs' :: ListHubs -> Maybe HubSortBy
sortBy} -> Maybe HubSortBy
sortBy) (\s :: ListHubs
s@ListHubs' {} Maybe HubSortBy
a -> ListHubs
s {$sel:sortBy:ListHubs' :: Maybe HubSortBy
sortBy = Maybe HubSortBy
a} :: ListHubs)

-- | Sort hubs by ascending or descending order.
listHubs_sortOrder :: Lens.Lens' ListHubs (Prelude.Maybe SortOrder)
listHubs_sortOrder :: Lens' ListHubs (Maybe SortOrder)
listHubs_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubs' {Maybe SortOrder
sortOrder :: Maybe SortOrder
$sel:sortOrder:ListHubs' :: ListHubs -> Maybe SortOrder
sortOrder} -> Maybe SortOrder
sortOrder) (\s :: ListHubs
s@ListHubs' {} Maybe SortOrder
a -> ListHubs
s {$sel:sortOrder:ListHubs' :: Maybe SortOrder
sortOrder = Maybe SortOrder
a} :: ListHubs)

instance Core.AWSRequest ListHubs where
  type AWSResponse ListHubs = ListHubsResponse
  request :: (Service -> Service) -> ListHubs -> Request ListHubs
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 ListHubs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListHubs)))
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 -> [HubInfo] -> ListHubsResponse
ListHubsResponse'
            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
"HubSummaries" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

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

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

instance Data.ToHeaders ListHubs where
  toHeaders :: ListHubs -> 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.ListHubs" :: 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 ListHubs where
  toJSON :: ListHubs -> Value
toJSON ListHubs' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe HubSortBy
Maybe SortOrder
sortOrder :: Maybe SortOrder
sortBy :: Maybe HubSortBy
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
lastModifiedTimeBefore :: Maybe POSIX
lastModifiedTimeAfter :: Maybe POSIX
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListHubs' :: ListHubs -> Maybe SortOrder
$sel:sortBy:ListHubs' :: ListHubs -> Maybe HubSortBy
$sel:nextToken:ListHubs' :: ListHubs -> Maybe Text
$sel:nameContains:ListHubs' :: ListHubs -> Maybe Text
$sel:maxResults:ListHubs' :: ListHubs -> Maybe Natural
$sel:lastModifiedTimeBefore:ListHubs' :: ListHubs -> Maybe POSIX
$sel:lastModifiedTimeAfter:ListHubs' :: ListHubs -> Maybe POSIX
$sel:creationTimeBefore:ListHubs' :: ListHubs -> Maybe POSIX
$sel:creationTimeAfter:ListHubs' :: ListHubs -> 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 HubSortBy
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 SortOrder
sortOrder
          ]
      )

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

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

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

-- |
-- Create a value of 'ListHubsResponse' 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', 'listHubsResponse_nextToken' - If the response is truncated, SageMaker returns this token. To retrieve
-- the next set of hubs, use it in the subsequent request.
--
-- 'httpStatus', 'listHubsResponse_httpStatus' - The response's http status code.
--
-- 'hubSummaries', 'listHubsResponse_hubSummaries' - The summaries of the listed hubs.
newListHubsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListHubsResponse
newListHubsResponse :: Int -> ListHubsResponse
newListHubsResponse Int
pHttpStatus_ =
  ListHubsResponse'
    { $sel:nextToken:ListHubsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListHubsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:hubSummaries:ListHubsResponse' :: [HubInfo]
hubSummaries = forall a. Monoid a => a
Prelude.mempty
    }

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

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

-- | The summaries of the listed hubs.
listHubsResponse_hubSummaries :: Lens.Lens' ListHubsResponse [HubInfo]
listHubsResponse_hubSummaries :: Lens' ListHubsResponse [HubInfo]
listHubsResponse_hubSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListHubsResponse' {[HubInfo]
hubSummaries :: [HubInfo]
$sel:hubSummaries:ListHubsResponse' :: ListHubsResponse -> [HubInfo]
hubSummaries} -> [HubInfo]
hubSummaries) (\s :: ListHubsResponse
s@ListHubsResponse' {} [HubInfo]
a -> ListHubsResponse
s {$sel:hubSummaries:ListHubsResponse' :: [HubInfo]
hubSummaries = [HubInfo]
a} :: ListHubsResponse) 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 ListHubsResponse where
  rnf :: ListHubsResponse -> ()
rnf ListHubsResponse' {Int
[HubInfo]
Maybe Text
hubSummaries :: [HubInfo]
httpStatus :: Int
nextToken :: Maybe Text
$sel:hubSummaries:ListHubsResponse' :: ListHubsResponse -> [HubInfo]
$sel:httpStatus:ListHubsResponse' :: ListHubsResponse -> Int
$sel:nextToken:ListHubsResponse' :: ListHubsResponse -> 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 [HubInfo]
hubSummaries