{-# 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.CloudDirectory.GetAppliedSchemaVersion
-- 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 current applied schema version ARN, including the minor version
-- in use.
module Amazonka.CloudDirectory.GetAppliedSchemaVersion
  ( -- * Creating a Request
    GetAppliedSchemaVersion (..),
    newGetAppliedSchemaVersion,

    -- * Request Lenses
    getAppliedSchemaVersion_schemaArn,

    -- * Destructuring the Response
    GetAppliedSchemaVersionResponse (..),
    newGetAppliedSchemaVersionResponse,

    -- * Response Lenses
    getAppliedSchemaVersionResponse_appliedSchemaArn,
    getAppliedSchemaVersionResponse_httpStatus,
  )
where

import Amazonka.CloudDirectory.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:/ 'newGetAppliedSchemaVersion' smart constructor.
data GetAppliedSchemaVersion = GetAppliedSchemaVersion'
  { -- | The ARN of the applied schema.
    GetAppliedSchemaVersion -> Text
schemaArn :: Prelude.Text
  }
  deriving (GetAppliedSchemaVersion -> GetAppliedSchemaVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAppliedSchemaVersion -> GetAppliedSchemaVersion -> Bool
$c/= :: GetAppliedSchemaVersion -> GetAppliedSchemaVersion -> Bool
== :: GetAppliedSchemaVersion -> GetAppliedSchemaVersion -> Bool
$c== :: GetAppliedSchemaVersion -> GetAppliedSchemaVersion -> Bool
Prelude.Eq, ReadPrec [GetAppliedSchemaVersion]
ReadPrec GetAppliedSchemaVersion
Int -> ReadS GetAppliedSchemaVersion
ReadS [GetAppliedSchemaVersion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAppliedSchemaVersion]
$creadListPrec :: ReadPrec [GetAppliedSchemaVersion]
readPrec :: ReadPrec GetAppliedSchemaVersion
$creadPrec :: ReadPrec GetAppliedSchemaVersion
readList :: ReadS [GetAppliedSchemaVersion]
$creadList :: ReadS [GetAppliedSchemaVersion]
readsPrec :: Int -> ReadS GetAppliedSchemaVersion
$creadsPrec :: Int -> ReadS GetAppliedSchemaVersion
Prelude.Read, Int -> GetAppliedSchemaVersion -> ShowS
[GetAppliedSchemaVersion] -> ShowS
GetAppliedSchemaVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAppliedSchemaVersion] -> ShowS
$cshowList :: [GetAppliedSchemaVersion] -> ShowS
show :: GetAppliedSchemaVersion -> String
$cshow :: GetAppliedSchemaVersion -> String
showsPrec :: Int -> GetAppliedSchemaVersion -> ShowS
$cshowsPrec :: Int -> GetAppliedSchemaVersion -> ShowS
Prelude.Show, forall x. Rep GetAppliedSchemaVersion x -> GetAppliedSchemaVersion
forall x. GetAppliedSchemaVersion -> Rep GetAppliedSchemaVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAppliedSchemaVersion x -> GetAppliedSchemaVersion
$cfrom :: forall x. GetAppliedSchemaVersion -> Rep GetAppliedSchemaVersion x
Prelude.Generic)

-- |
-- Create a value of 'GetAppliedSchemaVersion' 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:
--
-- 'schemaArn', 'getAppliedSchemaVersion_schemaArn' - The ARN of the applied schema.
newGetAppliedSchemaVersion ::
  -- | 'schemaArn'
  Prelude.Text ->
  GetAppliedSchemaVersion
newGetAppliedSchemaVersion :: Text -> GetAppliedSchemaVersion
newGetAppliedSchemaVersion Text
pSchemaArn_ =
  GetAppliedSchemaVersion' {$sel:schemaArn:GetAppliedSchemaVersion' :: Text
schemaArn = Text
pSchemaArn_}

-- | The ARN of the applied schema.
getAppliedSchemaVersion_schemaArn :: Lens.Lens' GetAppliedSchemaVersion Prelude.Text
getAppliedSchemaVersion_schemaArn :: Lens' GetAppliedSchemaVersion Text
getAppliedSchemaVersion_schemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAppliedSchemaVersion' {Text
schemaArn :: Text
$sel:schemaArn:GetAppliedSchemaVersion' :: GetAppliedSchemaVersion -> Text
schemaArn} -> Text
schemaArn) (\s :: GetAppliedSchemaVersion
s@GetAppliedSchemaVersion' {} Text
a -> GetAppliedSchemaVersion
s {$sel:schemaArn:GetAppliedSchemaVersion' :: Text
schemaArn = Text
a} :: GetAppliedSchemaVersion)

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

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

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

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

instance Data.ToPath GetAppliedSchemaVersion where
  toPath :: GetAppliedSchemaVersion -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/schema/getappliedschema"

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

-- | /See:/ 'newGetAppliedSchemaVersionResponse' smart constructor.
data GetAppliedSchemaVersionResponse = GetAppliedSchemaVersionResponse'
  { -- | Current applied schema ARN, including the minor version in use if one
    -- was provided.
    GetAppliedSchemaVersionResponse -> Maybe Text
appliedSchemaArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAppliedSchemaVersionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAppliedSchemaVersionResponse
-> GetAppliedSchemaVersionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAppliedSchemaVersionResponse
-> GetAppliedSchemaVersionResponse -> Bool
$c/= :: GetAppliedSchemaVersionResponse
-> GetAppliedSchemaVersionResponse -> Bool
== :: GetAppliedSchemaVersionResponse
-> GetAppliedSchemaVersionResponse -> Bool
$c== :: GetAppliedSchemaVersionResponse
-> GetAppliedSchemaVersionResponse -> Bool
Prelude.Eq, ReadPrec [GetAppliedSchemaVersionResponse]
ReadPrec GetAppliedSchemaVersionResponse
Int -> ReadS GetAppliedSchemaVersionResponse
ReadS [GetAppliedSchemaVersionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAppliedSchemaVersionResponse]
$creadListPrec :: ReadPrec [GetAppliedSchemaVersionResponse]
readPrec :: ReadPrec GetAppliedSchemaVersionResponse
$creadPrec :: ReadPrec GetAppliedSchemaVersionResponse
readList :: ReadS [GetAppliedSchemaVersionResponse]
$creadList :: ReadS [GetAppliedSchemaVersionResponse]
readsPrec :: Int -> ReadS GetAppliedSchemaVersionResponse
$creadsPrec :: Int -> ReadS GetAppliedSchemaVersionResponse
Prelude.Read, Int -> GetAppliedSchemaVersionResponse -> ShowS
[GetAppliedSchemaVersionResponse] -> ShowS
GetAppliedSchemaVersionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAppliedSchemaVersionResponse] -> ShowS
$cshowList :: [GetAppliedSchemaVersionResponse] -> ShowS
show :: GetAppliedSchemaVersionResponse -> String
$cshow :: GetAppliedSchemaVersionResponse -> String
showsPrec :: Int -> GetAppliedSchemaVersionResponse -> ShowS
$cshowsPrec :: Int -> GetAppliedSchemaVersionResponse -> ShowS
Prelude.Show, forall x.
Rep GetAppliedSchemaVersionResponse x
-> GetAppliedSchemaVersionResponse
forall x.
GetAppliedSchemaVersionResponse
-> Rep GetAppliedSchemaVersionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAppliedSchemaVersionResponse x
-> GetAppliedSchemaVersionResponse
$cfrom :: forall x.
GetAppliedSchemaVersionResponse
-> Rep GetAppliedSchemaVersionResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAppliedSchemaVersionResponse' 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:
--
-- 'appliedSchemaArn', 'getAppliedSchemaVersionResponse_appliedSchemaArn' - Current applied schema ARN, including the minor version in use if one
-- was provided.
--
-- 'httpStatus', 'getAppliedSchemaVersionResponse_httpStatus' - The response's http status code.
newGetAppliedSchemaVersionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAppliedSchemaVersionResponse
newGetAppliedSchemaVersionResponse :: Int -> GetAppliedSchemaVersionResponse
newGetAppliedSchemaVersionResponse Int
pHttpStatus_ =
  GetAppliedSchemaVersionResponse'
    { $sel:appliedSchemaArn:GetAppliedSchemaVersionResponse' :: Maybe Text
appliedSchemaArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAppliedSchemaVersionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Current applied schema ARN, including the minor version in use if one
-- was provided.
getAppliedSchemaVersionResponse_appliedSchemaArn :: Lens.Lens' GetAppliedSchemaVersionResponse (Prelude.Maybe Prelude.Text)
getAppliedSchemaVersionResponse_appliedSchemaArn :: Lens' GetAppliedSchemaVersionResponse (Maybe Text)
getAppliedSchemaVersionResponse_appliedSchemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAppliedSchemaVersionResponse' {Maybe Text
appliedSchemaArn :: Maybe Text
$sel:appliedSchemaArn:GetAppliedSchemaVersionResponse' :: GetAppliedSchemaVersionResponse -> Maybe Text
appliedSchemaArn} -> Maybe Text
appliedSchemaArn) (\s :: GetAppliedSchemaVersionResponse
s@GetAppliedSchemaVersionResponse' {} Maybe Text
a -> GetAppliedSchemaVersionResponse
s {$sel:appliedSchemaArn:GetAppliedSchemaVersionResponse' :: Maybe Text
appliedSchemaArn = Maybe Text
a} :: GetAppliedSchemaVersionResponse)

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

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