{-# 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.DetachObject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Detaches a given object from the parent object. The object that is to be
-- detached from the parent is specified by the link name.
module Amazonka.CloudDirectory.DetachObject
  ( -- * Creating a Request
    DetachObject (..),
    newDetachObject,

    -- * Request Lenses
    detachObject_directoryArn,
    detachObject_parentReference,
    detachObject_linkName,

    -- * Destructuring the Response
    DetachObjectResponse (..),
    newDetachObjectResponse,

    -- * Response Lenses
    detachObjectResponse_detachedObjectIdentifier,
    detachObjectResponse_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:/ 'newDetachObject' smart constructor.
data DetachObject = DetachObject'
  { -- | The Amazon Resource Name (ARN) that is associated with the Directory
    -- where objects reside. For more information, see arns.
    DetachObject -> Text
directoryArn :: Prelude.Text,
    -- | The parent reference from which the object with the specified link name
    -- is detached.
    DetachObject -> ObjectReference
parentReference :: ObjectReference,
    -- | The link name associated with the object that needs to be detached.
    DetachObject -> Text
linkName :: Prelude.Text
  }
  deriving (DetachObject -> DetachObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetachObject -> DetachObject -> Bool
$c/= :: DetachObject -> DetachObject -> Bool
== :: DetachObject -> DetachObject -> Bool
$c== :: DetachObject -> DetachObject -> Bool
Prelude.Eq, ReadPrec [DetachObject]
ReadPrec DetachObject
Int -> ReadS DetachObject
ReadS [DetachObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DetachObject]
$creadListPrec :: ReadPrec [DetachObject]
readPrec :: ReadPrec DetachObject
$creadPrec :: ReadPrec DetachObject
readList :: ReadS [DetachObject]
$creadList :: ReadS [DetachObject]
readsPrec :: Int -> ReadS DetachObject
$creadsPrec :: Int -> ReadS DetachObject
Prelude.Read, Int -> DetachObject -> ShowS
[DetachObject] -> ShowS
DetachObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetachObject] -> ShowS
$cshowList :: [DetachObject] -> ShowS
show :: DetachObject -> String
$cshow :: DetachObject -> String
showsPrec :: Int -> DetachObject -> ShowS
$cshowsPrec :: Int -> DetachObject -> ShowS
Prelude.Show, forall x. Rep DetachObject x -> DetachObject
forall x. DetachObject -> Rep DetachObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetachObject x -> DetachObject
$cfrom :: forall x. DetachObject -> Rep DetachObject x
Prelude.Generic)

-- |
-- Create a value of 'DetachObject' 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', 'detachObject_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory
-- where objects reside. For more information, see arns.
--
-- 'parentReference', 'detachObject_parentReference' - The parent reference from which the object with the specified link name
-- is detached.
--
-- 'linkName', 'detachObject_linkName' - The link name associated with the object that needs to be detached.
newDetachObject ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'parentReference'
  ObjectReference ->
  -- | 'linkName'
  Prelude.Text ->
  DetachObject
newDetachObject :: Text -> ObjectReference -> Text -> DetachObject
newDetachObject
  Text
pDirectoryArn_
  ObjectReference
pParentReference_
  Text
pLinkName_ =
    DetachObject'
      { $sel:directoryArn:DetachObject' :: Text
directoryArn = Text
pDirectoryArn_,
        $sel:parentReference:DetachObject' :: ObjectReference
parentReference = ObjectReference
pParentReference_,
        $sel:linkName:DetachObject' :: Text
linkName = Text
pLinkName_
      }

-- | The Amazon Resource Name (ARN) that is associated with the Directory
-- where objects reside. For more information, see arns.
detachObject_directoryArn :: Lens.Lens' DetachObject Prelude.Text
detachObject_directoryArn :: Lens' DetachObject Text
detachObject_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachObject' {Text
directoryArn :: Text
$sel:directoryArn:DetachObject' :: DetachObject -> Text
directoryArn} -> Text
directoryArn) (\s :: DetachObject
s@DetachObject' {} Text
a -> DetachObject
s {$sel:directoryArn:DetachObject' :: Text
directoryArn = Text
a} :: DetachObject)

-- | The parent reference from which the object with the specified link name
-- is detached.
detachObject_parentReference :: Lens.Lens' DetachObject ObjectReference
detachObject_parentReference :: Lens' DetachObject ObjectReference
detachObject_parentReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachObject' {ObjectReference
parentReference :: ObjectReference
$sel:parentReference:DetachObject' :: DetachObject -> ObjectReference
parentReference} -> ObjectReference
parentReference) (\s :: DetachObject
s@DetachObject' {} ObjectReference
a -> DetachObject
s {$sel:parentReference:DetachObject' :: ObjectReference
parentReference = ObjectReference
a} :: DetachObject)

-- | The link name associated with the object that needs to be detached.
detachObject_linkName :: Lens.Lens' DetachObject Prelude.Text
detachObject_linkName :: Lens' DetachObject Text
detachObject_linkName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachObject' {Text
linkName :: Text
$sel:linkName:DetachObject' :: DetachObject -> Text
linkName} -> Text
linkName) (\s :: DetachObject
s@DetachObject' {} Text
a -> DetachObject
s {$sel:linkName:DetachObject' :: Text
linkName = Text
a} :: DetachObject)

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

instance Prelude.NFData DetachObject where
  rnf :: DetachObject -> ()
rnf DetachObject' {Text
ObjectReference
linkName :: Text
parentReference :: ObjectReference
directoryArn :: Text
$sel:linkName:DetachObject' :: DetachObject -> Text
$sel:parentReference:DetachObject' :: DetachObject -> ObjectReference
$sel:directoryArn:DetachObject' :: DetachObject -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectReference
parentReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
linkName

instance Data.ToHeaders DetachObject where
  toHeaders :: DetachObject -> ResponseHeaders
toHeaders DetachObject' {Text
ObjectReference
linkName :: Text
parentReference :: ObjectReference
directoryArn :: Text
$sel:linkName:DetachObject' :: DetachObject -> Text
$sel:parentReference:DetachObject' :: DetachObject -> ObjectReference
$sel:directoryArn:DetachObject' :: DetachObject -> 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 DetachObject where
  toJSON :: DetachObject -> Value
toJSON DetachObject' {Text
ObjectReference
linkName :: Text
parentReference :: ObjectReference
directoryArn :: Text
$sel:linkName:DetachObject' :: DetachObject -> Text
$sel:parentReference:DetachObject' :: DetachObject -> ObjectReference
$sel:directoryArn:DetachObject' :: DetachObject -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ParentReference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
parentReference),
            forall a. a -> Maybe a
Prelude.Just (Key
"LinkName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
linkName)
          ]
      )

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

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

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

-- |
-- Create a value of 'DetachObjectResponse' 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:
--
-- 'detachedObjectIdentifier', 'detachObjectResponse_detachedObjectIdentifier' - The @ObjectIdentifier@ that was detached from the object.
--
-- 'httpStatus', 'detachObjectResponse_httpStatus' - The response's http status code.
newDetachObjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DetachObjectResponse
newDetachObjectResponse :: Int -> DetachObjectResponse
newDetachObjectResponse Int
pHttpStatus_ =
  DetachObjectResponse'
    { $sel:detachedObjectIdentifier:DetachObjectResponse' :: Maybe Text
detachedObjectIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DetachObjectResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @ObjectIdentifier@ that was detached from the object.
detachObjectResponse_detachedObjectIdentifier :: Lens.Lens' DetachObjectResponse (Prelude.Maybe Prelude.Text)
detachObjectResponse_detachedObjectIdentifier :: Lens' DetachObjectResponse (Maybe Text)
detachObjectResponse_detachedObjectIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DetachObjectResponse' {Maybe Text
detachedObjectIdentifier :: Maybe Text
$sel:detachedObjectIdentifier:DetachObjectResponse' :: DetachObjectResponse -> Maybe Text
detachedObjectIdentifier} -> Maybe Text
detachedObjectIdentifier) (\s :: DetachObjectResponse
s@DetachObjectResponse' {} Maybe Text
a -> DetachObjectResponse
s {$sel:detachedObjectIdentifier:DetachObjectResponse' :: Maybe Text
detachedObjectIdentifier = Maybe Text
a} :: DetachObjectResponse)

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

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