{-# 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.GamesParks.GetExtensionVersion
-- 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 details about a specified extension version.
module Amazonka.GamesParks.GetExtensionVersion
  ( -- * Creating a Request
    GetExtensionVersion (..),
    newGetExtensionVersion,

    -- * Request Lenses
    getExtensionVersion_extensionVersion,
    getExtensionVersion_name,
    getExtensionVersion_namespace,

    -- * Destructuring the Response
    GetExtensionVersionResponse (..),
    newGetExtensionVersionResponse,

    -- * Response Lenses
    getExtensionVersionResponse_extensionVersion,
    getExtensionVersionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetExtensionVersion' smart constructor.
data GetExtensionVersion = GetExtensionVersion'
  { -- | The version of the extension.
    GetExtensionVersion -> Text
extensionVersion :: Prelude.Text,
    -- | The name of the extension.
    GetExtensionVersion -> Text
name :: Prelude.Text,
    -- | The namespace (qualifier) of the extension.
    GetExtensionVersion -> Text
namespace :: Prelude.Text
  }
  deriving (GetExtensionVersion -> GetExtensionVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetExtensionVersion -> GetExtensionVersion -> Bool
$c/= :: GetExtensionVersion -> GetExtensionVersion -> Bool
== :: GetExtensionVersion -> GetExtensionVersion -> Bool
$c== :: GetExtensionVersion -> GetExtensionVersion -> Bool
Prelude.Eq, ReadPrec [GetExtensionVersion]
ReadPrec GetExtensionVersion
Int -> ReadS GetExtensionVersion
ReadS [GetExtensionVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetExtensionVersion]
$creadListPrec :: ReadPrec [GetExtensionVersion]
readPrec :: ReadPrec GetExtensionVersion
$creadPrec :: ReadPrec GetExtensionVersion
readList :: ReadS [GetExtensionVersion]
$creadList :: ReadS [GetExtensionVersion]
readsPrec :: Int -> ReadS GetExtensionVersion
$creadsPrec :: Int -> ReadS GetExtensionVersion
Prelude.Read, Int -> GetExtensionVersion -> ShowS
[GetExtensionVersion] -> ShowS
GetExtensionVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetExtensionVersion] -> ShowS
$cshowList :: [GetExtensionVersion] -> ShowS
show :: GetExtensionVersion -> String
$cshow :: GetExtensionVersion -> String
showsPrec :: Int -> GetExtensionVersion -> ShowS
$cshowsPrec :: Int -> GetExtensionVersion -> ShowS
Prelude.Show, forall x. Rep GetExtensionVersion x -> GetExtensionVersion
forall x. GetExtensionVersion -> Rep GetExtensionVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetExtensionVersion x -> GetExtensionVersion
$cfrom :: forall x. GetExtensionVersion -> Rep GetExtensionVersion x
Prelude.Generic)

-- |
-- Create a value of 'GetExtensionVersion' 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:
--
-- 'extensionVersion', 'getExtensionVersion_extensionVersion' - The version of the extension.
--
-- 'name', 'getExtensionVersion_name' - The name of the extension.
--
-- 'namespace', 'getExtensionVersion_namespace' - The namespace (qualifier) of the extension.
newGetExtensionVersion ::
  -- | 'extensionVersion'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'namespace'
  Prelude.Text ->
  GetExtensionVersion
newGetExtensionVersion :: Text -> Text -> Text -> GetExtensionVersion
newGetExtensionVersion
  Text
pExtensionVersion_
  Text
pName_
  Text
pNamespace_ =
    GetExtensionVersion'
      { $sel:extensionVersion:GetExtensionVersion' :: Text
extensionVersion =
          Text
pExtensionVersion_,
        $sel:name:GetExtensionVersion' :: Text
name = Text
pName_,
        $sel:namespace:GetExtensionVersion' :: Text
namespace = Text
pNamespace_
      }

-- | The version of the extension.
getExtensionVersion_extensionVersion :: Lens.Lens' GetExtensionVersion Prelude.Text
getExtensionVersion_extensionVersion :: Lens' GetExtensionVersion Text
getExtensionVersion_extensionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExtensionVersion' {Text
extensionVersion :: Text
$sel:extensionVersion:GetExtensionVersion' :: GetExtensionVersion -> Text
extensionVersion} -> Text
extensionVersion) (\s :: GetExtensionVersion
s@GetExtensionVersion' {} Text
a -> GetExtensionVersion
s {$sel:extensionVersion:GetExtensionVersion' :: Text
extensionVersion = Text
a} :: GetExtensionVersion)

-- | The name of the extension.
getExtensionVersion_name :: Lens.Lens' GetExtensionVersion Prelude.Text
getExtensionVersion_name :: Lens' GetExtensionVersion Text
getExtensionVersion_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExtensionVersion' {Text
name :: Text
$sel:name:GetExtensionVersion' :: GetExtensionVersion -> Text
name} -> Text
name) (\s :: GetExtensionVersion
s@GetExtensionVersion' {} Text
a -> GetExtensionVersion
s {$sel:name:GetExtensionVersion' :: Text
name = Text
a} :: GetExtensionVersion)

-- | The namespace (qualifier) of the extension.
getExtensionVersion_namespace :: Lens.Lens' GetExtensionVersion Prelude.Text
getExtensionVersion_namespace :: Lens' GetExtensionVersion Text
getExtensionVersion_namespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExtensionVersion' {Text
namespace :: Text
$sel:namespace:GetExtensionVersion' :: GetExtensionVersion -> Text
namespace} -> Text
namespace) (\s :: GetExtensionVersion
s@GetExtensionVersion' {} Text
a -> GetExtensionVersion
s {$sel:namespace:GetExtensionVersion' :: Text
namespace = Text
a} :: GetExtensionVersion)

instance Core.AWSRequest GetExtensionVersion where
  type
    AWSResponse GetExtensionVersion =
      GetExtensionVersionResponse
  request :: (Service -> Service)
-> GetExtensionVersion -> Request GetExtensionVersion
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 GetExtensionVersion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetExtensionVersion)))
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 ExtensionVersionDetails -> Int -> GetExtensionVersionResponse
GetExtensionVersionResponse'
            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
"ExtensionVersion")
            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 GetExtensionVersion where
  hashWithSalt :: Int -> GetExtensionVersion -> Int
hashWithSalt Int
_salt GetExtensionVersion' {Text
namespace :: Text
name :: Text
extensionVersion :: Text
$sel:namespace:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:name:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:extensionVersion:GetExtensionVersion' :: GetExtensionVersion -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
extensionVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
namespace

instance Prelude.NFData GetExtensionVersion where
  rnf :: GetExtensionVersion -> ()
rnf GetExtensionVersion' {Text
namespace :: Text
name :: Text
extensionVersion :: Text
$sel:namespace:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:name:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:extensionVersion:GetExtensionVersion' :: GetExtensionVersion -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
extensionVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
namespace

instance Data.ToHeaders GetExtensionVersion where
  toHeaders :: GetExtensionVersion -> 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 GetExtensionVersion where
  toPath :: GetExtensionVersion -> ByteString
toPath GetExtensionVersion' {Text
namespace :: Text
name :: Text
extensionVersion :: Text
$sel:namespace:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:name:GetExtensionVersion' :: GetExtensionVersion -> Text
$sel:extensionVersion:GetExtensionVersion' :: GetExtensionVersion -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/extension/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
namespace,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name,
        ByteString
"/version/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
extensionVersion
      ]

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

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

-- |
-- Create a value of 'GetExtensionVersionResponse' 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:
--
-- 'extensionVersion', 'getExtensionVersionResponse_extensionVersion' - The version of the extension.
--
-- 'httpStatus', 'getExtensionVersionResponse_httpStatus' - The response's http status code.
newGetExtensionVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetExtensionVersionResponse
newGetExtensionVersionResponse :: Int -> GetExtensionVersionResponse
newGetExtensionVersionResponse Int
pHttpStatus_ =
  GetExtensionVersionResponse'
    { $sel:extensionVersion:GetExtensionVersionResponse' :: Maybe ExtensionVersionDetails
extensionVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetExtensionVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The version of the extension.
getExtensionVersionResponse_extensionVersion :: Lens.Lens' GetExtensionVersionResponse (Prelude.Maybe ExtensionVersionDetails)
getExtensionVersionResponse_extensionVersion :: Lens' GetExtensionVersionResponse (Maybe ExtensionVersionDetails)
getExtensionVersionResponse_extensionVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetExtensionVersionResponse' {Maybe ExtensionVersionDetails
extensionVersion :: Maybe ExtensionVersionDetails
$sel:extensionVersion:GetExtensionVersionResponse' :: GetExtensionVersionResponse -> Maybe ExtensionVersionDetails
extensionVersion} -> Maybe ExtensionVersionDetails
extensionVersion) (\s :: GetExtensionVersionResponse
s@GetExtensionVersionResponse' {} Maybe ExtensionVersionDetails
a -> GetExtensionVersionResponse
s {$sel:extensionVersion:GetExtensionVersionResponse' :: Maybe ExtensionVersionDetails
extensionVersion = Maybe ExtensionVersionDetails
a} :: GetExtensionVersionResponse)

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

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