{-# 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.DirectoryService.CancelSchemaExtension
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels an in-progress schema extension to a Microsoft AD directory.
-- Once a schema extension has started replicating to all domain
-- controllers, the task can no longer be canceled. A schema extension can
-- be canceled during any of the following states; @Initializing@,
-- @CreatingSnapshot@, and @UpdatingSchema@.
module Amazonka.DirectoryService.CancelSchemaExtension
  ( -- * Creating a Request
    CancelSchemaExtension (..),
    newCancelSchemaExtension,

    -- * Request Lenses
    cancelSchemaExtension_directoryId,
    cancelSchemaExtension_schemaExtensionId,

    -- * Destructuring the Response
    CancelSchemaExtensionResponse (..),
    newCancelSchemaExtensionResponse,

    -- * Response Lenses
    cancelSchemaExtensionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCancelSchemaExtension' smart constructor.
data CancelSchemaExtension = CancelSchemaExtension'
  { -- | The identifier of the directory whose schema extension will be canceled.
    CancelSchemaExtension -> Text
directoryId :: Prelude.Text,
    -- | The identifier of the schema extension that will be canceled.
    CancelSchemaExtension -> Text
schemaExtensionId :: Prelude.Text
  }
  deriving (CancelSchemaExtension -> CancelSchemaExtension -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelSchemaExtension -> CancelSchemaExtension -> Bool
$c/= :: CancelSchemaExtension -> CancelSchemaExtension -> Bool
== :: CancelSchemaExtension -> CancelSchemaExtension -> Bool
$c== :: CancelSchemaExtension -> CancelSchemaExtension -> Bool
Prelude.Eq, ReadPrec [CancelSchemaExtension]
ReadPrec CancelSchemaExtension
Int -> ReadS CancelSchemaExtension
ReadS [CancelSchemaExtension]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelSchemaExtension]
$creadListPrec :: ReadPrec [CancelSchemaExtension]
readPrec :: ReadPrec CancelSchemaExtension
$creadPrec :: ReadPrec CancelSchemaExtension
readList :: ReadS [CancelSchemaExtension]
$creadList :: ReadS [CancelSchemaExtension]
readsPrec :: Int -> ReadS CancelSchemaExtension
$creadsPrec :: Int -> ReadS CancelSchemaExtension
Prelude.Read, Int -> CancelSchemaExtension -> ShowS
[CancelSchemaExtension] -> ShowS
CancelSchemaExtension -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelSchemaExtension] -> ShowS
$cshowList :: [CancelSchemaExtension] -> ShowS
show :: CancelSchemaExtension -> String
$cshow :: CancelSchemaExtension -> String
showsPrec :: Int -> CancelSchemaExtension -> ShowS
$cshowsPrec :: Int -> CancelSchemaExtension -> ShowS
Prelude.Show, forall x. Rep CancelSchemaExtension x -> CancelSchemaExtension
forall x. CancelSchemaExtension -> Rep CancelSchemaExtension x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelSchemaExtension x -> CancelSchemaExtension
$cfrom :: forall x. CancelSchemaExtension -> Rep CancelSchemaExtension x
Prelude.Generic)

-- |
-- Create a value of 'CancelSchemaExtension' 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:
--
-- 'directoryId', 'cancelSchemaExtension_directoryId' - The identifier of the directory whose schema extension will be canceled.
--
-- 'schemaExtensionId', 'cancelSchemaExtension_schemaExtensionId' - The identifier of the schema extension that will be canceled.
newCancelSchemaExtension ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'schemaExtensionId'
  Prelude.Text ->
  CancelSchemaExtension
newCancelSchemaExtension :: Text -> Text -> CancelSchemaExtension
newCancelSchemaExtension
  Text
pDirectoryId_
  Text
pSchemaExtensionId_ =
    CancelSchemaExtension'
      { $sel:directoryId:CancelSchemaExtension' :: Text
directoryId = Text
pDirectoryId_,
        $sel:schemaExtensionId:CancelSchemaExtension' :: Text
schemaExtensionId = Text
pSchemaExtensionId_
      }

-- | The identifier of the directory whose schema extension will be canceled.
cancelSchemaExtension_directoryId :: Lens.Lens' CancelSchemaExtension Prelude.Text
cancelSchemaExtension_directoryId :: Lens' CancelSchemaExtension Text
cancelSchemaExtension_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelSchemaExtension' {Text
directoryId :: Text
$sel:directoryId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
directoryId} -> Text
directoryId) (\s :: CancelSchemaExtension
s@CancelSchemaExtension' {} Text
a -> CancelSchemaExtension
s {$sel:directoryId:CancelSchemaExtension' :: Text
directoryId = Text
a} :: CancelSchemaExtension)

-- | The identifier of the schema extension that will be canceled.
cancelSchemaExtension_schemaExtensionId :: Lens.Lens' CancelSchemaExtension Prelude.Text
cancelSchemaExtension_schemaExtensionId :: Lens' CancelSchemaExtension Text
cancelSchemaExtension_schemaExtensionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelSchemaExtension' {Text
schemaExtensionId :: Text
$sel:schemaExtensionId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
schemaExtensionId} -> Text
schemaExtensionId) (\s :: CancelSchemaExtension
s@CancelSchemaExtension' {} Text
a -> CancelSchemaExtension
s {$sel:schemaExtensionId:CancelSchemaExtension' :: Text
schemaExtensionId = Text
a} :: CancelSchemaExtension)

instance Core.AWSRequest CancelSchemaExtension where
  type
    AWSResponse CancelSchemaExtension =
      CancelSchemaExtensionResponse
  request :: (Service -> Service)
-> CancelSchemaExtension -> Request CancelSchemaExtension
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 CancelSchemaExtension
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CancelSchemaExtension)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> CancelSchemaExtensionResponse
CancelSchemaExtensionResponse'
            forall (f :: * -> *) a b. Functor 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 CancelSchemaExtension where
  hashWithSalt :: Int -> CancelSchemaExtension -> Int
hashWithSalt Int
_salt CancelSchemaExtension' {Text
schemaExtensionId :: Text
directoryId :: Text
$sel:schemaExtensionId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
$sel:directoryId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaExtensionId

instance Prelude.NFData CancelSchemaExtension where
  rnf :: CancelSchemaExtension -> ()
rnf CancelSchemaExtension' {Text
schemaExtensionId :: Text
directoryId :: Text
$sel:schemaExtensionId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
$sel:directoryId:CancelSchemaExtension' :: CancelSchemaExtension -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaExtensionId

instance Data.ToHeaders CancelSchemaExtension where
  toHeaders :: CancelSchemaExtension -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DirectoryService_20150416.CancelSchemaExtension" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance Data.ToPath CancelSchemaExtension where
  toPath :: CancelSchemaExtension -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CancelSchemaExtensionResponse' 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:
--
-- 'httpStatus', 'cancelSchemaExtensionResponse_httpStatus' - The response's http status code.
newCancelSchemaExtensionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelSchemaExtensionResponse
newCancelSchemaExtensionResponse :: Int -> CancelSchemaExtensionResponse
newCancelSchemaExtensionResponse Int
pHttpStatus_ =
  CancelSchemaExtensionResponse'
    { $sel:httpStatus:CancelSchemaExtensionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData CancelSchemaExtensionResponse where
  rnf :: CancelSchemaExtensionResponse -> ()
rnf CancelSchemaExtensionResponse' {Int
httpStatus :: Int
$sel:httpStatus:CancelSchemaExtensionResponse' :: CancelSchemaExtensionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus