{-# 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.UnshareDirectory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops the directory sharing between the directory owner and consumer
-- accounts.
module Amazonka.DirectoryService.UnshareDirectory
  ( -- * Creating a Request
    UnshareDirectory (..),
    newUnshareDirectory,

    -- * Request Lenses
    unshareDirectory_directoryId,
    unshareDirectory_unshareTarget,

    -- * Destructuring the Response
    UnshareDirectoryResponse (..),
    newUnshareDirectoryResponse,

    -- * Response Lenses
    unshareDirectoryResponse_sharedDirectoryId,
    unshareDirectoryResponse_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:/ 'newUnshareDirectory' smart constructor.
data UnshareDirectory = UnshareDirectory'
  { -- | The identifier of the Managed Microsoft AD directory that you want to
    -- stop sharing.
    UnshareDirectory -> Text
directoryId :: Prelude.Text,
    -- | Identifier for the directory consumer account with whom the directory
    -- has to be unshared.
    UnshareDirectory -> UnshareTarget
unshareTarget :: UnshareTarget
  }
  deriving (UnshareDirectory -> UnshareDirectory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnshareDirectory -> UnshareDirectory -> Bool
$c/= :: UnshareDirectory -> UnshareDirectory -> Bool
== :: UnshareDirectory -> UnshareDirectory -> Bool
$c== :: UnshareDirectory -> UnshareDirectory -> Bool
Prelude.Eq, ReadPrec [UnshareDirectory]
ReadPrec UnshareDirectory
Int -> ReadS UnshareDirectory
ReadS [UnshareDirectory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnshareDirectory]
$creadListPrec :: ReadPrec [UnshareDirectory]
readPrec :: ReadPrec UnshareDirectory
$creadPrec :: ReadPrec UnshareDirectory
readList :: ReadS [UnshareDirectory]
$creadList :: ReadS [UnshareDirectory]
readsPrec :: Int -> ReadS UnshareDirectory
$creadsPrec :: Int -> ReadS UnshareDirectory
Prelude.Read, Int -> UnshareDirectory -> ShowS
[UnshareDirectory] -> ShowS
UnshareDirectory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnshareDirectory] -> ShowS
$cshowList :: [UnshareDirectory] -> ShowS
show :: UnshareDirectory -> String
$cshow :: UnshareDirectory -> String
showsPrec :: Int -> UnshareDirectory -> ShowS
$cshowsPrec :: Int -> UnshareDirectory -> ShowS
Prelude.Show, forall x. Rep UnshareDirectory x -> UnshareDirectory
forall x. UnshareDirectory -> Rep UnshareDirectory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnshareDirectory x -> UnshareDirectory
$cfrom :: forall x. UnshareDirectory -> Rep UnshareDirectory x
Prelude.Generic)

-- |
-- Create a value of 'UnshareDirectory' 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', 'unshareDirectory_directoryId' - The identifier of the Managed Microsoft AD directory that you want to
-- stop sharing.
--
-- 'unshareTarget', 'unshareDirectory_unshareTarget' - Identifier for the directory consumer account with whom the directory
-- has to be unshared.
newUnshareDirectory ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'unshareTarget'
  UnshareTarget ->
  UnshareDirectory
newUnshareDirectory :: Text -> UnshareTarget -> UnshareDirectory
newUnshareDirectory Text
pDirectoryId_ UnshareTarget
pUnshareTarget_ =
  UnshareDirectory'
    { $sel:directoryId:UnshareDirectory' :: Text
directoryId = Text
pDirectoryId_,
      $sel:unshareTarget:UnshareDirectory' :: UnshareTarget
unshareTarget = UnshareTarget
pUnshareTarget_
    }

-- | The identifier of the Managed Microsoft AD directory that you want to
-- stop sharing.
unshareDirectory_directoryId :: Lens.Lens' UnshareDirectory Prelude.Text
unshareDirectory_directoryId :: Lens' UnshareDirectory Text
unshareDirectory_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnshareDirectory' {Text
directoryId :: Text
$sel:directoryId:UnshareDirectory' :: UnshareDirectory -> Text
directoryId} -> Text
directoryId) (\s :: UnshareDirectory
s@UnshareDirectory' {} Text
a -> UnshareDirectory
s {$sel:directoryId:UnshareDirectory' :: Text
directoryId = Text
a} :: UnshareDirectory)

-- | Identifier for the directory consumer account with whom the directory
-- has to be unshared.
unshareDirectory_unshareTarget :: Lens.Lens' UnshareDirectory UnshareTarget
unshareDirectory_unshareTarget :: Lens' UnshareDirectory UnshareTarget
unshareDirectory_unshareTarget = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnshareDirectory' {UnshareTarget
unshareTarget :: UnshareTarget
$sel:unshareTarget:UnshareDirectory' :: UnshareDirectory -> UnshareTarget
unshareTarget} -> UnshareTarget
unshareTarget) (\s :: UnshareDirectory
s@UnshareDirectory' {} UnshareTarget
a -> UnshareDirectory
s {$sel:unshareTarget:UnshareDirectory' :: UnshareTarget
unshareTarget = UnshareTarget
a} :: UnshareDirectory)

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

instance Prelude.NFData UnshareDirectory where
  rnf :: UnshareDirectory -> ()
rnf UnshareDirectory' {Text
UnshareTarget
unshareTarget :: UnshareTarget
directoryId :: Text
$sel:unshareTarget:UnshareDirectory' :: UnshareDirectory -> UnshareTarget
$sel:directoryId:UnshareDirectory' :: UnshareDirectory -> 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 UnshareTarget
unshareTarget

instance Data.ToHeaders UnshareDirectory where
  toHeaders :: UnshareDirectory -> 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.UnshareDirectory" ::
                          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 UnshareDirectory where
  toJSON :: UnshareDirectory -> Value
toJSON UnshareDirectory' {Text
UnshareTarget
unshareTarget :: UnshareTarget
directoryId :: Text
$sel:unshareTarget:UnshareDirectory' :: UnshareDirectory -> UnshareTarget
$sel:directoryId:UnshareDirectory' :: UnshareDirectory -> 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
"UnshareTarget" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UnshareTarget
unshareTarget)
          ]
      )

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

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

-- | /See:/ 'newUnshareDirectoryResponse' smart constructor.
data UnshareDirectoryResponse = UnshareDirectoryResponse'
  { -- | Identifier of the directory stored in the directory consumer account
    -- that is to be unshared from the specified directory (@DirectoryId@).
    UnshareDirectoryResponse -> Maybe Text
sharedDirectoryId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UnshareDirectoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UnshareDirectoryResponse -> UnshareDirectoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnshareDirectoryResponse -> UnshareDirectoryResponse -> Bool
$c/= :: UnshareDirectoryResponse -> UnshareDirectoryResponse -> Bool
== :: UnshareDirectoryResponse -> UnshareDirectoryResponse -> Bool
$c== :: UnshareDirectoryResponse -> UnshareDirectoryResponse -> Bool
Prelude.Eq, ReadPrec [UnshareDirectoryResponse]
ReadPrec UnshareDirectoryResponse
Int -> ReadS UnshareDirectoryResponse
ReadS [UnshareDirectoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnshareDirectoryResponse]
$creadListPrec :: ReadPrec [UnshareDirectoryResponse]
readPrec :: ReadPrec UnshareDirectoryResponse
$creadPrec :: ReadPrec UnshareDirectoryResponse
readList :: ReadS [UnshareDirectoryResponse]
$creadList :: ReadS [UnshareDirectoryResponse]
readsPrec :: Int -> ReadS UnshareDirectoryResponse
$creadsPrec :: Int -> ReadS UnshareDirectoryResponse
Prelude.Read, Int -> UnshareDirectoryResponse -> ShowS
[UnshareDirectoryResponse] -> ShowS
UnshareDirectoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnshareDirectoryResponse] -> ShowS
$cshowList :: [UnshareDirectoryResponse] -> ShowS
show :: UnshareDirectoryResponse -> String
$cshow :: UnshareDirectoryResponse -> String
showsPrec :: Int -> UnshareDirectoryResponse -> ShowS
$cshowsPrec :: Int -> UnshareDirectoryResponse -> ShowS
Prelude.Show, forall x.
Rep UnshareDirectoryResponse x -> UnshareDirectoryResponse
forall x.
UnshareDirectoryResponse -> Rep UnshareDirectoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UnshareDirectoryResponse x -> UnshareDirectoryResponse
$cfrom :: forall x.
UnshareDirectoryResponse -> Rep UnshareDirectoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'UnshareDirectoryResponse' 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:
--
-- 'sharedDirectoryId', 'unshareDirectoryResponse_sharedDirectoryId' - Identifier of the directory stored in the directory consumer account
-- that is to be unshared from the specified directory (@DirectoryId@).
--
-- 'httpStatus', 'unshareDirectoryResponse_httpStatus' - The response's http status code.
newUnshareDirectoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UnshareDirectoryResponse
newUnshareDirectoryResponse :: Int -> UnshareDirectoryResponse
newUnshareDirectoryResponse Int
pHttpStatus_ =
  UnshareDirectoryResponse'
    { $sel:sharedDirectoryId:UnshareDirectoryResponse' :: Maybe Text
sharedDirectoryId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UnshareDirectoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Identifier of the directory stored in the directory consumer account
-- that is to be unshared from the specified directory (@DirectoryId@).
unshareDirectoryResponse_sharedDirectoryId :: Lens.Lens' UnshareDirectoryResponse (Prelude.Maybe Prelude.Text)
unshareDirectoryResponse_sharedDirectoryId :: Lens' UnshareDirectoryResponse (Maybe Text)
unshareDirectoryResponse_sharedDirectoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UnshareDirectoryResponse' {Maybe Text
sharedDirectoryId :: Maybe Text
$sel:sharedDirectoryId:UnshareDirectoryResponse' :: UnshareDirectoryResponse -> Maybe Text
sharedDirectoryId} -> Maybe Text
sharedDirectoryId) (\s :: UnshareDirectoryResponse
s@UnshareDirectoryResponse' {} Maybe Text
a -> UnshareDirectoryResponse
s {$sel:sharedDirectoryId:UnshareDirectoryResponse' :: Maybe Text
sharedDirectoryId = Maybe Text
a} :: UnshareDirectoryResponse)

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

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