{-# 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.FSx.DeleteDataRepositoryAssociation
-- 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 data repository association on an Amazon FSx for Lustre file
-- system. Deleting the data repository association unlinks the file system
-- from the Amazon S3 bucket. When deleting a data repository association,
-- you have the option of deleting the data in the file system that
-- corresponds to the data repository association. Data repository
-- associations are supported only for file systems with the @Persistent_2@
-- deployment type.
module Amazonka.FSx.DeleteDataRepositoryAssociation
  ( -- * Creating a Request
    DeleteDataRepositoryAssociation (..),
    newDeleteDataRepositoryAssociation,

    -- * Request Lenses
    deleteDataRepositoryAssociation_clientRequestToken,
    deleteDataRepositoryAssociation_deleteDataInFileSystem,
    deleteDataRepositoryAssociation_associationId,

    -- * Destructuring the Response
    DeleteDataRepositoryAssociationResponse (..),
    newDeleteDataRepositoryAssociationResponse,

    -- * Response Lenses
    deleteDataRepositoryAssociationResponse_associationId,
    deleteDataRepositoryAssociationResponse_deleteDataInFileSystem,
    deleteDataRepositoryAssociationResponse_lifecycle,
    deleteDataRepositoryAssociationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteDataRepositoryAssociation' smart constructor.
data DeleteDataRepositoryAssociation = DeleteDataRepositoryAssociation'
  { DeleteDataRepositoryAssociation -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Set to @true@ to delete the data in the file system that corresponds to
    -- the data repository association.
    DeleteDataRepositoryAssociation -> Maybe Bool
deleteDataInFileSystem :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the data repository association that you want to delete.
    DeleteDataRepositoryAssociation -> Text
associationId :: Prelude.Text
  }
  deriving (DeleteDataRepositoryAssociation
-> DeleteDataRepositoryAssociation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDataRepositoryAssociation
-> DeleteDataRepositoryAssociation -> Bool
$c/= :: DeleteDataRepositoryAssociation
-> DeleteDataRepositoryAssociation -> Bool
== :: DeleteDataRepositoryAssociation
-> DeleteDataRepositoryAssociation -> Bool
$c== :: DeleteDataRepositoryAssociation
-> DeleteDataRepositoryAssociation -> Bool
Prelude.Eq, ReadPrec [DeleteDataRepositoryAssociation]
ReadPrec DeleteDataRepositoryAssociation
Int -> ReadS DeleteDataRepositoryAssociation
ReadS [DeleteDataRepositoryAssociation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDataRepositoryAssociation]
$creadListPrec :: ReadPrec [DeleteDataRepositoryAssociation]
readPrec :: ReadPrec DeleteDataRepositoryAssociation
$creadPrec :: ReadPrec DeleteDataRepositoryAssociation
readList :: ReadS [DeleteDataRepositoryAssociation]
$creadList :: ReadS [DeleteDataRepositoryAssociation]
readsPrec :: Int -> ReadS DeleteDataRepositoryAssociation
$creadsPrec :: Int -> ReadS DeleteDataRepositoryAssociation
Prelude.Read, Int -> DeleteDataRepositoryAssociation -> ShowS
[DeleteDataRepositoryAssociation] -> ShowS
DeleteDataRepositoryAssociation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDataRepositoryAssociation] -> ShowS
$cshowList :: [DeleteDataRepositoryAssociation] -> ShowS
show :: DeleteDataRepositoryAssociation -> String
$cshow :: DeleteDataRepositoryAssociation -> String
showsPrec :: Int -> DeleteDataRepositoryAssociation -> ShowS
$cshowsPrec :: Int -> DeleteDataRepositoryAssociation -> ShowS
Prelude.Show, forall x.
Rep DeleteDataRepositoryAssociation x
-> DeleteDataRepositoryAssociation
forall x.
DeleteDataRepositoryAssociation
-> Rep DeleteDataRepositoryAssociation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteDataRepositoryAssociation x
-> DeleteDataRepositoryAssociation
$cfrom :: forall x.
DeleteDataRepositoryAssociation
-> Rep DeleteDataRepositoryAssociation x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDataRepositoryAssociation' 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:
--
-- 'clientRequestToken', 'deleteDataRepositoryAssociation_clientRequestToken' - Undocumented member.
--
-- 'deleteDataInFileSystem', 'deleteDataRepositoryAssociation_deleteDataInFileSystem' - Set to @true@ to delete the data in the file system that corresponds to
-- the data repository association.
--
-- 'associationId', 'deleteDataRepositoryAssociation_associationId' - The ID of the data repository association that you want to delete.
newDeleteDataRepositoryAssociation ::
  -- | 'associationId'
  Prelude.Text ->
  DeleteDataRepositoryAssociation
newDeleteDataRepositoryAssociation :: Text -> DeleteDataRepositoryAssociation
newDeleteDataRepositoryAssociation Text
pAssociationId_ =
  DeleteDataRepositoryAssociation'
    { $sel:clientRequestToken:DeleteDataRepositoryAssociation' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: Maybe Bool
deleteDataInFileSystem = forall a. Maybe a
Prelude.Nothing,
      $sel:associationId:DeleteDataRepositoryAssociation' :: Text
associationId = Text
pAssociationId_
    }

-- | Undocumented member.
deleteDataRepositoryAssociation_clientRequestToken :: Lens.Lens' DeleteDataRepositoryAssociation (Prelude.Maybe Prelude.Text)
deleteDataRepositoryAssociation_clientRequestToken :: Lens' DeleteDataRepositoryAssociation (Maybe Text)
deleteDataRepositoryAssociation_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociation' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: DeleteDataRepositoryAssociation
s@DeleteDataRepositoryAssociation' {} Maybe Text
a -> DeleteDataRepositoryAssociation
s {$sel:clientRequestToken:DeleteDataRepositoryAssociation' :: Maybe Text
clientRequestToken = Maybe Text
a} :: DeleteDataRepositoryAssociation)

-- | Set to @true@ to delete the data in the file system that corresponds to
-- the data repository association.
deleteDataRepositoryAssociation_deleteDataInFileSystem :: Lens.Lens' DeleteDataRepositoryAssociation (Prelude.Maybe Prelude.Bool)
deleteDataRepositoryAssociation_deleteDataInFileSystem :: Lens' DeleteDataRepositoryAssociation (Maybe Bool)
deleteDataRepositoryAssociation_deleteDataInFileSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociation' {Maybe Bool
deleteDataInFileSystem :: Maybe Bool
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Bool
deleteDataInFileSystem} -> Maybe Bool
deleteDataInFileSystem) (\s :: DeleteDataRepositoryAssociation
s@DeleteDataRepositoryAssociation' {} Maybe Bool
a -> DeleteDataRepositoryAssociation
s {$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: Maybe Bool
deleteDataInFileSystem = Maybe Bool
a} :: DeleteDataRepositoryAssociation)

-- | The ID of the data repository association that you want to delete.
deleteDataRepositoryAssociation_associationId :: Lens.Lens' DeleteDataRepositoryAssociation Prelude.Text
deleteDataRepositoryAssociation_associationId :: Lens' DeleteDataRepositoryAssociation Text
deleteDataRepositoryAssociation_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociation' {Text
associationId :: Text
$sel:associationId:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Text
associationId} -> Text
associationId) (\s :: DeleteDataRepositoryAssociation
s@DeleteDataRepositoryAssociation' {} Text
a -> DeleteDataRepositoryAssociation
s {$sel:associationId:DeleteDataRepositoryAssociation' :: Text
associationId = Text
a} :: DeleteDataRepositoryAssociation)

instance
  Core.AWSRequest
    DeleteDataRepositoryAssociation
  where
  type
    AWSResponse DeleteDataRepositoryAssociation =
      DeleteDataRepositoryAssociationResponse
  request :: (Service -> Service)
-> DeleteDataRepositoryAssociation
-> Request DeleteDataRepositoryAssociation
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 DeleteDataRepositoryAssociation
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DeleteDataRepositoryAssociation)))
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
-> Maybe Bool
-> Maybe DataRepositoryLifecycle
-> Int
-> DeleteDataRepositoryAssociationResponse
DeleteDataRepositoryAssociationResponse'
            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
"AssociationId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DeleteDataInFileSystem")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Lifecycle")
            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
    DeleteDataRepositoryAssociation
  where
  hashWithSalt :: Int -> DeleteDataRepositoryAssociation -> Int
hashWithSalt
    Int
_salt
    DeleteDataRepositoryAssociation' {Maybe Bool
Maybe Text
Text
associationId :: Text
deleteDataInFileSystem :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:associationId:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Text
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Bool
$sel:clientRequestToken:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deleteDataInFileSystem
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
associationId

instance
  Prelude.NFData
    DeleteDataRepositoryAssociation
  where
  rnf :: DeleteDataRepositoryAssociation -> ()
rnf DeleteDataRepositoryAssociation' {Maybe Bool
Maybe Text
Text
associationId :: Text
deleteDataInFileSystem :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:associationId:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Text
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Bool
$sel:clientRequestToken:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteDataInFileSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
associationId

instance
  Data.ToHeaders
    DeleteDataRepositoryAssociation
  where
  toHeaders :: DeleteDataRepositoryAssociation -> 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
"AWSSimbaAPIService_v20180301.DeleteDataRepositoryAssociation" ::
                          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 DeleteDataRepositoryAssociation where
  toJSON :: DeleteDataRepositoryAssociation -> Value
toJSON DeleteDataRepositoryAssociation' {Maybe Bool
Maybe Text
Text
associationId :: Text
deleteDataInFileSystem :: Maybe Bool
clientRequestToken :: Maybe Text
$sel:associationId:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Text
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Bool
$sel:clientRequestToken:DeleteDataRepositoryAssociation' :: DeleteDataRepositoryAssociation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
clientRequestToken,
            (Key
"DeleteDataInFileSystem" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
deleteDataInFileSystem,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AssociationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
associationId)
          ]
      )

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

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

-- | /See:/ 'newDeleteDataRepositoryAssociationResponse' smart constructor.
data DeleteDataRepositoryAssociationResponse = DeleteDataRepositoryAssociationResponse'
  { -- | The ID of the data repository association being deleted.
    DeleteDataRepositoryAssociationResponse -> Maybe Text
associationId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether data in the file system that corresponds to the data
    -- repository association is being deleted. Default is @false@.
    DeleteDataRepositoryAssociationResponse -> Maybe Bool
deleteDataInFileSystem :: Prelude.Maybe Prelude.Bool,
    -- | Describes the lifecycle state of the data repository association being
    -- deleted.
    DeleteDataRepositoryAssociationResponse
-> Maybe DataRepositoryLifecycle
lifecycle :: Prelude.Maybe DataRepositoryLifecycle,
    -- | The response's http status code.
    DeleteDataRepositoryAssociationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteDataRepositoryAssociationResponse
-> DeleteDataRepositoryAssociationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDataRepositoryAssociationResponse
-> DeleteDataRepositoryAssociationResponse -> Bool
$c/= :: DeleteDataRepositoryAssociationResponse
-> DeleteDataRepositoryAssociationResponse -> Bool
== :: DeleteDataRepositoryAssociationResponse
-> DeleteDataRepositoryAssociationResponse -> Bool
$c== :: DeleteDataRepositoryAssociationResponse
-> DeleteDataRepositoryAssociationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteDataRepositoryAssociationResponse]
ReadPrec DeleteDataRepositoryAssociationResponse
Int -> ReadS DeleteDataRepositoryAssociationResponse
ReadS [DeleteDataRepositoryAssociationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDataRepositoryAssociationResponse]
$creadListPrec :: ReadPrec [DeleteDataRepositoryAssociationResponse]
readPrec :: ReadPrec DeleteDataRepositoryAssociationResponse
$creadPrec :: ReadPrec DeleteDataRepositoryAssociationResponse
readList :: ReadS [DeleteDataRepositoryAssociationResponse]
$creadList :: ReadS [DeleteDataRepositoryAssociationResponse]
readsPrec :: Int -> ReadS DeleteDataRepositoryAssociationResponse
$creadsPrec :: Int -> ReadS DeleteDataRepositoryAssociationResponse
Prelude.Read, Int -> DeleteDataRepositoryAssociationResponse -> ShowS
[DeleteDataRepositoryAssociationResponse] -> ShowS
DeleteDataRepositoryAssociationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDataRepositoryAssociationResponse] -> ShowS
$cshowList :: [DeleteDataRepositoryAssociationResponse] -> ShowS
show :: DeleteDataRepositoryAssociationResponse -> String
$cshow :: DeleteDataRepositoryAssociationResponse -> String
showsPrec :: Int -> DeleteDataRepositoryAssociationResponse -> ShowS
$cshowsPrec :: Int -> DeleteDataRepositoryAssociationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteDataRepositoryAssociationResponse x
-> DeleteDataRepositoryAssociationResponse
forall x.
DeleteDataRepositoryAssociationResponse
-> Rep DeleteDataRepositoryAssociationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteDataRepositoryAssociationResponse x
-> DeleteDataRepositoryAssociationResponse
$cfrom :: forall x.
DeleteDataRepositoryAssociationResponse
-> Rep DeleteDataRepositoryAssociationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDataRepositoryAssociationResponse' 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:
--
-- 'associationId', 'deleteDataRepositoryAssociationResponse_associationId' - The ID of the data repository association being deleted.
--
-- 'deleteDataInFileSystem', 'deleteDataRepositoryAssociationResponse_deleteDataInFileSystem' - Indicates whether data in the file system that corresponds to the data
-- repository association is being deleted. Default is @false@.
--
-- 'lifecycle', 'deleteDataRepositoryAssociationResponse_lifecycle' - Describes the lifecycle state of the data repository association being
-- deleted.
--
-- 'httpStatus', 'deleteDataRepositoryAssociationResponse_httpStatus' - The response's http status code.
newDeleteDataRepositoryAssociationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteDataRepositoryAssociationResponse
newDeleteDataRepositoryAssociationResponse :: Int -> DeleteDataRepositoryAssociationResponse
newDeleteDataRepositoryAssociationResponse
  Int
