{-# 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.GetLegalHold
-- 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 returns details for a specified legal hold. The details are
-- the body of a legal hold in JSON format, in addition to metadata.
module Amazonka.Backup.GetLegalHold
  ( -- * Creating a Request
    GetLegalHold (..),
    newGetLegalHold,

    -- * Request Lenses
    getLegalHold_legalHoldId,

    -- * Destructuring the Response
    GetLegalHoldResponse (..),
    newGetLegalHoldResponse,

    -- * Response Lenses
    getLegalHoldResponse_cancelDescription,
    getLegalHoldResponse_cancellationDate,
    getLegalHoldResponse_creationDate,
    getLegalHoldResponse_description,
    getLegalHoldResponse_legalHoldArn,
    getLegalHoldResponse_legalHoldId,
    getLegalHoldResponse_recoveryPointSelection,
    getLegalHoldResponse_retainRecordUntil,
    getLegalHoldResponse_status,
    getLegalHoldResponse_title,
    getLegalHoldResponse_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:/ 'newGetLegalHold' smart constructor.
data GetLegalHold = GetLegalHold'
  { -- | This is the ID required to use @GetLegalHold@. This unique ID is
    -- associated with a specific legal hold.
    GetLegalHold -> Text
legalHoldId :: Prelude.Text
  }
  deriving (GetLegalHold -> GetLegalHold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLegalHold -> GetLegalHold -> Bool
$c/= :: GetLegalHold -> GetLegalHold -> Bool
== :: GetLegalHold -> GetLegalHold -> Bool
$c== :: GetLegalHold -> GetLegalHold -> Bool
Prelude.Eq, ReadPrec [GetLegalHold]
ReadPrec GetLegalHold
Int -> ReadS GetLegalHold
ReadS [GetLegalHold]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLegalHold]
$creadListPrec :: ReadPrec [GetLegalHold]
readPrec :: ReadPrec GetLegalHold
$creadPrec :: ReadPrec GetLegalHold
readList :: ReadS [GetLegalHold]
$creadList :: ReadS [GetLegalHold]
readsPrec :: Int -> ReadS GetLegalHold
$creadsPrec :: Int -> ReadS GetLegalHold
Prelude.Read, Int -> GetLegalHold -> ShowS
[GetLegalHold] -> ShowS
GetLegalHold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLegalHold] -> ShowS
$cshowList :: [GetLegalHold] -> ShowS
show :: GetLegalHold -> String
$cshow :: GetLegalHold -> String
showsPrec :: Int -> GetLegalHold -> ShowS
$cshowsPrec :: Int -> GetLegalHold -> ShowS
Prelude.Show, forall x. Rep GetLegalHold x -> GetLegalHold
forall x. GetLegalHold -> Rep GetLegalHold x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLegalHold x -> GetLegalHold
$cfrom :: forall x. GetLegalHold -> Rep GetLegalHold x
Prelude.Generic)

-- |
-- Create a value of 'GetLegalHold' 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:
--
-- 'legalHoldId', 'getLegalHold_legalHoldId' - This is the ID required to use @GetLegalHold@. This unique ID is
-- associated with a specific legal hold.
newGetLegalHold ::
  -- | 'legalHoldId'
  Prelude.Text ->
  GetLegalHold
newGetLegalHold :: Text -> GetLegalHold
newGetLegalHold Text
pLegalHoldId_ =
  GetLegalHold' {$sel:legalHoldId:GetLegalHold' :: Text
legalHoldId = Text
pLegalHoldId_}

-- | This is the ID required to use @GetLegalHold@. This unique ID is
-- associated with a specific legal hold.
getLegalHold_legalHoldId :: Lens.Lens' GetLegalHold Prelude.Text
getLegalHold_legalHoldId :: Lens' GetLegalHold Text
getLegalHold_legalHoldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHold' {Text
legalHoldId :: Text
$sel:legalHoldId:GetLegalHold' :: GetLegalHold -> Text
legalHoldId} -> Text
legalHoldId) (\s :: GetLegalHold
s@GetLegalHold' {} Text
a -> GetLegalHold
s {$sel:legalHoldId:GetLegalHold' :: Text
legalHoldId = Text
a} :: GetLegalHold)

instance Core.AWSRequest GetLegalHold where
  type AWSResponse GetLegalHold = GetLegalHoldResponse
  request :: (Service -> Service) -> GetLegalHold -> Request GetLegalHold
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetLegalHold
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetLegalHold)))
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 POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe RecoveryPointSelection
-> Maybe POSIX
-> Maybe LegalHoldStatus
-> Maybe Text
-> Int
-> GetLegalHoldResponse
GetLegalHoldResponse'
            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
"CancelDescription")
            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
"CancellationDate")
            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
"CreationDate")
            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
"Description")
            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
"LegalHoldArn")
            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
"LegalHoldId")
            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
"RecoveryPointSelection")
            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
"RetainRecordUntil")
            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
"Status")
            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
"Title")
            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 GetLegalHold where
  hashWithSalt :: Int -> GetLegalHold -> Int
hashWithSalt Int
_salt GetLegalHold' {Text
legalHoldId :: Text
$sel:legalHoldId:GetLegalHold' :: GetLegalHold -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
legalHoldId

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

instance Data.ToHeaders GetLegalHold where
  toHeaders :: GetLegalHold -> 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 GetLegalHold where
  toPath :: GetLegalHold -> ByteString
toPath GetLegalHold' {Text
legalHoldId :: Text
$sel:legalHoldId:GetLegalHold' :: GetLegalHold -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/legal-holds/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
legalHoldId, ByteString
"/"]

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

-- | /See:/ 'newGetLegalHoldResponse' smart constructor.
data GetLegalHoldResponse = GetLegalHoldResponse'
  { -- | String describing the reason for removing the legal hold.
    GetLegalHoldResponse -> Maybe Text
cancelDescription :: Prelude.Maybe Prelude.Text,
    -- | Time in number when legal hold was cancelled.
    GetLegalHoldResponse -> Maybe POSIX
cancellationDate :: Prelude.Maybe Data.POSIX,
    -- | Time in number format when legal hold was created.
    GetLegalHoldResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | This is the returned string description of the legal hold.
    GetLegalHoldResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | This is the returned framework ARN for the specified legal hold. An
    -- Amazon Resource Name (ARN) uniquely identifies a resource. The format of
    -- the ARN depends on the resource type.
    GetLegalHoldResponse -> Maybe Text
legalHoldArn :: Prelude.Maybe Prelude.Text,
    -- | This is the returned ID associated with a specified legal hold.
    GetLegalHoldResponse -> Maybe Text
legalHoldId :: Prelude.Maybe Prelude.Text,
    -- | This specifies criteria to assign a set of resources, such as resource
    -- types or backup vaults.
    GetLegalHoldResponse -> Maybe RecoveryPointSelection
recoveryPointSelection :: Prelude.Maybe RecoveryPointSelection,
    -- | This is the date and time until which the legal hold record will be
    -- retained.
    GetLegalHoldResponse -> Maybe POSIX
retainRecordUntil :: Prelude.Maybe Data.POSIX,
    -- | This is the status of the legal hold. Statuses can be @ACTIVE@,
    -- @CREATING@, @CANCELED@, and @CANCELING@.
    GetLegalHoldResponse -> Maybe LegalHoldStatus
status :: Prelude.Maybe LegalHoldStatus,
    -- | This is the string title of the legal hold.
    GetLegalHoldResponse -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetLegalHoldResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetLegalHoldResponse -> GetLegalHoldResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLegalHoldResponse -> GetLegalHoldResponse -> Bool
$c/= :: GetLegalHoldResponse -> GetLegalHoldResponse -> Bool
== :: GetLegalHoldResponse -> GetLegalHoldResponse -> Bool
$c== :: GetLegalHoldResponse -> GetLegalHoldResponse -> Bool
Prelude.Eq, ReadPrec [GetLegalHoldResponse]
ReadPrec GetLegalHoldResponse
Int -> ReadS GetLegalHoldResponse
ReadS [GetLegalHoldResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLegalHoldResponse]
$creadListPrec :: ReadPrec [GetLegalHoldResponse]
readPrec :: ReadPrec GetLegalHoldResponse
$creadPrec :: ReadPrec GetLegalHoldResponse
readList :: ReadS [GetLegalHoldResponse]
$creadList :: ReadS [GetLegalHoldResponse]
readsPrec :: Int -> ReadS GetLegalHoldResponse
$creadsPrec :: Int -> ReadS GetLegalHoldResponse
Prelude.Read, Int -> GetLegalHoldResponse -> ShowS
[GetLegalHoldResponse] -> ShowS
GetLegalHoldResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLegalHoldResponse] -> ShowS
$cshowList :: [GetLegalHoldResponse] -> ShowS
show :: GetLegalHoldResponse -> String
$cshow :: GetLegalHoldResponse -> String
showsPrec :: Int -> GetLegalHoldResponse -> ShowS
$cshowsPrec :: Int -> GetLegalHoldResponse -> ShowS
Prelude.Show, forall x. Rep GetLegalHoldResponse x -> GetLegalHoldResponse
forall x. GetLegalHoldResponse -> Rep GetLegalHoldResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLegalHoldResponse x -> GetLegalHoldResponse
$cfrom :: forall x. GetLegalHoldResponse -> Rep GetLegalHoldResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetLegalHoldResponse' 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:
--
-- 'cancelDescription', 'getLegalHoldResponse_cancelDescription' - String describing the reason for removing the legal hold.
--
-- 'cancellationDate', 'getLegalHoldResponse_cancellationDate' - Time in number when legal hold was cancelled.
--
-- 'creationDate', 'getLegalHoldResponse_creationDate' - Time in number format when legal hold was created.
--
-- 'description', 'getLegalHoldResponse_description' - This is the returned string description of the legal hold.
--
-- 'legalHoldArn', 'getLegalHoldResponse_legalHoldArn' - This is the returned framework ARN for the specified legal hold. An
-- Amazon Resource Name (ARN) uniquely identifies a resource. The format of
-- the ARN depends on the resource type.
--
-- 'legalHoldId', 'getLegalHoldResponse_legalHoldId' - This is the returned ID associated with a specified legal hold.
--
-- 'recoveryPointSelection', 'getLegalHoldResponse_recoveryPointSelection' - This specifies criteria to assign a set of resources, such as resource
-- types or backup vaults.
--
-- 'retainRecordUntil', 'getLegalHoldResponse_retainRecordUntil' - This is the date and time until which the legal hold record will be
-- retained.
--
-- 'status', 'getLegalHoldResponse_status' - This is the status of the legal hold. Statuses can be @ACTIVE@,
-- @CREATING@, @CANCELED@, and @CANCELING@.
--
-- 'title', 'getLegalHoldResponse_title' - This is the string title of the legal hold.
--
-- 'httpStatus', 'getLegalHoldResponse_httpStatus' - The response's http status code.
newGetLegalHoldResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLegalHoldResponse
newGetLegalHoldResponse :: Int -> GetLegalHoldResponse
newGetLegalHoldResponse Int
pHttpStatus_ =
  GetLegalHoldResponse'
    { $sel:cancelDescription:GetLegalHoldResponse' :: Maybe Text
cancelDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:cancellationDate:GetLegalHoldResponse' :: Maybe POSIX
cancellationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:GetLegalHoldResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:GetLegalHoldResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:legalHoldArn:GetLegalHoldResponse' :: Maybe Text
legalHoldArn = forall a. Maybe a
Prelude.Nothing,
      $sel:legalHoldId:GetLegalHoldResponse' :: Maybe Text
legalHoldId = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointSelection:GetLegalHoldResponse' :: Maybe RecoveryPointSelection
recoveryPointSelection = forall a. Maybe a
Prelude.Nothing,
      $sel:retainRecordUntil:GetLegalHoldResponse' :: Maybe POSIX
retainRecordUntil = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetLegalHoldResponse' :: Maybe LegalHoldStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:title:GetLegalHoldResponse' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLegalHoldResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | Time in number when legal hold was cancelled.
getLegalHoldResponse_cancellationDate :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.UTCTime)
getLegalHoldResponse_cancellationDate :: Lens' GetLegalHoldResponse (Maybe UTCTime)
getLegalHoldResponse_cancellationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe POSIX
cancellationDate :: Maybe POSIX
$sel:cancellationDate:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
cancellationDate} -> Maybe POSIX
cancellationDate) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe POSIX
a -> GetLegalHoldResponse
s {$sel:cancellationDate:GetLegalHoldResponse' :: Maybe POSIX
cancellationDate = Maybe POSIX
a} :: GetLegalHoldResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Time in number format when legal hold was created.
getLegalHoldResponse_creationDate :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.UTCTime)
getLegalHoldResponse_creationDate :: Lens' GetLegalHoldResponse (Maybe UTCTime)
getLegalHoldResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe POSIX
a -> GetLegalHoldResponse
s {$sel:creationDate:GetLegalHoldResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: GetLegalHoldResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | This is the returned string description of the legal hold.
getLegalHoldResponse_description :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.Text)
getLegalHoldResponse_description :: Lens' GetLegalHoldResponse (Maybe Text)
getLegalHoldResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe Text
description :: Maybe Text
$sel:description:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe Text
a -> GetLegalHoldResponse
s {$sel:description:GetLegalHoldResponse' :: Maybe Text
description = Maybe Text
a} :: GetLegalHoldResponse)

-- | This is the returned framework ARN for the specified legal hold. An
-- Amazon Resource Name (ARN) uniquely identifies a resource. The format of
-- the ARN depends on the resource type.
getLegalHoldResponse_legalHoldArn :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.Text)
getLegalHoldResponse_legalHoldArn :: Lens' GetLegalHoldResponse (Maybe Text)
getLegalHoldResponse_legalHoldArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe Text
legalHoldArn :: Maybe Text
$sel:legalHoldArn:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
legalHoldArn} -> Maybe Text
legalHoldArn) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe Text
a -> GetLegalHoldResponse
s {$sel:legalHoldArn:GetLegalHoldResponse' :: Maybe Text
legalHoldArn = Maybe Text
a} :: GetLegalHoldResponse)

-- | This is the returned ID associated with a specified legal hold.
getLegalHoldResponse_legalHoldId :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.Text)
getLegalHoldResponse_legalHoldId :: Lens' GetLegalHoldResponse (Maybe Text)
getLegalHoldResponse_legalHoldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe Text
legalHoldId :: Maybe Text
$sel:legalHoldId:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
legalHoldId} -> Maybe Text
legalHoldId) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe Text
a -> GetLegalHoldResponse
s {$sel:legalHoldId:GetLegalHoldResponse' :: Maybe Text
legalHoldId = Maybe Text
a} :: GetLegalHoldResponse)

-- | This specifies criteria to assign a set of resources, such as resource
-- types or backup vaults.
getLegalHoldResponse_recoveryPointSelection :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe RecoveryPointSelection)
getLegalHoldResponse_recoveryPointSelection :: Lens' GetLegalHoldResponse (Maybe RecoveryPointSelection)
getLegalHoldResponse_recoveryPointSelection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe RecoveryPointSelection
recoveryPointSelection :: Maybe RecoveryPointSelection
$sel:recoveryPointSelection:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe RecoveryPointSelection
recoveryPointSelection} -> Maybe RecoveryPointSelection
recoveryPointSelection) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe RecoveryPointSelection
a -> GetLegalHoldResponse
s {$sel:recoveryPointSelection:GetLegalHoldResponse' :: Maybe RecoveryPointSelection
recoveryPointSelection = Maybe RecoveryPointSelection
a} :: GetLegalHoldResponse)

-- | This is the date and time until which the legal hold record will be
-- retained.
getLegalHoldResponse_retainRecordUntil :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.UTCTime)
getLegalHoldResponse_retainRecordUntil :: Lens' GetLegalHoldResponse (Maybe UTCTime)
getLegalHoldResponse_retainRecordUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe POSIX
retainRecordUntil :: Maybe POSIX
$sel:retainRecordUntil:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
retainRecordUntil} -> Maybe POSIX
retainRecordUntil) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe POSIX
a -> GetLegalHoldResponse
s {$sel:retainRecordUntil:GetLegalHoldResponse' :: Maybe POSIX
retainRecordUntil = Maybe POSIX
a} :: GetLegalHoldResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | This is the status of the legal hold. Statuses can be @ACTIVE@,
-- @CREATING@, @CANCELED@, and @CANCELING@.
getLegalHoldResponse_status :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe LegalHoldStatus)
getLegalHoldResponse_status :: Lens' GetLegalHoldResponse (Maybe LegalHoldStatus)
getLegalHoldResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe LegalHoldStatus
status :: Maybe LegalHoldStatus
$sel:status:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe LegalHoldStatus
status} -> Maybe LegalHoldStatus
status) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe LegalHoldStatus
a -> GetLegalHoldResponse
s {$sel:status:GetLegalHoldResponse' :: Maybe LegalHoldStatus
status = Maybe LegalHoldStatus
a} :: GetLegalHoldResponse)

-- | This is the string title of the legal hold.
getLegalHoldResponse_title :: Lens.Lens' GetLegalHoldResponse (Prelude.Maybe Prelude.Text)
getLegalHoldResponse_title :: Lens' GetLegalHoldResponse (Maybe Text)
getLegalHoldResponse_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLegalHoldResponse' {Maybe Text
title :: Maybe Text
$sel:title:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
title} -> Maybe Text
title) (\s :: GetLegalHoldResponse
s@GetLegalHoldResponse' {} Maybe Text
a -> GetLegalHoldResponse
s {$sel:title:GetLegalHoldResponse' :: Maybe Text
title = Maybe Text
a} :: GetLegalHoldResponse)

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

instance Prelude.NFData GetLegalHoldResponse where
  rnf :: GetLegalHoldResponse -> ()
rnf GetLegalHoldResponse' {Int
Maybe Text
Maybe POSIX
Maybe LegalHoldStatus
Maybe RecoveryPointSelection
httpStatus :: Int
title :: Maybe Text
status :: Maybe LegalHoldStatus
retainRecordUntil :: Maybe POSIX
recoveryPointSelection :: Maybe RecoveryPointSelection
legalHoldId :: Maybe Text
legalHoldArn :: Maybe Text
description :: Maybe Text
creationDate :: Maybe POSIX
cancellationDate :: Maybe POSIX
cancelDescription :: Maybe Text
$sel:httpStatus:GetLegalHoldResponse' :: GetLegalHoldResponse -> Int
$sel:title:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
$sel:status:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe LegalHoldStatus
$sel:retainRecordUntil:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
$sel:recoveryPointSelection:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe RecoveryPointSelection
$sel:legalHoldId:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
$sel:legalHoldArn:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
$sel:description:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
$sel:creationDate:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
$sel:cancellationDate:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe POSIX
$sel:cancelDescription:GetLegalHoldResponse' :: GetLegalHoldResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cancelDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
cancellationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
legalHoldArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
legalHoldId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecoveryPointSelection
recoveryPointSelection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
retainRecordUntil
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LegalHoldStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus