{-# 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.Glue.BatchGetDevEndpoints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of resource metadata for a given list of development
-- endpoint names. After calling the @ListDevEndpoints@ operation, you can
-- call this operation to access the data to which you have been granted
-- permissions. This operation supports all IAM permissions, including
-- permission conditions that uses tags.
module Amazonka.Glue.BatchGetDevEndpoints
  ( -- * Creating a Request
    BatchGetDevEndpoints (..),
    newBatchGetDevEndpoints,

    -- * Request Lenses
    batchGetDevEndpoints_devEndpointNames,

    -- * Destructuring the Response
    BatchGetDevEndpointsResponse (..),
    newBatchGetDevEndpointsResponse,

    -- * Response Lenses
    batchGetDevEndpointsResponse_devEndpoints,
    batchGetDevEndpointsResponse_devEndpointsNotFound,
    batchGetDevEndpointsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newBatchGetDevEndpoints' smart constructor.
data BatchGetDevEndpoints = BatchGetDevEndpoints'
  { -- | The list of @DevEndpoint@ names, which might be the names returned from
    -- the @ListDevEndpoint@ operation.
    BatchGetDevEndpoints -> NonEmpty Text
devEndpointNames :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetDevEndpoints -> BatchGetDevEndpoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDevEndpoints -> BatchGetDevEndpoints -> Bool
$c/= :: BatchGetDevEndpoints -> BatchGetDevEndpoints -> Bool
== :: BatchGetDevEndpoints -> BatchGetDevEndpoints -> Bool
$c== :: BatchGetDevEndpoints -> BatchGetDevEndpoints -> Bool
Prelude.Eq, ReadPrec [BatchGetDevEndpoints]
ReadPrec BatchGetDevEndpoints
Int -> ReadS BatchGetDevEndpoints
ReadS [BatchGetDevEndpoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDevEndpoints]
$creadListPrec :: ReadPrec [BatchGetDevEndpoints]
readPrec :: ReadPrec BatchGetDevEndpoints
$creadPrec :: ReadPrec BatchGetDevEndpoints
readList :: ReadS [BatchGetDevEndpoints]
$creadList :: ReadS [BatchGetDevEndpoints]
readsPrec :: Int -> ReadS BatchGetDevEndpoints
$creadsPrec :: Int -> ReadS BatchGetDevEndpoints
Prelude.Read, Int -> BatchGetDevEndpoints -> ShowS
[BatchGetDevEndpoints] -> ShowS
BatchGetDevEndpoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDevEndpoints] -> ShowS
$cshowList :: [BatchGetDevEndpoints] -> ShowS
show :: BatchGetDevEndpoints -> String
$cshow :: BatchGetDevEndpoints -> String
showsPrec :: Int -> BatchGetDevEndpoints -> ShowS
$cshowsPrec :: Int -> BatchGetDevEndpoints -> ShowS
Prelude.Show, forall x. Rep BatchGetDevEndpoints x -> BatchGetDevEndpoints
forall x. BatchGetDevEndpoints -> Rep BatchGetDevEndpoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetDevEndpoints x -> BatchGetDevEndpoints
$cfrom :: forall x. BatchGetDevEndpoints -> Rep BatchGetDevEndpoints x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDevEndpoints' 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:
--
-- 'devEndpointNames', 'batchGetDevEndpoints_devEndpointNames' - The list of @DevEndpoint@ names, which might be the names returned from
-- the @ListDevEndpoint@ operation.
newBatchGetDevEndpoints ::
  -- | 'devEndpointNames'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetDevEndpoints
newBatchGetDevEndpoints :: NonEmpty Text -> BatchGetDevEndpoints
newBatchGetDevEndpoints NonEmpty Text
pDevEndpointNames_ =
  BatchGetDevEndpoints'
    { $sel:devEndpointNames:BatchGetDevEndpoints' :: NonEmpty Text
devEndpointNames =
        forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pDevEndpointNames_
    }

-- | The list of @DevEndpoint@ names, which might be the names returned from
-- the @ListDevEndpoint@ operation.
batchGetDevEndpoints_devEndpointNames :: Lens.Lens' BatchGetDevEndpoints (Prelude.NonEmpty Prelude.Text)
batchGetDevEndpoints_devEndpointNames :: Lens' BatchGetDevEndpoints (NonEmpty Text)
batchGetDevEndpoints_devEndpointNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDevEndpoints' {NonEmpty Text
devEndpointNames :: NonEmpty Text
$sel:devEndpointNames:BatchGetDevEndpoints' :: BatchGetDevEndpoints -> NonEmpty Text
devEndpointNames} -> NonEmpty Text
devEndpointNames) (\s :: BatchGetDevEndpoints
s@BatchGetDevEndpoints' {} NonEmpty Text
a -> BatchGetDevEndpoints
s {$sel:devEndpointNames:BatchGetDevEndpoints' :: NonEmpty Text
devEndpointNames = NonEmpty Text
a} :: BatchGetDevEndpoints) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchGetDevEndpoints where
  type
    AWSResponse BatchGetDevEndpoints =
      BatchGetDevEndpointsResponse
  request :: (Service -> Service)
-> BatchGetDevEndpoints -> Request BatchGetDevEndpoints
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy BatchGetDevEndpoints
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetDevEndpoints)))
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 [DevEndpoint]
-> Maybe (NonEmpty Text) -> Int -> BatchGetDevEndpointsResponse
BatchGetDevEndpointsResponse'
            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
"DevEndpoints" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DevEndpointsNotFound")
            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 BatchGetDevEndpoints where
  hashWithSalt :: Int -> BatchGetDevEndpoints -> Int
hashWithSalt Int
_salt BatchGetDevEndpoints' {NonEmpty Text
devEndpointNames :: NonEmpty Text
$sel:devEndpointNames:BatchGetDevEndpoints' :: BatchGetDevEndpoints -> NonEmpty Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
devEndpointNames

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

instance Data.ToHeaders BatchGetDevEndpoints where
  toHeaders :: BatchGetDevEndpoints -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSGlue.BatchGetDevEndpoints" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON BatchGetDevEndpoints where
  toJSON :: BatchGetDevEndpoints -> Value
toJSON BatchGetDevEndpoints' {NonEmpty Text
devEndpointNames :: NonEmpty Text
$sel:devEndpointNames:BatchGetDevEndpoints' :: BatchGetDevEndpoints -> NonEmpty Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"DevEndpointNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
devEndpointNames)
          ]
      )

instance Data.ToPath BatchGetDevEndpoints where
  toPath :: BatchGetDevEndpoints -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newBatchGetDevEndpointsResponse' smart constructor.
data BatchGetDevEndpointsResponse = BatchGetDevEndpointsResponse'
  { -- | A list of @DevEndpoint@ definitions.
    BatchGetDevEndpointsResponse -> Maybe [DevEndpoint]
devEndpoints :: Prelude.Maybe [DevEndpoint],
    -- | A list of @DevEndpoints@ not found.
    BatchGetDevEndpointsResponse -> Maybe (NonEmpty Text)
devEndpointsNotFound :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    BatchGetDevEndpointsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetDevEndpointsResponse
-> BatchGetDevEndpointsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDevEndpointsResponse
-> BatchGetDevEndpointsResponse -> Bool
$c/= :: BatchGetDevEndpointsResponse
-> BatchGetDevEndpointsResponse -> Bool
== :: BatchGetDevEndpointsResponse
-> BatchGetDevEndpointsResponse -> Bool
$c== :: BatchGetDevEndpointsResponse
-> BatchGetDevEndpointsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetDevEndpointsResponse]
ReadPrec BatchGetDevEndpointsResponse
Int -> ReadS BatchGetDevEndpointsResponse
ReadS [BatchGetDevEndpointsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDevEndpointsResponse]
$creadListPrec :: ReadPrec [BatchGetDevEndpointsResponse]
readPrec :: ReadPrec BatchGetDevEndpointsResponse
$creadPrec :: ReadPrec BatchGetDevEndpointsResponse
readList :: ReadS [BatchGetDevEndpointsResponse]
$creadList :: ReadS [BatchGetDevEndpointsResponse]
readsPrec :: Int -> ReadS BatchGetDevEndpointsResponse
$creadsPrec :: Int -> ReadS BatchGetDevEndpointsResponse
Prelude.Read, Int -> BatchGetDevEndpointsResponse -> ShowS
[BatchGetDevEndpointsResponse] -> ShowS
BatchGetDevEndpointsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDevEndpointsResponse] -> ShowS
$cshowList :: [BatchGetDevEndpointsResponse] -> ShowS
show :: BatchGetDevEndpointsResponse -> String
$cshow :: BatchGetDevEndpointsResponse -> String
showsPrec :: Int -> BatchGetDevEndpointsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetDevEndpointsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetDevEndpointsResponse x -> BatchGetDevEndpointsResponse
forall x.
BatchGetDevEndpointsResponse -> Rep BatchGetDevEndpointsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDevEndpointsResponse x -> BatchGetDevEndpointsResponse
$cfrom :: forall x.
BatchGetDevEndpointsResponse -> Rep BatchGetDevEndpointsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDevEndpointsResponse' 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:
--
-- 'devEndpoints', 'batchGetDevEndpointsResponse_devEndpoints' - A list of @DevEndpoint@ definitions.
--
-- 'devEndpointsNotFound', 'batchGetDevEndpointsResponse_devEndpointsNotFound' - A list of @DevEndpoints@ not found.
--
-- 'httpStatus', 'batchGetDevEndpointsResponse_httpStatus' - The response's http status code.
newBatchGetDevEndpointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetDevEndpointsResponse
newBatchGetDevEndpointsResponse :: Int -> BatchGetDevEndpointsResponse
newBatchGetDevEndpointsResponse Int
pHttpStatus_ =
  BatchGetDevEndpointsResponse'
    { $sel:devEndpoints:BatchGetDevEndpointsResponse' :: Maybe [DevEndpoint]
devEndpoints =
        forall a. Maybe a
Prelude.Nothing,
      $sel:devEndpointsNotFound:BatchGetDevEndpointsResponse' :: Maybe (NonEmpty Text)
devEndpointsNotFound = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetDevEndpointsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @DevEndpoint@ definitions.
batchGetDevEndpointsResponse_devEndpoints :: Lens.Lens' BatchGetDevEndpointsResponse (Prelude.Maybe [DevEndpoint])
batchGetDevEndpointsResponse_devEndpoints :: Lens' BatchGetDevEndpointsResponse (Maybe [DevEndpoint])
batchGetDevEndpointsResponse_devEndpoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDevEndpointsResponse' {Maybe [DevEndpoint]
devEndpoints :: Maybe [DevEndpoint]
$sel:devEndpoints:BatchGetDevEndpointsResponse' :: BatchGetDevEndpointsResponse -> Maybe [DevEndpoint]
devEndpoints} -> Maybe [DevEndpoint]
devEndpoints) (\s :: BatchGetDevEndpointsResponse
s@BatchGetDevEndpointsResponse' {} Maybe [DevEndpoint]
a -> BatchGetDevEndpointsResponse
s {$sel:devEndpoints:BatchGetDevEndpointsResponse' :: Maybe [DevEndpoint]
devEndpoints = Maybe [DevEndpoint]
a} :: BatchGetDevEndpointsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of @DevEndpoints@ not found.
batchGetDevEndpointsResponse_devEndpointsNotFound :: Lens.Lens' BatchGetDevEndpointsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
batchGetDevEndpointsResponse_devEndpointsNotFound :: Lens' BatchGetDevEndpointsResponse (Maybe (NonEmpty Text))
batchGetDevEndpointsResponse_devEndpointsNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDevEndpointsResponse' {Maybe (NonEmpty Text)
devEndpointsNotFound :: Maybe (NonEmpty Text)
$sel:devEndpointsNotFound:BatchGetDevEndpointsResponse' :: BatchGetDevEndpointsResponse -> Maybe (NonEmpty Text)
devEndpointsNotFound} -> Maybe (NonEmpty Text)
devEndpointsNotFound) (\s :: BatchGetDevEndpointsResponse
s@BatchGetDevEndpointsResponse' {} Maybe (NonEmpty Text)
a -> BatchGetDevEndpointsResponse
s {$sel:devEndpointsNotFound:BatchGetDevEndpointsResponse' :: Maybe (NonEmpty Text)
devEndpointsNotFound = Maybe (NonEmpty Text)
a} :: BatchGetDevEndpointsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData BatchGetDevEndpointsResponse where
  rnf :: BatchGetDevEndpointsResponse -> ()
rnf BatchGetDevEndpointsResponse' {Int
Maybe [DevEndpoint]
Maybe (NonEmpty Text)
httpStatus :: Int
devEndpointsNotFound :: Maybe (NonEmpty Text)
devEndpoints :: Maybe [DevEndpoint]
$sel:httpStatus:BatchGetDevEndpointsResponse' :: BatchGetDevEndpointsResponse -> Int
$sel:devEndpointsNotFound:BatchGetDevEndpointsResponse' :: BatchGetDevEndpointsResponse -> Maybe (NonEmpty Text)
$sel:devEndpoints:BatchGetDevEndpointsResponse' :: BatchGetDevEndpointsResponse -> Maybe [DevEndpoint]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DevEndpoint]
devEndpoints
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
devEndpointsNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus