{-# 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.BatchGetWorkflows
-- 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 workflow names.
-- After calling the @ListWorkflows@ 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.BatchGetWorkflows
  ( -- * Creating a Request
    BatchGetWorkflows (..),
    newBatchGetWorkflows,

    -- * Request Lenses
    batchGetWorkflows_includeGraph,
    batchGetWorkflows_names,

    -- * Destructuring the Response
    BatchGetWorkflowsResponse (..),
    newBatchGetWorkflowsResponse,

    -- * Response Lenses
    batchGetWorkflowsResponse_missingWorkflows,
    batchGetWorkflowsResponse_workflows,
    batchGetWorkflowsResponse_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:/ 'newBatchGetWorkflows' smart constructor.
data BatchGetWorkflows = BatchGetWorkflows'
  { -- | Specifies whether to include a graph when returning the workflow
    -- resource metadata.
    BatchGetWorkflows -> Maybe Bool
includeGraph :: Prelude.Maybe Prelude.Bool,
    -- | A list of workflow names, which may be the names returned from the
    -- @ListWorkflows@ operation.
    BatchGetWorkflows -> NonEmpty Text
names :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetWorkflows -> BatchGetWorkflows -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetWorkflows -> BatchGetWorkflows -> Bool
$c/= :: BatchGetWorkflows -> BatchGetWorkflows -> Bool
== :: BatchGetWorkflows -> BatchGetWorkflows -> Bool
$c== :: BatchGetWorkflows -> BatchGetWorkflows -> Bool
Prelude.Eq, ReadPrec [BatchGetWorkflows]
ReadPrec BatchGetWorkflows
Int -> ReadS BatchGetWorkflows
ReadS [BatchGetWorkflows]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetWorkflows]
$creadListPrec :: ReadPrec [BatchGetWorkflows]
readPrec :: ReadPrec BatchGetWorkflows
$creadPrec :: ReadPrec BatchGetWorkflows
readList :: ReadS [BatchGetWorkflows]
$creadList :: ReadS [BatchGetWorkflows]
readsPrec :: Int -> ReadS BatchGetWorkflows
$creadsPrec :: Int -> ReadS BatchGetWorkflows
Prelude.Read, Int -> BatchGetWorkflows -> ShowS
[BatchGetWorkflows] -> ShowS
BatchGetWorkflows -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetWorkflows] -> ShowS
$cshowList :: [BatchGetWorkflows] -> ShowS
show :: BatchGetWorkflows -> String
$cshow :: BatchGetWorkflows -> String
showsPrec :: Int -> BatchGetWorkflows -> ShowS
$cshowsPrec :: Int -> BatchGetWorkflows -> ShowS
Prelude.Show, forall x. Rep BatchGetWorkflows x -> BatchGetWorkflows
forall x. BatchGetWorkflows -> Rep BatchGetWorkflows x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetWorkflows x -> BatchGetWorkflows
$cfrom :: forall x. BatchGetWorkflows -> Rep BatchGetWorkflows x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetWorkflows' 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:
--
-- 'includeGraph', 'batchGetWorkflows_includeGraph' - Specifies whether to include a graph when returning the workflow
-- resource metadata.
--
-- 'names', 'batchGetWorkflows_names' - A list of workflow names, which may be the names returned from the
-- @ListWorkflows@ operation.
newBatchGetWorkflows ::
  -- | 'names'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetWorkflows
newBatchGetWorkflows :: NonEmpty Text -> BatchGetWorkflows
newBatchGetWorkflows NonEmpty Text
pNames_ =
  BatchGetWorkflows'
    { $sel:includeGraph:BatchGetWorkflows' :: Maybe Bool
includeGraph = forall a. Maybe a
Prelude.Nothing,
      $sel:names:BatchGetWorkflows' :: NonEmpty Text
names = 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
pNames_
    }

-- | Specifies whether to include a graph when returning the workflow
-- resource metadata.
batchGetWorkflows_includeGraph :: Lens.Lens' BatchGetWorkflows (Prelude.Maybe Prelude.Bool)
batchGetWorkflows_includeGraph :: Lens' BatchGetWorkflows (Maybe Bool)
batchGetWorkflows_includeGraph = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetWorkflows' {Maybe Bool
includeGraph :: Maybe Bool
$sel:includeGraph:BatchGetWorkflows' :: BatchGetWorkflows -> Maybe Bool
includeGraph} -> Maybe Bool
includeGraph) (\s :: BatchGetWorkflows
s@BatchGetWorkflows' {} Maybe Bool
a -> BatchGetWorkflows
s {$sel:includeGraph:BatchGetWorkflows' :: Maybe Bool
includeGraph = Maybe Bool
a} :: BatchGetWorkflows)

-- | A list of workflow names, which may be the names returned from the
-- @ListWorkflows@ operation.
batchGetWorkflows_names :: Lens.Lens' BatchGetWorkflows (Prelude.NonEmpty Prelude.Text)
batchGetWorkflows_names :: Lens' BatchGetWorkflows (NonEmpty Text)
batchGetWorkflows_names = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetWorkflows' {NonEmpty Text
names :: NonEmpty Text
$sel:names:BatchGetWorkflows' :: BatchGetWorkflows -> NonEmpty Text
names} -> NonEmpty Text
names) (\s :: BatchGetWorkflows
s@BatchGetWorkflows' {} NonEmpty Text
a -> BatchGetWorkflows
s {$sel:names:BatchGetWorkflows' :: NonEmpty Text
names = NonEmpty Text
a} :: BatchGetWorkflows) 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 BatchGetWorkflows where
  type
    AWSResponse BatchGetWorkflows =
      BatchGetWorkflowsResponse
  request :: (Service -> Service)
-> BatchGetWorkflows -> Request BatchGetWorkflows
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 BatchGetWorkflows
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetWorkflows)))
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 (NonEmpty Text)
-> Maybe (NonEmpty Workflow) -> Int -> BatchGetWorkflowsResponse
BatchGetWorkflowsResponse'
            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
"MissingWorkflows")
            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
"Workflows")
            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 BatchGetWorkflows where
  hashWithSalt :: Int -> BatchGetWorkflows -> Int
hashWithSalt Int
_salt BatchGetWorkflows' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeGraph :: Maybe Bool
$sel:names:BatchGetWorkflows' :: BatchGetWorkflows -> NonEmpty Text
$sel:includeGraph:BatchGetWorkflows' :: BatchGetWorkflows -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeGraph
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
names

instance Prelude.NFData BatchGetWorkflows where
  rnf :: BatchGetWorkflows -> ()
rnf BatchGetWorkflows' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeGraph :: Maybe Bool
$sel:names:BatchGetWorkflows' :: BatchGetWorkflows -> NonEmpty Text
$sel:includeGraph:BatchGetWorkflows' :: BatchGetWorkflows -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeGraph
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
names

instance Data.ToHeaders BatchGetWorkflows where
  toHeaders :: BatchGetWorkflows -> 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.BatchGetWorkflows" :: 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 BatchGetWorkflows where
  toJSON :: BatchGetWorkflows -> Value
toJSON BatchGetWorkflows' {Maybe Bool
NonEmpty Text
names :: NonEmpty Text
includeGraph :: Maybe Bool
$sel:names:BatchGetWorkflows' :: BatchGetWorkflows -> NonEmpty Text
$sel:includeGraph:BatchGetWorkflows' :: BatchGetWorkflows -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IncludeGraph" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
includeGraph,
            forall a. a -> Maybe a
Prelude.Just (Key
"Names" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
names)
          ]
      )

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

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

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

-- |
-- Create a value of 'BatchGetWorkflowsResponse' 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:
--
-- 'missingWorkflows', 'batchGetWorkflowsResponse_missingWorkflows' - A list of names of workflows not found.
--
-- 'workflows', 'batchGetWorkflowsResponse_workflows' - A list of workflow resource metadata.
--
-- 'httpStatus', 'batchGetWorkflowsResponse_httpStatus' - The response's http status code.
newBatchGetWorkflowsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetWorkflowsResponse
newBatchGetWorkflowsResponse :: Int -> BatchGetWorkflowsResponse
newBatchGetWorkflowsResponse Int
pHttpStatus_ =
  BatchGetWorkflowsResponse'
    { $sel:missingWorkflows:BatchGetWorkflowsResponse' :: Maybe (NonEmpty Text)
missingWorkflows =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workflows:BatchGetWorkflowsResponse' :: Maybe (NonEmpty Workflow)
workflows = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetWorkflowsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of names of workflows not found.
batchGetWorkflowsResponse_missingWorkflows :: Lens.Lens' BatchGetWorkflowsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
batchGetWorkflowsResponse_missingWorkflows :: Lens' BatchGetWorkflowsResponse (Maybe (NonEmpty Text))
batchGetWorkflowsResponse_missingWorkflows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetWorkflowsResponse' {Maybe (NonEmpty Text)
missingWorkflows :: Maybe (NonEmpty Text)
$sel:missingWorkflows:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Maybe (NonEmpty Text)
missingWorkflows} -> Maybe (NonEmpty Text)
missingWorkflows) (\s :: BatchGetWorkflowsResponse
s@BatchGetWorkflowsResponse' {} Maybe (NonEmpty Text)
a -> BatchGetWorkflowsResponse
s {$sel:missingWorkflows:BatchGetWorkflowsResponse' :: Maybe (NonEmpty Text)
missingWorkflows = Maybe (NonEmpty Text)
a} :: BatchGetWorkflowsResponse) 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 workflow resource metadata.
batchGetWorkflowsResponse_workflows :: Lens.Lens' BatchGetWorkflowsResponse (Prelude.Maybe (Prelude.NonEmpty Workflow))
batchGetWorkflowsResponse_workflows :: Lens' BatchGetWorkflowsResponse (Maybe (NonEmpty Workflow))
batchGetWorkflowsResponse_workflows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetWorkflowsResponse' {Maybe (NonEmpty Workflow)
workflows :: Maybe (NonEmpty Workflow)
$sel:workflows:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Maybe (NonEmpty Workflow)
workflows} -> Maybe (NonEmpty Workflow)
workflows) (\s :: BatchGetWorkflowsResponse
s@BatchGetWorkflowsResponse' {} Maybe (NonEmpty Workflow)
a -> BatchGetWorkflowsResponse
s {$sel:workflows:BatchGetWorkflowsResponse' :: Maybe (NonEmpty Workflow)
workflows = Maybe (NonEmpty Workflow)
a} :: BatchGetWorkflowsResponse) 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.
batchGetWorkflowsResponse_httpStatus :: Lens.Lens' BatchGetWorkflowsResponse Prelude.Int
batchGetWorkflowsResponse_httpStatus :: Lens' BatchGetWorkflowsResponse Int
batchGetWorkflowsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetWorkflowsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetWorkflowsResponse
s@BatchGetWorkflowsResponse' {} Int
a -> BatchGetWorkflowsResponse
s {$sel:httpStatus:BatchGetWorkflowsResponse' :: Int
httpStatus = Int
a} :: BatchGetWorkflowsResponse)

instance Prelude.NFData BatchGetWorkflowsResponse where
  rnf :: BatchGetWorkflowsResponse -> ()
rnf BatchGetWorkflowsResponse' {Int
Maybe (NonEmpty Text)
Maybe (NonEmpty Workflow)
httpStatus :: Int
workflows :: Maybe (NonEmpty Workflow)
missingWorkflows :: Maybe (NonEmpty Text)
$sel:httpStatus:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Int
$sel:workflows:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Maybe (NonEmpty Workflow)
$sel:missingWorkflows:BatchGetWorkflowsResponse' :: BatchGetWorkflowsResponse -> Maybe (NonEmpty Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
missingWorkflows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Workflow)
workflows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus