{-# 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.GetAttachment
-- 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 URL for download of a completed attachment. This
-- is an asynchronous API for use with active contacts.
--
-- @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.GetAttachment
  ( -- * Creating a Request
    GetAttachment (..),
    newGetAttachment,

    -- * Request Lenses
    getAttachment_attachmentId,
    getAttachment_connectionToken,

    -- * Destructuring the Response
    GetAttachmentResponse (..),
    newGetAttachmentResponse,

    -- * Response Lenses
    getAttachmentResponse_url,
    getAttachmentResponse_urlExpiry,
    getAttachmentResponse_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:/ 'newGetAttachment' smart constructor.
data GetAttachment = GetAttachment'
  { -- | A unique identifier for the attachment.
    GetAttachment -> Text
attachmentId :: Prelude.Text,
    -- | The authentication token associated with the participant\'s connection.
    GetAttachment -> Text
connectionToken :: Prelude.Text
  }
  deriving (GetAttachment -> GetAttachment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAttachment -> GetAttachment -> Bool
$c/= :: GetAttachment -> GetAttachment -> Bool
== :: GetAttachment -> GetAttachment -> Bool
$c== :: GetAttachment -> GetAttachment -> Bool
Prelude.Eq, ReadPrec [GetAttachment]
ReadPrec GetAttachment
Int -> ReadS GetAttachment
ReadS [GetAttachment]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAttachment]
$creadListPrec :: ReadPrec [GetAttachment]
readPrec :: ReadPrec GetAttachment
$creadPrec :: ReadPrec GetAttachment
readList :: ReadS [GetAttachment]
$creadList :: ReadS [GetAttachment]
readsPrec :: Int -> ReadS GetAttachment
$creadsPrec :: Int -> ReadS GetAttachment
Prelude.Read, Int -> GetAttachment -> ShowS
[GetAttachment] -> ShowS
GetAttachment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAttachment] -> ShowS
$cshowList :: [GetAttachment] -> ShowS
show :: GetAttachment -> String
$cshow :: GetAttachment -> String
showsPrec :: Int -> GetAttachment -> ShowS
$cshowsPrec :: Int -> GetAttachment -> ShowS
Prelude.Show, forall x. Rep GetAttachment x -> GetAttachment
forall x. GetAttachment -> Rep GetAttachment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAttachment x -> GetAttachment
$cfrom :: forall x. GetAttachment -> Rep GetAttachment x
Prelude.Generic)

-- |
-- Create a value of 'GetAttachment' 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', 'getAttachment_attachmentId' - A unique identifier for the attachment.
--
-- 'connectionToken', 'getAttachment_connectionToken' - The authentication token associated with the participant\'s connection.
newGetAttachment ::
  -- | 'attachmentId'
  Prelude.Text ->
  -- | 'connectionToken'
  Prelude.Text ->
  GetAttachment
newGetAttachment :: Text -> Text -> GetAttachment
newGetAttachment Text
pAttachmentId_ Text
pConnectionToken_ =
  GetAttachment'
    { $sel:attachmentId:GetAttachment' :: Text
attachmentId = Text
pAttachmentId_,
      $sel:connectionToken:GetAttachment' :: Text
connectionToken = Text
pConnectionToken_
    }

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

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

instance Core.AWSRequest GetAttachment where
  type
    AWSResponse GetAttachment =
      GetAttachmentResponse
  request :: (Service -> Service) -> GetAttachment -> Request GetAttachment
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 GetAttachment
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetAttachment)))
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 Text -> Int -> GetAttachmentResponse
GetAttachmentResponse'
            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
"Url")
            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
"UrlExpiry")
            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 GetAttachment where
  hashWithSalt :: Int -> GetAttachment -> Int
hashWithSalt Int
_salt GetAttachment' {Text
connectionToken :: Text
attachmentId :: Text
$sel:connectionToken:GetAttachment' :: GetAttachment -> Text
$sel:attachmentId:GetAttachment' :: GetAttachment -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
attachmentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectionToken

instance Prelude.NFData GetAttachment where
  rnf :: GetAttachment -> ()
rnf GetAttachment' {Text
connectionToken :: Text
attachmentId :: Text
$sel:connectionToken:GetAttachment' :: GetAttachment -> Text
$sel:attachmentId:GetAttachment' :: GetAttachment -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
attachmentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectionToken

instance Data.ToHeaders GetAttachment where
  toHeaders :: GetAttachment -> ResponseHeaders
toHeaders GetAttachment' {Text
connectionToken :: Text
attachmentId :: Text
$sel:connectionToken:GetAttachment' :: GetAttachment -> Text
$sel:attachmentId:GetAttachment' :: GetAttachment -> 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 GetAttachment where
  toJSON :: GetAttachment -> Value
toJSON GetAttachment' {Text
connectionToken :: Text
attachmentId :: Text
$sel:connectionToken:GetAttachment' :: GetAttachment -> Text
$sel:attachmentId:GetAttachment' :: GetAttachment -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"AttachmentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
attachmentId)]
      )

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

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

