{-# 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.Wisdom.StartContentUpload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get a URL to upload content to a knowledge base. To upload content,
-- first make a PUT request to the returned URL with your file, making sure
-- to include the required headers. Then use
-- <https://docs.aws.amazon.com/wisdom/latest/APIReference/API_CreateContent.html CreateContent>
-- to finalize the content creation process or
-- <https://docs.aws.amazon.com/wisdom/latest/APIReference/API_UpdateContent.html UpdateContent>
-- to modify an existing resource. You can only upload content to a
-- knowledge base of type CUSTOM.
module Amazonka.Wisdom.StartContentUpload
  ( -- * Creating a Request
    StartContentUpload (..),
    newStartContentUpload,

    -- * Request Lenses
    startContentUpload_contentType,
    startContentUpload_knowledgeBaseId,

    -- * Destructuring the Response
    StartContentUploadResponse (..),
    newStartContentUploadResponse,

    -- * Response Lenses
    startContentUploadResponse_httpStatus,
    startContentUploadResponse_headersToInclude,
    startContentUploadResponse_uploadId,
    startContentUploadResponse_url,
    startContentUploadResponse_urlExpiry,
  )
where

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
import Amazonka.Wisdom.Types

-- | /See:/ 'newStartContentUpload' smart constructor.
data StartContentUpload = StartContentUpload'
  { -- | The type of content to upload.
    StartContentUpload -> Text
contentType :: Prelude.Text,
    -- | The identifier of the knowledge base. Can be either the ID or the ARN.
    -- URLs cannot contain the ARN.
    StartContentUpload -> Text
knowledgeBaseId :: Prelude.Text
  }
  deriving (StartContentUpload -> StartContentUpload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartContentUpload -> StartContentUpload -> Bool
$c/= :: StartContentUpload -> StartContentUpload -> Bool
== :: StartContentUpload -> StartContentUpload -> Bool
$c== :: StartContentUpload -> StartContentUpload -> Bool
Prelude.Eq, ReadPrec [StartContentUpload]
ReadPrec StartContentUpload
Int -> ReadS StartContentUpload
ReadS [StartContentUpload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartContentUpload]
$creadListPrec :: ReadPrec [StartContentUpload]
readPrec :: ReadPrec StartContentUpload
$creadPrec :: ReadPrec StartContentUpload
readList :: ReadS [StartContentUpload]
$creadList :: ReadS [StartContentUpload]
readsPrec :: Int -> ReadS StartContentUpload
$creadsPrec :: Int -> ReadS StartContentUpload
Prelude.Read, Int -> StartContentUpload -> ShowS
[StartContentUpload] -> ShowS
StartContentUpload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartContentUpload] -> ShowS
$cshowList :: [StartContentUpload] -> ShowS
show :: StartContentUpload -> String
$cshow :: StartContentUpload -> String
showsPrec :: Int -> StartContentUpload -> ShowS
$cshowsPrec :: Int -> StartContentUpload -> ShowS
Prelude.Show, forall x. Rep StartContentUpload x -> StartContentUpload
forall x. StartContentUpload -> Rep StartContentUpload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartContentUpload x -> StartContentUpload
$cfrom :: forall x. StartContentUpload -> Rep StartContentUpload x
Prelude.Generic)

-- |
-- Create a value of 'StartContentUpload' 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', 'startContentUpload_contentType' - The type of content to upload.
--
-- 'knowledgeBaseId', 'startContentUpload_knowledgeBaseId' - The identifier of the knowledge base. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
newStartContentUpload ::
  -- | 'contentType'
  Prelude.Text ->
  -- | 'knowledgeBaseId'
  Prelude.Text ->
  StartContentUpload
newStartContentUpload :: Text -> Text -> StartContentUpload
newStartContentUpload Text
pContentType_ Text
pKnowledgeBaseId_ =
  StartContentUpload'
    { $sel:contentType:StartContentUpload' :: Text
contentType = Text
pContentType_,
      $sel:knowledgeBaseId:StartContentUpload' :: Text
knowledgeBaseId = Text
pKnowledgeBaseId_
    }

-- | The type of content to upload.
startContentUpload_contentType :: Lens.Lens' StartContentUpload Prelude.Text
startContentUpload_contentType :: Lens' StartContentUpload Text
startContentUpload_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUpload' {Text
contentType :: Text
$sel:contentType:StartContentUpload' :: StartContentUpload -> Text
contentType} -> Text
contentType) (\s :: StartContentUpload
s@StartContentUpload' {} Text
a -> StartContentUpload
s {$sel:contentType:StartContentUpload' :: Text
contentType = Text
a} :: StartContentUpload)

-- | The identifier of the knowledge base. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
startContentUpload_knowledgeBaseId :: Lens.Lens' StartContentUpload Prelude.Text
startContentUpload_knowledgeBaseId :: Lens' StartContentUpload Text
startContentUpload_knowledgeBaseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUpload' {Text
knowledgeBaseId :: Text
$sel:knowledgeBaseId:StartContentUpload' :: StartContentUpload -> Text
knowledgeBaseId} -> Text
knowledgeBaseId) (\s :: StartContentUpload
s@StartContentUpload' {} Text
a -> StartContentUpload
s {$sel:knowledgeBaseId:StartContentUpload' :: Text
knowledgeBaseId = Text
a} :: StartContentUpload)

instance Core.AWSRequest StartContentUpload where
  type
    AWSResponse StartContentUpload =
      StartContentUploadResponse
  request :: (Service -> Service)
-> StartContentUpload -> Request StartContentUpload
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 StartContentUpload
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartContentUpload)))
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
-> HashMap Text Text
-> Text
-> Sensitive Text
-> POSIX
-> StartContentUploadResponse
StartContentUploadResponse'
            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 (Maybe a)
Data..?> Key
"headersToInclude"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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")
            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
"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 a
Data..:> Key
"urlExpiry")
      )

instance Prelude.Hashable StartContentUpload where
  hashWithSalt :: Int -> StartContentUpload -> Int
hashWithSalt Int
_salt StartContentUpload' {Text
knowledgeBaseId :: Text
contentType :: Text
$sel:knowledgeBaseId:StartContentUpload' :: StartContentUpload -> Text
$sel:contentType:StartContentUpload' :: StartContentUpload -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
knowledgeBaseId

instance Prelude.NFData StartContentUpload where
  rnf :: StartContentUpload -> ()
rnf StartContentUpload' {Text
knowledgeBaseId :: Text
contentType :: Text
$sel:knowledgeBaseId:StartContentUpload' :: StartContentUpload -> Text
$sel:contentType:StartContentUpload' :: StartContentUpload -> 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 Text
knowledgeBaseId

instance Data.ToHeaders StartContentUpload where
  toHeaders :: StartContentUpload -> 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 StartContentUpload where
  toJSON :: StartContentUpload -> Value
toJSON StartContentUpload' {Text
knowledgeBaseId :: Text
contentType :: Text
$sel:knowledgeBaseId:StartContentUpload' :: StartContentUpload -> Text
$sel:contentType:StartContentUpload' :: StartContentUpload -> 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)]
      )

instance Data.ToPath StartContentUpload where
  toPath :: StartContentUpload -> ByteString
toPath StartContentUpload' {Text
knowledgeBaseId :: Text
contentType :: Text
$sel:knowledgeBaseId:StartContentUpload' :: StartContentUpload -> Text
$sel:contentType:StartContentUpload' :: StartContentUpload -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/knowledgeBases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
knowledgeBaseId,
        ByteString
"/upload"
      ]

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

-- | /See:/ 'newStartContentUploadResponse' smart constructor.
data StartContentUploadResponse = StartContentUploadResponse'
  { -- | The response's http status code.
    StartContentUploadResponse -> Int
httpStatus :: Prelude.Int,
    -- | The headers to include in the upload.
    StartContentUploadResponse -> HashMap Text Text
headersToInclude :: Prelude.HashMap Prelude.Text Prelude.Text,
    -- | The identifier of the upload.
    StartContentUploadResponse -> Text
uploadId :: Prelude.Text,
    -- | The URL of the upload.
    StartContentUploadResponse -> Sensitive Text
url :: Data.Sensitive Prelude.Text,
    -- | The expiration time of the URL as an epoch timestamp.
    StartContentUploadResponse -> POSIX
urlExpiry :: Data.POSIX
  }
  deriving (StartContentUploadResponse -> StartContentUploadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartContentUploadResponse -> StartContentUploadResponse -> Bool
$c/= :: StartContentUploadResponse -> StartContentUploadResponse -> Bool
== :: StartContentUploadResponse -> StartContentUploadResponse -> Bool
$c== :: StartContentUploadResponse -> StartContentUploadResponse -> Bool
Prelude.Eq, Int -> StartContentUploadResponse -> ShowS
[StartContentUploadResponse] -> ShowS
StartContentUploadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartContentUploadResponse] -> ShowS
$cshowList :: [StartContentUploadResponse] -> ShowS
show :: StartContentUploadResponse -> String
$cshow :: StartContentUploadResponse -> String
showsPrec :: Int -> StartContentUploadResponse -> ShowS
$cshowsPrec :: Int -> StartContentUploadResponse -> ShowS
Prelude.Show, forall x.
Rep StartContentUploadResponse x -> StartContentUploadResponse
forall x.
StartContentUploadResponse -> Rep StartContentUploadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartContentUploadResponse x -> StartContentUploadResponse
$cfrom :: forall x.
StartContentUploadResponse -> Rep StartContentUploadResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartContentUploadResponse' 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', 'startContentUploadResponse_httpStatus' - The response's http status code.
--
-- 'headersToInclude', 'startContentUploadResponse_headersToInclude' - The headers to include in the upload.
--
-- 'uploadId', 'startContentUploadResponse_uploadId' - The identifier of the upload.
--
-- 'url', 'startContentUploadResponse_url' - The URL of the upload.
--
-- 'urlExpiry', 'startContentUploadResponse_urlExpiry' - The expiration time of the URL as an epoch timestamp.
newStartContentUploadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'uploadId'
  Prelude.Text ->
  -- | 'url'
  Prelude.Text ->
  -- | 'urlExpiry'
  Prelude.UTCTime ->
  StartContentUploadResponse
newStartContentUploadResponse :: Int -> Text -> Text -> UTCTime -> StartContentUploadResponse
newStartContentUploadResponse
  Int
pHttpStatus_
  Text
pUploadId_
  Text
pUrl_
  UTCTime
pUrlExpiry_ =
    StartContentUploadResponse'
      { $sel:httpStatus:StartContentUploadResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:headersToInclude:StartContentUploadResponse' :: HashMap Text Text
headersToInclude = forall a. Monoid a => a
Prelude.mempty,
        $sel:uploadId:StartContentUploadResponse' :: Text
uploadId = Text
pUploadId_,
        $sel:url:StartContentUploadResponse' :: Sensitive Text
url = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pUrl_,
        $sel:urlExpiry:StartContentUploadResponse' :: POSIX
urlExpiry = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUrlExpiry_
      }

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

-- | The headers to include in the upload.
startContentUploadResponse_headersToInclude :: Lens.Lens' StartContentUploadResponse (Prelude.HashMap Prelude.Text Prelude.Text)
startContentUploadResponse_headersToInclude :: Lens' StartContentUploadResponse (HashMap Text Text)
startContentUploadResponse_headersToInclude = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUploadResponse' {HashMap Text Text
headersToInclude :: HashMap Text Text
$sel:headersToInclude:StartContentUploadResponse' :: StartContentUploadResponse -> HashMap Text Text
headersToInclude} -> HashMap Text Text
headersToInclude) (\s :: StartContentUploadResponse
s@StartContentUploadResponse' {} HashMap Text Text
a -> StartContentUploadResponse
s {$sel:headersToInclude:StartContentUploadResponse' :: HashMap Text Text
headersToInclude = HashMap Text Text
a} :: StartContentUploadResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The identifier of the upload.
startContentUploadResponse_uploadId :: Lens.Lens' StartContentUploadResponse Prelude.Text
startContentUploadResponse_uploadId :: Lens' StartContentUploadResponse Text
startContentUploadResponse_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUploadResponse' {Text
uploadId :: Text
$sel:uploadId:StartContentUploadResponse' :: StartContentUploadResponse -> Text
uploadId} -> Text
uploadId) (\s :: StartContentUploadResponse
s@StartContentUploadResponse' {} Text
a -> StartContentUploadResponse
s {$sel:uploadId:StartContentUploadResponse' :: Text
uploadId = Text
a} :: StartContentUploadResponse)

-- | The URL of the upload.
startContentUploadResponse_url :: Lens.Lens' StartContentUploadResponse Prelude.Text
startContentUploadResponse_url :: Lens' StartContentUploadResponse Text
startContentUploadResponse_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUploadResponse' {Sensitive Text
url :: Sensitive Text
$sel:url:StartContentUploadResponse' :: StartContentUploadResponse -> Sensitive Text
url} -> Sensitive Text
url) (\s :: StartContentUploadResponse
s@StartContentUploadResponse' {} Sensitive Text
a -> StartContentUploadResponse
s {$sel:url:StartContentUploadResponse' :: Sensitive Text
url = Sensitive Text
a} :: StartContentUploadResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The expiration time of the URL as an epoch timestamp.
startContentUploadResponse_urlExpiry :: Lens.Lens' StartContentUploadResponse Prelude.UTCTime
startContentUploadResponse_urlExpiry :: Lens' StartContentUploadResponse UTCTime
startContentUploadResponse_urlExpiry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartContentUploadResponse' {POSIX
urlExpiry :: POSIX
$sel:urlExpiry:StartContentUploadResponse' :: StartContentUploadResponse -> POSIX
urlExpiry} -> POSIX
urlExpiry) (\s :: StartContentUploadResponse
s@StartContentUploadResponse' {} POSIX
a -> StartContentUploadResponse
s {$sel:urlExpiry:StartContentUploadResponse' :: POSIX
urlExpiry = POSIX
a} :: StartContentUploadResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData StartContentUploadResponse where
  rnf :: StartContentUploadResponse -> ()
rnf StartContentUploadResponse' {Int
Text
HashMap Text Text
Sensitive Text
POSIX
urlExpiry :: POSIX
url :: Sensitive Text
uploadId :: Text
headersToInclude :: HashMap Text Text
httpStatus :: Int
$sel:urlExpiry:StartContentUploadResponse' :: StartContentUploadResponse -> POSIX
$sel:url:StartContentUploadResponse' :: StartContentUploadResponse -> Sensitive Text
$sel:uploadId:StartContentUploadResponse' :: StartContentUploadResponse -> Text
$sel:headersToInclude:StartContentUploadResponse' :: StartContentUploadResponse -> HashMap Text Text
$sel:httpStatus:StartContentUploadResponse' :: StartContentUploadResponse -> 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 HashMap Text Text
headersToInclude
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uploadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
url
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
urlExpiry