{-# 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.GetContentSummary
-- 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 summary information about the content.
module Amazonka.Wisdom.GetContentSummary
  ( -- * Creating a Request
    GetContentSummary (..),
    newGetContentSummary,

    -- * Request Lenses
    getContentSummary_contentId,
    getContentSummary_knowledgeBaseId,

    -- * Destructuring the Response
    GetContentSummaryResponse (..),
    newGetContentSummaryResponse,

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

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

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

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

instance Core.AWSRequest GetContentSummary where
  type
    AWSResponse GetContentSummary =
      GetContentSummaryResponse
  request :: (Service -> Service)
-> GetContentSummary -> Request GetContentSummary
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 GetContentSummary
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetContentSummary)))
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 ContentSummary -> Int -> GetContentSummaryResponse
GetContentSummaryResponse'
            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
"contentSummary")
            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 GetContentSummary where
  hashWithSalt :: Int -> GetContentSummary -> Int
hashWithSalt Int
_salt GetContentSummary' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContentSummary' :: GetContentSummary -> Text
$sel:contentId:GetContentSummary' :: GetContentSummary -> 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 GetContentSummary where
  rnf :: GetContentSummary -> ()
rnf GetContentSummary' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContentSummary' :: GetContentSummary -> Text
$sel:contentId:GetContentSummary' :: GetContentSummary -> 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 GetContentSummary where
  toHeaders :: GetContentSummary -> 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 GetContentSummary where
  toPath :: GetContentSummary -> ByteString
toPath GetContentSummary' {Text
knowledgeBaseId :: Text
contentId :: Text
$sel:knowledgeBaseId:GetContentSummary' :: GetContentSummary -> Text
$sel:contentId:GetContentSummary' :: GetContentSummary -> 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,
        ByteString
"/summary"
      ]

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

-- | /See:/ 'newGetContentSummaryResponse' smart constructor.
data GetContentSummaryResponse = GetContentSummaryResponse'
  { -- | The content summary.
    GetContentSummaryResponse -> Maybe ContentSummary
contentSummary :: Prelude.Maybe ContentSummary,
    -- | The response's http status code.
    GetContentSummaryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetContentSummaryResponse -> GetContentSummaryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetContentSummaryResponse -> GetContentSummaryResponse -> Bool
$c/= :: GetContentSummaryResponse -> GetContentSummaryResponse -> Bool
== :: GetContentSummaryResponse -> GetContentSummaryResponse -> Bool
$c== :: GetContentSummaryResponse -> GetContentSummaryResponse -> Bool
Prelude.Eq, ReadPrec [GetContentSummaryResponse]
ReadPrec GetContentSummaryResponse
Int -> ReadS GetContentSummaryResponse
ReadS [GetContentSummaryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetContentSummaryResponse]
$creadListPrec :: ReadPrec [GetContentSummaryResponse]
readPrec :: ReadPrec GetContentSummaryResponse
$creadPrec :: ReadPrec GetContentSummaryResponse
readList :: ReadS [GetContentSummaryResponse]
$creadList :: ReadS [GetContentSummaryResponse]
readsPrec :: Int -> ReadS GetContentSummaryResponse
$creadsPrec :: Int -> ReadS GetContentSummaryResponse
Prelude.Read, Int -> GetContentSummaryResponse -> ShowS
[GetContentSummaryResponse] -> ShowS
GetContentSummaryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetContentSummaryResponse] -> ShowS
$cshowList :: [GetContentSummaryResponse] -> ShowS
show :: GetContentSummaryResponse -> String
$cshow :: GetContentSummaryResponse -> String
showsPrec :: Int -> GetContentSummaryResponse -> ShowS
$cshowsPrec :: Int -> GetContentSummaryResponse -> ShowS
Prelude.Show, forall x.
Rep GetContentSummaryResponse x -> GetContentSummaryResponse
forall x.
GetContentSummaryResponse -> Rep GetContentSummaryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetContentSummaryResponse x -> GetContentSummaryResponse
$cfrom :: forall x.
GetContentSummaryResponse -> Rep GetContentSummaryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetContentSummaryResponse' 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:
--
-- 'contentSummary', 'getContentSummaryResponse_contentSummary' - The content summary.
--
-- 'httpStatus', 'getContentSummaryResponse_httpStatus' - The response's http status code.
newGetContentSummaryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetContentSummaryResponse
newGetContentSummaryResponse :: Int -> GetContentSummaryResponse
newGetContentSummaryResponse Int
pHttpStatus_ =
  GetContentSummaryResponse'
    { $sel:contentSummary:GetContentSummaryResponse' :: Maybe ContentSummary
contentSummary =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetContentSummaryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The content summary.
getContentSummaryResponse_contentSummary :: Lens.Lens' GetContentSummaryResponse (Prelude.Maybe ContentSummary)
getContentSummaryResponse_contentSummary :: Lens' GetContentSummaryResponse (Maybe ContentSummary)
getContentSummaryResponse_contentSummary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetContentSummaryResponse' {Maybe ContentSummary
contentSummary :: Maybe ContentSummary
$sel:contentSummary:GetContentSummaryResponse' :: GetContentSummaryResponse -> Maybe ContentSummary
contentSummary} -> Maybe ContentSummary
contentSummary) (\s :: GetContentSummaryResponse
s@GetContentSummaryResponse' {} Maybe ContentSummary
a -> GetContentSummaryResponse
s {$sel:contentSummary:GetContentSummaryResponse' :: Maybe ContentSummary
contentSummary = Maybe ContentSummary
a} :: GetContentSummaryResponse)

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

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