{-# 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.ApplySchema
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Copies the input published schema, at the specified version, into the
-- Directory with the same name and version as that of the published
-- schema.
module Amazonka.CloudDirectory.ApplySchema
  ( -- * Creating a Request
    ApplySchema (..),
    newApplySchema,

    -- * Request Lenses
    applySchema_publishedSchemaArn,
    applySchema_directoryArn,

    -- * Destructuring the Response
    ApplySchemaResponse (..),
    newApplySchemaResponse,

    -- * Response Lenses
    applySchemaResponse_appliedSchemaArn,
    applySchemaResponse_directoryArn,
    applySchemaResponse_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:/ 'newApplySchema' smart constructor.
data ApplySchema = ApplySchema'
  { -- | Published schema Amazon Resource Name (ARN) that needs to be copied. For
    -- more information, see arns.
    ApplySchema -> Text
publishedSchemaArn :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) that is associated with the Directory
    -- into which the schema is copied. For more information, see arns.
    ApplySchema -> Text
directoryArn :: Prelude.Text
  }
  deriving (ApplySchema -> ApplySchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplySchema -> ApplySchema -> Bool
$c/= :: ApplySchema -> ApplySchema -> Bool
== :: ApplySchema -> ApplySchema -> Bool
$c== :: ApplySchema -> ApplySchema -> Bool
Prelude.Eq, ReadPrec [ApplySchema]
ReadPrec ApplySchema
Int -> ReadS ApplySchema
ReadS [ApplySchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplySchema]
$creadListPrec :: ReadPrec [ApplySchema]
readPrec :: ReadPrec ApplySchema
$creadPrec :: ReadPrec ApplySchema
readList :: ReadS [ApplySchema]
$creadList :: ReadS [ApplySchema]
readsPrec :: Int -> ReadS ApplySchema
$creadsPrec :: Int -> ReadS ApplySchema
Prelude.Read, Int -> ApplySchema -> ShowS
[ApplySchema] -> ShowS
ApplySchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplySchema] -> ShowS
$cshowList :: [ApplySchema] -> ShowS
show :: ApplySchema -> String
$cshow :: ApplySchema -> String
showsPrec :: Int -> ApplySchema -> ShowS
$cshowsPrec :: Int -> ApplySchema -> ShowS
Prelude.Show, forall x. Rep ApplySchema x -> ApplySchema
forall x. ApplySchema -> Rep ApplySchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplySchema x -> ApplySchema
$cfrom :: forall x. ApplySchema -> Rep ApplySchema x
Prelude.Generic)

-- |
-- Create a value of 'ApplySchema' 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:
--
-- 'publishedSchemaArn', 'applySchema_publishedSchemaArn' - Published schema Amazon Resource Name (ARN) that needs to be copied. For
-- more information, see arns.
--
-- 'directoryArn', 'applySchema_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory
-- into which the schema is copied. For more information, see arns.
newApplySchema ::
  -- | 'publishedSchemaArn'
  Prelude.Text ->
  -- | 'directoryArn'
  Prelude.Text ->
  ApplySchema
newApplySchema :: Text -> Text -> ApplySchema
newApplySchema Text
pPublishedSchemaArn_ Text
pDirectoryArn_ =
  ApplySchema'
    { $sel:publishedSchemaArn:ApplySchema' :: Text
publishedSchemaArn =
        Text
pPublishedSchemaArn_,
      $sel:directoryArn:ApplySchema' :: Text
directoryArn = Text
pDirectoryArn_
    }

-- | Published schema Amazon Resource Name (ARN) that needs to be copied. For
-- more information, see arns.
applySchema_publishedSchemaArn :: Lens.Lens' ApplySchema Prelude.Text
applySchema_publishedSchemaArn :: Lens' ApplySchema Text
applySchema_publishedSchemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplySchema' {Text
publishedSchemaArn :: Text
$sel:publishedSchemaArn:ApplySchema' :: ApplySchema -> Text
publishedSchemaArn} -> Text
publishedSchemaArn) (\s :: ApplySchema
s@ApplySchema' {} Text
a -> ApplySchema
s {$sel:publishedSchemaArn:ApplySchema' :: Text
publishedSchemaArn = Text
a} :: ApplySchema)

