{-# 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.BackupGateway.TestHypervisorConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Tests your hypervisor configuration to validate that backup gateway can
-- connect with the hypervisor and its resources.
module Amazonka.BackupGateway.TestHypervisorConfiguration
  ( -- * Creating a Request
    TestHypervisorConfiguration (..),
    newTestHypervisorConfiguration,

    -- * Request Lenses
    testHypervisorConfiguration_password,
    testHypervisorConfiguration_username,
    testHypervisorConfiguration_gatewayArn,
    testHypervisorConfiguration_host,

    -- * Destructuring the Response
    TestHypervisorConfigurationResponse (..),
    newTestHypervisorConfigurationResponse,

    -- * Response Lenses
    testHypervisorConfigurationResponse_httpStatus,
  )
where

import Amazonka.BackupGateway.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newTestHypervisorConfiguration' smart constructor.
data TestHypervisorConfiguration = TestHypervisorConfiguration'
  { -- | The password for the hypervisor.
    TestHypervisorConfiguration -> Maybe (Sensitive Text)
password :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The username for the hypervisor.
    TestHypervisorConfiguration -> Maybe (Sensitive Text)
username :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The Amazon Resource Name (ARN) of the gateway to the hypervisor to test.
    TestHypervisorConfiguration -> Text
gatewayArn :: Prelude.Text,
    -- | The server host of the hypervisor. This can be either an IP address or a
    -- fully-qualified domain name (FQDN).
    TestHypervisorConfiguration -> Text
host :: Prelude.Text
  }
  deriving (TestHypervisorConfiguration -> TestHypervisorConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestHypervisorConfiguration -> TestHypervisorConfiguration -> Bool
$c/= :: TestHypervisorConfiguration -> TestHypervisorConfiguration -> Bool
== :: TestHypervisorConfiguration -> TestHypervisorConfiguration -> Bool
$c== :: TestHypervisorConfiguration -> TestHypervisorConfiguration -> Bool
Prelude.Eq, Int -> TestHypervisorConfiguration -> ShowS
[TestHypervisorConfiguration] -> ShowS
TestHypervisorConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestHypervisorConfiguration] -> ShowS
$cshowList :: [TestHypervisorConfiguration] -> ShowS
show :: TestHypervisorConfiguration -> String
$cshow :: TestHypervisorConfiguration -> String
showsPrec :: Int -> TestHypervisorConfiguration -> ShowS
$cshowsPrec :: Int -> TestHypervisorConfiguration -> ShowS
Prelude.Show, forall x.
Rep TestHypervisorConfiguration x -> TestHypervisorConfiguration
forall x.
TestHypervisorConfiguration -> Rep TestHypervisorConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestHypervisorConfiguration x -> TestHypervisorConfiguration
$cfrom :: forall x.
TestHypervisorConfiguration -> Rep TestHypervisorConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'TestHypervisorConfiguration' 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:
--
-- 'password', 'testHypervisorConfiguration_password' - The password for the hypervisor.
--
-- 'username', 'testHypervisorConfiguration_username' - The username for the hypervisor.
--
-- 'gatewayArn', 'testHypervisorConfiguration_gatewayArn' - The Amazon Resource Name (ARN) of the gateway to the hypervisor to test.
--
-- 'host', 'testHypervisorConfiguration_host' - The server host of the hypervisor. This can be either an IP address or a
-- fully-qualified domain name (FQDN).
newTestHypervisorConfiguration ::
  -- | 'gatewayArn'
  Prelude.Text ->
  -- | 'host'
  Prelude.Text ->
  TestHypervisorConfiguration
newTestHypervisorConfiguration :: Text -> Text -> TestHypervisorConfiguration
newTestHypervisorConfiguration Text
pGatewayArn_ Text
pHost_ =
  TestHypervisorConfiguration'
    { $sel:password:TestHypervisorConfiguration' :: Maybe (Sensitive Text)
password =
        forall a. Maybe a
Prelude.Nothing,
      $sel:username:TestHypervisorConfiguration' :: Maybe (Sensitive Text)
username = forall a. Maybe a
Prelude.Nothing,
      $sel:gatewayArn:TestHypervisorConfiguration' :: Text
gatewayArn = Text
pGatewayArn_,
      $sel:host:TestHypervisorConfiguration' :: Text
host = Text
pHost_
    }

-- | The password for the hypervisor.
testHypervisorConfiguration_password :: Lens.Lens' TestHypervisorConfiguration (Prelude.Maybe Prelude.Text)
testHypervisorConfiguration_password :: Lens' TestHypervisorConfiguration (Maybe Text)
testHypervisorConfiguration_password = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestHypervisorConfiguration' {Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:password:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
password} -> Maybe (Sensitive Text)
password) (\s :: TestHypervisorConfiguration
s@TestHypervisorConfiguration' {} Maybe (Sensitive Text)
a -> TestHypervisorConfiguration
s {$sel:password:TestHypervisorConfiguration' :: Maybe (Sensitive Text)
password = Maybe (Sensitive Text)
a} :: TestHypervisorConfiguration) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The username for the hypervisor.
testHypervisorConfiguration_username :: Lens.Lens' TestHypervisorConfiguration (Prelude.Maybe Prelude.Text)
testHypervisorConfiguration_username :: Lens' TestHypervisorConfiguration (Maybe Text)
testHypervisorConfiguration_username = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestHypervisorConfiguration' {Maybe (Sensitive Text)
username :: Maybe (Sensitive Text)
$sel:username:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
username} -> Maybe (Sensitive Text)
username) (\s :: TestHypervisorConfiguration
s@TestHypervisorConfiguration' {} Maybe (Sensitive Text)
a -> TestHypervisorConfiguration
s {$sel:username:TestHypervisorConfiguration' :: Maybe (Sensitive Text)
username = Maybe (Sensitive Text)
a} :: TestHypervisorConfiguration) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The Amazon Resource Name (ARN) of the gateway to the hypervisor to test.
testHypervisorConfiguration_gatewayArn :: Lens.Lens' TestHypervisorConfiguration Prelude.Text
testHypervisorConfiguration_gatewayArn :: Lens' TestHypervisorConfiguration Text
testHypervisorConfiguration_gatewayArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestHypervisorConfiguration' {Text
gatewayArn :: Text
$sel:gatewayArn:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
gatewayArn} -> Text
gatewayArn) (\s :: TestHypervisorConfiguration
s@TestHypervisorConfiguration' {} Text
a -> TestHypervisorConfiguration
s {$sel:gatewayArn:TestHypervisorConfiguration' :: Text
gatewayArn = Text
a} :: TestHypervisorConfiguration)

-- | The server host of the hypervisor. This can be either an IP address or a
-- fully-qualified domain name (FQDN).
testHypervisorConfiguration_host :: Lens.Lens' TestHypervisorConfiguration Prelude.Text
testHypervisorConfiguration_host :: Lens' TestHypervisorConfiguration Text
testHypervisorConfiguration_host = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TestHypervisorConfiguration' {Text
host :: Text
$sel:host:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
host} -> Text
host) (\s :: TestHypervisorConfiguration
s@TestHypervisorConfiguration' {} Text
a -> TestHypervisorConfiguration
s {$sel:host:TestHypervisorConfiguration' :: Text
host = Text
a} :: TestHypervisorConfiguration)

instance Core.AWSRequest TestHypervisorConfiguration where
  type
    AWSResponse TestHypervisorConfiguration =
      TestHypervisorConfigurationResponse
  request :: (Service -> Service)
-> TestHypervisorConfiguration
-> Request TestHypervisorConfiguration
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 TestHypervisorConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse TestHypervisorConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> TestHypervisorConfigurationResponse
TestHypervisorConfigurationResponse'
            forall (f :: * -> *) a b. Functor 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 TestHypervisorConfiguration where
  hashWithSalt :: Int -> TestHypervisorConfiguration -> Int
hashWithSalt Int
_salt TestHypervisorConfiguration' {Maybe (Sensitive Text)
Text
host :: Text
gatewayArn :: Text
username :: Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:host:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:gatewayArn:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:username:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
$sel:password:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
password
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
username
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
host

instance Prelude.NFData TestHypervisorConfiguration where
  rnf :: TestHypervisorConfiguration -> ()
rnf TestHypervisorConfiguration' {Maybe (Sensitive Text)
Text
host :: Text
gatewayArn :: Text
username :: Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:host:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:gatewayArn:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:username:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
$sel:password:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
password
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
username
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
gatewayArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
host

instance Data.ToHeaders TestHypervisorConfiguration where
  toHeaders :: TestHypervisorConfiguration -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"BackupOnPremises_v20210101.TestHypervisorConfiguration" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON TestHypervisorConfiguration where
  toJSON :: TestHypervisorConfiguration -> Value
toJSON TestHypervisorConfiguration' {Maybe (Sensitive Text)
Text
host :: Text
gatewayArn :: Text
username :: Maybe (Sensitive Text)
password :: Maybe (Sensitive Text)
$sel:host:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:gatewayArn:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Text
$sel:username:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
$sel:password:TestHypervisorConfiguration' :: TestHypervisorConfiguration -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Password" 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 (Sensitive Text)
password,
            (Key
"Username" 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 (Sensitive Text)
username,
            forall a. a -> Maybe a
Prelude.Just (Key
"GatewayArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
gatewayArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Host" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
host)
          ]
      )

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

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

-- | /See:/ 'newTestHypervisorConfigurationResponse' smart constructor.
data TestHypervisorConfigurationResponse = TestHypervisorConfigurationResponse'
  { -- | The response's http status code.
    TestHypervisorConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (TestHypervisorConfigurationResponse
-> TestHypervisorConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestHypervisorConfigurationResponse
-> TestHypervisorConfigurationResponse -> Bool
$c/= :: TestHypervisorConfigurationResponse
-> TestHypervisorConfigurationResponse -> Bool
== :: TestHypervisorConfigurationResponse
-> TestHypervisorConfigurationResponse -> Bool
$c== :: TestHypervisorConfigurationResponse
-> TestHypervisorConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [TestHypervisorConfigurationResponse]
ReadPrec TestHypervisorConfigurationResponse
Int -> ReadS TestHypervisorConfigurationResponse
ReadS [TestHypervisorConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TestHypervisorConfigurationResponse]
$creadListPrec :: ReadPrec [TestHypervisorConfigurationResponse]
readPrec :: ReadPrec TestHypervisorConfigurationResponse
$creadPrec :: ReadPrec TestHypervisorConfigurationResponse
readList :: ReadS [TestHypervisorConfigurationResponse]
$creadList :: ReadS [TestHypervisorConfigurationResponse]
readsPrec :: Int -> ReadS TestHypervisorConfigurationResponse
$creadsPrec :: Int -> ReadS TestHypervisorConfigurationResponse
Prelude.Read, Int -> TestHypervisorConfigurationResponse -> ShowS
[TestHypervisorConfigurationResponse] -> ShowS
TestHypervisorConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestHypervisorConfigurationResponse] -> ShowS
$cshowList :: [TestHypervisorConfigurationResponse] -> ShowS
show :: TestHypervisorConfigurationResponse -> String
$cshow :: TestHypervisorConfigurationResponse -> String
showsPrec :: Int -> TestHypervisorConfigurationResponse -> ShowS
$cshowsPrec :: Int -> TestHypervisorConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep TestHypervisorConfigurationResponse x
-> TestHypervisorConfigurationResponse
forall x.
TestHypervisorConfigurationResponse
-> Rep TestHypervisorConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TestHypervisorConfigurationResponse x
-> TestHypervisorConfigurationResponse
$cfrom :: forall x.
TestHypervisorConfigurationResponse
-> Rep TestHypervisorConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'TestHypervisorConfigurationResponse' 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:
--
-- 'httpStatus', 'testHypervisorConfigurationResponse_httpStatus' - The response's http status code.
newTestHypervisorConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  TestHypervisorConfigurationResponse
newTestHypervisorConfigurationResponse :: Int -> TestHypervisorConfigurationResponse
newTestHypervisorConfigurationResponse Int
pHttpStatus_ =
  TestHypervisorConfigurationResponse'
    { $sel:httpStatus:TestHypervisorConfigurationResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    TestHypervisorConfigurationResponse
  where
  rnf :: TestHypervisorConfigurationResponse -> ()
rnf TestHypervisorConfigurationResponse' {Int
httpStatus :: Int
$sel:httpStatus:TestHypervisorConfigurationResponse' :: TestHypervisorConfigurationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus