{-# 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.DeleteDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a directory. Only disabled directories can be deleted. A deleted
-- directory cannot be undone. Exercise extreme caution when deleting
-- directories.
module Amazonka.CloudDirectory.DeleteDirectory
  ( -- * Creating a Request
    DeleteDirectory (..),
    newDeleteDirectory,

    -- * Request Lenses
    deleteDirectory_directoryArn,

    -- * Destructuring the Response
    DeleteDirectoryResponse (..),
    newDeleteDirectoryResponse,

    -- * Response Lenses
    deleteDirectoryResponse_httpStatus,
    deleteDirectoryResponse_directoryArn,
  )
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:/ 'newDeleteDirectory' smart constructor.
data DeleteDirectory = DeleteDirectory'
  { -- | The ARN of the directory to delete.
    DeleteDirectory -> Text
directoryArn :: Prelude.Text
  }
  deriving (DeleteDirectory -> DeleteDirectory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDirectory -> DeleteDirectory -> Bool
$c/= :: DeleteDirectory -> DeleteDirectory -> Bool
== :: DeleteDirectory -> DeleteDirectory -> Bool
$c== :: DeleteDirectory -> DeleteDirectory -> Bool
Prelude.Eq, ReadPrec [DeleteDirectory]
ReadPrec DeleteDirectory
Int -> ReadS DeleteDirectory
ReadS [DeleteDirectory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDirectory]
$creadListPrec :: ReadPrec [DeleteDirectory]
readPrec :: ReadPrec DeleteDirectory
$creadPrec :: ReadPrec DeleteDirectory
readList :: ReadS [DeleteDirectory]
$creadList :: ReadS [DeleteDirectory]
readsPrec :: Int -> ReadS DeleteDirectory
$creadsPrec :: Int -> ReadS DeleteDirectory
Prelude.Read, Int -> DeleteDirectory -> ShowS
[DeleteDirectory] -> ShowS
DeleteDirectory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDirectory] -> ShowS
$cshowList :: [DeleteDirectory] -> ShowS
show :: DeleteDirectory -> String
$cshow :: DeleteDirectory -> String
showsPrec :: Int -> DeleteDirectory -> ShowS
$cshowsPrec :: Int -> DeleteDirectory -> ShowS
Prelude.Show, forall x. Rep DeleteDirectory x -> DeleteDirectory
forall x. DeleteDirectory -> Rep DeleteDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDirectory x -> DeleteDirectory
$cfrom :: forall x. DeleteDirectory -> Rep DeleteDirectory x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDirectory' 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', 'deleteDirectory_directoryArn' - The ARN of the directory to delete.
newDeleteDirectory ::
  -- | 'directoryArn'
  Prelude.Text ->
  DeleteDirectory
newDeleteDirectory :: Text -> DeleteDirectory
newDeleteDirectory Text
pDirectoryArn_ =
  DeleteDirectory' {$sel:directoryArn:DeleteDirectory' :: Text
directoryArn = Text
pDirectoryArn_}

-- | The ARN of the directory to delete.
deleteDirectory_directoryArn :: Lens.Lens' DeleteDirectory Prelude.Text
deleteDirectory_directoryArn :: Lens' DeleteDirectory Text
deleteDirectory_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDirectory' {Text
directoryArn :: Text
$sel:directoryArn:DeleteDirectory' :: DeleteDirectory -> Text
directoryArn} -> Text
directoryArn) (\s :: DeleteDirectory
s@DeleteDirectory' {} Text
a -> DeleteDirectory
s {$sel:directoryArn:DeleteDirectory' :: Text
directoryArn = Text
a} :: DeleteDirectory)

instance Core.AWSRequest DeleteDirectory where
  type
    AWSResponse DeleteDirectory =
      DeleteDirectoryResponse
  request :: (Service -> Service) -> DeleteDirectory -> Request DeleteDirectory
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 DeleteDirectory
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteDirectory)))
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 ->
          Int -> Text -> DeleteDirectoryResponse
DeleteDirectoryResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"DirectoryArn")
      )

instance Prelude.Hashable DeleteDirectory where
  hashWithSalt :: Int -> DeleteDirectory -> Int
hashWithSalt Int
_salt DeleteDirectory' {Text
directoryArn :: Text
$sel:directoryArn:DeleteDirectory' :: DeleteDirectory -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn

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

instance Data.ToHeaders DeleteDirectory where
  toHeaders :: DeleteDirectory -> ResponseHeaders
toHeaders DeleteDirectory' {Text
directoryArn :: Text
$sel:directoryArn:DeleteDirectory' :: DeleteDirectory -> 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 DeleteDirectory where
  toJSON :: DeleteDirectory -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

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

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

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

-- |
-- Create a value of 'DeleteDirectoryResponse' 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', 'deleteDirectoryResponse_httpStatus' - The response's http status code.
--
-- 'directoryArn', 'deleteDirectoryResponse_directoryArn' - The ARN of the deleted directory.
newDeleteDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'directoryArn'
  Prelude.Text ->
  DeleteDirectoryResponse
newDeleteDirectoryResponse :: Int -> Text -> DeleteDirectoryResponse
newDeleteDirectoryResponse
  Int
pHttpStatus_
  Text
pDirectoryArn_ =
    DeleteDirectoryResponse'
      { $sel:httpStatus:DeleteDirectoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:directoryArn:DeleteDirectoryResponse' :: Text
directoryArn = Text
pDirectoryArn_
      }

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

-- | The ARN of the deleted directory.
deleteDirectoryResponse_directoryArn :: Lens.Lens' DeleteDirectoryResponse Prelude.Text
deleteDirectoryResponse_directoryArn :: Lens' DeleteDirectoryResponse Text
deleteDirectoryResponse_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDirectoryResponse' {Text
directoryArn :: Text
$sel:directoryArn:DeleteDirectoryResponse' :: DeleteDirectoryResponse -> Text
directoryArn} -> Text
directoryArn) (\s :: DeleteDirectoryResponse
s@DeleteDirectoryResponse' {} Text
a -> DeleteDirectoryResponse
s {$sel:directoryArn:DeleteDirectoryResponse' :: Text
directoryArn = Text
a} :: DeleteDirectoryResponse)

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