{-# 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.UpgradeAppliedSchema
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Upgrades a single directory in-place using the @PublishedSchemaArn@ with
-- schema updates found in @MinorVersion@. Backwards-compatible minor
-- version upgrades are instantaneously available for readers on all
-- objects in the directory. Note: This is a synchronous API call and
-- upgrades only one schema on a given directory per call. To upgrade
-- multiple directories from one schema, you would need to call this API on
-- each directory.
module Amazonka.CloudDirectory.UpgradeAppliedSchema
  ( -- * Creating a Request
    UpgradeAppliedSchema (..),
    newUpgradeAppliedSchema,

    -- * Request Lenses
    upgradeAppliedSchema_dryRun,
    upgradeAppliedSchema_publishedSchemaArn,
    upgradeAppliedSchema_directoryArn,

    -- * Destructuring the Response
    UpgradeAppliedSchemaResponse (..),
    newUpgradeAppliedSchemaResponse,

    -- * Response Lenses
    upgradeAppliedSchemaResponse_directoryArn,
    upgradeAppliedSchemaResponse_upgradedSchemaArn,
    upgradeAppliedSchemaResponse_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:/ 'newUpgradeAppliedSchema' smart constructor.
data UpgradeAppliedSchema = UpgradeAppliedSchema'
  { -- | Used for testing whether the major version schemas are backward
    -- compatible or not. If schema compatibility fails, an exception would be
    -- thrown else the call would succeed but no changes will be saved. This
    -- parameter is optional.
    UpgradeAppliedSchema -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The revision of the published schema to upgrade the directory to.
    UpgradeAppliedSchema -> Text
publishedSchemaArn :: Prelude.Text,
    -- | The ARN for the directory to which the upgraded schema will be applied.
    UpgradeAppliedSchema -> Text
directoryArn :: Prelude.Text
  }
  deriving (UpgradeAppliedSchema -> UpgradeAppliedSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpgradeAppliedSchema -> UpgradeAppliedSchema -> Bool
$c/= :: UpgradeAppliedSchema -> UpgradeAppliedSchema -> Bool
== :: UpgradeAppliedSchema -> UpgradeAppliedSchema -> Bool
$c== :: UpgradeAppliedSchema -> UpgradeAppliedSchema -> Bool
Prelude.Eq, ReadPrec [UpgradeAppliedSchema]
ReadPrec UpgradeAppliedSchema
Int -> ReadS UpgradeAppliedSchema
ReadS [UpgradeAppliedSchema]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpgradeAppliedSchema]
$creadListPrec :: ReadPrec [UpgradeAppliedSchema]
readPrec :: ReadPrec UpgradeAppliedSchema
$creadPrec :: ReadPrec UpgradeAppliedSchema
readList :: ReadS [UpgradeAppliedSchema]
$creadList :: ReadS [UpgradeAppliedSchema]
readsPrec :: Int -> ReadS UpgradeAppliedSchema
$creadsPrec :: Int -> ReadS UpgradeAppliedSchema
Prelude.Read, Int -> UpgradeAppliedSchema -> ShowS
[UpgradeAppliedSchema] -> ShowS
UpgradeAppliedSchema -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpgradeAppliedSchema] -> ShowS
$cshowList :: [UpgradeAppliedSchema] -> ShowS
show :: UpgradeAppliedSchema -> String
$cshow :: UpgradeAppliedSchema -> String
showsPrec :: Int -> UpgradeAppliedSchema -> ShowS
$cshowsPrec :: Int -> UpgradeAppliedSchema -> ShowS
Prelude.Show, forall x. Rep UpgradeAppliedSchema x -> UpgradeAppliedSchema
forall x. UpgradeAppliedSchema -> Rep UpgradeAppliedSchema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpgradeAppliedSchema x -> UpgradeAppliedSchema
$cfrom :: forall x. UpgradeAppliedSchema -> Rep UpgradeAppliedSchema x
Prelude.Generic)

-- |
-- Create a value of 'UpgradeAppliedSchema' 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:
--
-- 'dryRun', 'upgradeAppliedSchema_dryRun' - Used for testing whether the major version schemas are backward
-- compatible or not. If schema compatibility fails, an exception would be
-- thrown else the call would succeed but no changes will be saved. This
-- parameter is optional.
--
-- 'publishedSchemaArn', 'upgradeAppliedSchema_publishedSchemaArn' - The revision of the published schema to upgrade the directory to.
--
-- 'directoryArn', 'upgradeAppliedSchema_directoryArn' - The ARN for the directory to which the upgraded schema will be applied.
newUpgradeAppliedSchema ::
  -- | 'publishedSchemaArn'
  Prelude.Text ->
  -- | 'directoryArn'
  Prelude.Text ->
  UpgradeAppliedSchema
newUpgradeAppliedSchema :: Text -> Text -> UpgradeAppliedSchema
newUpgradeAppliedSchema
  Text
pPublishedSchemaArn_
  Text
pDirectoryArn_ =
    UpgradeAppliedSchema'
      { $sel:dryRun:UpgradeAppliedSchema' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
        $sel:publishedSchemaArn:UpgradeAppliedSchema' :: Text
publishedSchemaArn = Text
pPublishedSchemaArn_,
        $sel:directoryArn:UpgradeAppliedSchema' :: Text
directoryArn = Text
pDirectoryArn_
      }

-- | Used for testing whether the major version schemas are backward
-- compatible or not. If schema compatibility fails, an exception would be
-- thrown else the call would succeed but no changes will be saved. This
-- parameter is optional.
upgradeAppliedSchema_dryRun :: Lens.Lens' UpgradeAppliedSchema (Prelude.Maybe Prelude.Bool)
upgradeAppliedSchema_dryRun :: Lens' UpgradeAppliedSchema (Maybe Bool)
upgradeAppliedSchema_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpgradeAppliedSchema' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: UpgradeAppliedSchema
s@UpgradeAppliedSchema' {} Maybe Bool
a -> UpgradeAppliedSchema
s {$sel:dryRun:UpgradeAppliedSchema' :: Maybe Bool
dryRun = Maybe Bool
a} :: UpgradeAppliedSchema)

-- | The revision of the published schema to upgrade the directory to.
upgradeAppliedSchema_publishedSchemaArn :: Lens.Lens' UpgradeAppliedSchema Prelude.Text
upgradeAppliedSchema_publishedSchemaArn :: Lens' UpgradeAppliedSchema Text
upgradeAppliedSchema_publishedSchemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpgradeAppliedSchema' {Text
publishedSchemaArn :: Text
$sel:publishedSchemaArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
publishedSchemaArn} -> Text
publishedSchemaArn) (\s :: UpgradeAppliedSchema
s@UpgradeAppliedSchema' {} Text
a -> UpgradeAppliedSchema
s {$sel:publishedSchemaArn:UpgradeAppliedSchema' :: Text
publishedSchemaArn = Text
a} :: UpgradeAppliedSchema)

-- | The ARN for the directory to which the upgraded schema will be applied.
upgradeAppliedSchema_directoryArn :: Lens.Lens' UpgradeAppliedSchema Prelude.Text
upgradeAppliedSchema_directoryArn :: Lens' UpgradeAppliedSchema Text
upgradeAppliedSchema_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpgradeAppliedSchema' {Text
directoryArn :: Text
$sel:directoryArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
directoryArn} -> Text
directoryArn) (\s :: UpgradeAppliedSchema
s@UpgradeAppliedSchema' {} Text
a -> UpgradeAppliedSchema
s {$sel:directoryArn:UpgradeAppliedSchema' :: Text
directoryArn = Text
a} :: UpgradeAppliedSchema)

instance Core.AWSRequest UpgradeAppliedSchema where
  type
    AWSResponse UpgradeAppliedSchema =
      UpgradeAppliedSchemaResponse
  request :: (Service -> Service)
-> UpgradeAppliedSchema -> Request UpgradeAppliedSchema
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 UpgradeAppliedSchema
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpgradeAppliedSchema)))
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 -> UpgradeAppliedSchemaResponse
UpgradeAppliedSchemaResponse'
            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
"DirectoryArn")
            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
"UpgradedSchemaArn")
            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 UpgradeAppliedSchema where
  hashWithSalt :: Int -> UpgradeAppliedSchema -> Int
hashWithSalt Int
_salt UpgradeAppliedSchema' {Maybe Bool
Text
directoryArn :: Text
publishedSchemaArn :: Text
dryRun :: Maybe Bool
$sel:directoryArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:publishedSchemaArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:dryRun:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      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 UpgradeAppliedSchema where
  rnf :: UpgradeAppliedSchema -> ()
rnf UpgradeAppliedSchema' {Maybe Bool
Text
directoryArn :: Text
publishedSchemaArn :: Text
dryRun :: Maybe Bool
$sel:directoryArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:publishedSchemaArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:dryRun:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 UpgradeAppliedSchema where
  toHeaders :: UpgradeAppliedSchema -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpgradeAppliedSchema where
  toJSON :: UpgradeAppliedSchema -> Value
toJSON UpgradeAppliedSchema' {Maybe Bool
Text
directoryArn :: Text
publishedSchemaArn :: Text
dryRun :: Maybe Bool
$sel:directoryArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:publishedSchemaArn:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Text
$sel:dryRun:UpgradeAppliedSchema' :: UpgradeAppliedSchema -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DryRun" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
dryRun,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PublishedSchemaArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
publishedSchemaArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryArn)
          ]
      )

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

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

