{-# 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.CompleteVaultLock
-- 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 completes the vault locking process by transitioning the
-- vault lock from the @InProgress@ state to the @Locked@ state, which
-- causes the vault lock policy to become unchangeable. A vault lock is put
-- into the @InProgress@ state by calling InitiateVaultLock. You can obtain
-- 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>.
--
-- This operation is idempotent. This request is always successful if the
-- vault lock is in the @Locked@ state and the provided lock ID matches the
-- lock ID originally used to lock the vault.
--
-- If an invalid lock ID is passed in the request when the vault lock is in
-- the @Locked@ state, the operation returns an @AccessDeniedException@
-- error. If an invalid lock ID is passed in the request when the vault
-- lock is in the @InProgress@ state, the operation throws an
-- @InvalidParameter@ error.
module Amazonka.Glacier.CompleteVaultLock
  ( -- * Creating a Request
    CompleteVaultLock (..),
    newCompleteVaultLock,

    -- * Request Lenses
    completeVaultLock_accountId,
    completeVaultLock_vaultName,
    completeVaultLock_lockId,

    -- * Destructuring the Response
    CompleteVaultLockResponse (..),
    newCompleteVaultLockResponse,
  )
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 @CompleteVaultLock@.
--
-- /See:/ 'newCompleteVaultLock' smart constructor.
data CompleteVaultLock = CompleteVaultLock'
  { -- | 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.
    CompleteVaultLock -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    CompleteVaultLock -> Text
vaultName :: Prelude.Text,
    -- | The @lockId@ value is the lock ID obtained from a InitiateVaultLock
    -- request.
    CompleteVaultLock -> Text
lockId :: Prelude.Text
  }
  deriving (CompleteVaultLock -> CompleteVaultLock -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteVaultLock -> CompleteVaultLock -> Bool
$c/= :: CompleteVaultLock -> CompleteVaultLock -> Bool
== :: CompleteVaultLock -> CompleteVaultLock -> Bool
$c== :: CompleteVaultLock -> CompleteVaultLock -> Bool
Prelude.Eq, ReadPrec [CompleteVaultLock]
ReadPrec CompleteVaultLock
Int -> ReadS CompleteVaultLock
ReadS [CompleteVaultLock]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteVaultLock]
$creadListPrec :: ReadPrec [CompleteVaultLock]
readPrec :: ReadPrec CompleteVaultLock
$creadPrec :: ReadPrec CompleteVaultLock
readList :: ReadS [CompleteVaultLock]
$creadList :: ReadS [CompleteVaultLock]
readsPrec :: Int -> ReadS CompleteVaultLock
$creadsPrec :: Int -> ReadS CompleteVaultLock
Prelude.Read, Int -> CompleteVaultLock -> ShowS
[CompleteVaultLock] -> ShowS
CompleteVaultLock -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteVaultLock] -> ShowS
$cshowList :: [CompleteVaultLock] -> ShowS
show :: CompleteVaultLock -> String
$cshow :: CompleteVaultLock -> String
showsPrec :: Int -> CompleteVaultLock -> ShowS
$cshowsPrec :: Int -> CompleteVaultLock -> ShowS
Prelude.Show, forall x. Rep CompleteVaultLock x -> CompleteVaultLock
forall x. CompleteVaultLock -> Rep CompleteVaultLock x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteVaultLock x -> CompleteVaultLock
$cfrom :: forall x. CompleteVaultLock -> Rep CompleteVaultLock x
Prelude.Generic)

-- |
-- Create a value of 'CompleteVaultLock' 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:
--
-- 'accountId', 'completeVaultLock_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', 'completeVaultLock_vaultName' - The name of the vault.
--
-- 'lockId', 'completeVaultLock_lockId' - The @lockId@ value is the lock ID obtained from a InitiateVaultLock
-- request.
newCompleteVaultLock ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  -- | 'lockId'
  Prelude.Text ->
  CompleteVaultLock
newCompleteVaultLock :: Text -> Text -> Text -> CompleteVaultLock
newCompleteVaultLock Text
pAccountId_ Text
pVaultName_ Text
pLockId_ =
  CompleteVaultLock'
    { $sel:accountId:CompleteVaultLock' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:CompleteVaultLock' :: Text
vaultName = Text
pVaultName_,
      $sel:lockId:CompleteVaultLock' :: Text
lockId = Text
pLockId_
    }

-- | 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.
completeVaultLock_accountId :: Lens.Lens' CompleteVaultLock Prelude.Text
completeVaultLock_accountId :: Lens' CompleteVaultLock Text
completeVaultLock_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteVaultLock' {Text
accountId :: Text
$sel:accountId:CompleteVaultLock' :: CompleteVaultLock -> Text
accountId} -> Text
accountId) (\s :: CompleteVaultLock
s@CompleteVaultLock' {} Text
a -> CompleteVaultLock
s {$sel:accountId:CompleteVaultLock' :: Text
accountId = Text
a} :: CompleteVaultLock)

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

-- | The @lockId@ value is the lock ID obtained from a InitiateVaultLock
-- request.
completeVaultLock_lockId :: Lens.Lens' CompleteVaultLock Prelude.Text
completeVaultLock_lockId :: Lens' CompleteVaultLock Text
completeVaultLock_lockId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteVaultLock' {Text
lockId :: Text
$sel:lockId:CompleteVaultLock' :: CompleteVaultLock -> Text
lockId} -> Text
lockId) (\s :: CompleteVaultLock
s@CompleteVaultLock' {} Text
a -> CompleteVaultLock
s {$sel:lockId:CompleteVaultLock' :: Text
lockId = Text
a} :: CompleteVaultLock)

instance Core.AWSRequest CompleteVaultLock where
  type
    AWSResponse CompleteVaultLock =
      CompleteVaultLockResponse
  request :: (Service -> Service)
-> CompleteVaultLock -> Request CompleteVaultLock
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 CompleteVaultLock
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CompleteVaultLock)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull CompleteVaultLockResponse
CompleteVaultLockResponse'

instance Prelude.Hashable CompleteVaultLock where
  hashWithSalt :: Int -> CompleteVaultLock -> Int
hashWithSalt Int
_salt CompleteVaultLock' {Text
lockId :: Text
vaultName :: Text
accountId :: Text
$sel:lockId:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:vaultName:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:accountId:CompleteVaultLock' :: CompleteVaultLock -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vaultName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
lockId

instance Prelude.NFData CompleteVaultLock where
  rnf :: CompleteVaultLock -> ()
rnf CompleteVaultLock' {Text
lockId :: Text
vaultName :: Text
accountId :: Text
$sel:lockId:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:vaultName:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:accountId:CompleteVaultLock' :: CompleteVaultLock -> Text
..} =
    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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
lockId

instance Data.ToHeaders CompleteVaultLock where
  toHeaders :: CompleteVaultLock -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON CompleteVaultLock where
  toJSON :: CompleteVaultLock -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CompleteVaultLock where
  toPath :: CompleteVaultLock -> ByteString
toPath CompleteVaultLock' {Text
lockId :: Text
vaultName :: Text
accountId :: Text
$sel:lockId:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:vaultName:CompleteVaultLock' :: CompleteVaultLock -> Text
$sel:accountId:CompleteVaultLock' :: CompleteVaultLock -> Text
..} =
    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/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
lockId
      ]

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

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

-- |
-- Create a value of 'CompleteVaultLockResponse' 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.
newCompleteVaultLockResponse ::
  CompleteVaultLockResponse
newCompleteVaultLockResponse :: CompleteVaultLockResponse
newCompleteVaultLockResponse =
  CompleteVaultLockResponse
CompleteVaultLockResponse'

instance Prelude.NFData CompleteVaultLockResponse where
  rnf :: CompleteVaultLockResponse -> ()
rnf CompleteVaultLockResponse
_ = ()