{-# 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.Lightsail.GetDiskSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a specific block storage disk snapshot.
module Amazonka.Lightsail.GetDiskSnapshot
  ( -- * Creating a Request
    GetDiskSnapshot (..),
    newGetDiskSnapshot,

    -- * Request Lenses
    getDiskSnapshot_diskSnapshotName,

    -- * Destructuring the Response
    GetDiskSnapshotResponse (..),
    newGetDiskSnapshotResponse,

    -- * Response Lenses
    getDiskSnapshotResponse_diskSnapshot,
    getDiskSnapshotResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetDiskSnapshot' smart constructor.
data GetDiskSnapshot = GetDiskSnapshot'
  { -- | The name of the disk snapshot (e.g., @my-disk-snapshot@).
    GetDiskSnapshot -> Text
diskSnapshotName :: Prelude.Text
  }
  deriving (GetDiskSnapshot -> GetDiskSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDiskSnapshot -> GetDiskSnapshot -> Bool
$c/= :: GetDiskSnapshot -> GetDiskSnapshot -> Bool
== :: GetDiskSnapshot -> GetDiskSnapshot -> Bool
$c== :: GetDiskSnapshot -> GetDiskSnapshot -> Bool
Prelude.Eq, ReadPrec [GetDiskSnapshot]
ReadPrec GetDiskSnapshot
Int -> ReadS GetDiskSnapshot
ReadS [GetDiskSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDiskSnapshot]
$creadListPrec :: ReadPrec [GetDiskSnapshot]
readPrec :: ReadPrec GetDiskSnapshot
$creadPrec :: ReadPrec GetDiskSnapshot
readList :: ReadS [GetDiskSnapshot]
$creadList :: ReadS [GetDiskSnapshot]
readsPrec :: Int -> ReadS GetDiskSnapshot
$creadsPrec :: Int -> ReadS GetDiskSnapshot
Prelude.Read, Int -> GetDiskSnapshot -> ShowS
[GetDiskSnapshot] -> ShowS
GetDiskSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDiskSnapshot] -> ShowS
$cshowList :: [GetDiskSnapshot] -> ShowS
show :: GetDiskSnapshot -> String
$cshow :: GetDiskSnapshot -> String
showsPrec :: Int -> GetDiskSnapshot -> ShowS
$cshowsPrec :: Int -> GetDiskSnapshot -> ShowS
Prelude.Show, forall x. Rep GetDiskSnapshot x -> GetDiskSnapshot
forall x. GetDiskSnapshot -> Rep GetDiskSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDiskSnapshot x -> GetDiskSnapshot
$cfrom :: forall x. GetDiskSnapshot -> Rep GetDiskSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'GetDiskSnapshot' 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:
--
-- 'diskSnapshotName', 'getDiskSnapshot_diskSnapshotName' - The name of the disk snapshot (e.g., @my-disk-snapshot@).
newGetDiskSnapshot ::
  -- | 'diskSnapshotName'
  Prelude.Text ->
  GetDiskSnapshot
newGetDiskSnapshot :: Text -> GetDiskSnapshot
newGetDiskSnapshot Text
pDiskSnapshotName_ =
  GetDiskSnapshot'
    { $sel:diskSnapshotName:GetDiskSnapshot' :: Text
diskSnapshotName =
        Text
pDiskSnapshotName_
    }

-- | The name of the disk snapshot (e.g., @my-disk-snapshot@).
getDiskSnapshot_diskSnapshotName :: Lens.Lens' GetDiskSnapshot Prelude.Text
getDiskSnapshot_diskSnapshotName :: Lens' GetDiskSnapshot Text
getDiskSnapshot_diskSnapshotName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:GetDiskSnapshot' :: GetDiskSnapshot -> Text
diskSnapshotName} -> Text
diskSnapshotName) (\s :: GetDiskSnapshot
s@GetDiskSnapshot' {} Text
a -> GetDiskSnapshot
s {$sel:diskSnapshotName:GetDiskSnapshot' :: Text
diskSnapshotName = Text
a} :: GetDiskSnapshot)

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

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

instance Data.ToHeaders GetDiskSnapshot where
  toHeaders :: GetDiskSnapshot -> 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
"Lightsail_20161128.GetDiskSnapshot" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON GetDiskSnapshot where
  toJSON :: GetDiskSnapshot -> Value
toJSON GetDiskSnapshot' {Text
diskSnapshotName :: Text
$sel:diskSnapshotName:GetDiskSnapshot' :: GetDiskSnapshot -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"diskSnapshotName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
diskSnapshotName)
          ]
      )

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

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

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

-- |
-- Create a value of 'GetDiskSnapshotResponse' 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:
--
-- 'diskSnapshot', 'getDiskSnapshotResponse_diskSnapshot' - An object containing information about the disk snapshot.
--
-- 'httpStatus', 'getDiskSnapshotResponse_httpStatus' - The response's http status code.
newGetDiskSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDiskSnapshotResponse
newGetDiskSnapshotResponse :: Int -> GetDiskSnapshotResponse
newGetDiskSnapshotResponse Int
pHttpStatus_ =
  GetDiskSnapshotResponse'
    { $sel:diskSnapshot:GetDiskSnapshotResponse' :: Maybe DiskSnapshot
diskSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDiskSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object containing information about the disk snapshot.
getDiskSnapshotResponse_diskSnapshot :: Lens.Lens' GetDiskSnapshotResponse (Prelude.Maybe DiskSnapshot)
getDiskSnapshotResponse_diskSnapshot :: Lens' GetDiskSnapshotResponse (Maybe DiskSnapshot)
getDiskSnapshotResponse_diskSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDiskSnapshotResponse' {Maybe DiskSnapshot
diskSnapshot :: Maybe DiskSnapshot
$sel:diskSnapshot:GetDiskSnapshotResponse' :: GetDiskSnapshotResponse -> Maybe DiskSnapshot
diskSnapshot} -> Maybe DiskSnapshot
diskSnapshot) (\s :: GetDiskSnapshotResponse
s@GetDiskSnapshotResponse' {} Maybe DiskSnapshot
a -> GetDiskSnapshotResponse
s {$sel:diskSnapshot:GetDiskSnapshotResponse' :: Maybe DiskSnapshot
diskSnapshot = Maybe DiskSnapshot
a} :: GetDiskSnapshotResponse)

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

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