{-# 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.Backup.CancelLegalHold
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action removes the specified legal hold on a recovery point. This
-- action can only be performed by a user with sufficient permissions.
module Amazonka.Backup.CancelLegalHold
  ( -- * Creating a Request
    CancelLegalHold (..),
    newCancelLegalHold,

    -- * Request Lenses
    cancelLegalHold_retainRecordInDays,
    cancelLegalHold_legalHoldId,
    cancelLegalHold_cancelDescription,

    -- * Destructuring the Response
    CancelLegalHoldResponse (..),
    newCancelLegalHoldResponse,

    -- * Response Lenses
    cancelLegalHoldResponse_httpStatus,
  )
where

import Amazonka.Backup.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:/ 'newCancelLegalHold' smart constructor.
data CancelLegalHold = CancelLegalHold'
  { -- | The integer amount in days specifying amount of days after this API
    -- operation to remove legal hold.
    CancelLegalHold -> Maybe Integer
retainRecordInDays :: Prelude.Maybe Prelude.Integer,
    -- | Legal hold ID required to remove the specified legal hold on a recovery
    -- point.
    CancelLegalHold -> Text
legalHoldId :: Prelude.Text,
    -- | String describing the reason for removing the legal hold.
    CancelLegalHold -> Text
cancelDescription :: Prelude.Text
  }
  deriving (CancelLegalHold -> CancelLegalHold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelLegalHold -> CancelLegalHold -> Bool
$c/= :: CancelLegalHold -> CancelLegalHold -> Bool
== :: CancelLegalHold -> CancelLegalHold -> Bool
$c== :: CancelLegalHold -> CancelLegalHold -> Bool
Prelude.Eq, ReadPrec [CancelLegalHold]
ReadPrec CancelLegalHold
Int -> ReadS CancelLegalHold
ReadS [CancelLegalHold]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelLegalHold]
$creadListPrec :: ReadPrec [CancelLegalHold]
readPrec :: ReadPrec CancelLegalHold
$creadPrec :: ReadPrec CancelLegalHold
readList :: ReadS [CancelLegalHold]
$creadList :: ReadS [CancelLegalHold]
readsPrec :: Int -> ReadS CancelLegalHold
$creadsPrec :: Int -> ReadS CancelLegalHold
Prelude.Read, Int -> CancelLegalHold -> ShowS
[CancelLegalHold] -> ShowS
CancelLegalHold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelLegalHold] -> ShowS
$cshowList :: [CancelLegalHold] -> ShowS
show :: CancelLegalHold -> String
$cshow :: CancelLegalHold -> String
showsPrec :: Int -> CancelLegalHold -> ShowS
$cshowsPrec :: Int -> CancelLegalHold -> ShowS
Prelude.Show, forall x. Rep CancelLegalHold x -> CancelLegalHold
forall x. CancelLegalHold -> Rep CancelLegalHold x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelLegalHold x -> CancelLegalHold
$cfrom :: forall x. CancelLegalHold -> Rep CancelLegalHold x
Prelude.Generic)

-- |
-- Create a value of 'CancelLegalHold' 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:
--
-- 'retainRecordInDays', 'cancelLegalHold_retainRecordInDays' - The integer amount in days specifying amount of days after this API
-- operation to remove legal hold.
--
-- 'legalHoldId', 'cancelLegalHold_legalHoldId' - Legal hold ID required to remove the specified legal hold on a recovery
-- point.
--
-- 'cancelDescription', 'cancelLegalHold_cancelDescription' - String describing the reason for removing the legal hold.
newCancelLegalHold ::
  -- | 'legalHoldId'
  Prelude.Text ->
  -- | 'cancelDescription'
  Prelude.Text ->
  CancelLegalHold
newCancelLegalHold :: Text -> Text -> CancelLegalHold
newCancelLegalHold Text
pLegalHoldId_ Text
pCancelDescription_ =
  CancelLegalHold'
    { $sel:retainRecordInDays:CancelLegalHold' :: Maybe Integer
retainRecordInDays =
        forall a. Maybe a
Prelude.Nothing,
      $sel:legalHoldId:CancelLegalHold' :: Text
legalHoldId = Text
pLegalHoldId_,
      $sel:cancelDescription:CancelLegalHold' :: Text
cancelDescription = Text
pCancelDescription_
    }

-- | The integer amount in days specifying amount of days after this API
-- operation to remove legal hold.
cancelLegalHold_retainRecordInDays :: Lens.Lens' CancelLegalHold (Prelude.Maybe Prelude.Integer)
cancelLegalHold_retainRecordInDays :: Lens' CancelLegalHold (Maybe Integer)
cancelLegalHold_retainRecordInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelLegalHold' {Maybe Integer
retainRecordInDays :: Maybe Integer
$sel:retainRecordInDays:CancelLegalHold' :: CancelLegalHold -> Maybe Integer
retainRecordInDays} -> Maybe Integer
retainRecordInDays) (\s :: CancelLegalHold
s@CancelLegalHold' {} Maybe Integer
a -> CancelLegalHold
s {$sel:retainRecordInDays:CancelLegalHold' :: Maybe Integer
retainRecordInDays = Maybe Integer
a} :: CancelLegalHold)

