{-# 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.CreateLegalHold
-- 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 creates a legal hold on a recovery point (backup). A legal
-- hold is a restraint on altering or deleting a backup until an authorized
-- user cancels the legal hold. Any actions to delete or disassociate a
-- recovery point will fail with an error if one or more active legal holds
-- are on the recovery point.
module Amazonka.Backup.CreateLegalHold
  ( -- * Creating a Request
    CreateLegalHold (..),
    newCreateLegalHold,

    -- * Request Lenses
    createLegalHold_idempotencyToken,
    createLegalHold_recoveryPointSelection,
    createLegalHold_tags,
    createLegalHold_title,
    createLegalHold_description,

    -- * Destructuring the Response
    CreateLegalHoldResponse (..),
    newCreateLegalHoldResponse,

    -- * Response Lenses
    createLegalHoldResponse_creationDate,
    createLegalHoldResponse_description,
    createLegalHoldResponse_legalHoldArn,
    createLegalHoldResponse_legalHoldId,
    createLegalHoldResponse_recoveryPointSelection,
    createLegalHoldResponse_status,
    createLegalHoldResponse_title,
    createLegalHoldResponse_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:/ 'newCreateLegalHold' smart constructor.
data CreateLegalHold = CreateLegalHold'
  { -- | This is a user-chosen string used to distinguish between otherwise
    -- identical calls. Retrying a successful request with the same idempotency
    -- token results in a success message with no action taken.
    CreateLegalHold -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | This specifies criteria to assign a set of resources, such as resource
    -- types or backup vaults.
    CreateLegalHold -> Maybe RecoveryPointSelection
recoveryPointSelection :: Prelude.Maybe RecoveryPointSelection,
    -- | Optional tags to include. A tag is a key-value pair you can use to
    -- manage, filter, and search for your resources. Allowed characters
    -- include UTF-8 letters, numbers, spaces, and the following characters: +
    -- - = . _ : \/.
    CreateLegalHold -> Maybe (Sensitive (HashMap Text Text))
tags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | This is the string title of the legal hold.
    CreateLegalHold -> Text
title :: Prelude.Text,
    -- | This is the string description of the legal hold.
    CreateLegalHold -> Text
description :: Prelude.Text
  }
  deriving (CreateLegalHold -> CreateLegalHold -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLegalHold -> CreateLegalHold -> Bool
$c/= :: CreateLegalHold -> CreateLegalHold -> Bool
== :: CreateLegalHold -> CreateLegalHold -> Bool
$c== :: CreateLegalHold -> CreateLegalHold -> Bool
Prelude.Eq, Int -> CreateLegalHold -> ShowS
[CreateLegalHold] -> ShowS
CreateLegalHold -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLegalHold] -> ShowS
$cshowList :: [CreateLegalHold] -> ShowS
show :: CreateLegalHold -> String
$cshow :: CreateLegalHold -> String
showsPrec :: Int -> CreateLegalHold -> ShowS
$cshowsPrec :: Int -> CreateLegalHold -> ShowS
Prelude.Show, forall x. Rep CreateLegalHold x -> CreateLegalHold
forall x. CreateLegalHold -> Rep CreateLegalHold x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLegalHold x -> CreateLegalHold
$cfrom :: forall x. CreateLegalHold -> Rep CreateLegalHold x
Prelude.Generic)

-- |
-- Create a value of 'CreateLegalHold' 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:
--
-- 'idempotencyToken', 'createLegalHold_idempotencyToken' - This is a user-chosen string used to distinguish between otherwise
-- identical calls. Retrying a successful request with the same idempotency
-- token results in a success message with no action taken.
--
-- 'recoveryPointSelection', 'createLegalHold_recoveryPointSelection' - This specifies criteria to assign a set of resources, such as resource
-- types or backup vaults.
--
-- 'tags', 'createLegalHold_tags' - Optional tags to include. A tag is a key-value pair you can use to
-- manage, filter, and search for your resources. Allowed characters
-- include UTF-8 letters, numbers, spaces, and the following characters: +
-- - = . _ : \/.
--
-- 'title', 'createLegalHold_title' - This is the string title of the legal hold.
--
-- 'description', 'createLegalHold_description' - This is the string description of the legal hold.
newCreateLegalHold ::
  -- | 'title'
  Prelude.Text ->
  -- | 'description'
  Prelude.Text ->
  CreateLegalHold
newCreateLegalHold :: Text -> Text -> CreateLegalHold
newCreateLegalHold Text
pTitle_ Text
pDescription_ =
  CreateLegalHold'
    { $sel:idempotencyToken:CreateLegalHold' :: Maybe Text
idempotencyToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointSelection:CreateLegalHold' :: Maybe RecoveryPointSelection
recoveryPointSelection = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLegalHold' :: Maybe (Sensitive (HashMap Text Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:title:CreateLegalHold' :: Text
title = Text
pTitle_,
      $sel:description:CreateLegalHold' :: Text
description = Text
pDescription_
    }

-- | This is a user-chosen string used to distinguish between otherwise
-- identical calls. Retrying a successful request with the same idempotency
-- token results in a success message with no action taken.
createLegalHold_idempotencyToken :: Lens.Lens' CreateLegalHold (Prelude.Maybe Prelude.Text)
createLegalHold_idempotencyToken :: Lens' CreateLegalHold (Maybe Text)
createLegalHold_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHold' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:CreateLegalHold' :: CreateLegalHold -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: CreateLegalHold
s@CreateLegalHold' {} Maybe Text
a -> CreateLegalHold
s {$sel:idempotencyToken:CreateLegalHold' :: Maybe Text
idempotencyToken = Maybe Text
a} :: CreateLegalHold)

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

