{-# 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.ConnectParticipant.StartAttachmentUpload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides a pre-signed Amazon S3 URL in response for uploading the file
-- directly to S3.
--
-- @ConnectionToken@ is used for invoking this API instead of
-- @ParticipantToken@.
--
-- The Amazon Connect Participant Service APIs do not use
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 authentication>.
module Amazonka.ConnectParticipant.StartAttachmentUpload
  ( -- * Creating a Request
    StartAttachmentUpload (..),
    newStartAttachmentUpload,

    -- * Request Lenses
    startAttachmentUpload_contentType,
    startAttachmentUpload_attachmentSizeInBytes,
    startAttachmentUpload_attachmentName,
    startAttachmentUpload_clientToken,
    startAttachmentUpload_connectionToken,

    -- * Destructuring the Response
    StartAttachmentUploadResponse (..),
    newStartAttachmentUploadResponse,

    -- * Response Lenses
    startAttachmentUploadResponse_attachmentId,
    startAttachmentUploadResponse_uploadMetadata,
    startAttachmentUploadResponse_httpStatus,
  )
where

import Amazonka.ConnectParticipant.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:/ 'newStartAttachmentUpload' smart constructor.
data StartAttachmentUpload = StartAttachmentUpload'
  { -- | Describes the MIME file type of the attachment. For a list of supported
    -- file types, see
    -- <https://docs.aws.amazon.com/connect/latest/adminguide/feature-limits.html Feature specifications>
    -- in the /Amazon Connect Administrator Guide/.
    StartAttachmentUpload -> Text
contentType :: Prelude.Text,
    -- | The size of the attachment in bytes.
    StartAttachmentUpload -> Natural
attachmentSizeInBytes :: Prelude.Natural,
    -- | A case-sensitive name of the attachment being uploaded.
    StartAttachmentUpload -> Text
attachmentName :: Prelude.Text,
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. If not provided, the Amazon Web Services SDK
    -- populates this field. For more information about idempotency, see
    -- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
    StartAttachmentUpload -> Text
clientToken :: Prelude.Text,
    -- | The authentication token associated with the participant\'s connection.
    StartAttachmentUpload -> Text
connectionToken :: Prelude.Text
  }
  deriving (StartAttachmentUpload -> StartAttachmentUpload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAttachmentUpload -> StartAttachmentUpload -> Bool
$c/= :: StartAttachmentUpload -> StartAttachmentUpload -> Bool
== :: StartAttachmentUpload -> StartAttachmentUpload -> Bool
$c== :: StartAttachmentUpload -> StartAttachmentUpload -> Bool
Prelude.Eq, ReadPrec [StartAttachmentUpload]
ReadPrec StartAttachmentUpload
Int -> ReadS StartAttachmentUpload
ReadS [StartAttachmentUpload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAttachmentUpload]
$creadListPrec :: ReadPrec [StartAttachmentUpload]
readPrec :: ReadPrec StartAttachmentUpload
$creadPrec :: ReadPrec StartAttachmentUpload
readList :: ReadS [StartAttachmentUpload]
$creadList :: ReadS [StartAttachmentUpload]
readsPrec :: Int -> ReadS StartAttachmentUpload
$creadsPrec :: Int -> ReadS StartAttachmentUpload
Prelude.Read, Int -> StartAttachmentUpload -> ShowS
[StartAttachmentUpload] -> ShowS
StartAttachmentUpload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAttachmentUpload] -> ShowS
$cshowList :: [StartAttachmentUpload] -> ShowS
show :: StartAttachmentUpload -> String
$cshow :: StartAttachmentUpload -> String
showsPrec :: Int -> StartAttachmentUpload -> ShowS
$cshowsPrec :: Int -> StartAttachmentUpload -> ShowS
Prelude.Show, forall x. Rep StartAttachmentUpload x -> StartAttachmentUpload
forall x. StartAttachmentUpload -> Rep StartAttachmentUpload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartAttachmentUpload x -> StartAttachmentUpload
$cfrom :: forall x. StartAttachmentUpload -> Rep StartAttachmentUpload x
Prelude.Generic)

-- |
-- Create a value of 'StartAttachmentUpload' 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:
--
-- 'contentType', 'startAttachmentUpload_contentType' - Describes the MIME file type of the attachment. For a list of supported
-- file types, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/feature-limits.html Feature specifications>
-- in the /Amazon Connect Administrator Guide/.
--
-- 'attachmentSizeInBytes', 'startAttachmentUpload_attachmentSizeInBytes' - The size of the attachment in bytes.
--
-- 'attachmentName', 'startAttachmentUpload_attachmentName' - A case-sensitive name of the attachment being uploaded.
--
-- 'clientToken', 'startAttachmentUpload_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
--
-- 'connectionToken', 'startAttachmentUpload_connectionToken' - The authentication token associated with the participant\'s connection.
newStartAttachmentUpload ::
  -- | 'contentType'
  Prelude.Text ->
  -- | 'attachmentSizeInBytes'
  Prelude.Natural ->
  -- | 'attachmentName'
  Prelude.Text ->
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'connectionToken'
  Prelude.Text ->
  StartAttachmentUpload
