{-# 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.Kafka.GetCompatibleKafkaVersions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the Apache Kafka versions to which you can update the MSK cluster.
module Amazonka.Kafka.GetCompatibleKafkaVersions
  ( -- * Creating a Request
    GetCompatibleKafkaVersions (..),
    newGetCompatibleKafkaVersions,

    -- * Request Lenses
    getCompatibleKafkaVersions_clusterArn,

    -- * Destructuring the Response
    GetCompatibleKafkaVersionsResponse (..),
    newGetCompatibleKafkaVersionsResponse,

    -- * Response Lenses
    getCompatibleKafkaVersionsResponse_compatibleKafkaVersions,
    getCompatibleKafkaVersionsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetCompatibleKafkaVersions' smart constructor.
data GetCompatibleKafkaVersions = GetCompatibleKafkaVersions'
  { -- | The Amazon Resource Name (ARN) of the cluster check.
    GetCompatibleKafkaVersions -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text
  }
  deriving (GetCompatibleKafkaVersions -> GetCompatibleKafkaVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCompatibleKafkaVersions -> GetCompatibleKafkaVersions -> Bool
$c/= :: GetCompatibleKafkaVersions -> GetCompatibleKafkaVersions -> Bool
== :: GetCompatibleKafkaVersions -> GetCompatibleKafkaVersions -> Bool
$c== :: GetCompatibleKafkaVersions -> GetCompatibleKafkaVersions -> Bool
Prelude.Eq, ReadPrec [GetCompatibleKafkaVersions]
ReadPrec GetCompatibleKafkaVersions
Int -> ReadS GetCompatibleKafkaVersions
ReadS [GetCompatibleKafkaVersions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCompatibleKafkaVersions]
$creadListPrec :: ReadPrec [GetCompatibleKafkaVersions]
readPrec :: ReadPrec GetCompatibleKafkaVersions
$creadPrec :: ReadPrec GetCompatibleKafkaVersions
readList :: ReadS [GetCompatibleKafkaVersions]
$creadList :: ReadS [GetCompatibleKafkaVersions]
readsPrec :: Int -> ReadS GetCompatibleKafkaVersions
$creadsPrec :: Int -> ReadS GetCompatibleKafkaVersions
Prelude.Read, Int -> GetCompatibleKafkaVersions -> ShowS
[GetCompatibleKafkaVersions] -> ShowS
GetCompatibleKafkaVersions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCompatibleKafkaVersions] -> ShowS
$cshowList :: [GetCompatibleKafkaVersions] -> ShowS
show :: GetCompatibleKafkaVersions -> String
$cshow :: GetCompatibleKafkaVersions -> String
showsPrec :: Int -> GetCompatibleKafkaVersions -> ShowS
$cshowsPrec :: Int -> GetCompatibleKafkaVersions -> ShowS
Prelude.Show, forall x.
Rep GetCompatibleKafkaVersions x -> GetCompatibleKafkaVersions
forall x.
GetCompatibleKafkaVersions -> Rep GetCompatibleKafkaVersions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCompatibleKafkaVersions x -> GetCompatibleKafkaVersions
$cfrom :: forall x.
GetCompatibleKafkaVersions -> Rep GetCompatibleKafkaVersions x
Prelude.Generic)

-- |
-- Create a value of 'GetCompatibleKafkaVersions' 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:
--
-- 'clusterArn', 'getCompatibleKafkaVersions_clusterArn' - The Amazon Resource Name (ARN) of the cluster check.
newGetCompatibleKafkaVersions ::
  GetCompatibleKafkaVersions
newGetCompatibleKafkaVersions :: GetCompatibleKafkaVersions
newGetCompatibleKafkaVersions =
  GetCompatibleKafkaVersions'
    { $sel:clusterArn:GetCompatibleKafkaVersions' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the cluster check.
getCompatibleKafkaVersions_clusterArn :: Lens.Lens' GetCompatibleKafkaVersions (Prelude.Maybe Prelude.Text)
getCompatibleKafkaVersions_clusterArn :: Lens' GetCompatibleKafkaVersions (Maybe Text)
getCompatibleKafkaVersions_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCompatibleKafkaVersions' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:GetCompatibleKafkaVersions' :: GetCompatibleKafkaVersions -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: GetCompatibleKafkaVersions
s@GetCompatibleKafkaVersions' {} Maybe Text
a -> GetCompatibleKafkaVersions
s {$sel:clusterArn:GetCompatibleKafkaVersions' :: Maybe Text
clusterArn = Maybe Text
a} :: GetCompatibleKafkaVersions)

instance Core.AWSRequest GetCompatibleKafkaVersions where
  type
    AWSResponse GetCompatibleKafkaVersions =
      GetCompatibleKafkaVersionsResponse
  request :: (Service -> Service)
-> GetCompatibleKafkaVersions -> Request GetCompatibleKafkaVersions
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetCompatibleKafkaVersions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCompatibleKafkaVersions)))
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 [CompatibleKafkaVersion]
-> Int -> GetCompatibleKafkaVersionsResponse
GetCompatibleKafkaVersionsResponse'
            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
"compatibleKafkaVersions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 GetCompatibleKafkaVersions where
  hashWithSalt :: Int -> GetCompatibleKafkaVersions -> Int
hashWithSalt Int
_salt GetCompatibleKafkaVersions' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:GetCompatibleKafkaVersions' :: GetCompatibleKafkaVersions -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterArn

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

instance Data.ToHeaders GetCompatibleKafkaVersions where
  toHeaders :: GetCompatibleKafkaVersions -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetCompatibleKafkaVersions where
  toPath :: GetCompatibleKafkaVersions -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/v1/compatible-kafka-versions"

instance Data.ToQuery GetCompatibleKafkaVersions where
  toQuery :: GetCompatibleKafkaVersions -> QueryString
toQuery GetCompatibleKafkaVersions' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:GetCompatibleKafkaVersions' :: GetCompatibleKafkaVersions -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"clusterArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterArn]

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

-- |
-- Create a value of 'GetCompatibleKafkaVersionsResponse' 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:
--
-- 'compatibleKafkaVersions', 'getCompatibleKafkaVersionsResponse_compatibleKafkaVersions' - A list of CompatibleKafkaVersion objects.
--
-- 'httpStatus', 'getCompatibleKafkaVersionsResponse_httpStatus' - The response's http status code.
newGetCompatibleKafkaVersionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCompatibleKafkaVersionsResponse
newGetCompatibleKafkaVersionsResponse :: Int -> GetCompatibleKafkaVersionsResponse
newGetCompatibleKafkaVersionsResponse Int
pHttpStatus_ =
  GetCompatibleKafkaVersionsResponse'
    { $sel:compatibleKafkaVersions:GetCompatibleKafkaVersionsResponse' :: Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCompatibleKafkaVersionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of CompatibleKafkaVersion objects.
getCompatibleKafkaVersionsResponse_compatibleKafkaVersions :: Lens.Lens' GetCompatibleKafkaVersionsResponse (Prelude.Maybe [CompatibleKafkaVersion])
getCompatibleKafkaVersionsResponse_compatibleKafkaVersions :: Lens'
  GetCompatibleKafkaVersionsResponse (Maybe [CompatibleKafkaVersion])
getCompatibleKafkaVersionsResponse_compatibleKafkaVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCompatibleKafkaVersionsResponse' {Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions :: Maybe [CompatibleKafkaVersion]
$sel:compatibleKafkaVersions:GetCompatibleKafkaVersionsResponse' :: GetCompatibleKafkaVersionsResponse
-> Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions} -> Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions) (\s :: GetCompatibleKafkaVersionsResponse
s@GetCompatibleKafkaVersionsResponse' {} Maybe [CompatibleKafkaVersion]
a -> GetCompatibleKafkaVersionsResponse
s {$sel:compatibleKafkaVersions:GetCompatibleKafkaVersionsResponse' :: Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions = Maybe [CompatibleKafkaVersion]
a} :: GetCompatibleKafkaVersionsResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    GetCompatibleKafkaVersionsResponse
  where
  rnf :: GetCompatibleKafkaVersionsResponse -> ()
rnf GetCompatibleKafkaVersionsResponse' {Int
Maybe [CompatibleKafkaVersion]
httpStatus :: Int
compatibleKafkaVersions :: Maybe [CompatibleKafkaVersion]
$sel:httpStatus:GetCompatibleKafkaVersionsResponse' :: GetCompatibleKafkaVersionsResponse -> Int
$sel:compatibleKafkaVersions:GetCompatibleKafkaVersionsResponse' :: GetCompatibleKafkaVersionsResponse
-> Maybe [CompatibleKafkaVersion]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CompatibleKafkaVersion]
compatibleKafkaVersions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus