{-# 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.AppSync.GetDataSource
-- 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 a @DataSource@ object.
module Amazonka.AppSync.GetDataSource
  ( -- * Creating a Request
    GetDataSource (..),
    newGetDataSource,

    -- * Request Lenses
    getDataSource_apiId,
    getDataSource_name,

    -- * Destructuring the Response
    GetDataSourceResponse (..),
    newGetDataSourceResponse,

    -- * Response Lenses
    getDataSourceResponse_dataSource,
    getDataSourceResponse_httpStatus,
  )
where

import Amazonka.AppSync.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:/ 'newGetDataSource' smart constructor.
data GetDataSource = GetDataSource'
  { -- | The API ID.
    GetDataSource -> Text
apiId :: Prelude.Text,
    -- | The name of the data source.
    GetDataSource -> Text
name :: Prelude.Text
  }
  deriving (GetDataSource -> GetDataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDataSource -> GetDataSource -> Bool
$c/= :: GetDataSource -> GetDataSource -> Bool
== :: GetDataSource -> GetDataSource -> Bool
$c== :: GetDataSource -> GetDataSource -> Bool
Prelude.Eq, ReadPrec [GetDataSource]
ReadPrec GetDataSource
Int -> ReadS GetDataSource
ReadS [GetDataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDataSource]
$creadListPrec :: ReadPrec [GetDataSource]
readPrec :: ReadPrec GetDataSource
$creadPrec :: ReadPrec GetDataSource
readList :: ReadS [GetDataSource]
$creadList :: ReadS [GetDataSource]
readsPrec :: Int -> ReadS GetDataSource
$creadsPrec :: Int -> ReadS GetDataSource
Prelude.Read, Int -> GetDataSource -> ShowS
[GetDataSource] -> ShowS
GetDataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDataSource] -> ShowS
$cshowList :: [GetDataSource] -> ShowS
show :: GetDataSource -> String
$cshow :: GetDataSource -> String
showsPrec :: Int -> GetDataSource -> ShowS
$cshowsPrec :: Int -> GetDataSource -> ShowS
Prelude.Show, forall x. Rep GetDataSource x -> GetDataSource
forall x. GetDataSource -> Rep GetDataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDataSource x -> GetDataSource
$cfrom :: forall x. GetDataSource -> Rep GetDataSource x
Prelude.Generic)

-- |
-- Create a value of 'GetDataSource' 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:
--
-- 'apiId', 'getDataSource_apiId' - The API ID.
--
-- 'name', 'getDataSource_name' - The name of the data source.
newGetDataSource ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  GetDataSource
newGetDataSource :: Text -> Text -> GetDataSource
newGetDataSource Text
pApiId_ Text
pName_ =
  GetDataSource' {$sel:apiId:GetDataSource' :: Text
apiId = Text
pApiId_, $sel:name:GetDataSource' :: Text
name = Text
pName_}

-- | The API ID.
getDataSource_apiId :: Lens.Lens' GetDataSource Prelude.Text
getDataSource_apiId :: Lens' GetDataSource Text
getDataSource_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSource' {Text
apiId :: Text
$sel:apiId:GetDataSource' :: GetDataSource -> Text
apiId} -> Text
apiId) (\s :: GetDataSource
s@GetDataSource' {} Text
a -> GetDataSource
s {$sel:apiId:GetDataSource' :: Text
apiId = Text
a} :: GetDataSource)

-- | The name of the data source.
getDataSource_name :: Lens.Lens' GetDataSource Prelude.Text
getDataSource_name :: Lens' GetDataSource Text
getDataSource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSource' {Text
name :: Text
$sel:name:GetDataSource' :: GetDataSource -> Text
name} -> Text
name) (\s :: GetDataSource
s@GetDataSource' {} Text
a -> GetDataSource
s {$sel:name:GetDataSource' :: Text
name = Text
a} :: GetDataSource)

instance Core.AWSRequest GetDataSource where
  type
    AWSResponse GetDataSource =
      GetDataSourceResponse
  request :: (Service -> Service) -> GetDataSource -> Request GetDataSource
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 GetDataSource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDataSource)))
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 DataSource -> Int -> GetDataSourceResponse
GetDataSourceResponse'
            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
"dataSource")
            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 GetDataSource where
  hashWithSalt :: Int -> GetDataSource -> Int
hashWithSalt Int
_salt GetDataSource' {Text
name :: Text
apiId :: Text
$sel:name:GetDataSource' :: GetDataSource -> Text
$sel:apiId:GetDataSource' :: GetDataSource -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetDataSource where
  rnf :: GetDataSource -> ()
rnf GetDataSource' {Text
name :: Text
apiId :: Text
$sel:name:GetDataSource' :: GetDataSource -> Text
$sel:apiId:GetDataSource' :: GetDataSource -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
apiId seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

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

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

-- |
-- Create a value of 'GetDataSourceResponse' 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:
--
-- 'dataSource', 'getDataSourceResponse_dataSource' - The @DataSource@ object.
--
-- 'httpStatus', 'getDataSourceResponse_httpStatus' - The response's http status code.
newGetDataSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDataSourceResponse
newGetDataSourceResponse :: Int -> GetDataSourceResponse
newGetDataSourceResponse Int
pHttpStatus_ =
  GetDataSourceResponse'
    { $sel:dataSource:GetDataSourceResponse' :: Maybe DataSource
dataSource =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDataSourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The @DataSource@ object.
getDataSourceResponse_dataSource :: Lens.Lens' GetDataSourceResponse (Prelude.Maybe DataSource)
getDataSourceResponse_dataSource :: Lens' GetDataSourceResponse (Maybe DataSource)
getDataSourceResponse_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDataSourceResponse' {Maybe DataSource
dataSource :: Maybe DataSource
$sel:dataSource:GetDataSourceResponse' :: GetDataSourceResponse -> Maybe DataSource
dataSource} -> Maybe DataSource
dataSource) (\s :: GetDataSourceResponse
s@GetDataSourceResponse' {} Maybe DataSource
a -> GetDataSourceResponse
s {$sel:dataSource:GetDataSourceResponse' :: Maybe DataSource
dataSource = Maybe DataSource
a} :: GetDataSourceResponse)

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

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