{-# 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.ExportClientVpnClientConfiguration
-- 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 contents of the Client VPN endpoint configuration file for
-- the specified Client VPN endpoint. The Client VPN endpoint configuration
-- file includes the Client VPN endpoint and certificate information
-- clients need to establish a connection with the Client VPN endpoint.
module Amazonka.EC2.ExportClientVpnClientConfiguration
  ( -- * Creating a Request
    ExportClientVpnClientConfiguration (..),
    newExportClientVpnClientConfiguration,

    -- * Request Lenses
    exportClientVpnClientConfiguration_dryRun,
    exportClientVpnClientConfiguration_clientVpnEndpointId,

    -- * Destructuring the Response
    ExportClientVpnClientConfigurationResponse (..),
    newExportClientVpnClientConfigurationResponse,

    -- * Response Lenses
    exportClientVpnClientConfigurationResponse_clientConfiguration,
    exportClientVpnClientConfigurationResponse_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:/ 'newExportClientVpnClientConfiguration' smart constructor.
data ExportClientVpnClientConfiguration = ExportClientVpnClientConfiguration'
  { -- | 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@.
    ExportClientVpnClientConfiguration -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Client VPN endpoint.
    ExportClientVpnClientConfiguration -> Text
clientVpnEndpointId :: Prelude.Text
  }
  deriving (ExportClientVpnClientConfiguration
-> ExportClientVpnClientConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportClientVpnClientConfiguration
-> ExportClientVpnClientConfiguration -> Bool
$c/= :: ExportClientVpnClientConfiguration
-> ExportClientVpnClientConfiguration -> Bool
== :: ExportClientVpnClientConfiguration
-> ExportClientVpnClientConfiguration -> Bool
$c== :: ExportClientVpnClientConfiguration
-> ExportClientVpnClientConfiguration -> Bool
Prelude.Eq, ReadPrec [ExportClientVpnClientConfiguration]
ReadPrec ExportClientVpnClientConfiguration
Int -> ReadS ExportClientVpnClientConfiguration
ReadS [ExportClientVpnClientConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportClientVpnClientConfiguration]
$creadListPrec :: ReadPrec [ExportClientVpnClientConfiguration]
readPrec :: ReadPrec ExportClientVpnClientConfiguration
$creadPrec :: ReadPrec ExportClientVpnClientConfiguration
readList :: ReadS [ExportClientVpnClientConfiguration]
$creadList :: ReadS [ExportClientVpnClientConfiguration]
readsPrec :: Int -> ReadS ExportClientVpnClientConfiguration
$creadsPrec :: Int -> ReadS ExportClientVpnClientConfiguration
Prelude.Read, Int -> ExportClientVpnClientConfiguration -> ShowS
[ExportClientVpnClientConfiguration] -> ShowS
ExportClientVpnClientConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportClientVpnClientConfiguration] -> ShowS
$cshowList :: [ExportClientVpnClientConfiguration] -> ShowS
show :: ExportClientVpnClientConfiguration -> String
$cshow :: ExportClientVpnClientConfiguration -> String
showsPrec :: Int -> ExportClientVpnClientConfiguration -> ShowS
$cshowsPrec :: Int -> ExportClientVpnClientConfiguration -> ShowS
Prelude.Show, forall x.
Rep ExportClientVpnClientConfiguration x
-> ExportClientVpnClientConfiguration
forall x.
ExportClientVpnClientConfiguration
-> Rep ExportClientVpnClientConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportClientVpnClientConfiguration x
-> ExportClientVpnClientConfiguration
$cfrom :: forall x.
ExportClientVpnClientConfiguration
-> Rep ExportClientVpnClientConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'ExportClientVpnClientConfiguration' 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', 'exportClientVpnClientConfiguration_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', 'exportClientVpnClientConfiguration_clientVpnEndpointId' - The ID of the Client VPN endpoint.
newExportClientVpnClientConfiguration ::
  -- | 'clientVpnEndpointId'
  Prelude.Text ->
  ExportClientVpnClientConfiguration
newExportClientVpnClientConfiguration :: Text -> ExportClientVpnClientConfiguration
newExportClientVpnClientConfiguration
  Text
pClientVpnEndpointId_ =
    ExportClientVpnClientConfiguration'
      { $sel:dryRun:ExportClientVpnClientConfiguration' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:clientVpnEndpointId:ExportClientVpnClientConfiguration' :: 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@.
exportClientVpnClientConfiguration_dryRun :: Lens.Lens' ExportClientVpnClientConfiguration (Prelude.Maybe Prelude.Bool)
exportClientVpnClientConfiguration_dryRun :: Lens' ExportClientVpnClientConfiguration (Maybe Bool)
exportClientVpnClientConfiguration_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientConfiguration' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ExportClientVpnClientConfiguration
s@ExportClientVpnClientConfiguration' {} Maybe Bool
a -> ExportClientVpnClientConfiguration
s {$sel:dryRun:ExportClientVpnClientConfiguration' :: Maybe Bool
dryRun = Maybe Bool
a} :: ExportClientVpnClientConfiguration)

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

instance
  Core.AWSRequest
    ExportClientVpnClientConfiguration
  where
  type
    AWSResponse ExportClientVpnClientConfiguration =
      ExportClientVpnClientConfigurationResponse
  request :: (Service -> Service)
-> ExportClientVpnClientConfiguration
-> Request ExportClientVpnClientConfiguration
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 ExportClientVpnClientConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ExportClientVpnClientConfiguration)))
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 -> Int -> ExportClientVpnClientConfigurationResponse
ExportClientVpnClientConfigurationResponse'
            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
"clientConfiguration")
            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
    ExportClientVpnClientConfiguration
  where
  hashWithSalt :: Int -> ExportClientVpnClientConfiguration -> Int
hashWithSalt
    Int
_salt
    ExportClientVpnClientConfiguration' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> Text
$sel:dryRun:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> 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
    ExportClientVpnClientConfiguration
  where
  rnf :: ExportClientVpnClientConfiguration -> ()
rnf ExportClientVpnClientConfiguration' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> Text
$sel:dryRun:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> 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
    ExportClientVpnClientConfiguration
  where
  toHeaders :: ExportClientVpnClientConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance
  Data.ToQuery
    ExportClientVpnClientConfiguration
  where
  toQuery :: ExportClientVpnClientConfiguration -> QueryString
toQuery ExportClientVpnClientConfiguration' {Maybe Bool
Text
clientVpnEndpointId :: Text
dryRun :: Maybe Bool
$sel:clientVpnEndpointId:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> Text
$sel:dryRun:ExportClientVpnClientConfiguration' :: ExportClientVpnClientConfiguration -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ExportClientVpnClientConfiguration" ::
                      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:/ 'newExportClientVpnClientConfigurationResponse' smart constructor.
data ExportClientVpnClientConfigurationResponse = ExportClientVpnClientConfigurationResponse'
  { -- | The contents of the Client VPN endpoint configuration file.
    ExportClientVpnClientConfigurationResponse -> Maybe Text
clientConfiguration :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExportClientVpnClientConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportClientVpnClientConfigurationResponse
-> ExportClientVpnClientConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportClientVpnClientConfigurationResponse
-> ExportClientVpnClientConfigurationResponse -> Bool
$c/= :: ExportClientVpnClientConfigurationResponse
-> ExportClientVpnClientConfigurationResponse -> Bool
== :: ExportClientVpnClientConfigurationResponse
-> ExportClientVpnClientConfigurationResponse -> Bool
$c== :: ExportClientVpnClientConfigurationResponse
-> ExportClientVpnClientConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [ExportClientVpnClientConfigurationResponse]
ReadPrec ExportClientVpnClientConfigurationResponse
Int -> ReadS ExportClientVpnClientConfigurationResponse
ReadS [ExportClientVpnClientConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportClientVpnClientConfigurationResponse]
$creadListPrec :: ReadPrec [ExportClientVpnClientConfigurationResponse]
readPrec :: ReadPrec ExportClientVpnClientConfigurationResponse
$creadPrec :: ReadPrec ExportClientVpnClientConfigurationResponse
readList :: ReadS [ExportClientVpnClientConfigurationResponse]
$creadList :: ReadS [ExportClientVpnClientConfigurationResponse]
readsPrec :: Int -> ReadS ExportClientVpnClientConfigurationResponse
$creadsPrec :: Int -> ReadS ExportClientVpnClientConfigurationResponse
Prelude.Read, Int -> ExportClientVpnClientConfigurationResponse -> ShowS
[ExportClientVpnClientConfigurationResponse] -> ShowS
ExportClientVpnClientConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportClientVpnClientConfigurationResponse] -> ShowS
$cshowList :: [ExportClientVpnClientConfigurationResponse] -> ShowS
show :: ExportClientVpnClientConfigurationResponse -> String
$cshow :: ExportClientVpnClientConfigurationResponse -> String
showsPrec :: Int -> ExportClientVpnClientConfigurationResponse -> ShowS
$cshowsPrec :: Int -> ExportClientVpnClientConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep ExportClientVpnClientConfigurationResponse x
-> ExportClientVpnClientConfigurationResponse
forall x.
ExportClientVpnClientConfigurationResponse
-> Rep ExportClientVpnClientConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ExportClientVpnClientConfigurationResponse x
-> ExportClientVpnClientConfigurationResponse
$cfrom :: forall x.
ExportClientVpnClientConfigurationResponse
-> Rep ExportClientVpnClientConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportClientVpnClientConfigurationResponse' 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:
--
-- 'clientConfiguration', 'exportClientVpnClientConfigurationResponse_clientConfiguration' - The contents of the Client VPN endpoint configuration file.
--
-- 'httpStatus', 'exportClientVpnClientConfigurationResponse_httpStatus' - The response's http status code.
newExportClientVpnClientConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportClientVpnClientConfigurationResponse
newExportClientVpnClientConfigurationResponse :: Int -> ExportClientVpnClientConfigurationResponse
newExportClientVpnClientConfigurationResponse
  Int
pHttpStatus_ =
    ExportClientVpnClientConfigurationResponse'
      { $sel:clientConfiguration:ExportClientVpnClientConfigurationResponse' :: Maybe Text
clientConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ExportClientVpnClientConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The contents of the Client VPN endpoint configuration file.
exportClientVpnClientConfigurationResponse_clientConfiguration :: Lens.Lens' ExportClientVpnClientConfigurationResponse (Prelude.Maybe Prelude.Text)
exportClientVpnClientConfigurationResponse_clientConfiguration :: Lens' ExportClientVpnClientConfigurationResponse (Maybe Text)
exportClientVpnClientConfigurationResponse_clientConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportClientVpnClientConfigurationResponse' {Maybe Text
clientConfiguration :: Maybe Text
$sel:clientConfiguration:ExportClientVpnClientConfigurationResponse' :: ExportClientVpnClientConfigurationResponse -> Maybe Text
clientConfiguration} -> Maybe Text
clientConfiguration) (\s :: ExportClientVpnClientConfigurationResponse
s@ExportClientVpnClientConfigurationResponse' {} Maybe Text
a -> ExportClientVpnClientConfigurationResponse
s {$sel:clientConfiguration:ExportClientVpnClientConfigurationResponse' :: Maybe Text
clientConfiguration = Maybe Text
a} :: ExportClientVpnClientConfigurationResponse)

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

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