pHttpStatus_ =
    DeleteDataRepositoryAssociationResponse'
      { $sel:associationId:DeleteDataRepositoryAssociationResponse' :: Maybe Text
associationId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:deleteDataInFileSystem:DeleteDataRepositoryAssociationResponse' :: Maybe Bool
deleteDataInFileSystem =
          forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycle:DeleteDataRepositoryAssociationResponse' :: Maybe DataRepositoryLifecycle
lifecycle = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DeleteDataRepositoryAssociationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The ID of the data repository association being deleted.
deleteDataRepositoryAssociationResponse_associationId :: Lens.Lens' DeleteDataRepositoryAssociationResponse (Prelude.Maybe Prelude.Text)
deleteDataRepositoryAssociationResponse_associationId :: Lens' DeleteDataRepositoryAssociationResponse (Maybe Text)
deleteDataRepositoryAssociationResponse_associationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociationResponse' {Maybe Text
associationId :: Maybe Text
$sel:associationId:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse -> Maybe Text
associationId} -> Maybe Text
associationId) (\s :: DeleteDataRepositoryAssociationResponse
s@DeleteDataRepositoryAssociationResponse' {} Maybe Text
a -> DeleteDataRepositoryAssociationResponse
s {$sel:associationId:DeleteDataRepositoryAssociationResponse' :: Maybe Text
associationId = Maybe Text
a} :: DeleteDataRepositoryAssociationResponse)

-- | Indicates whether data in the file system that corresponds to the data
-- repository association is being deleted. Default is @false@.
deleteDataRepositoryAssociationResponse_deleteDataInFileSystem :: Lens.Lens' DeleteDataRepositoryAssociationResponse (Prelude.Maybe Prelude.Bool)
deleteDataRepositoryAssociationResponse_deleteDataInFileSystem :: Lens' DeleteDataRepositoryAssociationResponse (Maybe Bool)
deleteDataRepositoryAssociationResponse_deleteDataInFileSystem = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociationResponse' {Maybe Bool
deleteDataInFileSystem :: Maybe Bool
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse -> Maybe Bool
deleteDataInFileSystem} -> Maybe Bool
deleteDataInFileSystem) (\s :: DeleteDataRepositoryAssociationResponse
s@DeleteDataRepositoryAssociationResponse' {} Maybe Bool
a -> DeleteDataRepositoryAssociationResponse
s {$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociationResponse' :: Maybe Bool
deleteDataInFileSystem = Maybe Bool
a} :: DeleteDataRepositoryAssociationResponse)

-- | Describes the lifecycle state of the data repository association being
-- deleted.
deleteDataRepositoryAssociationResponse_lifecycle :: Lens.Lens' DeleteDataRepositoryAssociationResponse (Prelude.Maybe DataRepositoryLifecycle)
deleteDataRepositoryAssociationResponse_lifecycle :: Lens'
  DeleteDataRepositoryAssociationResponse
  (Maybe DataRepositoryLifecycle)
deleteDataRepositoryAssociationResponse_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataRepositoryAssociationResponse' {Maybe DataRepositoryLifecycle
lifecycle :: Maybe DataRepositoryLifecycle
$sel:lifecycle:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse
-> Maybe DataRepositoryLifecycle
lifecycle} -> Maybe DataRepositoryLifecycle
lifecycle) (\s :: DeleteDataRepositoryAssociationResponse
s@DeleteDataRepositoryAssociationResponse' {} Maybe DataRepositoryLifecycle
a -> DeleteDataRepositoryAssociationResponse
s {$sel:lifecycle:DeleteDataRepositoryAssociationResponse' :: Maybe DataRepositoryLifecycle
lifecycle = Maybe DataRepositoryLifecycle
a} :: DeleteDataRepositoryAssociationResponse)

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

instance
  Prelude.NFData
    DeleteDataRepositoryAssociationResponse
  where
  rnf :: DeleteDataRepositoryAssociationResponse -> ()
rnf DeleteDataRepositoryAssociationResponse' {Int
Maybe Bool
Maybe Text
Maybe DataRepositoryLifecycle
httpStatus :: Int
lifecycle :: Maybe DataRepositoryLifecycle
deleteDataInFileSystem :: Maybe Bool
associationId :: Maybe Text
$sel:httpStatus:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse -> Int
$sel:lifecycle:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse
-> Maybe DataRepositoryLifecycle
$sel:deleteDataInFileSystem:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse -> Maybe Bool
$sel:associationId:DeleteDataRepositoryAssociationResponse' :: DeleteDataRepositoryAssociationResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
associationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteDataInFileSystem
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataRepositoryLifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus