{-# 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.OpenSearch.GetCompatibleVersions
-- 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 a map of OpenSearch or Elasticsearch versions and the versions
-- you can upgrade them to.
module Amazonka.OpenSearch.GetCompatibleVersions
  ( -- * Creating a Request
    GetCompatibleVersions (..),
    newGetCompatibleVersions,

    -- * Request Lenses
    getCompatibleVersions_domainName,

    -- * Destructuring the Response
    GetCompatibleVersionsResponse (..),
    newGetCompatibleVersionsResponse,

    -- * Response Lenses
    getCompatibleVersionsResponse_compatibleVersions,
    getCompatibleVersionsResponse_httpStatus,
  )
where

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

-- | Container for the request parameters to @GetCompatibleVersions@
-- operation.
--
-- /See:/ 'newGetCompatibleVersions' smart constructor.
data GetCompatibleVersions = GetCompatibleVersions'
  { -- | The name of an existing domain. Provide this parameter to limit the
    -- results to a single domain.
    GetCompatibleVersions -> Maybe Text
domainName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetCompatibleVersions -> GetCompatibleVersions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCompatibleVersions -> GetCompatibleVersions -> Bool
$c/= :: GetCompatibleVersions -> GetCompatibleVersions -> Bool
== :: GetCompatibleVersions -> GetCompatibleVersions -> Bool
$c== :: GetCompatibleVersions -> GetCompatibleVersions -> Bool
Prelude.Eq, ReadPrec [GetCompatibleVersions]
ReadPrec GetCompatibleVersions
Int -> ReadS GetCompatibleVersions
ReadS [GetCompatibleVersions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCompatibleVersions]
$creadListPrec :: ReadPrec [GetCompatibleVersions]
readPrec :: ReadPrec GetCompatibleVersions
$creadPrec :: ReadPrec GetCompatibleVersions
readList :: ReadS [GetCompatibleVersions]
$creadList :: ReadS [GetCompatibleVersions]
readsPrec :: Int -> ReadS GetCompatibleVersions
$creadsPrec :: Int -> ReadS GetCompatibleVersions
Prelude.Read, Int -> GetCompatibleVersions -> ShowS
[GetCompatibleVersions] -> ShowS
GetCompatibleVersions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCompatibleVersions] -> ShowS
$cshowList :: [GetCompatibleVersions] -> ShowS
show :: GetCompatibleVersions -> String
$cshow :: GetCompatibleVersions -> String
showsPrec :: Int -> GetCompatibleVersions -> ShowS
$cshowsPrec :: Int -> GetCompatibleVersions -> ShowS
Prelude.Show, forall x. Rep GetCompatibleVersions x -> GetCompatibleVersions
forall x. GetCompatibleVersions -> Rep GetCompatibleVersions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCompatibleVersions x -> GetCompatibleVersions
$cfrom :: forall x. GetCompatibleVersions -> Rep GetCompatibleVersions x
Prelude.Generic)

-- |
-- Create a value of 'GetCompatibleVersions' 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:
--
-- 'domainName', 'getCompatibleVersions_domainName' - The name of an existing domain. Provide this parameter to limit the
-- results to a single domain.
newGetCompatibleVersions ::
  GetCompatibleVersions
newGetCompatibleVersions :: GetCompatibleVersions
newGetCompatibleVersions =
  GetCompatibleVersions'
    { $sel:domainName:GetCompatibleVersions' :: Maybe Text
domainName =
        forall a. Maybe a
Prelude.Nothing
    }

-- | The name of an existing domain. Provide this parameter to limit the
-- results to a single domain.
getCompatibleVersions_domainName :: Lens.Lens' GetCompatibleVersions (Prelude.Maybe Prelude.Text)
getCompatibleVersions_domainName :: Lens' GetCompatibleVersions (Maybe Text)
getCompatibleVersions_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCompatibleVersions' {Maybe Text
domainName :: Maybe Text
$sel:domainName:GetCompatibleVersions' :: GetCompatibleVersions -> Maybe Text
domainName} -> Maybe Text
domainName) (\s :: GetCompatibleVersions
s@GetCompatibleVersions' {} Maybe Text
a -> GetCompatibleVersions
s {$sel:domainName:GetCompatibleVersions' :: Maybe Text
domainName = Maybe Text
a} :: GetCompatibleVersions)

instance Core.AWSRequest GetCompatibleVersions where
  type
    AWSResponse GetCompatibleVersions =
      GetCompatibleVersionsResponse
  request :: (Service -> Service)
-> GetCompatibleVersions -> Request GetCompatibleVersions
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 GetCompatibleVersions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCompatibleVersions)))
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 [CompatibleVersionsMap]
-> Int -> GetCompatibleVersionsResponse
GetCompatibleVersionsResponse'
            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
"CompatibleVersions"
                            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 GetCompatibleVersions where
  hashWithSalt :: Int -> GetCompatibleVersions -> Int
hashWithSalt Int
_salt GetCompatibleVersions' {Maybe Text
domainName :: Maybe Text
$sel:domainName:GetCompatibleVersions' :: GetCompatibleVersions -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
domainName

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

instance Data.ToHeaders GetCompatibleVersions where
  toHeaders :: GetCompatibleVersions -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath GetCompatibleVersions where
  toPath :: GetCompatibleVersions -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/2021-01-01/opensearch/compatibleVersions"

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

-- | Container for the response returned by the @GetCompatibleVersions@
-- operation.
--
-- /See:/ 'newGetCompatibleVersionsResponse' smart constructor.
data GetCompatibleVersionsResponse = GetCompatibleVersionsResponse'
  { -- | A map of OpenSearch or Elasticsearch versions and the versions you can
    -- upgrade them to.
    GetCompatibleVersionsResponse -> Maybe [CompatibleVersionsMap]
compatibleVersions :: Prelude.Maybe [CompatibleVersionsMap],
    -- | The response's http status code.
    GetCompatibleVersionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCompatibleVersionsResponse
-> GetCompatibleVersionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCompatibleVersionsResponse
-> GetCompatibleVersionsResponse -> Bool
$c/= :: GetCompatibleVersionsResponse
-> GetCompatibleVersionsResponse -> Bool
== :: GetCompatibleVersionsResponse
-> GetCompatibleVersionsResponse -> Bool
$c== :: GetCompatibleVersionsResponse
-> GetCompatibleVersionsResponse -> Bool
Prelude.Eq, ReadPrec [GetCompatibleVersionsResponse]
ReadPrec GetCompatibleVersionsResponse
Int -> ReadS GetCompatibleVersionsResponse
ReadS [GetCompatibleVersionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCompatibleVersionsResponse]
$creadListPrec :: ReadPrec [GetCompatibleVersionsResponse]
readPrec :: ReadPrec GetCompatibleVersionsResponse
$creadPrec :: ReadPrec GetCompatibleVersionsResponse
readList :: ReadS [GetCompatibleVersionsResponse]
$creadList :: ReadS [GetCompatibleVersionsResponse]
readsPrec :: Int -> ReadS GetCompatibleVersionsResponse
$creadsPrec :: Int -> ReadS GetCompatibleVersionsResponse
Prelude.Read, Int -> GetCompatibleVersionsResponse -> ShowS
[GetCompatibleVersionsResponse] -> ShowS
GetCompatibleVersionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCompatibleVersionsResponse] -> ShowS
$cshowList :: [GetCompatibleVersionsResponse] -> ShowS
show :: GetCompatibleVersionsResponse -> String
$cshow :: GetCompatibleVersionsResponse -> String
showsPrec :: Int -> GetCompatibleVersionsResponse -> ShowS
$cshowsPrec :: Int -> GetCompatibleVersionsResponse -> ShowS
Prelude.Show, forall x.
Rep GetCompatibleVersionsResponse x
-> GetCompatibleVersionsResponse
forall x.
GetCompatibleVersionsResponse
-> Rep GetCompatibleVersionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCompatibleVersionsResponse x
-> GetCompatibleVersionsResponse
$cfrom :: forall x.
GetCompatibleVersionsResponse
-> Rep GetCompatibleVersionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCompatibleVersionsResponse' 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:
--
-- 'compatibleVersions', 'getCompatibleVersionsResponse_compatibleVersions' - A map of OpenSearch or Elasticsearch versions and the versions you can
-- upgrade them to.
--
-- 'httpStatus', 'getCompatibleVersionsResponse_httpStatus' - The response's http status code.
newGetCompatibleVersionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCompatibleVersionsResponse
newGetCompatibleVersionsResponse :: Int -> GetCompatibleVersionsResponse
newGetCompatibleVersionsResponse Int
pHttpStatus_ =
  GetCompatibleVersionsResponse'
    { $sel:compatibleVersions:GetCompatibleVersionsResponse' :: Maybe [CompatibleVersionsMap]
compatibleVersions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCompatibleVersionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A map of OpenSearch or Elasticsearch versions and the versions you can
-- upgrade them to.
getCompatibleVersionsResponse_compatibleVersions :: Lens.Lens' GetCompatibleVersionsResponse (Prelude.Maybe [CompatibleVersionsMap])
getCompatibleVersionsResponse_compatibleVersions :: Lens' GetCompatibleVersionsResponse (Maybe [CompatibleVersionsMap])
getCompatibleVersionsResponse_compatibleVersions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCompatibleVersionsResponse' {Maybe [CompatibleVersionsMap]
compatibleVersions :: Maybe [CompatibleVersionsMap]
$sel:compatibleVersions:GetCompatibleVersionsResponse' :: GetCompatibleVersionsResponse -> Maybe [CompatibleVersionsMap]
compatibleVersions} -> Maybe [CompatibleVersionsMap]
compatibleVersions) (\s :: GetCompatibleVersionsResponse
s@GetCompatibleVersionsResponse' {} Maybe [CompatibleVersionsMap]
a -> GetCompatibleVersionsResponse
s {$sel:compatibleVersions:GetCompatibleVersionsResponse' :: Maybe [CompatibleVersionsMap]
compatibleVersions = Maybe [CompatibleVersionsMap]
a} :: GetCompatibleVersionsResponse) 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.
getCompatibleVersionsResponse_httpStatus :: Lens.Lens' GetCompatibleVersionsResponse Prelude.Int
getCompatibleVersionsResponse_httpStatus :: Lens' GetCompatibleVersionsResponse Int
getCompatibleVersionsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCompatibleVersionsResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCompatibleVersionsResponse' :: GetCompatibleVersionsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCompatibleVersionsResponse
s@GetCompatibleVersionsResponse' {} Int
a -> GetCompatibleVersionsResponse
s {$sel:httpStatus:GetCompatibleVersionsResponse' :: Int
httpStatus = Int
a} :: GetCompatibleVersionsResponse)

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