{-# 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.PrivateNetworks.ListDeviceIdentifiers
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists device identifiers. Add filters to your request to return a more
-- specific list of results. Use filters to match the Amazon Resource Name
-- (ARN) of an order, the status of device identifiers, or the ARN of the
-- traffic group.
--
-- >  <p>If you specify multiple filters, filters are joined with an OR, and the request
--
-- returns results that match all of the specified filters.
--
-- This operation returns paginated results.
module Amazonka.PrivateNetworks.ListDeviceIdentifiers
  ( -- * Creating a Request
    ListDeviceIdentifiers (..),
    newListDeviceIdentifiers,

    -- * Request Lenses
    listDeviceIdentifiers_filters,
    listDeviceIdentifiers_maxResults,
    listDeviceIdentifiers_startToken,
    listDeviceIdentifiers_networkArn,

    -- * Destructuring the Response
    ListDeviceIdentifiersResponse (..),
    newListDeviceIdentifiersResponse,

    -- * Response Lenses
    listDeviceIdentifiersResponse_deviceIdentifiers,
    listDeviceIdentifiersResponse_nextToken,
    listDeviceIdentifiersResponse_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 Amazonka.PrivateNetworks.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListDeviceIdentifiers' smart constructor.
data ListDeviceIdentifiers = ListDeviceIdentifiers'
  { -- | The filters.
    --
    -- -   @ORDER@ - The Amazon Resource Name (ARN) of the order.
    --
    -- -   @STATUS@ - The status (@ACTIVE@ | @INACTIVE@).
    --
    -- -   @TRAFFIC_GROUP@ - The Amazon Resource Name (ARN) of the traffic
    --     group.
    --
    -- Filter values are case sensitive. If you specify multiple values for a
    -- filter, the values are joined with an @OR@, and the request returns all
    -- results that match any of the specified values.
    ListDeviceIdentifiers
-> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters :: Prelude.Maybe (Prelude.HashMap DeviceIdentifierFilterKeys [Prelude.Text]),
    -- | The maximum number of results to return.
    ListDeviceIdentifiers -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next page of results.
    ListDeviceIdentifiers -> Maybe Text
startToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the network.
    ListDeviceIdentifiers -> Text
networkArn :: Prelude.Text
  }
  deriving (ListDeviceIdentifiers -> ListDeviceIdentifiers -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeviceIdentifiers -> ListDeviceIdentifiers -> Bool
$c/= :: ListDeviceIdentifiers -> ListDeviceIdentifiers -> Bool
== :: ListDeviceIdentifiers -> ListDeviceIdentifiers -> Bool
$c== :: ListDeviceIdentifiers -> ListDeviceIdentifiers -> Bool
Prelude.Eq, ReadPrec [ListDeviceIdentifiers]
ReadPrec ListDeviceIdentifiers
Int -> ReadS ListDeviceIdentifiers
ReadS [ListDeviceIdentifiers]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListDeviceIdentifiers]
$creadListPrec :: ReadPrec [ListDeviceIdentifiers]
readPrec :: ReadPrec ListDeviceIdentifiers
$creadPrec :: ReadPrec ListDeviceIdentifiers
readList :: ReadS [ListDeviceIdentifiers]
$creadList :: ReadS [ListDeviceIdentifiers]
readsPrec :: Int -> ReadS ListDeviceIdentifiers
$creadsPrec :: Int -> ReadS ListDeviceIdentifiers
Prelude.Read, Int -> ListDeviceIdentifiers -> ShowS
[ListDeviceIdentifiers] -> ShowS
ListDeviceIdentifiers -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeviceIdentifiers] -> ShowS
$cshowList :: [ListDeviceIdentifiers] -> ShowS
show :: ListDeviceIdentifiers -> String
$cshow :: ListDeviceIdentifiers -> String
showsPrec :: Int -> ListDeviceIdentifiers -> ShowS
$cshowsPrec :: Int -> ListDeviceIdentifiers -> ShowS
Prelude.Show, forall x. Rep ListDeviceIdentifiers x -> ListDeviceIdentifiers
forall x. ListDeviceIdentifiers -> Rep ListDeviceIdentifiers x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListDeviceIdentifiers x -> ListDeviceIdentifiers
$cfrom :: forall x. ListDeviceIdentifiers -> Rep ListDeviceIdentifiers x
Prelude.Generic)

-- |
-- Create a value of 'ListDeviceIdentifiers' 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:
--
-- 'filters', 'listDeviceIdentifiers_filters' - The filters.
--
-- -   @ORDER@ - The Amazon Resource Name (ARN) of the order.
--
-- -   @STATUS@ - The status (@ACTIVE@ | @INACTIVE@).
--
-- -   @TRAFFIC_GROUP@ - The Amazon Resource Name (ARN) of the traffic
--     group.
--
-- Filter values are case sensitive. If you specify multiple values for a
-- filter, the values are joined with an @OR@, and the request returns all
-- results that match any of the specified values.
--
-- 'maxResults', 'listDeviceIdentifiers_maxResults' - The maximum number of results to return.
--
-- 'startToken', 'listDeviceIdentifiers_startToken' - The token for the next page of results.
--
-- 'networkArn', 'listDeviceIdentifiers_networkArn' - The Amazon Resource Name (ARN) of the network.
newListDeviceIdentifiers ::
  -- | 'networkArn'
  Prelude.Text ->
  ListDeviceIdentifiers
newListDeviceIdentifiers :: Text -> ListDeviceIdentifiers
newListDeviceIdentifiers Text
pNetworkArn_ =
  ListDeviceIdentifiers'
    { $sel:filters:ListDeviceIdentifiers' :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListDeviceIdentifiers' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:startToken:ListDeviceIdentifiers' :: Maybe Text
startToken = forall a. Maybe a
Prelude.Nothing,
      $sel:networkArn:ListDeviceIdentifiers' :: Text
networkArn = Text
pNetworkArn_
    }

-- | The filters.
--
-- -   @ORDER@ - The Amazon Resource Name (ARN) of the order.
--
-- -   @STATUS@ - The status (@ACTIVE@ | @INACTIVE@).
--
-- -   @TRAFFIC_GROUP@ - The Amazon Resource Name (ARN) of the traffic
--     group.
--
-- Filter values are case sensitive. If you specify multiple values for a
-- filter, the values are joined with an @OR@, and the request returns all
-- results that match any of the specified values.
listDeviceIdentifiers_filters :: Lens.Lens' ListDeviceIdentifiers (Prelude.Maybe (Prelude.HashMap DeviceIdentifierFilterKeys [Prelude.Text]))
listDeviceIdentifiers_filters :: Lens'
  ListDeviceIdentifiers
  (Maybe (HashMap DeviceIdentifierFilterKeys [Text]))
listDeviceIdentifiers_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiers' {Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
$sel:filters:ListDeviceIdentifiers' :: ListDeviceIdentifiers
-> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters} -> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters) (\s :: ListDeviceIdentifiers
s@ListDeviceIdentifiers' {} Maybe (HashMap DeviceIdentifierFilterKeys [Text])
a -> ListDeviceIdentifiers
s {$sel:filters:ListDeviceIdentifiers' :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters = Maybe (HashMap DeviceIdentifierFilterKeys [Text])
a} :: ListDeviceIdentifiers) 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 maximum number of results to return.
listDeviceIdentifiers_maxResults :: Lens.Lens' ListDeviceIdentifiers (Prelude.Maybe Prelude.Natural)
listDeviceIdentifiers_maxResults :: Lens' ListDeviceIdentifiers (Maybe Natural)
listDeviceIdentifiers_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiers' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListDeviceIdentifiers
s@ListDeviceIdentifiers' {} Maybe Natural
a -> ListDeviceIdentifiers
s {$sel:maxResults:ListDeviceIdentifiers' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListDeviceIdentifiers)

-- | The token for the next page of results.
listDeviceIdentifiers_startToken :: Lens.Lens' ListDeviceIdentifiers (Prelude.Maybe Prelude.Text)
listDeviceIdentifiers_startToken :: Lens' ListDeviceIdentifiers (Maybe Text)
listDeviceIdentifiers_startToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiers' {Maybe Text
startToken :: Maybe Text
$sel:startToken:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Text
startToken} -> Maybe Text
startToken) (\s :: ListDeviceIdentifiers
s@ListDeviceIdentifiers' {} Maybe Text
a -> ListDeviceIdentifiers
s {$sel:startToken:ListDeviceIdentifiers' :: Maybe Text
startToken = Maybe Text
a} :: ListDeviceIdentifiers)

-- | The Amazon Resource Name (ARN) of the network.
listDeviceIdentifiers_networkArn :: Lens.Lens' ListDeviceIdentifiers Prelude.Text
listDeviceIdentifiers_networkArn :: Lens' ListDeviceIdentifiers Text
listDeviceIdentifiers_networkArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiers' {Text
networkArn :: Text
$sel:networkArn:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Text
networkArn} -> Text
networkArn) (\s :: ListDeviceIdentifiers
s@ListDeviceIdentifiers' {} Text
a -> ListDeviceIdentifiers
s {$sel:networkArn:ListDeviceIdentifiers' :: Text
networkArn = Text
a} :: ListDeviceIdentifiers)

instance Core.AWSPager ListDeviceIdentifiers where
  page :: ListDeviceIdentifiers
-> AWSResponse ListDeviceIdentifiers -> Maybe ListDeviceIdentifiers
page ListDeviceIdentifiers
rq AWSResponse ListDeviceIdentifiers
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListDeviceIdentifiers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeviceIdentifiersResponse (Maybe Text)
listDeviceIdentifiersResponse_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 ListDeviceIdentifiers
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeviceIdentifiersResponse (Maybe [DeviceIdentifier])
listDeviceIdentifiersResponse_deviceIdentifiers
            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.$ ListDeviceIdentifiers
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListDeviceIdentifiers (Maybe Text)
listDeviceIdentifiers_startToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListDeviceIdentifiers
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListDeviceIdentifiersResponse (Maybe Text)
listDeviceIdentifiersResponse_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 ListDeviceIdentifiers where
  type
    AWSResponse ListDeviceIdentifiers =
      ListDeviceIdentifiersResponse
  request :: (Service -> Service)
-> ListDeviceIdentifiers -> Request ListDeviceIdentifiers
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 ListDeviceIdentifiers
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListDeviceIdentifiers)))
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 [DeviceIdentifier]
-> Maybe Text -> Int -> ListDeviceIdentifiersResponse
ListDeviceIdentifiersResponse'
            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
"deviceIdentifiers"
                            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
"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))
      )

instance Prelude.Hashable ListDeviceIdentifiers where
  hashWithSalt :: Int -> ListDeviceIdentifiers -> Int
hashWithSalt Int
_salt ListDeviceIdentifiers' {Maybe Natural
Maybe Text
Maybe (HashMap DeviceIdentifierFilterKeys [Text])
Text
networkArn :: Text
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
$sel:networkArn:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Text
$sel:startToken:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Text
$sel:maxResults:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Natural
$sel:filters:ListDeviceIdentifiers' :: ListDeviceIdentifiers
-> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
startToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
networkArn

instance Prelude.NFData ListDeviceIdentifiers where
  rnf :: ListDeviceIdentifiers -> ()
rnf ListDeviceIdentifiers' {Maybe Natural
Maybe Text
Maybe (HashMap DeviceIdentifierFilterKeys [Text])
Text
networkArn :: Text
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
$sel:networkArn:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Text
$sel:startToken:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Text
$sel:maxResults:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Natural
$sel:filters:ListDeviceIdentifiers' :: ListDeviceIdentifiers
-> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap DeviceIdentifierFilterKeys [Text])
filters
      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
startToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
networkArn

instance Data.ToHeaders ListDeviceIdentifiers where
  toHeaders :: ListDeviceIdentifiers -> 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 ListDeviceIdentifiers where
  toJSON :: ListDeviceIdentifiers -> Value
toJSON ListDeviceIdentifiers' {Maybe Natural
Maybe Text
Maybe (HashMap DeviceIdentifierFilterKeys [Text])
Text
networkArn :: Text
startToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe (HashMap DeviceIdentifierFilterKeys [Text])
$sel:networkArn:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Text
$sel:startToken:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Text
$sel:maxResults:ListDeviceIdentifiers' :: ListDeviceIdentifiers -> Maybe Natural
$sel:filters:ListDeviceIdentifiers' :: ListDeviceIdentifiers
-> Maybe (HashMap DeviceIdentifierFilterKeys [Text])
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"filters" 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 (HashMap DeviceIdentifierFilterKeys [Text])
filters,
            (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
"startToken" 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
startToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"networkArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
networkArn)
          ]
      )

instance Data.ToPath ListDeviceIdentifiers where
  toPath :: ListDeviceIdentifiers -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/device-identifiers/list"

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

-- | /See:/ 'newListDeviceIdentifiersResponse' smart constructor.
data ListDeviceIdentifiersResponse = ListDeviceIdentifiersResponse'
  { -- | Information about the device identifiers.
    ListDeviceIdentifiersResponse -> Maybe [DeviceIdentifier]
deviceIdentifiers :: Prelude.Maybe [DeviceIdentifier],
    -- | The token for the next page of results.
    ListDeviceIdentifiersResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListDeviceIdentifiersResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListDeviceIdentifiersResponse
-> ListDeviceIdentifiersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListDeviceIdentifiersResponse
-> ListDeviceIdentifiersResponse -> Bool
$c/= :: ListDeviceIdentifiersResponse
-> ListDeviceIdentifiersResponse -> Bool
== :: ListDeviceIdentifiersResponse
-> ListDeviceIdentifiersResponse -> Bool
$c== :: ListDeviceIdentifiersResponse
-> ListDeviceIdentifiersResponse -> Bool
Prelude.Eq, Int -> ListDeviceIdentifiersResponse -> ShowS
[ListDeviceIdentifiersResponse] -> ShowS
ListDeviceIdentifiersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListDeviceIdentifiersResponse] -> ShowS
$cshowList :: [ListDeviceIdentifiersResponse] -> ShowS
show :: ListDeviceIdentifiersResponse -> String
$cshow :: ListDeviceIdentifiersResponse -> String
showsPrec :: Int -> ListDeviceIdentifiersResponse -> ShowS
$cshowsPrec :: Int -> ListDeviceIdentifiersResponse -> ShowS
Prelude.Show, forall x.
Rep ListDeviceIdentifiersResponse x
-> ListDeviceIdentifiersResponse
forall x.
ListDeviceIdentifiersResponse
-> Rep ListDeviceIdentifiersResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListDeviceIdentifiersResponse x
-> ListDeviceIdentifiersResponse
$cfrom :: forall x.
ListDeviceIdentifiersResponse
-> Rep ListDeviceIdentifiersResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListDeviceIdentifiersResponse' 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:
--
-- 'deviceIdentifiers', 'listDeviceIdentifiersResponse_deviceIdentifiers' - Information about the device identifiers.
--
-- 'nextToken', 'listDeviceIdentifiersResponse_nextToken' - The token for the next page of results.
--
-- 'httpStatus', 'listDeviceIdentifiersResponse_httpStatus' - The response's http status code.
newListDeviceIdentifiersResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListDeviceIdentifiersResponse
newListDeviceIdentifiersResponse :: Int -> ListDeviceIdentifiersResponse
newListDeviceIdentifiersResponse Int
pHttpStatus_ =
  ListDeviceIdentifiersResponse'
    { $sel:deviceIdentifiers:ListDeviceIdentifiersResponse' :: Maybe [DeviceIdentifier]
deviceIdentifiers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListDeviceIdentifiersResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListDeviceIdentifiersResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the device identifiers.
listDeviceIdentifiersResponse_deviceIdentifiers :: Lens.Lens' ListDeviceIdentifiersResponse (Prelude.Maybe [DeviceIdentifier])
listDeviceIdentifiersResponse_deviceIdentifiers :: Lens' ListDeviceIdentifiersResponse (Maybe [DeviceIdentifier])
listDeviceIdentifiersResponse_deviceIdentifiers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiersResponse' {Maybe [DeviceIdentifier]
deviceIdentifiers :: Maybe [DeviceIdentifier]
$sel:deviceIdentifiers:ListDeviceIdentifiersResponse' :: ListDeviceIdentifiersResponse -> Maybe [DeviceIdentifier]
deviceIdentifiers} -> Maybe [DeviceIdentifier]
deviceIdentifiers) (\s :: ListDeviceIdentifiersResponse
s@ListDeviceIdentifiersResponse' {} Maybe [DeviceIdentifier]
a -> ListDeviceIdentifiersResponse
s {$sel:deviceIdentifiers:ListDeviceIdentifiersResponse' :: Maybe [DeviceIdentifier]
deviceIdentifiers = Maybe [DeviceIdentifier]
a} :: ListDeviceIdentifiersResponse) 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 token for the next page of results.
listDeviceIdentifiersResponse_nextToken :: Lens.Lens' ListDeviceIdentifiersResponse (Prelude.Maybe Prelude.Text)
listDeviceIdentifiersResponse_nextToken :: Lens' ListDeviceIdentifiersResponse (Maybe Text)
listDeviceIdentifiersResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListDeviceIdentifiersResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListDeviceIdentifiersResponse' :: ListDeviceIdentifiersResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListDeviceIdentifiersResponse
s@ListDeviceIdentifiersResponse' {} Maybe Text
a -> ListDeviceIdentifiersResponse
s {$sel:nextToken:ListDeviceIdentifiersResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListDeviceIdentifiersResponse)

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

instance Prelude.NFData ListDeviceIdentifiersResponse where
  rnf :: ListDeviceIdentifiersResponse -> ()
rnf ListDeviceIdentifiersResponse' {Int
Maybe [DeviceIdentifier]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
deviceIdentifiers :: Maybe [DeviceIdentifier]
$sel:httpStatus:ListDeviceIdentifiersResponse' :: ListDeviceIdentifiersResponse -> Int
$sel:nextToken:ListDeviceIdentifiersResponse' :: ListDeviceIdentifiersResponse -> Maybe Text
$sel:deviceIdentifiers:ListDeviceIdentifiersResponse' :: ListDeviceIdentifiersResponse -> Maybe [DeviceIdentifier]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeviceIdentifier]
deviceIdentifiers
      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 Int
httpStatus