newStartAttachmentUpload :: Text -> Natural -> Text -> Text -> Text -> StartAttachmentUpload
newStartAttachmentUpload
  Text
pContentType_
  Natural
pAttachmentSizeInBytes_
  Text
pAttachmentName_
  Text
pClientToken_
  Text
pConnectionToken_ =
    StartAttachmentUpload'
      { $sel:contentType:StartAttachmentUpload' :: Text
contentType = Text
pContentType_,
        $sel:attachmentSizeInBytes:StartAttachmentUpload' :: Natural
attachmentSizeInBytes = Natural
pAttachmentSizeInBytes_,
        $sel:attachmentName:StartAttachmentUpload' :: Text
attachmentName = Text
pAttachmentName_,
        $sel:clientToken:StartAttachmentUpload' :: Text
clientToken = Text
pClientToken_,
        $sel:connectionToken:StartAttachmentUpload' :: Text
connectionToken = Text
pConnectionToken_
      }

-- | Describes the MIME file type of the attachment. For a list of supported
-- file types, see
-- <https://docs.aws.amazon.com/connect/latest/adminguide/feature-limits.html Feature specifications>
-- in the /Amazon Connect Administrator Guide/.
startAttachmentUpload_contentType :: Lens.Lens' StartAttachmentUpload Prelude.Text
startAttachmentUpload_contentType :: Lens' StartAttachmentUpload Text
startAttachmentUpload_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUpload' {Text
contentType :: Text
$sel:contentType:StartAttachmentUpload' :: StartAttachmentUpload -> Text
contentType} -> Text
contentType) (\s :: StartAttachmentUpload
s@StartAttachmentUpload' {} Text
a -> StartAttachmentUpload
s {$sel:contentType:StartAttachmentUpload' :: Text
contentType = Text
a} :: StartAttachmentUpload)

-- | The size of the attachment in bytes.
startAttachmentUpload_attachmentSizeInBytes :: Lens.Lens' StartAttachmentUpload Prelude.Natural
startAttachmentUpload_attachmentSizeInBytes :: Lens' StartAttachmentUpload Natural
startAttachmentUpload_attachmentSizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUpload' {Natural
attachmentSizeInBytes :: Natural
$sel:attachmentSizeInBytes:StartAttachmentUpload' :: StartAttachmentUpload -> Natural
attachmentSizeInBytes} -> Natural
attachmentSizeInBytes) (\s :: StartAttachmentUpload
s@StartAttachmentUpload' {} Natural
a -> StartAttachmentUpload
s {$sel:attachmentSizeInBytes:StartAttachmentUpload' :: Natural
attachmentSizeInBytes = Natural
a} :: StartAttachmentUpload)

-- | A case-sensitive name of the attachment being uploaded.
startAttachmentUpload_attachmentName :: Lens.Lens' StartAttachmentUpload Prelude.Text
startAttachmentUpload_attachmentName :: Lens' StartAttachmentUpload Text
startAttachmentUpload_attachmentName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUpload' {Text
attachmentName :: Text
$sel:attachmentName:StartAttachmentUpload' :: StartAttachmentUpload -> Text
attachmentName} -> Text
attachmentName) (\s :: StartAttachmentUpload
s@StartAttachmentUpload' {} Text
a -> StartAttachmentUpload
s {$sel:attachmentName:StartAttachmentUpload' :: Text
attachmentName = Text
a} :: StartAttachmentUpload)

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. If not provided, the Amazon Web Services SDK
-- populates this field. For more information about idempotency, see
-- <https://aws.amazon.com/builders-library/making-retries-safe-with-idempotent-APIs/ Making retries safe with idempotent APIs>.
startAttachmentUpload_clientToken :: Lens.Lens' StartAttachmentUpload Prelude.Text
startAttachmentUpload_clientToken :: Lens' StartAttachmentUpload Text
startAttachmentUpload_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUpload' {Text
clientToken :: Text
$sel:clientToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
clientToken} -> Text
clientToken) (\s :: StartAttachmentUpload
s@StartAttachmentUpload' {} Text
a -> StartAttachmentUpload
s {$sel:clientToken:StartAttachmentUpload' :: Text
clientToken = Text
a} :: StartAttachmentUpload)

-- | The authentication token associated with the participant\'s connection.
startAttachmentUpload_connectionToken :: Lens.Lens' StartAttachmentUpload Prelude.Text
startAttachmentUpload_connectionToken :: Lens' StartAttachmentUpload Text
startAttachmentUpload_connectionToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUpload' {Text
connectionToken :: Text
$sel:connectionToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
connectionToken} -> Text
connectionToken) (\s :: StartAttachmentUpload
s@StartAttachmentUpload' {} Text
a -> StartAttachmentUpload
s {$sel:connectionToken:StartAttachmentUpload' :: Text
connectionToken = Text
a} :: StartAttachmentUpload)

instance Core.AWSRequest StartAttachmentUpload where
  type
    AWSResponse StartAttachmentUpload =
      StartAttachmentUploadResponse
  request :: (Service -> Service)
-> StartAttachmentUpload -> Request StartAttachmentUpload
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 StartAttachmentUpload
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartAttachmentUpload)))
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 UploadMetadata -> Int -> StartAttachmentUploadResponse
StartAttachmentUploadResponse'
            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
"AttachmentId")
            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
"UploadMetadata")
            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 StartAttachmentUpload where
  hashWithSalt :: Int -> StartAttachmentUpload -> Int
hashWithSalt Int
_salt StartAttachmentUpload' {Natural
Text
connectionToken :: Text
clientToken :: Text
attachmentName :: Text
attachmentSizeInBytes :: Natural
contentType :: Text
$sel:connectionToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:clientToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentName:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentSizeInBytes:StartAttachmentUpload' :: StartAttachmentUpload -> Natural
$sel:contentType:StartAttachmentUpload' :: StartAttachmentUpload -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
attachmentSizeInBytes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attachmentName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionToken

instance Prelude.NFData StartAttachmentUpload where
  rnf :: StartAttachmentUpload -> ()
rnf StartAttachmentUpload' {Natural
Text
connectionToken :: Text
clientToken :: Text
attachmentName :: Text
attachmentSizeInBytes :: Natural
contentType :: Text
$sel:connectionToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:clientToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentName:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentSizeInBytes:StartAttachmentUpload' :: StartAttachmentUpload -> Natural
$sel:contentType:StartAttachmentUpload' :: StartAttachmentUpload -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
attachmentSizeInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
attachmentName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionToken

instance Data.ToHeaders StartAttachmentUpload where
  toHeaders :: StartAttachmentUpload -> ResponseHeaders
toHeaders StartAttachmentUpload' {Natural
Text
connectionToken :: Text
clientToken :: Text
attachmentName :: Text
attachmentSizeInBytes :: Natural
contentType :: Text
$sel:connectionToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:clientToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentName:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentSizeInBytes:StartAttachmentUpload' :: StartAttachmentUpload -> Natural
$sel:contentType:StartAttachmentUpload' :: StartAttachmentUpload -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"X-Amz-Bearer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
connectionToken,
        HeaderName
"Content-Type"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"application/x-amz-json-1.1" :: Prelude.ByteString)
      ]

instance Data.ToJSON StartAttachmentUpload where
  toJSON :: StartAttachmentUpload -> Value
toJSON StartAttachmentUpload' {Natural
Text
connectionToken :: Text
clientToken :: Text
attachmentName :: Text
attachmentSizeInBytes :: Natural
contentType :: Text
$sel:connectionToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:clientToken:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentName:StartAttachmentUpload' :: StartAttachmentUpload -> Text
$sel:attachmentSizeInBytes:StartAttachmentUpload' :: StartAttachmentUpload -> Natural
$sel:contentType:StartAttachmentUpload' :: StartAttachmentUpload -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ContentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
contentType),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AttachmentSizeInBytes"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
attachmentSizeInBytes
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AttachmentName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attachmentName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken)
          ]
      )

instance Data.ToPath StartAttachmentUpload where
  toPath :: StartAttachmentUpload -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/participant/start-attachment-upload"

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

-- | /See:/ 'newStartAttachmentUploadResponse' smart constructor.
data StartAttachmentUploadResponse = StartAttachmentUploadResponse'
  { -- | A unique identifier for the attachment.
    StartAttachmentUploadResponse -> Maybe Text
attachmentId :: Prelude.Maybe Prelude.Text,
    -- | Fields to be used while uploading the attachment.
    StartAttachmentUploadResponse -> Maybe UploadMetadata
uploadMetadata :: Prelude.Maybe UploadMetadata,
    -- | The response's http status code.
    StartAttachmentUploadResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartAttachmentUploadResponse
-> StartAttachmentUploadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAttachmentUploadResponse
-> StartAttachmentUploadResponse -> Bool
$c/= :: StartAttachmentUploadResponse
-> StartAttachmentUploadResponse -> Bool
== :: StartAttachmentUploadResponse
-> StartAttachmentUploadResponse -> Bool
$c== :: StartAttachmentUploadResponse
-> StartAttachmentUploadResponse -> Bool
Prelude.Eq, ReadPrec [StartAttachmentUploadResponse]
ReadPrec StartAttachmentUploadResponse
Int -> ReadS StartAttachmentUploadResponse
ReadS [StartAttachmentUploadResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAttachmentUploadResponse]
$creadListPrec :: ReadPrec [StartAttachmentUploadResponse]
readPrec :: ReadPrec StartAttachmentUploadResponse
$creadPrec :: ReadPrec StartAttachmentUploadResponse
readList :: ReadS [StartAttachmentUploadResponse]
$creadList :: ReadS [StartAttachmentUploadResponse]
readsPrec :: Int -> ReadS StartAttachmentUploadResponse
$creadsPrec :: Int -> ReadS StartAttachmentUploadResponse
Prelude.Read, Int -> StartAttachmentUploadResponse -> ShowS
[StartAttachmentUploadResponse] -> ShowS
StartAttachmentUploadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAttachmentUploadResponse] -> ShowS
$cshowList :: [StartAttachmentUploadResponse] -> ShowS
show :: StartAttachmentUploadResponse -> String
$cshow :: StartAttachmentUploadResponse -> String
showsPrec :: Int -> StartAttachmentUploadResponse -> ShowS
$cshowsPrec :: Int -> StartAttachmentUploadResponse -> ShowS
Prelude.Show, forall x.
Rep StartAttachmentUploadResponse x
-> StartAttachmentUploadResponse
forall x.
StartAttachmentUploadResponse
-> Rep StartAttachmentUploadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartAttachmentUploadResponse x
-> StartAttachmentUploadResponse
$cfrom :: forall x.
StartAttachmentUploadResponse
-> Rep StartAttachmentUploadResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartAttachmentUploadResponse' 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:
--
-- 'attachmentId', 'startAttachmentUploadResponse_attachmentId' - A unique identifier for the attachment.
--
-- 'uploadMetadata', 'startAttachmentUploadResponse_uploadMetadata' - Fields to be used while uploading the attachment.
--
-- 'httpStatus', 'startAttachmentUploadResponse_httpStatus' - The response's http status code.
newStartAttachmentUploadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartAttachmentUploadResponse
newStartAttachmentUploadResponse :: Int -> StartAttachmentUploadResponse
newStartAttachmentUploadResponse Int
pHttpStatus_ =
  StartAttachmentUploadResponse'
    { $sel:attachmentId:StartAttachmentUploadResponse' :: Maybe Text
attachmentId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:uploadMetadata:StartAttachmentUploadResponse' :: Maybe UploadMetadata
uploadMetadata = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartAttachmentUploadResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier for the attachment.
startAttachmentUploadResponse_attachmentId :: Lens.Lens' StartAttachmentUploadResponse (Prelude.Maybe Prelude.Text)
startAttachmentUploadResponse_attachmentId :: Lens' StartAttachmentUploadResponse (Maybe Text)
startAttachmentUploadResponse_attachmentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUploadResponse' {Maybe Text
attachmentId :: Maybe Text
$sel:attachmentId:StartAttachmentUploadResponse' :: StartAttachmentUploadResponse -> Maybe Text
attachmentId} -> Maybe Text
attachmentId) (\s :: StartAttachmentUploadResponse
s@StartAttachmentUploadResponse' {} Maybe Text
a -> StartAttachmentUploadResponse
s {$sel:attachmentId:StartAttachmentUploadResponse' :: Maybe Text
attachmentId = Maybe Text
a} :: StartAttachmentUploadResponse)

-- | Fields to be used while uploading the attachment.
startAttachmentUploadResponse_uploadMetadata :: Lens.Lens' StartAttachmentUploadResponse (Prelude.Maybe UploadMetadata)
startAttachmentUploadResponse_uploadMetadata :: Lens' StartAttachmentUploadResponse (Maybe UploadMetadata)
startAttachmentUploadResponse_uploadMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAttachmentUploadResponse' {Maybe UploadMetadata
uploadMetadata :: Maybe UploadMetadata
$sel:uploadMetadata:StartAttachmentUploadResponse' :: StartAttachmentUploadResponse -> Maybe UploadMetadata
uploadMetadata} -> Maybe UploadMetadata
uploadMetadata) (\s :: StartAttachmentUploadResponse
s@StartAttachmentUploadResponse' {} Maybe UploadMetadata
a -> StartAttachmentUploadResponse
s {$sel:uploadMetadata:StartAttachmentUploadResponse' :: Maybe UploadMetadata
uploadMetadata = Maybe UploadMetadata
a} :: StartAttachmentUploadResponse)

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

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