{-# 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.ResourceExplorer2.Search
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Searches for resources and displays details about all resources that
-- match the specified criteria. You must specify a query string.
--
-- All search queries must use a view. If you don\'t explicitly specify a
-- view, then Amazon Web Services Resource Explorer uses the default view
-- for the Amazon Web Services Region in which you call this operation. The
-- results are the logical intersection of the results that match both the
-- @QueryString@ parameter supplied to this operation and the
-- @SearchFilter@ parameter attached to the view.
--
-- For the complete syntax supported by the @QueryString@ parameter, see
-- <https://docs.aws.amazon.com/resource-explorer/latest/APIReference/about-query-syntax.html Search query syntax reference for Resource Explorer>.
--
-- If your search results are empty, or are missing results that you think
-- should be there, see
-- <https://docs.aws.amazon.com/resource-explorer/latest/userguide/troubleshooting_search.html Troubleshooting Resource Explorer search>.
--
-- This operation returns paginated results.
module Amazonka.ResourceExplorer2.Search
  ( -- * Creating a Request
    Search (..),
    newSearch,

    -- * Request Lenses
    search_maxResults,
    search_nextToken,
    search_viewArn,
    search_queryString,

    -- * Destructuring the Response
    SearchResponse (..),
    newSearchResponse,

    -- * Response Lenses
    searchResponse_count,
    searchResponse_nextToken,
    searchResponse_resources,
    searchResponse_viewArn,
    searchResponse_httpStatus,
  )
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 Amazonka.ResourceExplorer2.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newSearch' smart constructor.
data Search = Search'
  { -- | The maximum number of results that you want included on each page of the
    -- response. If you do not include this parameter, it defaults to a value
    -- appropriate to the operation. If additional items exist beyond those
    -- included in the current response, the @NextToken@ response element is
    -- present and has a value (is not null). Include that value as the
    -- @NextToken@ request parameter in the next call to the operation to get
    -- the next part of the results.
    --
    -- An API operation can return fewer results than the maximum even when
    -- there are more results available. You should check @NextToken@ after
    -- every operation to ensure that you receive all of the results.
    Search -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The parameter for receiving additional results if you receive a
    -- @NextToken@ response in a previous request. A @NextToken@ response
    -- indicates that more output is available. Set this parameter to the value
    -- of the previous call\'s @NextToken@ response to indicate where the
    -- output should continue from.
    Search -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
    -- of the view to use for the query. If you don\'t specify a value for this
    -- parameter, then the operation automatically uses the default view for
    -- the Amazon Web Services Region in which you called this operation. If
    -- the Region either doesn\'t have a default view or if you don\'t have
    -- permission to use the default view, then the operation fails with a
    -- @401 Unauthorized@ exception.
    Search -> Maybe Text
viewArn :: Prelude.Maybe Prelude.Text,
    -- | A string that includes keywords and filters that specify the resources
    -- that you want to include in the results.
    --
    -- For the complete syntax supported by the @QueryString@ parameter, see
    -- <https://docs.aws.amazon.com/resource-explorer/latest/userguide/using-search-query-syntax.html Search query syntax reference for Resource Explorer>.
    --
    -- The search is completely case insensitive. You can specify an empty
    -- string to return all results up to the limit of 1,000 total results.
    --
    -- The operation can return only the first 1,000 results. If the resource
    -- you want is not included, then use a different value for @QueryString@
    -- to refine the results.
    Search -> Sensitive Text
queryString :: Data.Sensitive Prelude.Text
  }
  deriving (Search -> Search -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Search -> Search -> Bool
$c/= :: Search -> Search -> Bool
== :: Search -> Search -> Bool
$c== :: Search -> Search -> Bool
Prelude.Eq, Int -> Search -> ShowS
[Search] -> ShowS
Search -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Search] -> ShowS
$cshowList :: [Search] -> ShowS
show :: Search -> String
$cshow :: Search -> String
showsPrec :: Int -> Search -> ShowS
$cshowsPrec :: Int -> Search -> ShowS
Prelude.Show, forall x. Rep Search x -> Search
forall x. Search -> Rep Search x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Search x -> Search
$cfrom :: forall x. Search -> Rep Search x
Prelude.Generic)

-- |
-- Create a value of 'Search' 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:
--
-- 'maxResults', 'search_maxResults' - The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
--
-- 'nextToken', 'search_nextToken' - The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
--
-- 'viewArn', 'search_viewArn' - Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the view to use for the query. If you don\'t specify a value for this
-- parameter, then the operation automatically uses the default view for
-- the Amazon Web Services Region in which you called this operation. If
-- the Region either doesn\'t have a default view or if you don\'t have
-- permission to use the default view, then the operation fails with a
-- @401 Unauthorized@ exception.
--
-- 'queryString', 'search_queryString' - A string that includes keywords and filters that specify the resources
-- that you want to include in the results.
--
-- For the complete syntax supported by the @QueryString@ parameter, see
-- <https://docs.aws.amazon.com/resource-explorer/latest/userguide/using-search-query-syntax.html Search query syntax reference for Resource Explorer>.
--
-- The search is completely case insensitive. You can specify an empty
-- string to return all results up to the limit of 1,000 total results.
--
-- The operation can return only the first 1,000 results. If the resource
-- you want is not included, then use a different value for @QueryString@
-- to refine the results.
newSearch ::
  -- | 'queryString'
  Prelude.Text ->
  Search
newSearch :: Text -> Search
newSearch Text
pQueryString_ =
  Search'
    { $sel:maxResults:Search' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:Search' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:viewArn:Search' :: Maybe Text
viewArn = forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:Search' :: Sensitive Text
queryString = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pQueryString_
    }

-- | The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
search_maxResults :: Lens.Lens' Search (Prelude.Maybe Prelude.Natural)
search_maxResults :: Lens' Search (Maybe Natural)
search_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Search' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:Search' :: Search -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: Search
s@Search' {} Maybe Natural
a -> Search
s {$sel:maxResults:Search' :: Maybe Natural
maxResults = Maybe Natural
a} :: Search)

-- | The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
search_nextToken :: Lens.Lens' Search (Prelude.Maybe Prelude.Text)
search_nextToken :: Lens' Search (Maybe Text)
search_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Search' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:Search' :: Search -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: Search
s@Search' {} Maybe Text
a -> Search
s {$sel:nextToken:Search' :: Maybe Text
nextToken = Maybe Text
a} :: Search)

-- | Specifies the
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the view to use for the query. If you don\'t specify a value for this
-- parameter, then the operation automatically uses the default view for
-- the Amazon Web Services Region in which you called this operation. If
-- the Region either doesn\'t have a default view or if you don\'t have
-- permission to use the default view, then the operation fails with a
-- @401 Unauthorized@ exception.
search_viewArn :: Lens.Lens' Search (Prelude.Maybe Prelude.Text)
search_viewArn :: Lens' Search (Maybe Text)
search_viewArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Search' {Maybe Text
viewArn :: Maybe Text
$sel:viewArn:Search' :: Search -> Maybe Text
viewArn} -> Maybe Text
viewArn) (\s :: Search
s@Search' {} Maybe Text
a -> Search
s {$sel:viewArn:Search' :: Maybe Text
viewArn = Maybe Text
a} :: Search)

-- | A string that includes keywords and filters that specify the resources
-- that you want to include in the results.
--
-- For the complete syntax supported by the @QueryString@ parameter, see
-- <https://docs.aws.amazon.com/resource-explorer/latest/userguide/using-search-query-syntax.html Search query syntax reference for Resource Explorer>.
--
-- The search is completely case insensitive. You can specify an empty
-- string to return all results up to the limit of 1,000 total results.
--
-- The operation can return only the first 1,000 results. If the resource
-- you want is not included, then use a different value for @QueryString@
-- to refine the results.
search_queryString :: Lens.Lens' Search Prelude.Text
search_queryString :: Lens' Search Text
search_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Search' {Sensitive Text
queryString :: Sensitive Text
$sel:queryString:Search' :: Search -> Sensitive Text
queryString} -> Sensitive Text
queryString) (\s :: Search
s@Search' {} Sensitive Text
a -> Search
s {$sel:queryString:Search' :: Sensitive Text
queryString = Sensitive Text
a} :: Search) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSPager Search where
  page :: Search -> AWSResponse Search -> Maybe Search
page Search
rq AWSResponse Search
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse Search
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchResponse (Maybe Text)
searchResponse_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 Search
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchResponse (Maybe [Resource])
searchResponse_resources
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ Search
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' Search (Maybe Text)
search_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse Search
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' SearchResponse (Maybe Text)
searchResponse_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 Search where
  type AWSResponse Search = SearchResponse
  request :: (Service -> Service) -> Search -> Request Search
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 Search
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Search)))
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 ResourceCount
-> Maybe Text
-> Maybe [Resource]
-> Maybe Text
-> Int
-> SearchResponse
SearchResponse'
            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
"Count")
            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
"NextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Resources" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ViewArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable Search where
  hashWithSalt :: Int -> Search -> Int
hashWithSalt Int
_salt Search' {Maybe Natural
Maybe Text
Sensitive Text
queryString :: Sensitive Text
viewArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:queryString:Search' :: Search -> Sensitive Text
$sel:viewArn:Search' :: Search -> Maybe Text
$sel:nextToken:Search' :: Search -> Maybe Text
$sel:maxResults:Search' :: Search -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
viewArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
queryString

instance Prelude.NFData Search where
  rnf :: Search -> ()
rnf Search' {Maybe Natural
Maybe Text
Sensitive Text
queryString :: Sensitive Text
viewArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:queryString:Search' :: Search -> Sensitive Text
$sel:viewArn:Search' :: Search -> Maybe Text
$sel:nextToken:Search' :: Search -> Maybe Text
$sel:maxResults:Search' :: Search -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
viewArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
queryString

instance Data.ToHeaders Search where
  toHeaders :: Search -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON Search where
  toJSON :: Search -> Value
toJSON Search' {Maybe Natural
Maybe Text
Sensitive Text
queryString :: Sensitive Text
viewArn :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:queryString:Search' :: Search -> Sensitive Text
$sel:viewArn:Search' :: Search -> Maybe Text
$sel:nextToken:Search' :: Search -> Maybe Text
$sel:maxResults:Search' :: Search -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"ViewArn" 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
viewArn,
            forall a. a -> Maybe a
Prelude.Just (Key
"QueryString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
queryString)
          ]
      )

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

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

-- | /See:/ 'newSearchResponse' smart constructor.
data SearchResponse = SearchResponse'
  { -- | The number of resources that match the query.
    SearchResponse -> Maybe ResourceCount
count :: Prelude.Maybe ResourceCount,
    -- | If present, indicates that more output is available than is included in
    -- the current response. Use this value in the @NextToken@ request
    -- parameter in a subsequent call to the operation to get the next part of
    -- the output. You should repeat this until the @NextToken@ response
    -- element comes back as @null@.
    SearchResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The list of structures that describe the resources that match the query.
    SearchResponse -> Maybe [Resource]
resources :: Prelude.Maybe [Resource],
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
    -- of the view that this operation used to perform the search.
    SearchResponse -> Maybe Text
viewArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SearchResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (SearchResponse -> SearchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResponse -> SearchResponse -> Bool
$c/= :: SearchResponse -> SearchResponse -> Bool
== :: SearchResponse -> SearchResponse -> Bool
$c== :: SearchResponse -> SearchResponse -> Bool
Prelude.Eq, ReadPrec [SearchResponse]
ReadPrec SearchResponse
Int -> ReadS SearchResponse
ReadS [SearchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SearchResponse]
$creadListPrec :: ReadPrec [SearchResponse]
readPrec :: ReadPrec SearchResponse
$creadPrec :: ReadPrec SearchResponse
readList :: ReadS [SearchResponse]
$creadList :: ReadS [SearchResponse]
readsPrec :: Int -> ReadS SearchResponse
$creadsPrec :: Int -> ReadS SearchResponse
Prelude.Read, Int -> SearchResponse -> ShowS
[SearchResponse] -> ShowS
SearchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchResponse] -> ShowS
$cshowList :: [SearchResponse] -> ShowS
show :: SearchResponse -> String
$cshow :: SearchResponse -> String
showsPrec :: Int -> SearchResponse -> ShowS
$cshowsPrec :: Int -> SearchResponse -> ShowS
Prelude.Show, forall x. Rep SearchResponse x -> SearchResponse
forall x. SearchResponse -> Rep SearchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchResponse x -> SearchResponse
$cfrom :: forall x. SearchResponse -> Rep SearchResponse x
Prelude.Generic)

-- |
-- Create a value of 'SearchResponse' 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:
--
-- 'count', 'searchResponse_count' - The number of resources that match the query.
--
-- 'nextToken', 'searchResponse_nextToken' - If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
--
-- 'resources', 'searchResponse_resources' - The list of structures that describe the resources that match the query.
--
-- 'viewArn', 'searchResponse_viewArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the view that this operation used to perform the search.
--
-- 'httpStatus', 'searchResponse_httpStatus' - The response's http status code.
newSearchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  SearchResponse
newSearchResponse :: Int -> SearchResponse
newSearchResponse Int
pHttpStatus_ =
  SearchResponse'
    { $sel:count:SearchResponse' :: Maybe ResourceCount
count = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:SearchResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resources:SearchResponse' :: Maybe [Resource]
resources = forall a. Maybe a
Prelude.Nothing,
      $sel:viewArn:SearchResponse' :: Maybe Text
viewArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:SearchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The number of resources that match the query.
searchResponse_count :: Lens.Lens' SearchResponse (Prelude.Maybe ResourceCount)
searchResponse_count :: Lens' SearchResponse (Maybe ResourceCount)
searchResponse_count = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchResponse' {Maybe ResourceCount
count :: Maybe ResourceCount
$sel:count:SearchResponse' :: SearchResponse -> Maybe ResourceCount
count} -> Maybe ResourceCount
count) (\s :: SearchResponse
s@SearchResponse' {} Maybe ResourceCount
a -> SearchResponse
s {$sel:count:SearchResponse' :: Maybe ResourceCount
count = Maybe ResourceCount
a} :: SearchResponse)

-- | If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
searchResponse_nextToken :: Lens.Lens' SearchResponse (Prelude.Maybe Prelude.Text)
searchResponse_nextToken :: Lens' SearchResponse (Maybe Text)
searchResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:SearchResponse' :: SearchResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: SearchResponse
s@SearchResponse' {} Maybe Text
a -> SearchResponse
s {$sel:nextToken:SearchResponse' :: Maybe Text
nextToken = Maybe Text
a} :: SearchResponse)

-- | The list of structures that describe the resources that match the query.
searchResponse_resources :: Lens.Lens' SearchResponse (Prelude.Maybe [Resource])
searchResponse_resources :: Lens' SearchResponse (Maybe [Resource])
searchResponse_resources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchResponse' {Maybe [Resource]
resources :: Maybe [Resource]
$sel:resources:SearchResponse' :: SearchResponse -> Maybe [Resource]
resources} -> Maybe [Resource]
resources) (\s :: SearchResponse
s@SearchResponse' {} Maybe [Resource]
a -> SearchResponse
s {$sel:resources:SearchResponse' :: Maybe [Resource]
resources = Maybe [Resource]
a} :: SearchResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon resource name (ARN)>
-- of the view that this operation used to perform the search.
searchResponse_viewArn :: Lens.Lens' SearchResponse (Prelude.Maybe Prelude.Text)
searchResponse_viewArn :: Lens' SearchResponse (Maybe Text)
searchResponse_viewArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SearchResponse' {Maybe Text
viewArn :: Maybe Text
$sel:viewArn:SearchResponse' :: SearchResponse -> Maybe Text
viewArn} -> Maybe Text
viewArn) (\s :: SearchResponse
s@SearchResponse' {} Maybe Text
a -> SearchResponse
s {$sel:viewArn:SearchResponse' :: Maybe Text
viewArn = Maybe Text
a} :: SearchResponse)

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

instance Prelude.NFData SearchResponse where
  rnf :: SearchResponse -> ()
rnf SearchResponse' {Int
Maybe [Resource]
Maybe Text
Maybe ResourceCount
httpStatus :: Int
viewArn :: Maybe Text
resources :: Maybe [Resource]
nextToken :: Maybe Text
count :: Maybe ResourceCount
$sel:httpStatus:SearchResponse' :: SearchResponse -> Int
$sel:viewArn:SearchResponse' :: SearchResponse -> Maybe Text
$sel:resources:SearchResponse' :: SearchResponse -> Maybe [Resource]
$sel:nextToken:SearchResponse' :: SearchResponse -> Maybe Text
$sel:count:SearchResponse' :: SearchResponse -> Maybe ResourceCount
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceCount
count
      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 [Resource]
resources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
viewArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus