{-# 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.EC2.ExportClientVpnClientCertificateRevocationList
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Downloads the client certificate revocation list for the specified
-- Client VPN endpoint.
module Amazonka.EC2.ExportClientVpnClientCertificateRevocationList
  ( -- * Creating a Request
    ExportClientVpnClientCertificateRevocationList (..),
    newExportClientVpnClientCertificateRevocationList,

    -- * Request Lenses
    exportClientVpnClientCertificateRevocationList_dryRun,
    exportClientVpnClientCertificateRevocationList_clientVpnEndpointId,

    -- * Destructuring the Response
    ExportClientVpnClientCertificateRevocationListResponse (..),
    newExportClientVpnClientCertificateRevocationListResponse,

    -- * Response Lenses
    exportClientVpnClientCertificateRevocationListResponse_certificateRevocationList,
    exportClientVpnClientCertificateRevocationListResponse_status,
    exportClientVpnClientCertificateRevocationListResponse_httpStatus,
  )
where

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

-- | /See:/ 'newExportClientVpnClientCertificateRevocationList' smart constructor.
data ExportClientVpnClientCertificateRevocationList = ExportClientVpnClientCertificateRevocationList'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ExportClientVpnClientCertificateRevocationList -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint.
    ExportClientVpnClientCertificateRevocationList -> Text
clientVpnEndpointId :: Prelude.Text
  }
  deriving (ExportClientVpnClientCertificateRevocationList
-> ExportClientVpnClientCertificateRevocationList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportClientVpnClientCertificateRevocationList
-> ExportClientVpnClientCertificateRevocationList -> Bool
$c/= :: ExportClientVpnClientCertificateRevocationList
-> ExportClientVpnClientCertificateRevocationList -> Bool
== :: ExportClientVpnClientCertificateRevocationList
-> ExportClientVpnClientCertificateRevocationList -> Bool
$c== :: ExportClientVpnClientCertificateRevocationList
-> ExportClientVpnClientCertificateRevocationList -> Bool
Prelude.Eq, ReadPrec [ExportClientVpnClientCertificateRevocationList]
ReadPrec ExportClientVpnClientCertificateRevocationList
Int -> ReadS ExportClientVpnClientCertificateRevocationList
ReadS [ExportClientVpnClientCertificateRevocationList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportClientVpnClientCertificateRevocationList]
$creadListPrec :: ReadPrec [ExportClientVpnClientCertificateRevocationList]
readPrec :: ReadPrec ExportClientVpnClientCertificateRevocationList
$creadPrec :: ReadPrec ExportClientVpnClientCertificateRevocationList
readList :: ReadS [ExportClientVpnClientCertificateRevocationList]
$creadList :: ReadS [ExportClientVpnClientCertificateRevocationList]
readsPrec :: Int -> ReadS ExportClientVpnClientCertificateRevocationList
$creadsPrec :: Int -> ReadS ExportClientVpnClientCertificateRevocationList
Prelude.Read, Int -> ExportClientVpnClientCertificateRevocationList -> ShowS
[ExportClientVpnClientCertificateRevocationList] -> ShowS
ExportClientVpnClientCertificateRevocationList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportClientVpnClientCertificateRevocationList] -> ShowS
$cshowList :: [ExportClientVpnClientCertificateRevocationList] -> ShowS
show :: ExportClientVpnClientCertificateRevocationList -> String
$cshow :: ExportClientVpnClientCertificateRevocationList -> String
showsPrec :: Int -> ExportClientVpnClientCertificateRevocationList -> ShowS
$cshowsPrec :: Int -> ExportClientVpnClientCertificateRevocationList -> ShowS
Prelude.Show, forall x.
Rep ExportClientVpnClientCertificateRevocationList x
-> ExportClientVpnClientCertificateRevocationList
forall x.
ExportClientVpnClientCertificateRevocationList
-> Rep ExportClientVpnClientCertificateRevocationList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportClientVpnClientCertificateRevocationList x
-> ExportClientVpnClientCertificateRevocationList
$cfrom :: forall x.
ExportClientVpnClientCertificateRevocationList
-> Rep ExportClientVpnClientCertificateRevocationList x
Prelude.Generic)

-- |
-- Create a value of 'ExportClientVpnClientCertificateRevocationList' 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:
--
-- 'dryRun', 'exportClientVpnClientCertificateRevocationList_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'clientVpnEndpointId', 'exportClientVpnClientCertificateRevocationList_clientVpnEndpointId' - The ID of the Client VPN endpoint.
newExportClientVpnClientCertificateRevocationList ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  ExportClientVpnClientCertificateRevocationList
newExportClientVpnClientCertificateRevocationList :: Text -> ExportClientVpnClientCertificateRevocationList
newExportClientVpnClientCertificateRevocationList
  Text
pClientVpnEndpointId_ =
    ExportClientVpnClientCertificateRevocationList'
      { $sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: Text
clientVpnEndpointId =
          Text
pClientVpnEndpointId_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
exportClientVpnClientCertificateRevocationList_dryRun :: Lens.Lens' ExportClientVpnClientCertificateRevocationList (Prelude.Maybe Prelude.Bool)
exportClientVpnClientCertificateRevocationList_dryRun :: Lens' ExportClientVpnClientCertificateRevocationList (Maybe Bool)
exportClientVpnClientCertificateRevocationList_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientCertificateRevocationList' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ExportClientVpnClientCertificateRevocationList
s@ExportClientVpnClientCertificateRevocationList' {} Maybe Bool
a -> ExportClientVpnClientCertificateRevocationList
s {$sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: Maybe Bool
dryRun = Maybe Bool
a} :: ExportClientVpnClientCertificateRevocationList)

-- | The ID of the Client VPN endpoint.
exportClientVpnClientCertificateRevocationList_clientVpnEndpointId :: Lens.Lens' ExportClientVpnClientCertificateRevocationList Prelude.Text
exportClientVpnClientCertificateRevocationList_clientVpnEndpointId :: Lens' ExportClientVpnClientCertificateRevocationList Text
exportClientVpnClientCertificateRevocationList_clientVpnEndpointId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientCertificateRevocationList' {Text
clientVpnEndpointId :: Text
$sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Text
clientVpnEndpointId} -> Text
clientVpnEndpointId) (\s :: ExportClientVpnClientCertificateRevocationList
s@ExportClientVpnClientCertificateRevocationList' {} Text
a -> ExportClientVpnClientCertificateRevocationList
s {$sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: Text
clientVpnEndpointId = Text
a} :: ExportClientVpnClientCertificateRevocationList)

instance
  Core.AWSRequest
    ExportClientVpnClientCertificateRevocationList
  where
  type
    AWSResponse
      ExportClientVpnClientCertificateRevocationList =
      ExportClientVpnClientCertificateRevocationListResponse
  request :: (Service -> Service)
-> ExportClientVpnClientCertificateRevocationList
-> Request ExportClientVpnClientCertificateRevocationList
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ExportClientVpnClientCertificateRevocationList
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse ExportClientVpnClientCertificateRevocationList)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe ClientCertificateRevocationListStatus
-> Int
-> ExportClientVpnClientCertificateRevocationListResponse
ExportClientVpnClientCertificateRevocationListResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"certificateRevocationList")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"status")
            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
    ExportClientVpnClientCertificateRevocationList
  where
  hashWithSalt :: Int -> ExportClientVpnClientCertificateRevocationList -> Int
hashWithSalt
    Int
_salt
    ExportClientVpnClientCertificateRevocationList' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Text
$sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientVpnEndpointId

instance
  Prelude.NFData
    ExportClientVpnClientCertificateRevocationList
  where
  rnf :: ExportClientVpnClientCertificateRevocationList -> ()
rnf
    ExportClientVpnClientCertificateRevocationList' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Text
$sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Maybe Bool
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientVpnEndpointId

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

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

instance
  Data.ToQuery
    ExportClientVpnClientCertificateRevocationList
  where
  toQuery :: ExportClientVpnClientCertificateRevocationList -> QueryString
toQuery
    ExportClientVpnClientCertificateRevocationList' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Text
$sel:dryRun:ExportClientVpnClientCertificateRevocationList' :: ExportClientVpnClientCertificateRevocationList -> Maybe Bool
..} =
      forall a. Monoid a => [a] -> a
Prelude.mconcat
        [ ByteString
"Action"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ExportClientVpnClientCertificateRevocationList" ::
                        Prelude.ByteString
                    ),
          ByteString
"Version"
            forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
          ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
          ByteString
"ClientVpnEndpointId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clientVpnEndpointId
        ]

-- | /See:/ 'newExportClientVpnClientCertificateRevocationListResponse' smart constructor.
data ExportClientVpnClientCertificateRevocationListResponse = ExportClientVpnClientCertificateRevocationListResponse'
  { -- | Information about the client certificate revocation list.
    ExportClientVpnClientCertificateRevocationListResponse
-> Maybe Text
certificateRevocationList :: Prelude.Maybe Prelude.Text,
    -- | The current state of the client certificate revocation list.
    ExportClientVpnClientCertificateRevocationListResponse
-> Maybe ClientCertificateRevocationListStatus
status :: Prelude.Maybe ClientCertificateRevocationListStatus,
    -- | The response's http status code.
    ExportClientVpnClientCertificateRevocationListResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportClientVpnClientCertificateRevocationListResponse
-> ExportClientVpnClientCertificateRevocationListResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportClientVpnClientCertificateRevocationListResponse
-> ExportClientVpnClientCertificateRevocationListResponse -> Bool
$c/= :: ExportClientVpnClientCertificateRevocationListResponse
-> ExportClientVpnClientCertificateRevocationListResponse -> Bool
== :: ExportClientVpnClientCertificateRevocationListResponse
-> ExportClientVpnClientCertificateRevocationListResponse -> Bool
$c== :: ExportClientVpnClientCertificateRevocationListResponse
-> ExportClientVpnClientCertificateRevocationListResponse -> Bool
Prelude.Eq, ReadPrec [ExportClientVpnClientCertificateRevocationListResponse]
ReadPrec ExportClientVpnClientCertificateRevocationListResponse
Int -> ReadS ExportClientVpnClientCertificateRevocationListResponse
ReadS [ExportClientVpnClientCertificateRevocationListResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportClientVpnClientCertificateRevocationListResponse]
$creadListPrec :: ReadPrec [ExportClientVpnClientCertificateRevocationListResponse]
readPrec :: ReadPrec ExportClientVpnClientCertificateRevocationListResponse
$creadPrec :: ReadPrec ExportClientVpnClientCertificateRevocationListResponse
readList :: ReadS [ExportClientVpnClientCertificateRevocationListResponse]
$creadList :: ReadS [ExportClientVpnClientCertificateRevocationListResponse]
readsPrec :: Int -> ReadS ExportClientVpnClientCertificateRevocationListResponse
$creadsPrec :: Int -> ReadS ExportClientVpnClientCertificateRevocationListResponse
Prelude.Read, Int
-> ExportClientVpnClientCertificateRevocationListResponse -> ShowS
[ExportClientVpnClientCertificateRevocationListResponse] -> ShowS
ExportClientVpnClientCertificateRevocationListResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportClientVpnClientCertificateRevocationListResponse] -> ShowS
$cshowList :: [ExportClientVpnClientCertificateRevocationListResponse] -> ShowS
show :: ExportClientVpnClientCertificateRevocationListResponse -> String
$cshow :: ExportClientVpnClientCertificateRevocationListResponse -> String
showsPrec :: Int
-> ExportClientVpnClientCertificateRevocationListResponse -> ShowS
$cshowsPrec :: Int
-> ExportClientVpnClientCertificateRevocationListResponse -> ShowS
Prelude.Show, forall x.
Rep ExportClientVpnClientCertificateRevocationListResponse x
-> ExportClientVpnClientCertificateRevocationListResponse
forall x.
ExportClientVpnClientCertificateRevocationListResponse
-> Rep ExportClientVpnClientCertificateRevocationListResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportClientVpnClientCertificateRevocationListResponse x
-> ExportClientVpnClientCertificateRevocationListResponse
$cfrom :: forall x.
ExportClientVpnClientCertificateRevocationListResponse
-> Rep ExportClientVpnClientCertificateRevocationListResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportClientVpnClientCertificateRevocationListResponse' 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:
--
-- 'certificateRevocationList', 'exportClientVpnClientCertificateRevocationListResponse_certificateRevocationList' - Information about the client certificate revocation list.
--
-- 'status', 'exportClientVpnClientCertificateRevocationListResponse_status' - The current state of the client certificate revocation list.
--
-- 'httpStatus', 'exportClientVpnClientCertificateRevocationListResponse_httpStatus' - The response's http status code.
newExportClientVpnClientCertificateRevocationListResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportClientVpnClientCertificateRevocationListResponse
newExportClientVpnClientCertificateRevocationListResponse :: Int -> ExportClientVpnClientCertificateRevocationListResponse
newExportClientVpnClientCertificateRevocationListResponse
  Int
pHttpStatus_ =
    ExportClientVpnClientCertificateRevocationListResponse'
      { $sel:certificateRevocationList:ExportClientVpnClientCertificateRevocationListResponse' :: Maybe Text
certificateRevocationList =
          forall a. Maybe a
Prelude.Nothing,
        $sel:status:ExportClientVpnClientCertificateRevocationListResponse' :: Maybe ClientCertificateRevocationListStatus
status =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ExportClientVpnClientCertificateRevocationListResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

-- | Information about the client certificate revocation list.
exportClientVpnClientCertificateRevocationListResponse_certificateRevocationList :: Lens.Lens' ExportClientVpnClientCertificateRevocationListResponse (Prelude.Maybe Prelude.Text)
exportClientVpnClientCertificateRevocationListResponse_certificateRevocationList :: Lens'
  ExportClientVpnClientCertificateRevocationListResponse (Maybe Text)
exportClientVpnClientCertificateRevocationListResponse_certificateRevocationList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientCertificateRevocationListResponse' {Maybe Text
certificateRevocationList :: Maybe Text
$sel:certificateRevocationList:ExportClientVpnClientCertificateRevocationListResponse' :: ExportClientVpnClientCertificateRevocationListResponse
-> Maybe Text
certificateRevocationList} -> Maybe Text
certificateRevocationList) (\s :: ExportClientVpnClientCertificateRevocationListResponse
s@ExportClientVpnClientCertificateRevocationListResponse' {} Maybe Text
a -> ExportClientVpnClientCertificateRevocationListResponse
s {$sel:certificateRevocationList:ExportClientVpnClientCertificateRevocationListResponse' :: Maybe Text
certificateRevocationList = Maybe Text
a} :: ExportClientVpnClientCertificateRevocationListResponse)

-- | The current state of the client certificate revocation list.
exportClientVpnClientCertificateRevocationListResponse_status :: Lens.Lens' ExportClientVpnClientCertificateRevocationListResponse (Prelude.Maybe ClientCertificateRevocationListStatus)
exportClientVpnClientCertificateRevocationListResponse_status :: Lens'
  ExportClientVpnClientCertificateRevocationListResponse
  (Maybe ClientCertificateRevocationListStatus)
exportClientVpnClientCertificateRevocationListResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientCertificateRevocationListResponse' {Maybe ClientCertificateRevocationListStatus
status :: Maybe ClientCertificateRevocationListStatus
$sel:status:ExportClientVpnClientCertificateRevocationListResponse' :: ExportClientVpnClientCertificateRevocationListResponse
-> Maybe ClientCertificateRevocationListStatus
status} -> Maybe ClientCertificateRevocationListStatus
status) (\s :: ExportClientVpnClientCertificateRevocationListResponse
s@ExportClientVpnClientCertificateRevocationListResponse' {} Maybe ClientCertificateRevocationListStatus
a -> ExportClientVpnClientCertificateRevocationListResponse
s {$sel:status:ExportClientVpnClientCertificateRevocationListResponse' :: Maybe ClientCertificateRevocationListStatus
status = Maybe ClientCertificateRevocationListStatus
a} :: ExportClientVpnClientCertificateRevocationListResponse)

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

instance
  Prelude.NFData
    ExportClientVpnClientCertificateRevocationListResponse
  where
  rnf :: ExportClientVpnClientCertificateRevocationListResponse -> ()
rnf
    ExportClientVpnClientCertificateRevocationListResponse' {Int
Maybe Text
Maybe ClientCertificateRevocationListStatus
httpStatus :: Int
status :: Maybe ClientCertificateRevocationListStatus
certificateRevocationList :: Maybe Text
$sel:httpStatus:ExportClientVpnClientCertificateRevocationListResponse' :: ExportClientVpnClientCertificateRevocationListResponse -> Int
$sel:status:ExportClientVpnClientCertificateRevocationListResponse' :: ExportClientVpnClientCertificateRevocationListResponse
-> Maybe ClientCertificateRevocationListStatus
$sel:certificateRevocationList:ExportClientVpnClientCertificateRevocationListResponse' :: ExportClientVpnClientCertificateRevocationListResponse
-> Maybe Text
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificateRevocationList
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientCertificateRevocationListStatus
status
        seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus