{-# 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.GetContent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves content, including a pre-signed URL to download the content.
module Amazonka.Wisdom.GetContent
  ( -- * Creating a Request
    GetContent (..),
    newGetContent,

    -- * Request Lenses
    getContent_contentId,
    getContent_knowledgeBaseId,

    -- * Destructuring the Response
    GetContentResponse (..),
    newGetContentResponse,

    -- * Response Lenses
    getContentResponse_content,
    getContentResponse_httpStatus,
  )
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:/ 'newGetContent' smart constructor.
data GetContent = GetContent'
  { -- | The identifier of the content. Can be either the ID or the ARN. URLs
    -- cannot contain the ARN.
    GetContent -> Text
contentId :: Prelude.Text,
    -- | The identifier of the knowledge base. Can be either the ID or the ARN.
    -- URLs cannot contain the ARN.
    GetContent -> Text
knowledgeBaseId :: Prelude.Text
  }
  deriving (GetContent -> GetContent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContent -> GetContent -> Bool
$c/= :: GetContent -> GetContent -> Bool
== :: GetContent -> GetContent -> Bool
$c== :: GetContent -> GetContent -> Bool
Prelude.Eq, ReadPrec [GetContent]
ReadPrec GetContent
Int -> ReadS GetContent
ReadS [GetContent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContent]
$creadListPrec :: ReadPrec [GetContent]
readPrec :: ReadPrec GetContent
$creadPrec :: ReadPrec GetContent
readList :: ReadS [GetContent]
$creadList :: ReadS [GetContent]
readsPrec :: Int -> ReadS GetContent
$creadsPrec :: Int -> ReadS GetContent
Prelude.Read, Int -> GetContent -> ShowS
[GetContent] -> ShowS
GetContent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContent] -> ShowS
$cshowList :: [GetContent] -> ShowS
show :: GetContent -> String
$cshow :: GetContent -> String
showsPrec :: Int -> GetContent -> ShowS
$cshowsPrec :: Int -> GetContent -> ShowS
Prelude.Show, forall x. Rep GetContent x -> GetContent
forall x. GetContent -> Rep GetContent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetContent x -> GetContent
$cfrom :: forall x. GetContent -> Rep GetContent x
Prelude.Generic)

-- |
-- Create a value of 'GetContent' 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:
--
-- 'contentId', 'getContent_contentId' - The identifier of the content. Can be either the ID or the ARN. URLs
-- cannot contain the ARN.
--
-- 'knowledgeBaseId', 'getContent_knowledgeBaseId' - The identifier of the knowledge base. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
newGetContent ::
  -- | 'contentId'
  Prelude.Text ->
  -- | 'knowledgeBaseId'
  Prelude.Text ->
  GetContent
newGetContent :: Text -> Text -> GetContent
newGetContent Text
pContentId_ Text
pKnowledgeBaseId_ =
  GetContent'
    { $sel:contentId:GetContent' :: Text
contentId = Text
pContentId_,
      $sel:knowledgeBaseId:GetContent' :: Text
knowledgeBaseId = Text
pKnowledgeBaseId_
    }

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

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

instance Core.AWSRequest GetContent where
  type AWSResponse GetContent = GetContentResponse
  request :: (Service -> Service) -> GetContent -> Request GetContent
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetContent
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetContent)))
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 ContentData -> Int -> GetContentResponse
GetContentResponse'
            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
"content")
            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 GetContent where
  hashWithSalt :: Int -> GetContent -> Int
hashWithSalt Int
_salt GetContent' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContent' :: GetContent -> Text
$sel:contentId:GetContent' :: GetContent -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
contentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
knowledgeBaseId

instance Prelude.NFData GetContent where
  rnf :: GetContent -> ()
rnf GetContent' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContent' :: GetContent -> Text
$sel:contentId:GetContent' :: GetContent -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
contentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
knowledgeBaseId

instance Data.ToHeaders GetContent where
  toHeaders :: GetContent -> 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.ToPath GetContent where
  toPath :: GetContent -> ByteString
toPath GetContent' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContent' :: GetContent -> Text
$sel:contentId:GetContent' :: GetContent -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/knowledgeBases/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
knowledgeBaseId,
        ByteString
"/contents/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
contentId
      ]

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

-- | /See:/ 'newGetContentResponse' smart constructor.
data GetContentResponse = GetContentResponse'
  { -- | The content.
    GetContentResponse -> Maybe ContentData
content :: Prelude.Maybe ContentData,
    -- | The response's http status code.
    GetContentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetContentResponse -> GetContentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContentResponse -> GetContentResponse -> Bool
$c/= :: GetContentResponse -> GetContentResponse -> Bool
== :: GetContentResponse -> GetContentResponse -> Bool
$c== :: GetContentResponse -> GetContentResponse -> Bool
Prelude.Eq, Int -> GetContentResponse -> ShowS
[GetContentResponse] -> ShowS
GetContentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContentResponse] -> ShowS
$cshowList :: [GetContentResponse] -> ShowS
show :: GetContentResponse -> String
$cshow :: GetContentResponse -> String
showsPrec :: Int -> GetContentResponse -> ShowS
$cshowsPrec :: Int -> GetContentResponse -> ShowS
Prelude.Show, forall x. Rep GetContentResponse x -> GetContentResponse
forall x. GetContentResponse -> Rep GetContentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetContentResponse x -> GetContentResponse
$cfrom :: forall x. GetContentResponse -> Rep GetContentResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContentResponse' 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:
--
-- 'content', 'getContentResponse_content' - The content.
--
-- 'httpStatus', 'getContentResponse_httpStatus' - The response's http status code.
newGetContentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetContentResponse
newGetContentResponse :: Int -> GetContentResponse
newGetContentResponse Int
pHttpStatus_ =
  GetContentResponse'
    { $sel:content:GetContentResponse' :: Maybe ContentData
content = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetContentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The content.
getContentResponse_content :: Lens.Lens' GetContentResponse (Prelude.Maybe ContentData)
getContentResponse_content :: Lens' GetContentResponse (Maybe ContentData)
getContentResponse_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContentResponse' {Maybe ContentData
content :: Maybe ContentData
$sel:content:GetContentResponse' :: GetContentResponse -> Maybe ContentData
content} -> Maybe ContentData
content) (\s :: GetContentResponse
s@GetContentResponse' {} Maybe ContentData
a -> GetContentResponse
s {$sel:content:GetContentResponse' :: Maybe ContentData
content = Maybe ContentData
a} :: GetContentResponse)

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

instance Prelude.NFData GetContentResponse where
  rnf :: GetContentResponse -> ()
rnf GetContentResponse' {Int
Maybe ContentData
httpStatus :: Int
content :: Maybe ContentData
$sel:httpStatus:GetContentResponse' :: GetContentResponse -> Int
$sel:content:GetContentResponse' :: GetContentResponse -> Maybe ContentData
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ContentData
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus