{-# 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.ListFeatureGroups
-- 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 @FeatureGroup@s based on given filter and order.
--
-- This operation returns paginated results.
module Amazonka.SageMaker.ListFeatureGroups
  ( -- * Creating a Request
    ListFeatureGroups (..),
    newListFeatureGroups,

    -- * Request Lenses
    listFeatureGroups_creationTimeAfter,
    listFeatureGroups_creationTimeBefore,
    listFeatureGroups_featureGroupStatusEquals,
    listFeatureGroups_maxResults,
    listFeatureGroups_nameContains,
    listFeatureGroups_nextToken,
    listFeatureGroups_offlineStoreStatusEquals,
    listFeatureGroups_sortBy,
    listFeatureGroups_sortOrder,

    -- * Destructuring the Response
    ListFeatureGroupsResponse (..),
    newListFeatureGroupsResponse,

    -- * Response Lenses
    listFeatureGroupsResponse_nextToken,
    listFeatureGroupsResponse_httpStatus,
    listFeatureGroupsResponse_featureGroupSummaries,
  )
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:/ 'newListFeatureGroups' smart constructor.
data ListFeatureGroups = ListFeatureGroups'
  { -- | Use this parameter to search for @FeatureGroups@s created after a
    -- specific date and time.
    ListFeatureGroups -> Maybe POSIX
creationTimeAfter :: Prelude.Maybe Data.POSIX,
    -- | Use this parameter to search for @FeatureGroups@s created before a
    -- specific date and time.
    ListFeatureGroups -> Maybe POSIX
creationTimeBefore :: Prelude.Maybe Data.POSIX,
    -- | A @FeatureGroup@ status. Filters by @FeatureGroup@ status.
    ListFeatureGroups -> Maybe FeatureGroupStatus
featureGroupStatusEquals :: Prelude.Maybe FeatureGroupStatus,
    -- | The maximum number of results returned by @ListFeatureGroups@.
    ListFeatureGroups -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | A string that partially matches one or more @FeatureGroup@s names.
    -- Filters @FeatureGroup@s by name.
    ListFeatureGroups -> Maybe Text
nameContains :: Prelude.Maybe Prelude.Text,
    -- | A token to resume pagination of @ListFeatureGroups@ results.
    ListFeatureGroups -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An @OfflineStore@ status. Filters by @OfflineStore@ status.
    ListFeatureGroups -> Maybe OfflineStoreStatusValue
offlineStoreStatusEquals :: Prelude.Maybe OfflineStoreStatusValue,
    -- | The value on which the feature group list is sorted.
    ListFeatureGroups -> Maybe FeatureGroupSortBy
sortBy :: Prelude.Maybe FeatureGroupSortBy,
    -- | The order in which feature groups are listed.
    ListFeatureGroups -> Maybe FeatureGroupSortOrder
sortOrder :: Prelude.Maybe FeatureGroupSortOrder
  }
  deriving (ListFeatureGroups -> ListFeatureGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFeatureGroups -> ListFeatureGroups -> Bool
$c/= :: ListFeatureGroups -> ListFeatureGroups -> Bool
== :: ListFeatureGroups -> ListFeatureGroups -> Bool
$c== :: ListFeatureGroups -> ListFeatureGroups -> Bool
Prelude.Eq, ReadPrec [ListFeatureGroups]
ReadPrec ListFeatureGroups
Int -> ReadS ListFeatureGroups
ReadS [ListFeatureGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFeatureGroups]
$creadListPrec :: ReadPrec [ListFeatureGroups]
readPrec :: ReadPrec ListFeatureGroups
$creadPrec :: ReadPrec ListFeatureGroups
readList :: ReadS [ListFeatureGroups]
$creadList :: ReadS [ListFeatureGroups]
readsPrec :: Int -> ReadS ListFeatureGroups
$creadsPrec :: Int -> ReadS ListFeatureGroups
Prelude.Read, Int -> ListFeatureGroups -> ShowS
[ListFeatureGroups] -> ShowS
ListFeatureGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFeatureGroups] -> ShowS
$cshowList :: [ListFeatureGroups] -> ShowS
show :: ListFeatureGroups -> String
$cshow :: ListFeatureGroups -> String
showsPrec :: Int -> ListFeatureGroups -> ShowS
$cshowsPrec :: Int -> ListFeatureGroups -> ShowS
Prelude.Show, forall x. Rep ListFeatureGroups x -> ListFeatureGroups
forall x. ListFeatureGroups -> Rep ListFeatureGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListFeatureGroups x -> ListFeatureGroups
$cfrom :: forall x. ListFeatureGroups -> Rep ListFeatureGroups x
Prelude.Generic)

-- |
-- Create a value of 'ListFeatureGroups' 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', 'listFeatureGroups_creationTimeAfter' - Use this parameter to search for @FeatureGroups@s created after a
-- specific date and time.
--
-- 'creationTimeBefore', 'listFeatureGroups_creationTimeBefore' - Use this parameter to search for @FeatureGroups@s created before a
-- specific date and time.
--
-- 'featureGroupStatusEquals', 'listFeatureGroups_featureGroupStatusEquals' - A @FeatureGroup@ status. Filters by @FeatureGroup@ status.
--
-- 'maxResults', 'listFeatureGroups_maxResults' - The maximum number of results returned by @ListFeatureGroups@.
--
-- 'nameContains', 'listFeatureGroups_nameContains' - A string that partially matches one or more @FeatureGroup@s names.
-- Filters @FeatureGroup@s by name.
--
-- 'nextToken', 'listFeatureGroups_nextToken' - A token to resume pagination of @ListFeatureGroups@ results.
--
-- 'offlineStoreStatusEquals', 'listFeatureGroups_offlineStoreStatusEquals' - An @OfflineStore@ status. Filters by @OfflineStore@ status.
--
-- 'sortBy', 'listFeatureGroups_sortBy' - The value on which the feature group list is sorted.
--
-- 'sortOrder', 'listFeatureGroups_sortOrder' - The order in which feature groups are listed.
newListFeatureGroups ::
  ListFeatureGroups
newListFeatureGroups :: ListFeatureGroups
newListFeatureGroups =
  ListFeatureGroups'
    { $sel:creationTimeAfter:ListFeatureGroups' :: Maybe POSIX
creationTimeAfter =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationTimeBefore:ListFeatureGroups' :: Maybe POSIX
creationTimeBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:featureGroupStatusEquals:ListFeatureGroups' :: Maybe FeatureGroupStatus
featureGroupStatusEquals = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListFeatureGroups' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nameContains:ListFeatureGroups' :: Maybe Text
nameContains = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListFeatureGroups' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:offlineStoreStatusEquals:ListFeatureGroups' :: Maybe OfflineStoreStatusValue
offlineStoreStatusEquals = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListFeatureGroups' :: Maybe FeatureGroupSortBy
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:sortOrder:ListFeatureGroups' :: Maybe FeatureGroupSortOrder
sortOrder = forall a. Maybe a
Prelude.Nothing
    }

-- | Use this parameter to search for @FeatureGroups@s created after a
-- specific date and time.
listFeatureGroups_creationTimeAfter :: Lens.Lens' ListFeatureGroups (Prelude.Maybe Prelude.UTCTime)
listFeatureGroups_creationTimeAfter :: Lens' ListFeatureGroups (Maybe UTCTime)
listFeatureGroups_creationTimeAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:creationTimeAfter:ListFeatureGroups' :: ListFeatureGroups -> Maybe POSIX
creationTimeAfter} -> Maybe POSIX
creationTimeAfter) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe POSIX
a -> ListFeatureGroups
s {$sel:creationTimeAfter:ListFeatureGroups' :: Maybe POSIX
creationTimeAfter = Maybe POSIX
a} :: ListFeatureGroups) 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

-- | Use this parameter to search for @FeatureGroups@s created before a
-- specific date and time.
listFeatureGroups_creationTimeBefore :: Lens.Lens' ListFeatureGroups (Prelude.Maybe Prelude.UTCTime)
listFeatureGroups_creationTimeBefore :: Lens' ListFeatureGroups (Maybe UTCTime)
listFeatureGroups_creationTimeBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe POSIX
creationTimeBefore :: Maybe POSIX
$sel:creationTimeBefore:ListFeatureGroups' :: ListFeatureGroups -> Maybe POSIX
creationTimeBefore} -> Maybe POSIX
creationTimeBefore) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe POSIX
a -> ListFeatureGroups
s {$sel:creationTimeBefore:ListFeatureGroups' :: Maybe POSIX
creationTimeBefore = Maybe POSIX
a} :: ListFeatureGroups) 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 @FeatureGroup@ status. Filters by @FeatureGroup@ status.
listFeatureGroups_featureGroupStatusEquals :: Lens.Lens' ListFeatureGroups (Prelude.Maybe FeatureGroupStatus)
listFeatureGroups_featureGroupStatusEquals :: Lens' ListFeatureGroups (Maybe FeatureGroupStatus)
listFeatureGroups_featureGroupStatusEquals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe FeatureGroupStatus
featureGroupStatusEquals :: Maybe FeatureGroupStatus
$sel:featureGroupStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupStatus
featureGroupStatusEquals} -> Maybe FeatureGroupStatus
featureGroupStatusEquals) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe FeatureGroupStatus
a -> ListFeatureGroups
s {$sel:featureGroupStatusEquals:ListFeatureGroups' :: Maybe FeatureGroupStatus
featureGroupStatusEquals = Maybe FeatureGroupStatus
a} :: ListFeatureGroups)

-- | The maximum number of results returned by @ListFeatureGroups@.
listFeatureGroups_maxResults :: Lens.Lens' ListFeatureGroups (Prelude.Maybe Prelude.Natural)
listFeatureGroups_maxResults :: Lens' ListFeatureGroups (Maybe Natural)
listFeatureGroups_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListFeatureGroups' :: ListFeatureGroups -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe Natural
a -> ListFeatureGroups
s {$sel:maxResults:ListFeatureGroups' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListFeatureGroups)

-- | A string that partially matches one or more @FeatureGroup@s names.
-- Filters @FeatureGroup@s by name.
listFeatureGroups_nameContains :: Lens.Lens' ListFeatureGroups (Prelude.Maybe Prelude.Text)
listFeatureGroups_nameContains :: Lens' ListFeatureGroups (Maybe Text)
listFeatureGroups_nameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe Text
nameContains :: Maybe Text
$sel:nameContains:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
nameContains} -> Maybe Text
nameContains) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe Text
a -> ListFeatureGroups
s {$sel:nameContains:ListFeatureGroups' :: Maybe Text
nameContains = Maybe Text
a} :: ListFeatureGroups)

-- | A token to resume pagination of @ListFeatureGroups@ results.
listFeatureGroups_nextToken :: Lens.Lens' ListFeatureGroups (Prelude.Maybe Prelude.Text)
listFeatureGroups_nextToken :: Lens' ListFeatureGroups (Maybe Text)
listFeatureGroups_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe Text
a -> ListFeatureGroups
s {$sel:nextToken:ListFeatureGroups' :: Maybe Text
nextToken = Maybe Text
a} :: ListFeatureGroups)

-- | An @OfflineStore@ status. Filters by @OfflineStore@ status.
listFeatureGroups_offlineStoreStatusEquals :: Lens.Lens' ListFeatureGroups (Prelude.Maybe OfflineStoreStatusValue)
listFeatureGroups_offlineStoreStatusEquals :: Lens' ListFeatureGroups (Maybe OfflineStoreStatusValue)
listFeatureGroups_offlineStoreStatusEquals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe OfflineStoreStatusValue
offlineStoreStatusEquals :: Maybe OfflineStoreStatusValue
$sel:offlineStoreStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe OfflineStoreStatusValue
offlineStoreStatusEquals} -> Maybe OfflineStoreStatusValue
offlineStoreStatusEquals) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe OfflineStoreStatusValue
a -> ListFeatureGroups
s {$sel:offlineStoreStatusEquals:ListFeatureGroups' :: Maybe OfflineStoreStatusValue
offlineStoreStatusEquals = Maybe OfflineStoreStatusValue
a} :: ListFeatureGroups)

-- | The value on which the feature group list is sorted.
listFeatureGroups_sortBy :: Lens.Lens' ListFeatureGroups (Prelude.Maybe FeatureGroupSortBy)
listFeatureGroups_sortBy :: Lens' ListFeatureGroups (Maybe FeatureGroupSortBy)
listFeatureGroups_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe FeatureGroupSortBy
sortBy :: Maybe FeatureGroupSortBy
$sel:sortBy:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortBy
sortBy} -> Maybe FeatureGroupSortBy
sortBy) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe FeatureGroupSortBy
a -> ListFeatureGroups
s {$sel:sortBy:ListFeatureGroups' :: Maybe FeatureGroupSortBy
sortBy = Maybe FeatureGroupSortBy
a} :: ListFeatureGroups)

-- | The order in which feature groups are listed.
listFeatureGroups_sortOrder :: Lens.Lens' ListFeatureGroups (Prelude.Maybe FeatureGroupSortOrder)
listFeatureGroups_sortOrder :: Lens' ListFeatureGroups (Maybe FeatureGroupSortOrder)
listFeatureGroups_sortOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroups' {Maybe FeatureGroupSortOrder
sortOrder :: Maybe FeatureGroupSortOrder
$sel:sortOrder:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortOrder
sortOrder} -> Maybe FeatureGroupSortOrder
sortOrder) (\s :: ListFeatureGroups
s@ListFeatureGroups' {} Maybe FeatureGroupSortOrder
a -> ListFeatureGroups
s {$sel:sortOrder:ListFeatureGroups' :: Maybe FeatureGroupSortOrder
sortOrder = Maybe FeatureGroupSortOrder
a} :: ListFeatureGroups)

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

instance Prelude.Hashable ListFeatureGroups where
  hashWithSalt :: Int -> ListFeatureGroups -> Int
hashWithSalt Int
_salt ListFeatureGroups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe FeatureGroupSortBy
Maybe FeatureGroupSortOrder
Maybe FeatureGroupStatus
Maybe OfflineStoreStatusValue
sortOrder :: Maybe FeatureGroupSortOrder
sortBy :: Maybe FeatureGroupSortBy
offlineStoreStatusEquals :: Maybe OfflineStoreStatusValue
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
featureGroupStatusEquals :: Maybe FeatureGroupStatus
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortOrder
$sel:sortBy:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortBy
$sel:offlineStoreStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe OfflineStoreStatusValue
$sel:nextToken:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:nameContains:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:maxResults:ListFeatureGroups' :: ListFeatureGroups -> Maybe Natural
$sel:featureGroupStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupStatus
$sel:creationTimeBefore:ListFeatureGroups' :: ListFeatureGroups -> Maybe POSIX
$sel:creationTimeAfter:ListFeatureGroups' :: ListFeatureGroups -> 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 FeatureGroupStatus
featureGroupStatusEquals
      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 OfflineStoreStatusValue
offlineStoreStatusEquals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FeatureGroupSortBy
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FeatureGroupSortOrder
sortOrder

instance Prelude.NFData ListFeatureGroups where
  rnf :: ListFeatureGroups -> ()
rnf ListFeatureGroups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe FeatureGroupSortBy
Maybe FeatureGroupSortOrder
Maybe FeatureGroupStatus
Maybe OfflineStoreStatusValue
sortOrder :: Maybe FeatureGroupSortOrder
sortBy :: Maybe FeatureGroupSortBy
offlineStoreStatusEquals :: Maybe OfflineStoreStatusValue
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
featureGroupStatusEquals :: Maybe FeatureGroupStatus
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortOrder
$sel:sortBy:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortBy
$sel:offlineStoreStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe OfflineStoreStatusValue
$sel:nextToken:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:nameContains:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:maxResults:ListFeatureGroups' :: ListFeatureGroups -> Maybe Natural
$sel:featureGroupStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupStatus
$sel:creationTimeBefore:ListFeatureGroups' :: ListFeatureGroups -> Maybe POSIX
$sel:creationTimeAfter:ListFeatureGroups' :: ListFeatureGroups -> 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 FeatureGroupStatus
featureGroupStatusEquals
      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 OfflineStoreStatusValue
offlineStoreStatusEquals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FeatureGroupSortBy
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FeatureGroupSortOrder
sortOrder

instance Data.ToHeaders ListFeatureGroups where
  toHeaders :: ListFeatureGroups -> 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.ListFeatureGroups" ::
                          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 ListFeatureGroups where
  toJSON :: ListFeatureGroups -> Value
toJSON ListFeatureGroups' {Maybe Natural
Maybe Text
Maybe POSIX
Maybe FeatureGroupSortBy
Maybe FeatureGroupSortOrder
Maybe FeatureGroupStatus
Maybe OfflineStoreStatusValue
sortOrder :: Maybe FeatureGroupSortOrder
sortBy :: Maybe FeatureGroupSortBy
offlineStoreStatusEquals :: Maybe OfflineStoreStatusValue
nextToken :: Maybe Text
nameContains :: Maybe Text
maxResults :: Maybe Natural
featureGroupStatusEquals :: Maybe FeatureGroupStatus
creationTimeBefore :: Maybe POSIX
creationTimeAfter :: Maybe POSIX
$sel:sortOrder:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortOrder
$sel:sortBy:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupSortBy
$sel:offlineStoreStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe OfflineStoreStatusValue
$sel:nextToken:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:nameContains:ListFeatureGroups' :: ListFeatureGroups -> Maybe Text
$sel:maxResults:ListFeatureGroups' :: ListFeatureGroups -> Maybe Natural
$sel:featureGroupStatusEquals:ListFeatureGroups' :: ListFeatureGroups -> Maybe FeatureGroupStatus
$sel:creationTimeBefore:ListFeatureGroups' :: ListFeatureGroups -> Maybe POSIX
$sel:creationTimeAfter:ListFeatureGroups' :: ListFeatureGroups -> 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
"FeatureGroupStatusEquals" 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 FeatureGroupStatus
featureGroupStatusEquals,
            (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
"OfflineStoreStatusEquals" 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 OfflineStoreStatusValue
offlineStoreStatusEquals,
            (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 FeatureGroupSortBy
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 FeatureGroupSortOrder
sortOrder
          ]
      )

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

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

-- | /See:/ 'newListFeatureGroupsResponse' smart constructor.
data ListFeatureGroupsResponse = ListFeatureGroupsResponse'
  { -- | A token to resume pagination of @ListFeatureGroups@ results.
    ListFeatureGroupsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListFeatureGroupsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A summary of feature groups.
    ListFeatureGroupsResponse -> [FeatureGroupSummary]
featureGroupSummaries :: [FeatureGroupSummary]
  }
  deriving (ListFeatureGroupsResponse -> ListFeatureGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListFeatureGroupsResponse -> ListFeatureGroupsResponse -> Bool
$c/= :: ListFeatureGroupsResponse -> ListFeatureGroupsResponse -> Bool
== :: ListFeatureGroupsResponse -> ListFeatureGroupsResponse -> Bool
$c== :: ListFeatureGroupsResponse -> ListFeatureGroupsResponse -> Bool
Prelude.Eq, ReadPrec [ListFeatureGroupsResponse]
ReadPrec ListFeatureGroupsResponse
Int -> ReadS ListFeatureGroupsResponse
ReadS [ListFeatureGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListFeatureGroupsResponse]
$creadListPrec :: ReadPrec [ListFeatureGroupsResponse]
readPrec :: ReadPrec ListFeatureGroupsResponse
$creadPrec :: ReadPrec ListFeatureGroupsResponse
readList :: ReadS [ListFeatureGroupsResponse]
$creadList :: ReadS [ListFeatureGroupsResponse]
readsPrec :: Int -> ReadS ListFeatureGroupsResponse
$creadsPrec :: Int -> ReadS ListFeatureGroupsResponse
Prelude.Read, Int -> ListFeatureGroupsResponse -> ShowS
[ListFeatureGroupsResponse] -> ShowS
ListFeatureGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListFeatureGroupsResponse] -> ShowS
$cshowList :: [ListFeatureGroupsResponse] -> ShowS
show :: ListFeatureGroupsResponse -> String
$cshow :: ListFeatureGroupsResponse -> String
showsPrec :: Int -> ListFeatureGroupsResponse -> ShowS
$cshowsPrec :: Int -> ListFeatureGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep ListFeatureGroupsResponse x -> ListFeatureGroupsResponse
forall x.
ListFeatureGroupsResponse -> Rep ListFeatureGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListFeatureGroupsResponse x -> ListFeatureGroupsResponse
$cfrom :: forall x.
ListFeatureGroupsResponse -> Rep ListFeatureGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListFeatureGroupsResponse' 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', 'listFeatureGroupsResponse_nextToken' - A token to resume pagination of @ListFeatureGroups@ results.
--
-- 'httpStatus', 'listFeatureGroupsResponse_httpStatus' - The response's http status code.
--
-- 'featureGroupSummaries', 'listFeatureGroupsResponse_featureGroupSummaries' - A summary of feature groups.
newListFeatureGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListFeatureGroupsResponse
newListFeatureGroupsResponse :: Int -> ListFeatureGroupsResponse
newListFeatureGroupsResponse Int
pHttpStatus_ =
  ListFeatureGroupsResponse'
    { $sel:nextToken:ListFeatureGroupsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListFeatureGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:featureGroupSummaries:ListFeatureGroupsResponse' :: [FeatureGroupSummary]
featureGroupSummaries = forall a. Monoid a => a
Prelude.mempty
    }

-- | A token to resume pagination of @ListFeatureGroups@ results.
listFeatureGroupsResponse_nextToken :: Lens.Lens' ListFeatureGroupsResponse (Prelude.Maybe Prelude.Text)
listFeatureGroupsResponse_nextToken :: Lens' ListFeatureGroupsResponse (Maybe Text)
listFeatureGroupsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroupsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListFeatureGroupsResponse' :: ListFeatureGroupsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListFeatureGroupsResponse
s@ListFeatureGroupsResponse' {} Maybe Text
a -> ListFeatureGroupsResponse
s {$sel:nextToken:ListFeatureGroupsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListFeatureGroupsResponse)

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

-- | A summary of feature groups.
listFeatureGroupsResponse_featureGroupSummaries :: Lens.Lens' ListFeatureGroupsResponse [FeatureGroupSummary]
listFeatureGroupsResponse_featureGroupSummaries :: Lens' ListFeatureGroupsResponse [FeatureGroupSummary]
listFeatureGroupsResponse_featureGroupSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListFeatureGroupsResponse' {[FeatureGroupSummary]
featureGroupSummaries :: [FeatureGroupSummary]
$sel:featureGroupSummaries:ListFeatureGroupsResponse' :: ListFeatureGroupsResponse -> [FeatureGroupSummary]
featureGroupSummaries} -> [FeatureGroupSummary]
featureGroupSummaries) (\s :: ListFeatureGroupsResponse
s@ListFeatureGroupsResponse' {} [FeatureGroupSummary]
a -> ListFeatureGroupsResponse
s {$sel:featureGroupSummaries:ListFeatureGroupsResponse' :: [FeatureGroupSummary]
featureGroupSummaries = [FeatureGroupSummary]
a} :: ListFeatureGroupsResponse) 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 ListFeatureGroupsResponse where
  rnf :: ListFeatureGroupsResponse -> ()
rnf ListFeatureGroupsResponse' {Int
[FeatureGroupSummary]
Maybe Text
featureGroupSummaries :: [FeatureGroupSummary]
httpStatus :: Int
nextToken :: Maybe Text
$sel:featureGroupSummaries:ListFeatureGroupsResponse' :: ListFeatureGroupsResponse -> [FeatureGroupSummary]
$sel:httpStatus:ListFeatureGroupsResponse' :: ListFeatureGroupsResponse -> Int
$sel:nextToken:ListFeatureGroupsResponse' :: ListFeatureGroupsResponse -> 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 [FeatureGroupSummary]
featureGroupSummaries