-- | Legal hold ID required to remove the specified legal hold on a recovery
-- point.
cancelLegalHold_legalHoldId :: Lens.Lens' CancelLegalHold Prelude.Text
cancelLegalHold_legalHoldId :: Lens' CancelLegalHold Text
cancelLegalHold_legalHoldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelLegalHold' {Text
legalHoldId :: Text
$sel:legalHoldId:CancelLegalHold' :: CancelLegalHold -> Text
legalHoldId} -> Text
legalHoldId) (\s :: CancelLegalHold
s@CancelLegalHold' {} Text
a -> CancelLegalHold
s {$sel:legalHoldId:CancelLegalHold' :: Text
legalHoldId = Text
a} :: CancelLegalHold)

-- | String describing the reason for removing the legal hold.
cancelLegalHold_cancelDescription :: Lens.Lens' CancelLegalHold Prelude.Text
cancelLegalHold_cancelDescription :: Lens' CancelLegalHold Text
cancelLegalHold_cancelDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelLegalHold' {Text
cancelDescription :: Text
$sel:cancelDescription:CancelLegalHold' :: CancelLegalHold -> Text
cancelDescription} -> Text
cancelDescription) (\s :: CancelLegalHold
s@CancelLegalHold' {} Text
a -> CancelLegalHold
s {$sel:cancelDescription:CancelLegalHold' :: Text
cancelDescription = Text
a} :: CancelLegalHold)

instance Core.AWSRequest CancelLegalHold where
  type
    AWSResponse CancelLegalHold =
      CancelLegalHoldResponse
  request :: (Service -> Service) -> CancelLegalHold -> Request CancelLegalHold
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CancelLegalHold
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelLegalHold)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> CancelLegalHoldResponse
CancelLegalHoldResponse'
            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))
      )

instance Prelude.Hashable CancelLegalHold where
  hashWithSalt :: Int -> CancelLegalHold -> Int
hashWithSalt Int
_salt CancelLegalHold' {Maybe Integer
Text
cancelDescription :: Text
legalHoldId :: Text
retainRecordInDays :: Maybe Integer
$sel:cancelDescription:CancelLegalHold' :: CancelLegalHold -> Text
$sel:legalHoldId:CancelLegalHold' :: CancelLegalHold -> Text
$sel:retainRecordInDays:CancelLegalHold' :: CancelLegalHold -> Maybe Integer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
retainRecordInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
legalHoldId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cancelDescription

instance Prelude.NFData CancelLegalHold where
  rnf :: CancelLegalHold -> ()
rnf CancelLegalHold' {Maybe Integer
Text
cancelDescription :: Text
legalHoldId :: Text
retainRecordInDays :: Maybe Integer
$sel:cancelDescription:CancelLegalHold' :: CancelLegalHold -> Text
$sel:legalHoldId:CancelLegalHold' :: CancelLegalHold -> Text
$sel:retainRecordInDays:CancelLegalHold' :: CancelLegalHold -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
retainRecordInDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
legalHoldId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
cancelDescription

instance Data.ToHeaders CancelLegalHold where
  toHeaders :: CancelLegalHold -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath CancelLegalHold where
  toPath :: CancelLegalHold -> ByteString
toPath CancelLegalHold' {Maybe Integer
Text
cancelDescription :: Text
legalHoldId :: Text
retainRecordInDays :: Maybe Integer
$sel:cancelDescription:CancelLegalHold' :: CancelLegalHold -> Text
$sel:legalHoldId:CancelLegalHold' :: CancelLegalHold -> Text
$sel:retainRecordInDays:CancelLegalHold' :: CancelLegalHold -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/legal-holds/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
legalHoldId]

instance Data.ToQuery CancelLegalHold where
  toQuery :: CancelLegalHold -> QueryString
toQuery CancelLegalHold' {Maybe Integer
Text
cancelDescription :: Text
legalHoldId :: Text
retainRecordInDays :: Maybe Integer
$sel:cancelDescription:CancelLegalHold' :: CancelLegalHold -> Text
$sel:legalHoldId:CancelLegalHold' :: CancelLegalHold -> Text
$sel:retainRecordInDays:CancelLegalHold' :: CancelLegalHold -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"retainRecordInDays" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Integer
retainRecordInDays,
        ByteString
"cancelDescription" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cancelDescription
      ]

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

-- |
-- Create a value of 'CancelLegalHoldResponse' 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', 'cancelLegalHoldResponse_httpStatus' - The response's http status code.
newCancelLegalHoldResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelLegalHoldResponse
newCancelLegalHoldResponse :: Int -> CancelLegalHoldResponse
newCancelLegalHoldResponse Int
pHttpStatus_ =
  CancelLegalHoldResponse' {$sel:httpStatus:CancelLegalHoldResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData CancelLegalHoldResponse where
  rnf :: CancelLegalHoldResponse -> ()
rnf CancelLegalHoldResponse' {Int
httpStatus :: Int
$sel:httpStatus:CancelLegalHoldResponse' :: CancelLegalHoldResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus