{-# 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.BackupStorage.StartObject
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Start upload containing one or many chunks.
module Amazonka.BackupStorage.StartObject
  ( -- * Creating a Request
    StartObject (..),
    newStartObject,

    -- * Request Lenses
    startObject_throwOnDuplicate,
    startObject_backupJobId,
    startObject_objectName,

    -- * Destructuring the Response
    StartObjectResponse (..),
    newStartObjectResponse,

    -- * Response Lenses
    startObjectResponse_httpStatus,
    startObjectResponse_uploadId,
  )
where

import Amazonka.BackupStorage.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:/ 'newStartObject' smart constructor.
data StartObject = StartObject'
  { -- | Throw an exception if Object name is already exist.
    StartObject -> Maybe Bool
throwOnDuplicate :: Prelude.Maybe Prelude.Bool,
    -- | Backup job Id for the in-progress backup
    StartObject -> Text
backupJobId :: Prelude.Text,
    -- | Name for the object.
    StartObject -> Text
objectName :: Prelude.Text
  }
  deriving (StartObject -> StartObject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartObject -> StartObject -> Bool
$c/= :: StartObject -> StartObject -> Bool
== :: StartObject -> StartObject -> Bool
$c== :: StartObject -> StartObject -> Bool
Prelude.Eq, ReadPrec [StartObject]
ReadPrec StartObject
Int -> ReadS StartObject
ReadS [StartObject]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartObject]
$creadListPrec :: ReadPrec [StartObject]
readPrec :: ReadPrec StartObject
$creadPrec :: ReadPrec StartObject
readList :: ReadS [StartObject]
$creadList :: ReadS [StartObject]
readsPrec :: Int -> ReadS StartObject
$creadsPrec :: Int -> ReadS StartObject
Prelude.Read, Int -> StartObject -> ShowS
[StartObject] -> ShowS
StartObject -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartObject] -> ShowS
$cshowList :: [StartObject] -> ShowS
show :: StartObject -> String
$cshow :: StartObject -> String
showsPrec :: Int -> StartObject -> ShowS
$cshowsPrec :: Int -> StartObject -> ShowS
Prelude.Show, forall x. Rep StartObject x -> StartObject
forall x. StartObject -> Rep StartObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartObject x -> StartObject
$cfrom :: forall x. StartObject -> Rep StartObject x
Prelude.Generic)

-- |
-- Create a value of 'StartObject' 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:
--
-- 'throwOnDuplicate', 'startObject_throwOnDuplicate' - Throw an exception if Object name is already exist.
--
-- 'backupJobId', 'startObject_backupJobId' - Backup job Id for the in-progress backup
--
-- 'objectName', 'startObject_objectName' - Name for the object.
newStartObject ::
  -- | 'backupJobId'
  Prelude.Text ->
  -- | 'objectName'
  Prelude.Text ->
  StartObject
newStartObject :: Text -> Text -> StartObject
newStartObject Text
pBackupJobId_ Text
pObjectName_ =
  StartObject'
    { $sel:throwOnDuplicate:StartObject' :: Maybe Bool
throwOnDuplicate = forall a. Maybe a
Prelude.Nothing,
      $sel:backupJobId:StartObject' :: Text
backupJobId = Text
pBackupJobId_,
      $sel:objectName:StartObject' :: Text
objectName = Text
pObjectName_
    }

-- | Throw an exception if Object name is already exist.
startObject_throwOnDuplicate :: Lens.Lens' StartObject (Prelude.Maybe Prelude.Bool)
startObject_throwOnDuplicate :: Lens' StartObject (Maybe Bool)
startObject_throwOnDuplicate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartObject' {Maybe Bool
throwOnDuplicate :: Maybe Bool
$sel:throwOnDuplicate:StartObject' :: StartObject -> Maybe Bool
throwOnDuplicate} -> Maybe Bool
throwOnDuplicate) (\s :: StartObject
s@StartObject' {} Maybe Bool
a -> StartObject
s {$sel:throwOnDuplicate:StartObject' :: Maybe Bool
throwOnDuplicate = Maybe Bool
a} :: StartObject)

-- | Backup job Id for the in-progress backup
startObject_backupJobId :: Lens.Lens' StartObject Prelude.Text
startObject_backupJobId :: Lens' StartObject Text
startObject_backupJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartObject' {Text
backupJobId :: Text
$sel:backupJobId:StartObject' :: StartObject -> Text
backupJobId} -> Text
backupJobId) (\s :: StartObject
s@StartObject' {} Text
a -> StartObject
s {$sel:backupJobId:StartObject' :: Text
backupJobId = Text
a} :: StartObject)

-- | Name for the object.
startObject_objectName :: Lens.Lens' StartObject Prelude.Text
startObject_objectName :: Lens' StartObject Text
startObject_objectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartObject' {Text
objectName :: Text
$sel:objectName:StartObject' :: StartObject -> Text
objectName} -> Text
objectName) (\s :: StartObject
s@StartObject' {} Text
a -> StartObject
s {$sel:objectName:StartObject' :: Text
objectName = Text
a} :: StartObject)

instance Core.AWSRequest StartObject where
  type AWSResponse StartObject = StartObjectResponse
  request :: (Service -> Service) -> StartObject -> Request StartObject
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartObject
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartObject)))
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 ->
          Int -> Text -> StartObjectResponse
StartObjectResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"UploadId")
      )

instance Prelude.Hashable StartObject where
  hashWithSalt :: Int -> StartObject -> Int
hashWithSalt Int
_salt StartObject' {Maybe Bool
Text
objectName :: Text
backupJobId :: Text
throwOnDuplicate :: Maybe Bool
$sel:objectName:StartObject' :: StartObject -> Text
$sel:backupJobId:StartObject' :: StartObject -> Text
$sel:throwOnDuplicate:StartObject' :: StartObject -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
throwOnDuplicate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupJobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectName

instance Prelude.NFData StartObject where
  rnf :: StartObject -> ()
rnf StartObject' {Maybe Bool
Text
objectName :: Text
backupJobId :: Text
throwOnDuplicate :: Maybe Bool
$sel:objectName:StartObject' :: StartObject -> Text
$sel:backupJobId:StartObject' :: StartObject -> Text
$sel:throwOnDuplicate:StartObject' :: StartObject -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
throwOnDuplicate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
backupJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
objectName

instance Data.ToHeaders StartObject where
  toHeaders :: StartObject -> 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 StartObject where
  toJSON :: StartObject -> Value
toJSON StartObject' {Maybe Bool
Text
objectName :: Text
backupJobId :: Text
throwOnDuplicate :: Maybe Bool
$sel:objectName:StartObject' :: StartObject -> Text
$sel:backupJobId:StartObject' :: StartObject -> Text
$sel:throwOnDuplicate:StartObject' :: StartObject -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ThrowOnDuplicate" 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 Bool
throwOnDuplicate
          ]
      )

instance Data.ToPath StartObject where
  toPath :: StartObject -> ByteString
toPath StartObject' {Maybe Bool
Text
objectName :: Text
backupJobId :: Text
throwOnDuplicate :: Maybe Bool
$sel:objectName:StartObject' :: StartObject -> Text
$sel:backupJobId:StartObject' :: StartObject -> Text
$sel:throwOnDuplicate:StartObject' :: StartObject -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup-jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupJobId,
        ByteString
"/object/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
objectName
      ]

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

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

-- |
-- Create a value of 'StartObjectResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'startObjectResponse_httpStatus' - The response's http status code.
--
-- 'uploadId', 'startObjectResponse_uploadId' - Upload Id for a given upload.
newStartObjectResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'uploadId'
  Prelude.Text ->
  StartObjectResponse
newStartObjectResponse :: Int -> Text -> StartObjectResponse
newStartObjectResponse Int
pHttpStatus_ Text
pUploadId_ =
  StartObjectResponse'
    { $sel:httpStatus:StartObjectResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:uploadId:StartObjectResponse' :: Text
uploadId = Text
pUploadId_
    }

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

-- | Upload Id for a given upload.
startObjectResponse_uploadId :: Lens.Lens' StartObjectResponse Prelude.Text
startObjectResponse_uploadId :: Lens' StartObjectResponse Text
startObjectResponse_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartObjectResponse' {Text
uploadId :: Text
$sel:uploadId:StartObjectResponse' :: StartObjectResponse -> Text
uploadId} -> Text
uploadId) (\s :: StartObjectResponse
s@StartObjectResponse' {} Text
a -> StartObjectResponse
s {$sel:uploadId:StartObjectResponse' :: Text
uploadId = Text
a} :: StartObjectResponse)

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