-- | /See:/ 'newGetAttachmentResponse' smart constructor.
data GetAttachmentResponse = GetAttachmentResponse'
  { -- | This is the pre-signed URL that can be used for uploading the file to
    -- Amazon S3 when used in response to
    -- <https://docs.aws.amazon.com/connect-participant/latest/APIReference/API_StartAttachmentUpload.html StartAttachmentUpload>.
    GetAttachmentResponse -> Maybe Text
url :: Prelude.Maybe Prelude.Text,
    -- | The expiration time of the URL in ISO timestamp. It\'s specified in ISO
    -- 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For example,
    -- 2019-11-08T02:41:28.172Z.
    GetAttachmentResponse -> Maybe Text
urlExpiry :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAttachmentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAttachmentResponse -> GetAttachmentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAttachmentResponse -> GetAttachmentResponse -> Bool
$c/= :: GetAttachmentResponse -> GetAttachmentResponse -> Bool
== :: GetAttachmentResponse -> GetAttachmentResponse -> Bool
$c== :: GetAttachmentResponse -> GetAttachmentResponse -> Bool
Prelude.Eq, ReadPrec [GetAttachmentResponse]
ReadPrec GetAttachmentResponse
Int -> ReadS GetAttachmentResponse
ReadS [GetAttachmentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAttachmentResponse]
$creadListPrec :: ReadPrec [GetAttachmentResponse]
readPrec :: ReadPrec GetAttachmentResponse
$creadPrec :: ReadPrec GetAttachmentResponse
readList :: ReadS [GetAttachmentResponse]
$creadList :: ReadS [GetAttachmentResponse]
readsPrec :: Int -> ReadS GetAttachmentResponse
$creadsPrec :: Int -> ReadS GetAttachmentResponse
Prelude.Read, Int -> GetAttachmentResponse -> ShowS
[GetAttachmentResponse] -> ShowS
GetAttachmentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAttachmentResponse] -> ShowS
$cshowList :: [GetAttachmentResponse] -> ShowS
show :: GetAttachmentResponse -> String
$cshow :: GetAttachmentResponse -> String
showsPrec :: Int -> GetAttachmentResponse -> ShowS
$cshowsPrec :: Int -> GetAttachmentResponse -> ShowS
Prelude.Show, forall x. Rep GetAttachmentResponse x -> GetAttachmentResponse
forall x. GetAttachmentResponse -> Rep GetAttachmentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAttachmentResponse x -> GetAttachmentResponse
$cfrom :: forall x. GetAttachmentResponse -> Rep GetAttachmentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAttachmentResponse' 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:
--
-- 'url', 'getAttachmentResponse_url' - This is the pre-signed URL that can be used for uploading the file to
-- Amazon S3 when used in response to
-- <https://docs.aws.amazon.com/connect-participant/latest/APIReference/API_StartAttachmentUpload.html StartAttachmentUpload>.
--
-- 'urlExpiry', 'getAttachmentResponse_urlExpiry' - The expiration time of the URL in ISO timestamp. It\'s specified in ISO
-- 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For example,
-- 2019-11-08T02:41:28.172Z.
--
-- 'httpStatus', 'getAttachmentResponse_httpStatus' - The response's http status code.
newGetAttachmentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAttachmentResponse
newGetAttachmentResponse :: Int -> GetAttachmentResponse
newGetAttachmentResponse Int
pHttpStatus_ =
  GetAttachmentResponse'
    { $sel:url:GetAttachmentResponse' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing,
      $sel:urlExpiry:GetAttachmentResponse' :: Maybe Text
urlExpiry = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAttachmentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | This is the pre-signed URL that can be used for uploading the file to
-- Amazon S3 when used in response to
-- <https://docs.aws.amazon.com/connect-participant/latest/APIReference/API_StartAttachmentUpload.html StartAttachmentUpload>.
getAttachmentResponse_url :: Lens.Lens' GetAttachmentResponse (Prelude.Maybe Prelude.Text)
getAttachmentResponse_url :: Lens' GetAttachmentResponse (Maybe Text)
getAttachmentResponse_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAttachmentResponse' {Maybe Text
url :: Maybe Text
$sel:url:GetAttachmentResponse' :: GetAttachmentResponse -> Maybe Text
url} -> Maybe Text
url) (\s :: GetAttachmentResponse
s@GetAttachmentResponse' {} Maybe Text
a -> GetAttachmentResponse
s {$sel:url:GetAttachmentResponse' :: Maybe Text
url = Maybe Text
a} :: GetAttachmentResponse)

-- | The expiration time of the URL in ISO timestamp. It\'s specified in ISO
-- 8601 format: yyyy-MM-ddThh:mm:ss.SSSZ. For example,
-- 2019-11-08T02:41:28.172Z.
getAttachmentResponse_urlExpiry :: Lens.Lens' GetAttachmentResponse (Prelude.Maybe Prelude.Text)
getAttachmentResponse_urlExpiry :: Lens' GetAttachmentResponse (Maybe Text)
getAttachmentResponse_urlExpiry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAttachmentResponse' {Maybe Text
urlExpiry :: Maybe Text
$sel:urlExpiry:GetAttachmentResponse' :: GetAttachmentResponse -> Maybe Text
urlExpiry} -> Maybe Text
urlExpiry) (\s :: GetAttachmentResponse
s@GetAttachmentResponse' {} Maybe Text
a -> GetAttachmentResponse
s {$sel:urlExpiry:GetAttachmentResponse' :: Maybe Text
urlExpiry = Maybe Text
a} :: GetAttachmentResponse)

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

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