{-# 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.Glacier.InitiateVaultLock
-- 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 operation initiates the vault locking process by doing the
-- following:
--
-- -   Installing a vault lock policy on the specified vault.
--
-- -   Setting the lock state of vault lock to @InProgress@.
--
-- -   Returning a lock ID, which is used to complete the vault locking
--     process.
--
-- You can set one vault lock policy for each vault and this policy can be
-- up to 20 KB in size. For more information about vault lock policies, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/vault-lock-policy.html Amazon Glacier Access Control with Vault Lock Policies>.
--
-- You must complete the vault locking process within 24 hours after the
-- vault lock enters the @InProgress@ state. After the 24 hour window ends,
-- the lock ID expires, the vault automatically exits the @InProgress@
-- state, and the vault lock policy is removed from the vault. You call
-- CompleteVaultLock to complete the vault locking process by setting the
-- state of the vault lock to @Locked@.
--
-- After a vault lock is in the @Locked@ state, you cannot initiate a new
-- vault lock for the vault.
--
-- You can abort the vault locking process by calling AbortVaultLock. You
-- can get the state of the vault lock by calling GetVaultLock. For more
-- information about the vault locking process,
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/vault-lock.html Amazon Glacier Vault Lock>.
--
-- If this operation is called when the vault lock is in the @InProgress@
-- state, the operation returns an @AccessDeniedException@ error. When the
-- vault lock is in the @InProgress@ state you must call AbortVaultLock
-- before you can initiate a new vault lock policy.
module Amazonka.Glacier.InitiateVaultLock
  ( -- * Creating a Request
    InitiateVaultLock (..),
    newInitiateVaultLock,

    -- * Request Lenses
    initiateVaultLock_policy,
    initiateVaultLock_accountId,
    initiateVaultLock_vaultName,

    -- * Destructuring the Response
    InitiateVaultLockResponse (..),
    newInitiateVaultLockResponse,

    -- * Response Lenses
    initiateVaultLockResponse_lockId,
    initiateVaultLockResponse_httpStatus,
  )
where

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

-- | The input values for @InitiateVaultLock@.
--
-- /See:/ 'newInitiateVaultLock' smart constructor.
data InitiateVaultLock = InitiateVaultLock'
  { -- | The vault lock policy as a JSON string, which uses \"\\\" as an escape
    -- character.
    InitiateVaultLock -> Maybe VaultLockPolicy
policy :: Prelude.Maybe VaultLockPolicy,
    -- | The @AccountId@ value is the AWS account ID. This value must match the
    -- AWS account ID associated with the credentials used to sign the request.
    -- You can either specify an AWS account ID or optionally a single \'@-@\'
    -- (hyphen), in which case Amazon Glacier uses the AWS account ID
    -- associated with the credentials used to sign the request. If you specify
    -- your account ID, do not include any hyphens (\'-\') in the ID.
    InitiateVaultLock -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    InitiateVaultLock -> Text
vaultName :: Prelude.Text
  }
  deriving (InitiateVaultLock -> InitiateVaultLock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitiateVaultLock -> InitiateVaultLock -> Bool
$c/= :: InitiateVaultLock -> InitiateVaultLock -> Bool
== :: InitiateVaultLock -> InitiateVaultLock -> Bool
$c== :: InitiateVaultLock -> InitiateVaultLock -> Bool
Prelude.Eq, ReadPrec [InitiateVaultLock]
ReadPrec InitiateVaultLock
Int -> ReadS InitiateVaultLock
ReadS [InitiateVaultLock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitiateVaultLock]
$creadListPrec :: ReadPrec [InitiateVaultLock]
readPrec :: ReadPrec InitiateVaultLock
$creadPrec :: ReadPrec InitiateVaultLock
readList :: ReadS [InitiateVaultLock]
$creadList :: ReadS [InitiateVaultLock]
readsPrec :: Int -> ReadS InitiateVaultLock
$creadsPrec :: Int -> ReadS InitiateVaultLock
Prelude.Read, Int -> InitiateVaultLock -> ShowS
[InitiateVaultLock] -> ShowS
InitiateVaultLock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitiateVaultLock] -> ShowS
$cshowList :: [InitiateVaultLock] -> ShowS
show :: InitiateVaultLock -> String
$cshow :: InitiateVaultLock -> String
showsPrec :: Int -> InitiateVaultLock -> ShowS
$cshowsPrec :: Int -> InitiateVaultLock -> ShowS
Prelude.Show, forall x. Rep InitiateVaultLock x -> InitiateVaultLock
forall x. InitiateVaultLock -> Rep InitiateVaultLock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InitiateVaultLock x -> InitiateVaultLock
$cfrom :: forall x. InitiateVaultLock -> Rep InitiateVaultLock x
Prelude.Generic)

-- |
-- Create a value of 'InitiateVaultLock' 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:
--
-- 'policy', 'initiateVaultLock_policy' - The vault lock policy as a JSON string, which uses \"\\\" as an escape
-- character.
--
-- 'accountId', 'initiateVaultLock_accountId' - The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
--
-- 'vaultName', 'initiateVaultLock_vaultName' - The name of the vault.
newInitiateVaultLock ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  InitiateVaultLock
newInitiateVaultLock :: Text -> Text -> InitiateVaultLock
newInitiateVaultLock Text
pAccountId_ Text
pVaultName_ =
  InitiateVaultLock'
    { $sel:policy:InitiateVaultLock' :: Maybe VaultLockPolicy
policy = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:InitiateVaultLock' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:InitiateVaultLock' :: Text
vaultName = Text
pVaultName_
    }

-- | The vault lock policy as a JSON string, which uses \"\\\" as an escape
-- character.
initiateVaultLock_policy :: Lens.Lens' InitiateVaultLock (Prelude.Maybe VaultLockPolicy)
initiateVaultLock_policy :: Lens' InitiateVaultLock (Maybe VaultLockPolicy)
initiateVaultLock_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateVaultLock' {Maybe VaultLockPolicy
policy :: Maybe VaultLockPolicy
$sel:policy:InitiateVaultLock' :: InitiateVaultLock -> Maybe VaultLockPolicy
policy} -> Maybe VaultLockPolicy
policy) (\s :: InitiateVaultLock
s@InitiateVaultLock' {} Maybe VaultLockPolicy
a -> InitiateVaultLock
s {$sel:policy:InitiateVaultLock' :: Maybe VaultLockPolicy
policy = Maybe VaultLockPolicy
a} :: InitiateVaultLock)

-- | The @AccountId@ value is the AWS account ID. This value must match the
-- AWS account ID associated with the credentials used to sign the request.
-- You can either specify an AWS account ID or optionally a single \'@-@\'
-- (hyphen), in which case Amazon Glacier uses the AWS account ID
-- associated with the credentials used to sign the request. If you specify
-- your account ID, do not include any hyphens (\'-\') in the ID.
initiateVaultLock_accountId :: Lens.Lens' InitiateVaultLock Prelude.Text
initiateVaultLock_accountId :: Lens' InitiateVaultLock Text
initiateVaultLock_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateVaultLock' {Text
accountId :: Text
$sel:accountId:InitiateVaultLock' :: InitiateVaultLock -> Text
accountId} -> Text
accountId) (\s :: InitiateVaultLock
s@InitiateVaultLock' {} Text
a -> InitiateVaultLock
s {$sel:accountId:InitiateVaultLock' :: Text
accountId = Text
a} :: InitiateVaultLock)

-- | The name of the vault.
initiateVaultLock_vaultName :: Lens.Lens' InitiateVaultLock Prelude.Text
initiateVaultLock_vaultName :: Lens' InitiateVaultLock Text
initiateVaultLock_vaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateVaultLock' {Text
vaultName :: Text
$sel:vaultName:InitiateVaultLock' :: InitiateVaultLock -> Text
vaultName} -> Text
vaultName) (\s :: InitiateVaultLock
s@InitiateVaultLock' {} Text
a -> InitiateVaultLock
s {$sel:vaultName:InitiateVaultLock' :: Text
vaultName = Text
a} :: InitiateVaultLock)

instance Core.AWSRequest InitiateVaultLock where
  type
    AWSResponse InitiateVaultLock =
      InitiateVaultLockResponse
  request :: (Service -> Service)
-> InitiateVaultLock -> Request InitiateVaultLock
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 InitiateVaultLock
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse InitiateVaultLock)))
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 ->
          Maybe Text -> Int -> InitiateVaultLockResponse
InitiateVaultLockResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-lock-id")
            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 InitiateVaultLock where
  hashWithSalt :: Int -> InitiateVaultLock -> Int
hashWithSalt Int
_salt InitiateVaultLock' {Maybe VaultLockPolicy
Text
vaultName :: Text
accountId :: Text
policy :: Maybe VaultLockPolicy
$sel:vaultName:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:accountId:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:policy:InitiateVaultLock' :: InitiateVaultLock -> Maybe VaultLockPolicy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VaultLockPolicy
policy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vaultName

instance Prelude.NFData InitiateVaultLock where
  rnf :: InitiateVaultLock -> ()
rnf InitiateVaultLock' {Maybe VaultLockPolicy
Text
vaultName :: Text
accountId :: Text
policy :: Maybe VaultLockPolicy
$sel:vaultName:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:accountId:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:policy:InitiateVaultLock' :: InitiateVaultLock -> Maybe VaultLockPolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe VaultLockPolicy
policy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vaultName

instance Data.ToHeaders InitiateVaultLock where
  toHeaders :: InitiateVaultLock -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON InitiateVaultLock where
  toJSON :: InitiateVaultLock -> Value
toJSON InitiateVaultLock' {Maybe VaultLockPolicy
Text
vaultName :: Text
accountId :: Text
policy :: Maybe VaultLockPolicy
$sel:vaultName:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:accountId:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:policy:InitiateVaultLock' :: InitiateVaultLock -> Maybe VaultLockPolicy
..} = forall a. ToJSON a => a -> Value
Data.toJSON Maybe VaultLockPolicy
policy

instance Data.ToPath InitiateVaultLock where
  toPath :: InitiateVaultLock -> ByteString
toPath InitiateVaultLock' {Maybe VaultLockPolicy
Text
vaultName :: Text
accountId :: Text
policy :: Maybe VaultLockPolicy
$sel:vaultName:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:accountId:InitiateVaultLock' :: InitiateVaultLock -> Text
$sel:policy:InitiateVaultLock' :: InitiateVaultLock -> Maybe VaultLockPolicy
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
vaultName,
        ByteString
"/lock-policy"
      ]

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

-- | Contains the Amazon S3 Glacier response to your request.
--
-- /See:/ 'newInitiateVaultLockResponse' smart constructor.
data InitiateVaultLockResponse = InitiateVaultLockResponse'
  { -- | The lock ID, which is used to complete the vault locking process.
    InitiateVaultLockResponse -> Maybe Text
lockId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    InitiateVaultLockResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (InitiateVaultLockResponse -> InitiateVaultLockResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitiateVaultLockResponse -> InitiateVaultLockResponse -> Bool
$c/= :: InitiateVaultLockResponse -> InitiateVaultLockResponse -> Bool
== :: InitiateVaultLockResponse -> InitiateVaultLockResponse -> Bool
$c== :: InitiateVaultLockResponse -> InitiateVaultLockResponse -> Bool
Prelude.Eq, ReadPrec [InitiateVaultLockResponse]
ReadPrec InitiateVaultLockResponse
Int -> ReadS InitiateVaultLockResponse
ReadS [InitiateVaultLockResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitiateVaultLockResponse]
$creadListPrec :: ReadPrec [InitiateVaultLockResponse]
readPrec :: ReadPrec InitiateVaultLockResponse
$creadPrec :: ReadPrec InitiateVaultLockResponse
readList :: ReadS [InitiateVaultLockResponse]
$creadList :: ReadS [InitiateVaultLockResponse]
readsPrec :: Int -> ReadS InitiateVaultLockResponse
$creadsPrec :: Int -> ReadS InitiateVaultLockResponse
Prelude.Read, Int -> InitiateVaultLockResponse -> ShowS
[InitiateVaultLockResponse] -> ShowS
InitiateVaultLockResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitiateVaultLockResponse] -> ShowS
$cshowList :: [InitiateVaultLockResponse] -> ShowS
show :: InitiateVaultLockResponse -> String
$cshow :: InitiateVaultLockResponse -> String
showsPrec :: Int -> InitiateVaultLockResponse -> ShowS
$cshowsPrec :: Int -> InitiateVaultLockResponse -> ShowS
Prelude.Show, forall x.
Rep InitiateVaultLockResponse x -> InitiateVaultLockResponse
forall x.
InitiateVaultLockResponse -> Rep InitiateVaultLockResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InitiateVaultLockResponse x -> InitiateVaultLockResponse
$cfrom :: forall x.
InitiateVaultLockResponse -> Rep InitiateVaultLockResponse x
Prelude.Generic)

-- |
-- Create a value of 'InitiateVaultLockResponse' 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:
--
-- 'lockId', 'initiateVaultLockResponse_lockId' - The lock ID, which is used to complete the vault locking process.
--
-- 'httpStatus', 'initiateVaultLockResponse_httpStatus' - The response's http status code.
newInitiateVaultLockResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  InitiateVaultLockResponse
newInitiateVaultLockResponse :: Int -> InitiateVaultLockResponse
newInitiateVaultLockResponse Int
pHttpStatus_ =
  InitiateVaultLockResponse'
    { $sel:lockId:InitiateVaultLockResponse' :: Maybe Text
lockId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:InitiateVaultLockResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The lock ID, which is used to complete the vault locking process.
initiateVaultLockResponse_lockId :: Lens.Lens' InitiateVaultLockResponse (Prelude.Maybe Prelude.Text)
initiateVaultLockResponse_lockId :: Lens' InitiateVaultLockResponse (Maybe Text)
initiateVaultLockResponse_lockId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InitiateVaultLockResponse' {Maybe Text
lockId :: Maybe Text
$sel:lockId:InitiateVaultLockResponse' :: InitiateVaultLockResponse -> Maybe Text
lockId} -> Maybe Text
lockId) (\s :: InitiateVaultLockResponse
s@InitiateVaultLockResponse' {} Maybe Text
a -> InitiateVaultLockResponse
s {$sel:lockId:InitiateVaultLockResponse' :: Maybe Text
lockId = Maybe Text
a} :: InitiateVaultLockResponse)

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

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