-- | Optional tags to include. A tag is a key-value pair you can use to
-- manage, filter, and search for your resources. Allowed characters
-- include UTF-8 letters, numbers, spaces, and the following characters: +
-- - = . _ : \/.
createLegalHold_tags :: Lens.Lens' CreateLegalHold (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createLegalHold_tags :: Lens' CreateLegalHold (Maybe (HashMap Text Text))
createLegalHold_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHold' {Maybe (Sensitive (HashMap Text Text))
tags :: Maybe (Sensitive (HashMap Text Text))
$sel:tags:CreateLegalHold' :: CreateLegalHold -> Maybe (Sensitive (HashMap Text Text))
tags} -> Maybe (Sensitive (HashMap Text Text))
tags) (\s :: CreateLegalHold
s@CreateLegalHold' {} Maybe (Sensitive (HashMap Text Text))
a -> CreateLegalHold
s {$sel:tags:CreateLegalHold' :: Maybe (Sensitive (HashMap Text Text))
tags = Maybe (Sensitive (HashMap Text Text))
a} :: CreateLegalHold) 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. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

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

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

instance Core.AWSRequest CreateLegalHold where
  type
    AWSResponse CreateLegalHold =
      CreateLegalHoldResponse
  request :: (Service -> Service) -> CreateLegalHold -> Request CreateLegalHold
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 CreateLegalHold
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLegalHold)))
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 POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe RecoveryPointSelection
-> Maybe LegalHoldStatus
-> Maybe Text
-> Int
-> CreateLegalHoldResponse
CreateLegalHoldResponse'
            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
"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
"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 CreateLegalHold where
  hashWithSalt :: Int -> CreateLegalHold -> Int
hashWithSalt Int
_salt CreateLegalHold' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
Maybe RecoveryPointSelection
Text
description :: Text
title :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
recoveryPointSelection :: Maybe RecoveryPointSelection
idempotencyToken :: Maybe Text
$sel:description:CreateLegalHold' :: CreateLegalHold -> Text
$sel:title:CreateLegalHold' :: CreateLegalHold -> Text
$sel:tags:CreateLegalHold' :: CreateLegalHold -> Maybe (Sensitive (HashMap Text Text))
$sel:recoveryPointSelection:CreateLegalHold' :: CreateLegalHold -> Maybe RecoveryPointSelection
$sel:idempotencyToken:CreateLegalHold' :: CreateLegalHold -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecoveryPointSelection
recoveryPointSelection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description

instance Prelude.NFData CreateLegalHold where
  rnf :: CreateLegalHold -> ()
rnf CreateLegalHold' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
Maybe RecoveryPointSelection
Text
description :: Text
title :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
recoveryPointSelection :: Maybe RecoveryPointSelection
idempotencyToken :: Maybe Text
$sel:description:CreateLegalHold' :: CreateLegalHold -> Text
$sel:title:CreateLegalHold' :: CreateLegalHold -> Text
$sel:tags:CreateLegalHold' :: CreateLegalHold -> Maybe (Sensitive (HashMap Text Text))
$sel:recoveryPointSelection:CreateLegalHold' :: CreateLegalHold -> Maybe RecoveryPointSelection
$sel:idempotencyToken:CreateLegalHold' :: CreateLegalHold -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      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 (Sensitive (HashMap Text Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description

instance Data.ToHeaders CreateLegalHold where
  toHeaders :: CreateLegalHold -> 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.ToJSON CreateLegalHold where
  toJSON :: CreateLegalHold -> Value
toJSON CreateLegalHold' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
Maybe RecoveryPointSelection
Text
description :: Text
title :: Text
tags :: Maybe (Sensitive (HashMap Text Text))
recoveryPointSelection :: Maybe RecoveryPointSelection
idempotencyToken :: Maybe Text
$sel:description:CreateLegalHold' :: CreateLegalHold -> Text
$sel:title:CreateLegalHold' :: CreateLegalHold -> Text
$sel:tags:CreateLegalHold' :: CreateLegalHold -> Maybe (Sensitive (HashMap Text Text))
$sel:recoveryPointSelection:CreateLegalHold' :: CreateLegalHold -> Maybe RecoveryPointSelection
$sel:idempotencyToken:CreateLegalHold' :: CreateLegalHold -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IdempotencyToken" 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
idempotencyToken,
            (Key
"RecoveryPointSelection" 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 RecoveryPointSelection
recoveryPointSelection,
            (Key
"Tags" 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 (Sensitive (HashMap Text Text))
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Title" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
title),
            forall a. a -> Maybe a
Prelude.Just (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
description)
          ]
      )

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

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

-- | /See:/ 'newCreateLegalHoldResponse' smart constructor.
data CreateLegalHoldResponse = CreateLegalHoldResponse'
  { -- | Time in number format when legal hold was created.
    CreateLegalHoldResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | This is the returned string description of the legal hold.
    CreateLegalHoldResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | This is the ARN (Amazon Resource Number) of the created legal hold.
    CreateLegalHoldResponse -> Maybe Text
legalHoldArn :: Prelude.Maybe Prelude.Text,
    -- | Legal hold ID returned for the specified legal hold on a recovery point.
    CreateLegalHoldResponse -> Maybe Text
legalHoldId :: Prelude.Maybe Prelude.Text,
    -- | This specifies criteria to assign a set of resources, such as resource
    -- types or backup vaults.
    CreateLegalHoldResponse -> Maybe RecoveryPointSelection
recoveryPointSelection :: Prelude.Maybe RecoveryPointSelection,
    -- | This displays the status of the legal hold returned after creating the
    -- legal hold. Statuses can be @ACTIVE@, @PENDING@, @CANCELED@,
    -- @CANCELING@, or @FAILED@.
    CreateLegalHoldResponse -> Maybe LegalHoldStatus
status :: Prelude.Maybe LegalHoldStatus,
    -- | This is the string title of the legal hold returned after creating the
    -- legal hold.
    CreateLegalHoldResponse -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLegalHoldResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLegalHoldResponse -> CreateLegalHoldResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLegalHoldResponse -> CreateLegalHoldResponse -> Bool
$c/= :: CreateLegalHoldResponse -> CreateLegalHoldResponse -> Bool
== :: CreateLegalHoldResponse -> CreateLegalHoldResponse -> Bool
$c== :: CreateLegalHoldResponse -> CreateLegalHoldResponse -> Bool
Prelude.Eq, ReadPrec [CreateLegalHoldResponse]
ReadPrec CreateLegalHoldResponse
Int -> ReadS CreateLegalHoldResponse
ReadS [CreateLegalHoldResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLegalHoldResponse]
$creadListPrec :: ReadPrec [CreateLegalHoldResponse]
readPrec :: ReadPrec CreateLegalHoldResponse
$creadPrec :: ReadPrec CreateLegalHoldResponse
readList :: ReadS [CreateLegalHoldResponse]
$creadList :: ReadS [CreateLegalHoldResponse]
readsPrec :: Int -> ReadS CreateLegalHoldResponse
$creadsPrec :: Int -> ReadS CreateLegalHoldResponse
Prelude.Read, Int -> CreateLegalHoldResponse -> ShowS
[CreateLegalHoldResponse] -> ShowS
CreateLegalHoldResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLegalHoldResponse] -> ShowS
$cshowList :: [CreateLegalHoldResponse] -> ShowS
show :: CreateLegalHoldResponse -> String
$cshow :: CreateLegalHoldResponse -> String
showsPrec :: Int -> CreateLegalHoldResponse -> ShowS
$cshowsPrec :: Int -> CreateLegalHoldResponse -> ShowS
Prelude.Show, forall x. Rep CreateLegalHoldResponse x -> CreateLegalHoldResponse
forall x. CreateLegalHoldResponse -> Rep CreateLegalHoldResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLegalHoldResponse x -> CreateLegalHoldResponse
$cfrom :: forall x. CreateLegalHoldResponse -> Rep CreateLegalHoldResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLegalHoldResponse' 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:
--
-- 'creationDate', 'createLegalHoldResponse_creationDate' - Time in number format when legal hold was created.
--
-- 'description', 'createLegalHoldResponse_description' - This is the returned string description of the legal hold.
--
-- 'legalHoldArn', 'createLegalHoldResponse_legalHoldArn' - This is the ARN (Amazon Resource Number) of the created legal hold.
--
-- 'legalHoldId', 'createLegalHoldResponse_legalHoldId' - Legal hold ID returned for the specified legal hold on a recovery point.
--
-- 'recoveryPointSelection', 'createLegalHoldResponse_recoveryPointSelection' - This specifies criteria to assign a set of resources, such as resource
-- types or backup vaults.
--
-- 'status', 'createLegalHoldResponse_status' - This displays the status of the legal hold returned after creating the
-- legal hold. Statuses can be @ACTIVE@, @PENDING@, @CANCELED@,
-- @CANCELING@, or @FAILED@.
--
-- 'title', 'createLegalHoldResponse_title' - This is the string title of the legal hold returned after creating the
-- legal hold.
--
-- 'httpStatus', 'createLegalHoldResponse_httpStatus' - The response's http status code.
newCreateLegalHoldResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLegalHoldResponse
newCreateLegalHoldResponse :: Int -> CreateLegalHoldResponse
newCreateLegalHoldResponse Int
pHttpStatus_ =
  CreateLegalHoldResponse'
    { $sel:creationDate:CreateLegalHoldResponse' :: Maybe POSIX
creationDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateLegalHoldResponse' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:legalHoldArn:CreateLegalHoldResponse' :: Maybe Text
legalHoldArn = forall a. Maybe a
Prelude.Nothing,
      $sel:legalHoldId:CreateLegalHoldResponse' :: Maybe Text
legalHoldId = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointSelection:CreateLegalHoldResponse' :: Maybe RecoveryPointSelection
recoveryPointSelection = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateLegalHoldResponse' :: Maybe LegalHoldStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:title:CreateLegalHoldResponse' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLegalHoldResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Time in number format when legal hold was created.
createLegalHoldResponse_creationDate :: Lens.Lens' CreateLegalHoldResponse (Prelude.Maybe Prelude.UTCTime)
createLegalHoldResponse_creationDate :: Lens' CreateLegalHoldResponse (Maybe UTCTime)
createLegalHoldResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHoldResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: CreateLegalHoldResponse
s@CreateLegalHoldResponse' {} Maybe POSIX
a -> CreateLegalHoldResponse
s {$sel:creationDate:CreateLegalHoldResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: CreateLegalHoldResponse) 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.
createLegalHoldResponse_description :: Lens.Lens' CreateLegalHoldResponse (Prelude.Maybe Prelude.Text)
createLegalHoldResponse_description :: Lens' CreateLegalHoldResponse (Maybe Text)
createLegalHoldResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHoldResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateLegalHoldResponse
s@CreateLegalHoldResponse' {} Maybe Text
a -> CreateLegalHoldResponse
s {$sel:description:CreateLegalHoldResponse' :: Maybe Text
description = Maybe Text
a} :: CreateLegalHoldResponse)

-- | This is the ARN (Amazon Resource Number) of the created legal hold.
createLegalHoldResponse_legalHoldArn :: Lens.Lens' CreateLegalHoldResponse (Prelude.Maybe Prelude.Text)
createLegalHoldResponse_legalHoldArn :: Lens' CreateLegalHoldResponse (Maybe Text)
createLegalHoldResponse_legalHoldArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHoldResponse' {Maybe Text
legalHoldArn :: Maybe Text
$sel:legalHoldArn:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
legalHoldArn} -> Maybe Text
legalHoldArn) (\s :: CreateLegalHoldResponse
s@CreateLegalHoldResponse' {} Maybe Text
a -> CreateLegalHoldResponse
s {$sel:legalHoldArn:CreateLegalHoldResponse' :: Maybe Text
legalHoldArn = Maybe Text
a} :: CreateLegalHoldResponse)

-- | Legal hold ID returned for the specified legal hold on a recovery point.
createLegalHoldResponse_legalHoldId :: Lens.Lens' CreateLegalHoldResponse (Prelude.Maybe Prelude.Text)
createLegalHoldResponse_legalHoldId :: Lens' CreateLegalHoldResponse (Maybe Text)
createLegalHoldResponse_legalHoldId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHoldResponse' {Maybe Text
legalHoldId :: Maybe Text
$sel:legalHoldId:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
legalHoldId} -> Maybe Text
legalHoldId) (\s :: CreateLegalHoldResponse
s@CreateLegalHoldResponse' {} Maybe Text
a -> CreateLegalHoldResponse
s {$sel:legalHoldId:CreateLegalHoldResponse' :: Maybe Text
legalHoldId = Maybe Text
a} :: CreateLegalHoldResponse)

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

-- | This displays the status of the legal hold returned after creating the
-- legal hold. Statuses can be @ACTIVE@, @PENDING@, @CANCELED@,
-- @CANCELING@, or @FAILED@.
createLegalHoldResponse_status :: Lens.Lens' CreateLegalHoldResponse (Prelude.Maybe LegalHoldStatus)
createLegalHoldResponse_status :: Lens' CreateLegalHoldResponse (Maybe LegalHoldStatus)
createLegalHoldResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLegalHoldResponse' {Maybe LegalHoldStatus
status :: Maybe LegalHoldStatus
$sel:status:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe LegalHoldStatus
status} -> Maybe LegalHoldStatus
status) (\s :: CreateLegalHoldResponse
s@CreateLegalHoldResponse' {} Maybe LegalHoldStatus
a -> CreateLegalHoldResponse
s {$sel:status:CreateLegalHoldResponse' :: Maybe LegalHoldStatus
status = Maybe LegalHoldStatus
a} :: CreateLegalHoldResponse)

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

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

instance Prelude.NFData CreateLegalHoldResponse where
  rnf :: CreateLegalHoldResponse -> ()
rnf CreateLegalHoldResponse' {Int
Maybe Text
Maybe POSIX
Maybe LegalHoldStatus
Maybe RecoveryPointSelection
httpStatus :: Int
title :: Maybe Text
status :: Maybe LegalHoldStatus
recoveryPointSelection :: Maybe RecoveryPointSelection
legalHoldId :: Maybe Text
legalHoldArn :: Maybe Text
description :: Maybe Text
creationDate :: Maybe POSIX
$sel:httpStatus:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Int
$sel:title:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
$sel:status:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe LegalHoldStatus
$sel:recoveryPointSelection:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe RecoveryPointSelection
$sel:legalHoldId:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
$sel:legalHoldArn:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
$sel:description:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe Text
$sel:creationDate:CreateLegalHoldResponse' :: CreateLegalHoldResponse -> Maybe POSIX
..} =
    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 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