{-# 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.GetHypervisor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action requests information about the specified hypervisor to which
-- the gateway will connect. A hypervisor is hardware, software, or
-- firmware that creates and manages virtual machines, and allocates
-- resources to them.
module Amazonka.BackupGateway.GetHypervisor
  ( -- * Creating a Request
    GetHypervisor (..),
    newGetHypervisor,

    -- * Request Lenses
    getHypervisor_hypervisorArn,

    -- * Destructuring the Response
    GetHypervisorResponse (..),
    newGetHypervisorResponse,

    -- * Response Lenses
    getHypervisorResponse_hypervisor,
    getHypervisorResponse_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:/ 'newGetHypervisor' smart constructor.
data GetHypervisor = GetHypervisor'
  { -- | The Amazon Resource Name (ARN) of the hypervisor.
    GetHypervisor -> Text
hypervisorArn :: Prelude.Text
  }
  deriving (GetHypervisor -> GetHypervisor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHypervisor -> GetHypervisor -> Bool
$c/= :: GetHypervisor -> GetHypervisor -> Bool
== :: GetHypervisor -> GetHypervisor -> Bool
$c== :: GetHypervisor -> GetHypervisor -> Bool
Prelude.Eq, ReadPrec [GetHypervisor]
ReadPrec GetHypervisor
Int -> ReadS GetHypervisor
ReadS [GetHypervisor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHypervisor]
$creadListPrec :: ReadPrec [GetHypervisor]
readPrec :: ReadPrec GetHypervisor
$creadPrec :: ReadPrec GetHypervisor
readList :: ReadS [GetHypervisor]
$creadList :: ReadS [GetHypervisor]
readsPrec :: Int -> ReadS GetHypervisor
$creadsPrec :: Int -> ReadS GetHypervisor
Prelude.Read, Int -> GetHypervisor -> ShowS
[GetHypervisor] -> ShowS
GetHypervisor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHypervisor] -> ShowS
$cshowList :: [GetHypervisor] -> ShowS
show :: GetHypervisor -> String
$cshow :: GetHypervisor -> String
showsPrec :: Int -> GetHypervisor -> ShowS
$cshowsPrec :: Int -> GetHypervisor -> ShowS
Prelude.Show, forall x. Rep GetHypervisor x -> GetHypervisor
forall x. GetHypervisor -> Rep GetHypervisor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHypervisor x -> GetHypervisor
$cfrom :: forall x. GetHypervisor -> Rep GetHypervisor x
Prelude.Generic)

-- |
-- Create a value of 'GetHypervisor' 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:
--
-- 'hypervisorArn', 'getHypervisor_hypervisorArn' - The Amazon Resource Name (ARN) of the hypervisor.
newGetHypervisor ::
  -- | 'hypervisorArn'
  Prelude.Text ->
  GetHypervisor
newGetHypervisor :: Text -> GetHypervisor
newGetHypervisor Text
pHypervisorArn_ =
  GetHypervisor' {$sel:hypervisorArn:GetHypervisor' :: Text
hypervisorArn = Text
pHypervisorArn_}

-- | The Amazon Resource Name (ARN) of the hypervisor.
getHypervisor_hypervisorArn :: Lens.Lens' GetHypervisor Prelude.Text
getHypervisor_hypervisorArn :: Lens' GetHypervisor Text
getHypervisor_hypervisorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHypervisor' {Text
hypervisorArn :: Text
$sel:hypervisorArn:GetHypervisor' :: GetHypervisor -> Text
hypervisorArn} -> Text
hypervisorArn) (\s :: GetHypervisor
s@GetHypervisor' {} Text
a -> GetHypervisor
s {$sel:hypervisorArn:GetHypervisor' :: Text
hypervisorArn = Text
a} :: GetHypervisor)

instance Core.AWSRequest GetHypervisor where
  type
    AWSResponse GetHypervisor =
      GetHypervisorResponse
  request :: (Service -> Service) -> GetHypervisor -> Request GetHypervisor
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 GetHypervisor
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetHypervisor)))
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 HypervisorDetails -> Int -> GetHypervisorResponse
GetHypervisorResponse'
            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
"Hypervisor")
            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 GetHypervisor where
  hashWithSalt :: Int -> GetHypervisor -> Int
hashWithSalt Int
_salt GetHypervisor' {Text
hypervisorArn :: Text
$sel:hypervisorArn:GetHypervisor' :: GetHypervisor -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hypervisorArn

instance Prelude.NFData GetHypervisor where
  rnf :: GetHypervisor -> ()
rnf GetHypervisor' {Text
hypervisorArn :: Text
$sel:hypervisorArn:GetHypervisor' :: GetHypervisor -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
hypervisorArn

instance Data.ToHeaders GetHypervisor where
  toHeaders :: GetHypervisor -> 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.GetHypervisor" ::
                          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 GetHypervisor where
  toJSON :: GetHypervisor -> Value
toJSON GetHypervisor' {Text
hypervisorArn :: Text
$sel:hypervisorArn:GetHypervisor' :: GetHypervisor -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"HypervisorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hypervisorArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'GetHypervisorResponse' 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:
--
-- 'hypervisor', 'getHypervisorResponse_hypervisor' - Details about the requested hypervisor.
--
-- 'httpStatus', 'getHypervisorResponse_httpStatus' - The response's http status code.
newGetHypervisorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetHypervisorResponse
newGetHypervisorResponse :: Int -> GetHypervisorResponse
newGetHypervisorResponse Int
pHttpStatus_ =
  GetHypervisorResponse'
    { $sel:hypervisor:GetHypervisorResponse' :: Maybe HypervisorDetails
hypervisor =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetHypervisorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details about the requested hypervisor.
getHypervisorResponse_hypervisor :: Lens.Lens' GetHypervisorResponse (Prelude.Maybe HypervisorDetails)
getHypervisorResponse_hypervisor :: Lens' GetHypervisorResponse (Maybe HypervisorDetails)
getHypervisorResponse_hypervisor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHypervisorResponse' {Maybe HypervisorDetails
hypervisor :: Maybe HypervisorDetails
$sel:hypervisor:GetHypervisorResponse' :: GetHypervisorResponse -> Maybe HypervisorDetails
hypervisor} -> Maybe HypervisorDetails
hypervisor) (\s :: GetHypervisorResponse
s@GetHypervisorResponse' {} Maybe HypervisorDetails
a -> GetHypervisorResponse
s {$sel:hypervisor:GetHypervisorResponse' :: Maybe HypervisorDetails
hypervisor = Maybe HypervisorDetails
a} :: GetHypervisorResponse)

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

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