{-# 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.Schemas.GetCodeBindingSource
-- 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 the code binding source URI.
module Amazonka.Schemas.GetCodeBindingSource
  ( -- * Creating a Request
    GetCodeBindingSource (..),
    newGetCodeBindingSource,

    -- * Request Lenses
    getCodeBindingSource_schemaVersion,
    getCodeBindingSource_registryName,
    getCodeBindingSource_schemaName,
    getCodeBindingSource_language,

    -- * Destructuring the Response
    GetCodeBindingSourceResponse (..),
    newGetCodeBindingSourceResponse,

    -- * Response Lenses
    getCodeBindingSourceResponse_body,
    getCodeBindingSourceResponse_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.Schemas.Types

-- | /See:/ 'newGetCodeBindingSource' smart constructor.
data GetCodeBindingSource = GetCodeBindingSource'
  { -- | Specifying this limits the results to only this schema version.
    GetCodeBindingSource -> Maybe Text
schemaVersion :: Prelude.Maybe Prelude.Text,
    -- | The name of the registry.
    GetCodeBindingSource -> Text
registryName :: Prelude.Text,
    -- | The name of the schema.
    GetCodeBindingSource -> Text
schemaName :: Prelude.Text,
    -- | The language of the code binding.
    GetCodeBindingSource -> Text
language :: Prelude.Text
  }
  deriving (GetCodeBindingSource -> GetCodeBindingSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCodeBindingSource -> GetCodeBindingSource -> Bool
$c/= :: GetCodeBindingSource -> GetCodeBindingSource -> Bool
== :: GetCodeBindingSource -> GetCodeBindingSource -> Bool
$c== :: GetCodeBindingSource -> GetCodeBindingSource -> Bool
Prelude.Eq, ReadPrec [GetCodeBindingSource]
ReadPrec GetCodeBindingSource
Int -> ReadS GetCodeBindingSource
ReadS [GetCodeBindingSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCodeBindingSource]
$creadListPrec :: ReadPrec [GetCodeBindingSource]
readPrec :: ReadPrec GetCodeBindingSource
$creadPrec :: ReadPrec GetCodeBindingSource
readList :: ReadS [GetCodeBindingSource]
$creadList :: ReadS [GetCodeBindingSource]
readsPrec :: Int -> ReadS GetCodeBindingSource
$creadsPrec :: Int -> ReadS GetCodeBindingSource
Prelude.Read, Int -> GetCodeBindingSource -> ShowS
[GetCodeBindingSource] -> ShowS
GetCodeBindingSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCodeBindingSource] -> ShowS
$cshowList :: [GetCodeBindingSource] -> ShowS
show :: GetCodeBindingSource -> String
$cshow :: GetCodeBindingSource -> String
showsPrec :: Int -> GetCodeBindingSource -> ShowS
$cshowsPrec :: Int -> GetCodeBindingSource -> ShowS
Prelude.Show, forall x. Rep GetCodeBindingSource x -> GetCodeBindingSource
forall x. GetCodeBindingSource -> Rep GetCodeBindingSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCodeBindingSource x -> GetCodeBindingSource
$cfrom :: forall x. GetCodeBindingSource -> Rep GetCodeBindingSource x
Prelude.Generic)

-- |
-- Create a value of 'GetCodeBindingSource' 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:
--
-- 'schemaVersion', 'getCodeBindingSource_schemaVersion' - Specifying this limits the results to only this schema version.
--
-- 'registryName', 'getCodeBindingSource_registryName' - The name of the registry.
--
-- 'schemaName', 'getCodeBindingSource_schemaName' - The name of the schema.
--
-- 'language', 'getCodeBindingSource_language' - The language of the code binding.
newGetCodeBindingSource ::
  -- | 'registryName'
  Prelude.Text ->
  -- | 'schemaName'
  Prelude.Text ->
  -- | 'language'
  Prelude.Text ->
  GetCodeBindingSource
newGetCodeBindingSource :: Text -> Text -> Text -> GetCodeBindingSource
newGetCodeBindingSource
  Text
pRegistryName_
  Text
pSchemaName_
  Text
pLanguage_ =
    GetCodeBindingSource'
      { $sel:schemaVersion:GetCodeBindingSource' :: Maybe Text
schemaVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:registryName:GetCodeBindingSource' :: Text
registryName = Text
pRegistryName_,
        $sel:schemaName:GetCodeBindingSource' :: Text
schemaName = Text
pSchemaName_,
        $sel:language:GetCodeBindingSource' :: Text
language = Text
pLanguage_
      }

-- | Specifying this limits the results to only this schema version.
getCodeBindingSource_schemaVersion :: Lens.Lens' GetCodeBindingSource (Prelude.Maybe Prelude.Text)
getCodeBindingSource_schemaVersion :: Lens' GetCodeBindingSource (Maybe Text)
getCodeBindingSource_schemaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeBindingSource' {Maybe Text
schemaVersion :: Maybe Text
$sel:schemaVersion:GetCodeBindingSource' :: GetCodeBindingSource -> Maybe Text
schemaVersion} -> Maybe Text
schemaVersion) (\s :: GetCodeBindingSource
s@GetCodeBindingSource' {} Maybe Text
a -> GetCodeBindingSource
s {$sel:schemaVersion:GetCodeBindingSource' :: Maybe Text
schemaVersion = Maybe Text
a} :: GetCodeBindingSource)

-- | The name of the registry.
getCodeBindingSource_registryName :: Lens.Lens' GetCodeBindingSource Prelude.Text
getCodeBindingSource_registryName :: Lens' GetCodeBindingSource Text
getCodeBindingSource_registryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeBindingSource' {Text
registryName :: Text
$sel:registryName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
registryName} -> Text
registryName) (\s :: GetCodeBindingSource
s@GetCodeBindingSource' {} Text
a -> GetCodeBindingSource
s {$sel:registryName:GetCodeBindingSource' :: Text
registryName = Text
a} :: GetCodeBindingSource)

-- | The name of the schema.
getCodeBindingSource_schemaName :: Lens.Lens' GetCodeBindingSource Prelude.Text
getCodeBindingSource_schemaName :: Lens' GetCodeBindingSource Text
getCodeBindingSource_schemaName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeBindingSource' {Text
schemaName :: Text
$sel:schemaName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
schemaName} -> Text
schemaName) (\s :: GetCodeBindingSource
s@GetCodeBindingSource' {} Text
a -> GetCodeBindingSource
s {$sel:schemaName:GetCodeBindingSource' :: Text
schemaName = Text
a} :: GetCodeBindingSource)

-- | The language of the code binding.
getCodeBindingSource_language :: Lens.Lens' GetCodeBindingSource Prelude.Text
getCodeBindingSource_language :: Lens' GetCodeBindingSource Text
getCodeBindingSource_language = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeBindingSource' {Text
language :: Text
$sel:language:GetCodeBindingSource' :: GetCodeBindingSource -> Text
language} -> Text
language) (\s :: GetCodeBindingSource
s@GetCodeBindingSource' {} Text
a -> GetCodeBindingSource
s {$sel:language:GetCodeBindingSource' :: Text
language = Text
a} :: GetCodeBindingSource)

instance Core.AWSRequest GetCodeBindingSource where
  type
    AWSResponse GetCodeBindingSource =
      GetCodeBindingSourceResponse
  request :: (Service -> Service)
-> GetCodeBindingSource -> Request GetCodeBindingSource
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 GetCodeBindingSource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCodeBindingSource)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe ByteString -> Int -> GetCodeBindingSourceResponse
GetCodeBindingSourceResponse'
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            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 GetCodeBindingSource where
  hashWithSalt :: Int -> GetCodeBindingSource -> Int
hashWithSalt Int
_salt GetCodeBindingSource' {Maybe Text
Text
language :: Text
schemaName :: Text
registryName :: Text
schemaVersion :: Maybe Text
$sel:language:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:registryName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaVersion:GetCodeBindingSource' :: GetCodeBindingSource -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
schemaVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
registryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
schemaName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
language

instance Prelude.NFData GetCodeBindingSource where
  rnf :: GetCodeBindingSource -> ()
rnf GetCodeBindingSource' {Maybe Text
Text
language :: Text
schemaName :: Text
registryName :: Text
schemaVersion :: Maybe Text
$sel:language:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:registryName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaVersion:GetCodeBindingSource' :: GetCodeBindingSource -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
schemaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
registryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
schemaName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
language

instance Data.ToHeaders GetCodeBindingSource where
  toHeaders :: GetCodeBindingSource -> 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 GetCodeBindingSource where
  toPath :: GetCodeBindingSource -> ByteString
toPath GetCodeBindingSource' {Maybe Text
Text
language :: Text
schemaName :: Text
registryName :: Text
schemaVersion :: Maybe Text
$sel:language:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:registryName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaVersion:GetCodeBindingSource' :: GetCodeBindingSource -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/registries/name/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
registryName,
        ByteString
"/schemas/name/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
schemaName,
        ByteString
"/language/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
language,
        ByteString
"/source"
      ]

instance Data.ToQuery GetCodeBindingSource where
  toQuery :: GetCodeBindingSource -> QueryString
toQuery GetCodeBindingSource' {Maybe Text
Text
language :: Text
schemaName :: Text
registryName :: Text
schemaVersion :: Maybe Text
$sel:language:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:registryName:GetCodeBindingSource' :: GetCodeBindingSource -> Text
$sel:schemaVersion:GetCodeBindingSource' :: GetCodeBindingSource -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"schemaVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
schemaVersion]

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

-- |
-- Create a value of 'GetCodeBindingSourceResponse' 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:
--
-- 'body', 'getCodeBindingSourceResponse_body' - Undocumented member.
--
-- 'httpStatus', 'getCodeBindingSourceResponse_httpStatus' - The response's http status code.
newGetCodeBindingSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCodeBindingSourceResponse
newGetCodeBindingSourceResponse :: Int -> GetCodeBindingSourceResponse
newGetCodeBindingSourceResponse Int
pHttpStatus_ =
  GetCodeBindingSourceResponse'
    { $sel:body:GetCodeBindingSourceResponse' :: Maybe ByteString
body =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCodeBindingSourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getCodeBindingSourceResponse_body :: Lens.Lens' GetCodeBindingSourceResponse (Prelude.Maybe Prelude.ByteString)
getCodeBindingSourceResponse_body :: Lens' GetCodeBindingSourceResponse (Maybe ByteString)
getCodeBindingSourceResponse_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCodeBindingSourceResponse' {Maybe ByteString
body :: Maybe ByteString
$sel:body:GetCodeBindingSourceResponse' :: GetCodeBindingSourceResponse -> Maybe ByteString
body} -> Maybe ByteString
body) (\s :: GetCodeBindingSourceResponse
s@GetCodeBindingSourceResponse' {} Maybe ByteString
a -> GetCodeBindingSourceResponse
s {$sel:body:GetCodeBindingSourceResponse' :: Maybe ByteString
body = Maybe ByteString
a} :: GetCodeBindingSourceResponse)

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

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