-- | /See:/ 'newUpgradeAppliedSchemaResponse' smart constructor.
data UpgradeAppliedSchemaResponse = UpgradeAppliedSchemaResponse'
  { -- | The ARN of the directory that is returned as part of the response.
    UpgradeAppliedSchemaResponse -> Maybe Text
directoryArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the upgraded schema that is returned as part of the response.
    UpgradeAppliedSchemaResponse -> Maybe Text
upgradedSchemaArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpgradeAppliedSchemaResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpgradeAppliedSchemaResponse
-> UpgradeAppliedSchemaResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpgradeAppliedSchemaResponse
-> UpgradeAppliedSchemaResponse -> Bool
$c/= :: UpgradeAppliedSchemaResponse
-> UpgradeAppliedSchemaResponse -> Bool
== :: UpgradeAppliedSchemaResponse
-> UpgradeAppliedSchemaResponse -> Bool
$c== :: UpgradeAppliedSchemaResponse
-> UpgradeAppliedSchemaResponse -> Bool
Prelude.Eq, ReadPrec [UpgradeAppliedSchemaResponse]
ReadPrec UpgradeAppliedSchemaResponse
Int -> ReadS UpgradeAppliedSchemaResponse
ReadS [UpgradeAppliedSchemaResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpgradeAppliedSchemaResponse]
$creadListPrec :: ReadPrec [UpgradeAppliedSchemaResponse]
readPrec :: ReadPrec UpgradeAppliedSchemaResponse
$creadPrec :: ReadPrec UpgradeAppliedSchemaResponse
readList :: ReadS [UpgradeAppliedSchemaResponse]
$creadList :: ReadS [UpgradeAppliedSchemaResponse]
readsPrec :: Int -> ReadS UpgradeAppliedSchemaResponse
$creadsPrec :: Int -> ReadS UpgradeAppliedSchemaResponse
Prelude.Read, Int -> UpgradeAppliedSchemaResponse -> ShowS
[UpgradeAppliedSchemaResponse] -> ShowS
UpgradeAppliedSchemaResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpgradeAppliedSchemaResponse] -> ShowS
$cshowList :: [UpgradeAppliedSchemaResponse] -> ShowS
show :: UpgradeAppliedSchemaResponse -> String
$cshow :: UpgradeAppliedSchemaResponse -> String
showsPrec :: Int -> UpgradeAppliedSchemaResponse -> ShowS
$cshowsPrec :: Int -> UpgradeAppliedSchemaResponse -> ShowS
Prelude.Show, forall x.
Rep UpgradeAppliedSchemaResponse x -> UpgradeAppliedSchemaResponse
forall x.
UpgradeAppliedSchemaResponse -> Rep UpgradeAppliedSchemaResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpgradeAppliedSchemaResponse x -> UpgradeAppliedSchemaResponse
$cfrom :: forall x.
UpgradeAppliedSchemaResponse -> Rep UpgradeAppliedSchemaResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpgradeAppliedSchemaResponse' 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:
--
-- 'directoryArn', 'upgradeAppliedSchemaResponse_directoryArn' - The ARN of the directory that is returned as part of the response.
--
-- 'upgradedSchemaArn', 'upgradeAppliedSchemaResponse_upgradedSchemaArn' - The ARN of the upgraded schema that is returned as part of the response.
--
-- 'httpStatus', 'upgradeAppliedSchemaResponse_httpStatus' - The response's http status code.
newUpgradeAppliedSchemaResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpgradeAppliedSchemaResponse
newUpgradeAppliedSchemaResponse :: Int -> UpgradeAppliedSchemaResponse
newUpgradeAppliedSchemaResponse Int
pHttpStatus_ =
  UpgradeAppliedSchemaResponse'
    { $sel:directoryArn:UpgradeAppliedSchemaResponse' :: Maybe Text
directoryArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:upgradedSchemaArn:UpgradeAppliedSchemaResponse' :: Maybe Text
upgradedSchemaArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpgradeAppliedSchemaResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the directory that is returned as part of the response.
upgradeAppliedSchemaResponse_directoryArn :: Lens.Lens' UpgradeAppliedSchemaResponse (Prelude.Maybe Prelude.Text)
upgradeAppliedSchemaResponse_directoryArn :: Lens' UpgradeAppliedSchemaResponse (Maybe Text)
upgradeAppliedSchemaResponse_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpgradeAppliedSchemaResponse' {Maybe Text
directoryArn :: Maybe Text
$sel:directoryArn:UpgradeAppliedSchemaResponse' :: UpgradeAppliedSchemaResponse -> Maybe Text
directoryArn} -> Maybe Text
directoryArn) (\s :: UpgradeAppliedSchemaResponse
s@UpgradeAppliedSchemaResponse' {} Maybe Text
a -> UpgradeAppliedSchemaResponse
s {$sel:directoryArn:UpgradeAppliedSchemaResponse' :: Maybe Text
directoryArn = Maybe Text
a} :: UpgradeAppliedSchemaResponse)

-- | The ARN of the upgraded schema that is returned as part of the response.
upgradeAppliedSchemaResponse_upgradedSchemaArn :: Lens.Lens' UpgradeAppliedSchemaResponse (Prelude.Maybe Prelude.Text)
upgradeAppliedSchemaResponse_upgradedSchemaArn :: Lens' UpgradeAppliedSchemaResponse (Maybe Text)
upgradeAppliedSchemaResponse_upgradedSchemaArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpgradeAppliedSchemaResponse' {Maybe Text
upgradedSchemaArn :: Maybe Text
$sel:upgradedSchemaArn:UpgradeAppliedSchemaResponse' :: UpgradeAppliedSchemaResponse -> Maybe Text
upgradedSchemaArn} -> Maybe Text
upgradedSchemaArn) (\s :: UpgradeAppliedSchemaResponse
s@UpgradeAppliedSchemaResponse' {} Maybe Text
a -> UpgradeAppliedSchemaResponse
s {$sel:upgradedSchemaArn:UpgradeAppliedSchemaResponse' :: Maybe Text
upgradedSchemaArn = Maybe Text
a} :: UpgradeAppliedSchemaResponse)

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

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