-- | The Amazon Resource Name (ARN) that is associated with the Directory
-- into which the schema is copied. For more information, see arns.
applySchema_directoryArn :: Lens.Lens' ApplySchema Prelude.Text
applySchema_directoryArn :: Lens' ApplySchema Text
applySchema_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplySchema' {Text
directoryArn :: Text
$sel:directoryArn:ApplySchema' :: ApplySchema -> Text
directoryArn} -> Text
directoryArn) (\s :: ApplySchema
s@ApplySchema' {} Text
a -> ApplySchema
s {$sel:directoryArn:ApplySchema' :: Text
directoryArn = Text
a} :: ApplySchema)

instance Core.AWSRequest ApplySchema where
  type AWSResponse ApplySchema = ApplySchemaResponse
  request :: (Service -> Service) -> ApplySchema -> Request ApplySchema
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ApplySchema
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ApplySchema)))
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 -> Maybe Text -> Int -> ApplySchemaResponse
ApplySchemaResponse'
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DirectoryArn")
            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 ApplySchema where
  hashWithSalt :: Int -> ApplySchema -> Int
hashWithSalt Int
_salt ApplySchema' {Text
directoryArn :: Text
publishedSchemaArn :: Text
$sel:directoryArn:ApplySchema' :: ApplySchema -> Text
$sel:publishedSchemaArn:ApplySchema' :: ApplySchema -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
publishedSchemaArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn

instance Prelude.NFData ApplySchema where
  rnf :: ApplySchema -> ()
rnf ApplySchema' {Text
directoryArn :: Text
publishedSchemaArn :: Text
$sel:directoryArn:ApplySchema' :: ApplySchema -> Text
$sel:publishedSchemaArn:ApplySchema' :: ApplySchema -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
publishedSchemaArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryArn

instance Data.ToHeaders ApplySchema where
  toHeaders :: ApplySchema -> ResponseHeaders
toHeaders ApplySchema' {Text
directoryArn :: Text
publishedSchemaArn :: Text
$sel:directoryArn:ApplySchema' :: ApplySchema -> Text
$sel:publishedSchemaArn:ApplySchema' :: ApplySchema -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
directoryArn]

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

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

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

-- | /See:/ 'newApplySchemaResponse' smart constructor.
data ApplySchemaResponse = ApplySchemaResponse'
  { -- | The applied schema ARN that is associated with the copied schema in the
    -- Directory. You can use this ARN to describe the schema information
    -- applied on this directory. For more information, see arns.
    ApplySchemaResponse -> Maybe Text
appliedSchemaArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN that is associated with the Directory. For more information, see
    -- arns.
    ApplySchemaResponse -> Maybe Text
directoryArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ApplySchemaResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ApplySchemaResponse -> ApplySchemaResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplySchemaResponse -> ApplySchemaResponse -> Bool
$c/= :: ApplySchemaResponse -> ApplySchemaResponse -> Bool
== :: ApplySchemaResponse -> ApplySchemaResponse -> Bool
$c== :: ApplySchemaResponse -> ApplySchemaResponse -> Bool
Prelude.Eq, ReadPrec [ApplySchemaResponse]
ReadPrec ApplySchemaResponse
Int -> ReadS ApplySchemaResponse
ReadS [ApplySchemaResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplySchemaResponse]
$creadListPrec :: ReadPrec [ApplySchemaResponse]
readPrec :: ReadPrec ApplySchemaResponse
$creadPrec :: ReadPrec ApplySchemaResponse
readList :: ReadS [ApplySchemaResponse]
$creadList :: ReadS [ApplySchemaResponse]
readsPrec :: Int -> ReadS ApplySchemaResponse
$creadsPrec :: Int -> ReadS ApplySchemaResponse
Prelude.Read, Int -> ApplySchemaResponse -> ShowS
[ApplySchemaResponse] -> ShowS
ApplySchemaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplySchemaResponse] -> ShowS
$cshowList :: [ApplySchemaResponse] -> ShowS
show :: ApplySchemaResponse -> String
$cshow :: ApplySchemaResponse -> String
showsPrec :: Int -> ApplySchemaResponse -> ShowS
$cshowsPrec :: Int -> ApplySchemaResponse -> ShowS
Prelude.Show, forall x. Rep ApplySchemaResponse x -> ApplySchemaResponse
forall x. ApplySchemaResponse -> Rep ApplySchemaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplySchemaResponse x -> ApplySchemaResponse
$cfrom :: forall x. ApplySchemaResponse -> Rep ApplySchemaResponse x
Prelude.Generic)

-- |
-- Create a value of 'ApplySchemaResponse' 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', 'applySchemaResponse_appliedSchemaArn' - The applied schema ARN that is associated with the copied schema in the
-- Directory. You can use this ARN to describe the schema information
-- applied on this directory. For more information, see arns.
--
-- 'directoryArn', 'applySchemaResponse_directoryArn' - The ARN that is associated with the Directory. For more information, see
-- arns.
--
-- 'httpStatus', 'applySchemaResponse_httpStatus' - The response's http status code.
newApplySchemaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ApplySchemaResponse
newApplySchemaResponse :: Int -> ApplySchemaResponse
newApplySchemaResponse Int
pHttpStatus_ =
  ApplySchemaResponse'
    { $sel:appliedSchemaArn:ApplySchemaResponse' :: Maybe Text
appliedSchemaArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:directoryArn:ApplySchemaResponse' :: Maybe Text
directoryArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ApplySchemaResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The applied schema ARN that is associated with the copied schema in the
-- Directory. You can use this ARN to describe the schema information
-- applied on this directory. For more information, see arns.
applySchemaResponse_appliedSchemaArn :: Lens.Lens' ApplySchemaResponse (Prelude.Maybe Prelude.Text)
applySchemaResponse_appliedSchemaArn :: Lens' ApplySchemaResponse (Maybe Text)
applySchemaResponse_appliedSchemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplySchemaResponse' {Maybe Text
appliedSchemaArn :: Maybe Text
$sel:appliedSchemaArn:ApplySchemaResponse' :: ApplySchemaResponse -> Maybe Text
appliedSchemaArn} -> Maybe Text
appliedSchemaArn) (\s :: ApplySchemaResponse
s@ApplySchemaResponse' {} Maybe Text
a -> ApplySchemaResponse
s {$sel:appliedSchemaArn:ApplySchemaResponse' :: Maybe Text
appliedSchemaArn = Maybe Text
a} :: ApplySchemaResponse)

-- | The ARN that is associated with the Directory. For more information, see
-- arns.
applySchemaResponse_directoryArn :: Lens.Lens' ApplySchemaResponse (Prelude.Maybe Prelude.Text)
applySchemaResponse_directoryArn :: Lens' ApplySchemaResponse (Maybe Text)
applySchemaResponse_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ApplySchemaResponse' {Maybe Text
directoryArn :: Maybe Text
$sel:directoryArn:ApplySchemaResponse' :: ApplySchemaResponse -> Maybe Text
directoryArn} -> Maybe Text
directoryArn) (\s :: ApplySchemaResponse
s@ApplySchemaResponse' {} Maybe Text
a -> ApplySchemaResponse
s {$sel:directoryArn:ApplySchemaResponse' :: Maybe Text
directoryArn = Maybe Text
a} :: ApplySchemaResponse)

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

instance Prelude.NFData ApplySchemaResponse where
  rnf :: ApplySchemaResponse -> ()
rnf ApplySchemaResponse' {Int
Maybe Text
httpStatus :: Int
directoryArn :: Maybe Text
appliedSchemaArn :: Maybe Text
$sel:httpStatus:ApplySchemaResponse' :: ApplySchemaResponse -> Int
$sel:directoryArn:ApplySchemaResponse' :: ApplySchemaResponse -> Maybe Text
$sel:appliedSchemaArn:ApplySchemaResponse' :: ApplySchemaResponse -> 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 Maybe Text
directoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus