{-# 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.IoT.ListCertificates
-- 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 the certificates registered in your Amazon Web Services account.
--
-- The results are paginated with a default page size of 25. You can use
-- the returned marker to retrieve additional results.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions ListCertificates>
-- action.
--
-- This operation returns paginated results.
module Amazonka.IoT.ListCertificates
  ( -- * Creating a Request
    ListCertificates (..),
    newListCertificates,

    -- * Request Lenses
    listCertificates_ascendingOrder,
    listCertificates_marker,
    listCertificates_pageSize,

    -- * Destructuring the Response
    ListCertificatesResponse (..),
    newListCertificatesResponse,

    -- * Response Lenses
    listCertificatesResponse_certificates,
    listCertificatesResponse_nextMarker,
    listCertificatesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | The input for the ListCertificates operation.
--
-- /See:/ 'newListCertificates' smart constructor.
data ListCertificates = ListCertificates'
  { -- | Specifies the order for results. If True, the results are returned in
    -- ascending order, based on the creation date.
    ListCertificates -> Maybe Bool
ascendingOrder :: Prelude.Maybe Prelude.Bool,
    -- | The marker for the next set of results.
    ListCertificates -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The result page size.
    ListCertificates -> Maybe Natural
pageSize :: Prelude.Maybe Prelude.Natural
  }
  deriving (ListCertificates -> ListCertificates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificates -> ListCertificates -> Bool
$c/= :: ListCertificates -> ListCertificates -> Bool
== :: ListCertificates -> ListCertificates -> Bool
$c== :: ListCertificates -> ListCertificates -> Bool
Prelude.Eq, ReadPrec [ListCertificates]
ReadPrec ListCertificates
Int -> ReadS ListCertificates
ReadS [ListCertificates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificates]
$creadListPrec :: ReadPrec [ListCertificates]
readPrec :: ReadPrec ListCertificates
$creadPrec :: ReadPrec ListCertificates
readList :: ReadS [ListCertificates]
$creadList :: ReadS [ListCertificates]
readsPrec :: Int -> ReadS ListCertificates
$creadsPrec :: Int -> ReadS ListCertificates
Prelude.Read, Int -> ListCertificates -> ShowS
[ListCertificates] -> ShowS
ListCertificates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificates] -> ShowS
$cshowList :: [ListCertificates] -> ShowS
show :: ListCertificates -> String
$cshow :: ListCertificates -> String
showsPrec :: Int -> ListCertificates -> ShowS
$cshowsPrec :: Int -> ListCertificates -> ShowS
Prelude.Show, forall x. Rep ListCertificates x -> ListCertificates
forall x. ListCertificates -> Rep ListCertificates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCertificates x -> ListCertificates
$cfrom :: forall x. ListCertificates -> Rep ListCertificates x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificates' 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:
--
-- 'ascendingOrder', 'listCertificates_ascendingOrder' - Specifies the order for results. If True, the results are returned in
-- ascending order, based on the creation date.
--
-- 'marker', 'listCertificates_marker' - The marker for the next set of results.
--
-- 'pageSize', 'listCertificates_pageSize' - The result page size.
newListCertificates ::
  ListCertificates
newListCertificates :: ListCertificates
newListCertificates =
  ListCertificates'
    { $sel:ascendingOrder:ListCertificates' :: Maybe Bool
ascendingOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListCertificates' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListCertificates' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies the order for results. If True, the results are returned in
-- ascending order, based on the creation date.
listCertificates_ascendingOrder :: Lens.Lens' ListCertificates (Prelude.Maybe Prelude.Bool)
listCertificates_ascendingOrder :: Lens' ListCertificates (Maybe Bool)
listCertificates_ascendingOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificates' {Maybe Bool
ascendingOrder :: Maybe Bool
$sel:ascendingOrder:ListCertificates' :: ListCertificates -> Maybe Bool
ascendingOrder} -> Maybe Bool
ascendingOrder) (\s :: ListCertificates
s@ListCertificates' {} Maybe Bool
a -> ListCertificates
s {$sel:ascendingOrder:ListCertificates' :: Maybe Bool
ascendingOrder = Maybe Bool
a} :: ListCertificates)

-- | The marker for the next set of results.
listCertificates_marker :: Lens.Lens' ListCertificates (Prelude.Maybe Prelude.Text)
listCertificates_marker :: Lens' ListCertificates (Maybe Text)
listCertificates_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificates' {Maybe Text
marker :: Maybe Text
$sel:marker:ListCertificates' :: ListCertificates -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListCertificates
s@ListCertificates' {} Maybe Text
a -> ListCertificates
s {$sel:marker:ListCertificates' :: Maybe Text
marker = Maybe Text
a} :: ListCertificates)

-- | The result page size.
listCertificates_pageSize :: Lens.Lens' ListCertificates (Prelude.Maybe Prelude.Natural)
listCertificates_pageSize :: Lens' ListCertificates (Maybe Natural)
listCertificates_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificates' {Maybe Natural
pageSize :: Maybe Natural
$sel:pageSize:ListCertificates' :: ListCertificates -> Maybe Natural
pageSize} -> Maybe Natural
pageSize) (\s :: ListCertificates
s@ListCertificates' {} Maybe Natural
a -> ListCertificates
s {$sel:pageSize:ListCertificates' :: Maybe Natural
pageSize = Maybe Natural
a} :: ListCertificates)

instance Core.AWSPager ListCertificates where
  page :: ListCertificates
-> AWSResponse ListCertificates -> Maybe ListCertificates
page ListCertificates
rq AWSResponse ListCertificates
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCertificates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesResponse (Maybe Text)
listCertificatesResponse_nextMarker
            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 ListCertificates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesResponse (Maybe [Certificate])
listCertificatesResponse_certificates
            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.$ ListCertificates
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCertificates (Maybe Text)
listCertificates_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCertificates
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesResponse (Maybe Text)
listCertificatesResponse_nextMarker
          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 ListCertificates where
  type
    AWSResponse ListCertificates =
      ListCertificatesResponse
  request :: (Service -> Service)
-> ListCertificates -> Request ListCertificates
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListCertificates
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCertificates)))
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 [Certificate]
-> Maybe Text -> Int -> ListCertificatesResponse
ListCertificatesResponse'
            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
"certificates" 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
"nextMarker")
            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 ListCertificates where
  hashWithSalt :: Int -> ListCertificates -> Int
hashWithSalt Int
_salt ListCertificates' {Maybe Bool
Maybe Natural
Maybe Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:pageSize:ListCertificates' :: ListCertificates -> Maybe Natural
$sel:marker:ListCertificates' :: ListCertificates -> Maybe Text
$sel:ascendingOrder:ListCertificates' :: ListCertificates -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ascendingOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
pageSize

instance Prelude.NFData ListCertificates where
  rnf :: ListCertificates -> ()
rnf ListCertificates' {Maybe Bool
Maybe Natural
Maybe Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:pageSize:ListCertificates' :: ListCertificates -> Maybe Natural
$sel:marker:ListCertificates' :: ListCertificates -> Maybe Text
$sel:ascendingOrder:ListCertificates' :: ListCertificates -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ascendingOrder
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
pageSize

instance Data.ToHeaders ListCertificates where
  toHeaders :: ListCertificates -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListCertificates where
  toQuery :: ListCertificates -> QueryString
toQuery ListCertificates' {Maybe Bool
Maybe Natural
Maybe Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:pageSize:ListCertificates' :: ListCertificates -> Maybe Natural
$sel:marker:ListCertificates' :: ListCertificates -> Maybe Text
$sel:ascendingOrder:ListCertificates' :: ListCertificates -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"isAscendingOrder" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
ascendingOrder,
        ByteString
"marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"pageSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
pageSize
      ]

-- | The output of the ListCertificates operation.
--
-- /See:/ 'newListCertificatesResponse' smart constructor.
data ListCertificatesResponse = ListCertificatesResponse'
  { -- | The descriptions of the certificates.
    ListCertificatesResponse -> Maybe [Certificate]
certificates :: Prelude.Maybe [Certificate],
    -- | The marker for the next set of results, or null if there are no
    -- additional results.
    ListCertificatesResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCertificatesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCertificatesResponse -> ListCertificatesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificatesResponse -> ListCertificatesResponse -> Bool
$c/= :: ListCertificatesResponse -> ListCertificatesResponse -> Bool
== :: ListCertificatesResponse -> ListCertificatesResponse -> Bool
$c== :: ListCertificatesResponse -> ListCertificatesResponse -> Bool
Prelude.Eq, ReadPrec [ListCertificatesResponse]
ReadPrec ListCertificatesResponse
Int -> ReadS ListCertificatesResponse
ReadS [ListCertificatesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificatesResponse]
$creadListPrec :: ReadPrec [ListCertificatesResponse]
readPrec :: ReadPrec ListCertificatesResponse
$creadPrec :: ReadPrec ListCertificatesResponse
readList :: ReadS [ListCertificatesResponse]
$creadList :: ReadS [ListCertificatesResponse]
readsPrec :: Int -> ReadS ListCertificatesResponse
$creadsPrec :: Int -> ReadS ListCertificatesResponse
Prelude.Read, Int -> ListCertificatesResponse -> ShowS
[ListCertificatesResponse] -> ShowS
ListCertificatesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificatesResponse] -> ShowS
$cshowList :: [ListCertificatesResponse] -> ShowS
show :: ListCertificatesResponse -> String
$cshow :: ListCertificatesResponse -> String
showsPrec :: Int -> ListCertificatesResponse -> ShowS
$cshowsPrec :: Int -> ListCertificatesResponse -> ShowS
Prelude.Show, forall x.
Rep ListCertificatesResponse x -> ListCertificatesResponse
forall x.
ListCertificatesResponse -> Rep ListCertificatesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCertificatesResponse x -> ListCertificatesResponse
$cfrom :: forall x.
ListCertificatesResponse -> Rep ListCertificatesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificatesResponse' 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:
--
-- 'certificates', 'listCertificatesResponse_certificates' - The descriptions of the certificates.
--
-- 'nextMarker', 'listCertificatesResponse_nextMarker' - The marker for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'listCertificatesResponse_httpStatus' - The response's http status code.
newListCertificatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCertificatesResponse
newListCertificatesResponse :: Int -> ListCertificatesResponse
newListCertificatesResponse Int
pHttpStatus_ =
  ListCertificatesResponse'
    { $sel:certificates:ListCertificatesResponse' :: Maybe [Certificate]
certificates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextMarker:ListCertificatesResponse' :: Maybe Text
nextMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCertificatesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The descriptions of the certificates.
listCertificatesResponse_certificates :: Lens.Lens' ListCertificatesResponse (Prelude.Maybe [Certificate])
listCertificatesResponse_certificates :: Lens' ListCertificatesResponse (Maybe [Certificate])
listCertificatesResponse_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificatesResponse' {Maybe [Certificate]
certificates :: Maybe [Certificate]
$sel:certificates:ListCertificatesResponse' :: ListCertificatesResponse -> Maybe [Certificate]
certificates} -> Maybe [Certificate]
certificates) (\s :: ListCertificatesResponse
s@ListCertificatesResponse' {} Maybe [Certificate]
a -> ListCertificatesResponse
s {$sel:certificates:ListCertificatesResponse' :: Maybe [Certificate]
certificates = Maybe [Certificate]
a} :: ListCertificatesResponse) 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 marker for the next set of results, or null if there are no
-- additional results.
listCertificatesResponse_nextMarker :: Lens.Lens' ListCertificatesResponse (Prelude.Maybe Prelude.Text)
listCertificatesResponse_nextMarker :: Lens' ListCertificatesResponse (Maybe Text)
listCertificatesResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificatesResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:ListCertificatesResponse' :: ListCertificatesResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: ListCertificatesResponse
s@ListCertificatesResponse' {} Maybe Text
a -> ListCertificatesResponse
s {$sel:nextMarker:ListCertificatesResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: ListCertificatesResponse)

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

instance Prelude.NFData ListCertificatesResponse where
  rnf :: ListCertificatesResponse -> ()
rnf ListCertificatesResponse' {Int
Maybe [Certificate]
Maybe Text
httpStatus :: Int
nextMarker :: Maybe Text
certificates :: Maybe [Certificate]
$sel:httpStatus:ListCertificatesResponse' :: ListCertificatesResponse -> Int
$sel:nextMarker:ListCertificatesResponse' :: ListCertificatesResponse -> Maybe Text
$sel:certificates:ListCertificatesResponse' :: ListCertificatesResponse -> Maybe [Certificate]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Certificate]
certificates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus