{-# 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.GetKnowledgeBase
-- 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 information about the knowledge base.
module Amazonka.Wisdom.GetKnowledgeBase
  ( -- * Creating a Request
    GetKnowledgeBase (..),
    newGetKnowledgeBase,

    -- * Request Lenses
    getKnowledgeBase_knowledgeBaseId,

    -- * Destructuring the Response
    GetKnowledgeBaseResponse (..),
    newGetKnowledgeBaseResponse,

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

-- |
-- Create a value of 'GetKnowledgeBase' 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:
--
-- 'knowledgeBaseId', 'getKnowledgeBase_knowledgeBaseId' - The identifier of the knowledge base. Can be either the ID or the ARN.
-- URLs cannot contain the ARN.
newGetKnowledgeBase ::
  -- | 'knowledgeBaseId'
  Prelude.Text ->
  GetKnowledgeBase
newGetKnowledgeBase :: Text -> GetKnowledgeBase
newGetKnowledgeBase Text
pKnowledgeBaseId_ =
  GetKnowledgeBase'
    { $sel:knowledgeBaseId:GetKnowledgeBase' :: Text
knowledgeBaseId =
        Text
pKnowledgeBaseId_
    }

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

instance Core.AWSRequest GetKnowledgeBase where
  type
    AWSResponse GetKnowledgeBase =
      GetKnowledgeBaseResponse
  request :: (Service -> Service)
-> GetKnowledgeBase -> Request GetKnowledgeBase
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 GetKnowledgeBase
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetKnowledgeBase)))
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 KnowledgeBaseData -> Int -> GetKnowledgeBaseResponse
GetKnowledgeBaseResponse'
            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
"knowledgeBase")
            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 GetKnowledgeBase where
  hashWithSalt :: Int -> GetKnowledgeBase -> Int
hashWithSalt Int
_salt GetKnowledgeBase' {Text
knowledgeBaseId :: Text
$sel:knowledgeBaseId:GetKnowledgeBase' :: GetKnowledgeBase -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
knowledgeBaseId

instance Prelude.NFData GetKnowledgeBase where
  rnf :: GetKnowledgeBase -> ()
rnf GetKnowledgeBase' {Text
knowledgeBaseId :: Text
$sel:knowledgeBaseId:GetKnowledgeBase' :: GetKnowledgeBase -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
knowledgeBaseId

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

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

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

-- |
-- Create a value of 'GetKnowledgeBaseResponse' 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:
--
-- 'knowledgeBase', 'getKnowledgeBaseResponse_knowledgeBase' - The knowledge base.
--
-- 'httpStatus', 'getKnowledgeBaseResponse_httpStatus' - The response's http status code.
newGetKnowledgeBaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetKnowledgeBaseResponse
newGetKnowledgeBaseResponse :: Int -> GetKnowledgeBaseResponse
newGetKnowledgeBaseResponse Int
pHttpStatus_ =
  GetKnowledgeBaseResponse'
    { $sel:knowledgeBase:GetKnowledgeBaseResponse' :: Maybe KnowledgeBaseData
knowledgeBase =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetKnowledgeBaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The knowledge base.
getKnowledgeBaseResponse_knowledgeBase :: Lens.Lens' GetKnowledgeBaseResponse (Prelude.Maybe KnowledgeBaseData)
getKnowledgeBaseResponse_knowledgeBase :: Lens' GetKnowledgeBaseResponse (Maybe KnowledgeBaseData)
getKnowledgeBaseResponse_knowledgeBase = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetKnowledgeBaseResponse' {Maybe KnowledgeBaseData
knowledgeBase :: Maybe KnowledgeBaseData
$sel:knowledgeBase:GetKnowledgeBaseResponse' :: GetKnowledgeBaseResponse -> Maybe KnowledgeBaseData
knowledgeBase} -> Maybe KnowledgeBaseData
knowledgeBase) (\s :: GetKnowledgeBaseResponse
s@GetKnowledgeBaseResponse' {} Maybe KnowledgeBaseData
a -> GetKnowledgeBaseResponse
s {$sel:knowledgeBase:GetKnowledgeBaseResponse' :: Maybe KnowledgeBaseData
knowledgeBase = Maybe KnowledgeBaseData
a} :: GetKnowledgeBaseResponse)

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

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