{-# 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.ListCertificatesByCA
-- 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 the device certificates signed by the specified CA certificate.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions ListCertificatesByCA>
-- action.
--
-- This operation returns paginated results.
module Amazonka.IoT.ListCertificatesByCA
  ( -- * Creating a Request
    ListCertificatesByCA (..),
    newListCertificatesByCA,

    -- * Request Lenses
    listCertificatesByCA_ascendingOrder,
    listCertificatesByCA_marker,
    listCertificatesByCA_pageSize,
    listCertificatesByCA_caCertificateId,

    -- * Destructuring the Response
    ListCertificatesByCAResponse (..),
    newListCertificatesByCAResponse,

    -- * Response Lenses
    listCertificatesByCAResponse_certificates,
    listCertificatesByCAResponse_nextMarker,
    listCertificatesByCAResponse_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 to the ListCertificatesByCA operation.
--
-- /See:/ 'newListCertificatesByCA' smart constructor.
data ListCertificatesByCA = ListCertificatesByCA'
  { -- | Specifies the order for results. If True, the results are returned in
    -- ascending order, based on the creation date.
    ListCertificatesByCA -> Maybe Bool
ascendingOrder :: Prelude.Maybe Prelude.Bool,
    -- | The marker for the next set of results.
    ListCertificatesByCA -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The result page size.
    ListCertificatesByCA -> Maybe Natural
pageSize :: Prelude.Maybe Prelude.Natural,
    -- | The ID of the CA certificate. This operation will list all registered
    -- device certificate that were signed by this CA certificate.
    ListCertificatesByCA -> Text
caCertificateId :: Prelude.Text
  }
  deriving (ListCertificatesByCA -> ListCertificatesByCA -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificatesByCA -> ListCertificatesByCA -> Bool
$c/= :: ListCertificatesByCA -> ListCertificatesByCA -> Bool
== :: ListCertificatesByCA -> ListCertificatesByCA -> Bool
$c== :: ListCertificatesByCA -> ListCertificatesByCA -> Bool
Prelude.Eq, ReadPrec [ListCertificatesByCA]
ReadPrec ListCertificatesByCA
Int -> ReadS ListCertificatesByCA
ReadS [ListCertificatesByCA]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificatesByCA]
$creadListPrec :: ReadPrec [ListCertificatesByCA]
readPrec :: ReadPrec ListCertificatesByCA
$creadPrec :: ReadPrec ListCertificatesByCA
readList :: ReadS [ListCertificatesByCA]
$creadList :: ReadS [ListCertificatesByCA]
readsPrec :: Int -> ReadS ListCertificatesByCA
$creadsPrec :: Int -> ReadS ListCertificatesByCA
Prelude.Read, Int -> ListCertificatesByCA -> ShowS
[ListCertificatesByCA] -> ShowS
ListCertificatesByCA -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificatesByCA] -> ShowS
$cshowList :: [ListCertificatesByCA] -> ShowS
show :: ListCertificatesByCA -> String
$cshow :: ListCertificatesByCA -> String
showsPrec :: Int -> ListCertificatesByCA -> ShowS
$cshowsPrec :: Int -> ListCertificatesByCA -> ShowS
Prelude.Show, forall x. Rep ListCertificatesByCA x -> ListCertificatesByCA
forall x. ListCertificatesByCA -> Rep ListCertificatesByCA x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCertificatesByCA x -> ListCertificatesByCA
$cfrom :: forall x. ListCertificatesByCA -> Rep ListCertificatesByCA x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificatesByCA' 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', 'listCertificatesByCA_ascendingOrder' - Specifies the order for results. If True, the results are returned in
-- ascending order, based on the creation date.
--
-- 'marker', 'listCertificatesByCA_marker' - The marker for the next set of results.
--
-- 'pageSize', 'listCertificatesByCA_pageSize' - The result page size.
--
-- 'caCertificateId', 'listCertificatesByCA_caCertificateId' - The ID of the CA certificate. This operation will list all registered
-- device certificate that were signed by this CA certificate.
newListCertificatesByCA ::
  -- | 'caCertificateId'
  Prelude.Text ->
  ListCertificatesByCA
newListCertificatesByCA :: Text -> ListCertificatesByCA
newListCertificatesByCA Text
pCaCertificateId_ =
  ListCertificatesByCA'
    { $sel:ascendingOrder:ListCertificatesByCA' :: Maybe Bool
ascendingOrder =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListCertificatesByCA' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListCertificatesByCA' :: Maybe Natural
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:caCertificateId:ListCertificatesByCA' :: Text
caCertificateId = Text
pCaCertificateId_
    }

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

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

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

-- | The ID of the CA certificate. This operation will list all registered
-- device certificate that were signed by this CA certificate.
listCertificatesByCA_caCertificateId :: Lens.Lens' ListCertificatesByCA Prelude.Text
listCertificatesByCA_caCertificateId :: Lens' ListCertificatesByCA Text
listCertificatesByCA_caCertificateId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificatesByCA' {Text
caCertificateId :: Text
$sel:caCertificateId:ListCertificatesByCA' :: ListCertificatesByCA -> Text
caCertificateId} -> Text
caCertificateId) (\s :: ListCertificatesByCA
s@ListCertificatesByCA' {} Text
a -> ListCertificatesByCA
s {$sel:caCertificateId:ListCertificatesByCA' :: Text
caCertificateId = Text
a} :: ListCertificatesByCA)

instance Core.AWSPager ListCertificatesByCA where
  page :: ListCertificatesByCA
-> AWSResponse ListCertificatesByCA -> Maybe ListCertificatesByCA
page ListCertificatesByCA
rq AWSResponse ListCertificatesByCA
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCertificatesByCA
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesByCAResponse (Maybe Text)
listCertificatesByCAResponse_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 ListCertificatesByCA
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesByCAResponse (Maybe [Certificate])
listCertificatesByCAResponse_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.$ ListCertificatesByCA
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCertificatesByCA (Maybe Text)
listCertificatesByCA_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCertificatesByCA
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCertificatesByCAResponse (Maybe Text)
listCertificatesByCAResponse_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 ListCertificatesByCA where
  type
    AWSResponse ListCertificatesByCA =
      ListCertificatesByCAResponse
  request :: (Service -> Service)
-> ListCertificatesByCA -> Request ListCertificatesByCA
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 ListCertificatesByCA
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCertificatesByCA)))
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 -> ListCertificatesByCAResponse
ListCertificatesByCAResponse'
            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 ListCertificatesByCA where
  hashWithSalt :: Int -> ListCertificatesByCA -> Int
hashWithSalt Int
_salt ListCertificatesByCA' {Maybe Bool
Maybe Natural
Maybe Text
Text
caCertificateId :: Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:caCertificateId:ListCertificatesByCA' :: ListCertificatesByCA -> Text
$sel:pageSize:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Natural
$sel:marker:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Text
$sel:ascendingOrder:ListCertificatesByCA' :: ListCertificatesByCA -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
caCertificateId

instance Prelude.NFData ListCertificatesByCA where
  rnf :: ListCertificatesByCA -> ()
rnf ListCertificatesByCA' {Maybe Bool
Maybe Natural
Maybe Text
Text
caCertificateId :: Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:caCertificateId:ListCertificatesByCA' :: ListCertificatesByCA -> Text
$sel:pageSize:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Natural
$sel:marker:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Text
$sel:ascendingOrder:ListCertificatesByCA' :: ListCertificatesByCA -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
caCertificateId

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

instance Data.ToPath ListCertificatesByCA where
  toPath :: ListCertificatesByCA -> ByteString
toPath ListCertificatesByCA' {Maybe Bool
Maybe Natural
Maybe Text
Text
caCertificateId :: Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:caCertificateId:ListCertificatesByCA' :: ListCertificatesByCA -> Text
$sel:pageSize:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Natural
$sel:marker:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Text
$sel:ascendingOrder:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/certificates-by-ca/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
caCertificateId]

instance Data.ToQuery ListCertificatesByCA where
  toQuery :: ListCertificatesByCA -> QueryString
toQuery ListCertificatesByCA' {Maybe Bool
Maybe Natural
Maybe Text
Text
caCertificateId :: Text
pageSize :: Maybe Natural
marker :: Maybe Text
ascendingOrder :: Maybe Bool
$sel:caCertificateId:ListCertificatesByCA' :: ListCertificatesByCA -> Text
$sel:pageSize:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Natural
$sel:marker:ListCertificatesByCA' :: ListCertificatesByCA -> Maybe Text
$sel:ascendingOrder:ListCertificatesByCA' :: ListCertificatesByCA -> 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 ListCertificatesByCA operation.
--
-- /See:/ 'newListCertificatesByCAResponse' smart constructor.
data ListCertificatesByCAResponse = ListCertificatesByCAResponse'
  { -- | The device certificates signed by the specified CA certificate.
    ListCertificatesByCAResponse -> Maybe [Certificate]
certificates :: Prelude.Maybe [Certificate],
    -- | The marker for the next set of results, or null if there are no
    -- additional results.
    ListCertificatesByCAResponse -> Maybe Text
nextMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCertificatesByCAResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCertificatesByCAResponse
-> ListCertificatesByCAResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCertificatesByCAResponse
-> ListCertificatesByCAResponse -> Bool
$c/= :: ListCertificatesByCAResponse
-> ListCertificatesByCAResponse -> Bool
== :: ListCertificatesByCAResponse
-> ListCertificatesByCAResponse -> Bool
$c== :: ListCertificatesByCAResponse
-> ListCertificatesByCAResponse -> Bool
Prelude.Eq, ReadPrec [ListCertificatesByCAResponse]
ReadPrec ListCertificatesByCAResponse
Int -> ReadS ListCertificatesByCAResponse
ReadS [ListCertificatesByCAResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCertificatesByCAResponse]
$creadListPrec :: ReadPrec [ListCertificatesByCAResponse]
readPrec :: ReadPrec ListCertificatesByCAResponse
$creadPrec :: ReadPrec ListCertificatesByCAResponse
readList :: ReadS [ListCertificatesByCAResponse]
$creadList :: ReadS [ListCertificatesByCAResponse]
readsPrec :: Int -> ReadS ListCertificatesByCAResponse
$creadsPrec :: Int -> ReadS ListCertificatesByCAResponse
Prelude.Read, Int -> ListCertificatesByCAResponse -> ShowS
[ListCertificatesByCAResponse] -> ShowS
ListCertificatesByCAResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCertificatesByCAResponse] -> ShowS
$cshowList :: [ListCertificatesByCAResponse] -> ShowS
show :: ListCertificatesByCAResponse -> String
$cshow :: ListCertificatesByCAResponse -> String
showsPrec :: Int -> ListCertificatesByCAResponse -> ShowS
$cshowsPrec :: Int -> ListCertificatesByCAResponse -> ShowS
Prelude.Show, forall x.
Rep ListCertificatesByCAResponse x -> ListCertificatesByCAResponse
forall x.
ListCertificatesByCAResponse -> Rep ListCertificatesByCAResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCertificatesByCAResponse x -> ListCertificatesByCAResponse
$cfrom :: forall x.
ListCertificatesByCAResponse -> Rep ListCertificatesByCAResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCertificatesByCAResponse' 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', 'listCertificatesByCAResponse_certificates' - The device certificates signed by the specified CA certificate.
--
-- 'nextMarker', 'listCertificatesByCAResponse_nextMarker' - The marker for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'listCertificatesByCAResponse_httpStatus' - The response's http status code.
newListCertificatesByCAResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCertificatesByCAResponse
newListCertificatesByCAResponse :: Int -> ListCertificatesByCAResponse
newListCertificatesByCAResponse Int
pHttpStatus_ =
  ListCertificatesByCAResponse'
    { $sel:certificates:ListCertificatesByCAResponse' :: Maybe [Certificate]
certificates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextMarker:ListCertificatesByCAResponse' :: Maybe Text
nextMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCertificatesByCAResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The device certificates signed by the specified CA certificate.
listCertificatesByCAResponse_certificates :: Lens.Lens' ListCertificatesByCAResponse (Prelude.Maybe [Certificate])
listCertificatesByCAResponse_certificates :: Lens' ListCertificatesByCAResponse (Maybe [Certificate])
listCertificatesByCAResponse_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificatesByCAResponse' {Maybe [Certificate]
certificates :: Maybe [Certificate]
$sel:certificates:ListCertificatesByCAResponse' :: ListCertificatesByCAResponse -> Maybe [Certificate]
certificates} -> Maybe [Certificate]
certificates) (\s :: ListCertificatesByCAResponse
s@ListCertificatesByCAResponse' {} Maybe [Certificate]
a -> ListCertificatesByCAResponse
s {$sel:certificates:ListCertificatesByCAResponse' :: Maybe [Certificate]
certificates = Maybe [Certificate]
a} :: ListCertificatesByCAResponse) 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.
listCertificatesByCAResponse_nextMarker :: Lens.Lens' ListCertificatesByCAResponse (Prelude.Maybe Prelude.Text)
listCertificatesByCAResponse_nextMarker :: Lens' ListCertificatesByCAResponse (Maybe Text)
listCertificatesByCAResponse_nextMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCertificatesByCAResponse' {Maybe Text
nextMarker :: Maybe Text
$sel:nextMarker:ListCertificatesByCAResponse' :: ListCertificatesByCAResponse -> Maybe Text
nextMarker} -> Maybe Text
nextMarker) (\s :: ListCertificatesByCAResponse
s@ListCertificatesByCAResponse' {} Maybe Text
a -> ListCertificatesByCAResponse
s {$sel:nextMarker:ListCertificatesByCAResponse' :: Maybe Text
nextMarker = Maybe Text
a} :: ListCertificatesByCAResponse)

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

instance Prelude.NFData ListCertificatesByCAResponse where
  rnf :: ListCertificatesByCAResponse -> ()
rnf ListCertificatesByCAResponse' {Int
Maybe [Certificate]
Maybe Text
httpStatus :: Int
nextMarker :: Maybe Text
certificates :: Maybe [Certificate]
$sel:httpStatus:ListCertificatesByCAResponse' :: ListCertificatesByCAResponse -> Int
$sel:nextMarker:ListCertificatesByCAResponse' :: ListCertificatesByCAResponse -> Maybe Text
$sel:certificates:ListCertificatesByCAResponse' :: ListCertificatesByCAResponse -> 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