{-# 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.DisableDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables the specified directory. Disabled directories cannot be read or
-- written to. Only enabled directories can be disabled. Disabled
-- directories may be reenabled.
module Amazonka.CloudDirectory.DisableDirectory
  ( -- * Creating a Request
    DisableDirectory (..),
    newDisableDirectory,

    -- * Request Lenses
    disableDirectory_directoryArn,

    -- * Destructuring the Response
    DisableDirectoryResponse (..),
    newDisableDirectoryResponse,

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

-- |
-- Create a value of 'DisableDirectory' 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', 'disableDirectory_directoryArn' - The ARN of the directory to disable.
newDisableDirectory ::
  -- | 'directoryArn'
  Prelude.Text ->
  DisableDirectory
newDisableDirectory :: Text -> DisableDirectory
newDisableDirectory Text
pDirectoryArn_ =
  DisableDirectory' {$sel:directoryArn:DisableDirectory' :: Text
directoryArn = Text
pDirectoryArn_}

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

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

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

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

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

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

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

-- |
-- Create a value of 'DisableDirectoryResponse' 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', 'disableDirectoryResponse_httpStatus' - The response's http status code.
--
-- 'directoryArn', 'disableDirectoryResponse_directoryArn' - The ARN of the directory that has been disabled.
newDisableDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'directoryArn'
  Prelude.Text ->
  DisableDirectoryResponse
newDisableDirectoryResponse :: Int -> Text -> DisableDirectoryResponse
newDisableDirectoryResponse
  Int
pHttpStatus_
  Text
pDirectoryArn_ =
    DisableDirectoryResponse'
      { $sel:httpStatus:DisableDirectoryResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:directoryArn:DisableDirectoryResponse' :: Text
directoryArn = Text
pDirectoryArn_
      }

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

-- | The ARN of the directory that has been disabled.
disableDirectoryResponse_directoryArn :: Lens.Lens' DisableDirectoryResponse Prelude.Text
disableDirectoryResponse_directoryArn :: Lens' DisableDirectoryResponse Text
disableDirectoryResponse_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DisableDirectoryResponse' {Text
directoryArn :: Text
$sel:directoryArn:DisableDirectoryResponse' :: DisableDirectoryResponse -> Text
directoryArn} -> Text
directoryArn) (\s :: DisableDirectoryResponse
s@DisableDirectoryResponse' {} Text
a -> DisableDirectoryResponse
s {$sel:directoryArn:DisableDirectoryResponse' :: Text
directoryArn = Text
a} :: DisableDirectoryResponse)

instance Prelude.NFData DisableDirectoryResponse where
  rnf :: DisableDirectoryResponse -> ()
rnf DisableDirectoryResponse' {Int
Text
directoryArn :: Text
httpStatus :: Int
$sel:directoryArn:DisableDirectoryResponse' :: DisableDirectoryResponse -> Text
$sel:httpStatus:DisableDirectoryResponse' :: DisableDirectoryResponse -> 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