{-# 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.CodeBuild.BatchGetReportGroups
-- 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 an array of report groups.
module Amazonka.CodeBuild.BatchGetReportGroups
  ( -- * Creating a Request
    BatchGetReportGroups (..),
    newBatchGetReportGroups,

    -- * Request Lenses
    batchGetReportGroups_reportGroupArns,

    -- * Destructuring the Response
    BatchGetReportGroupsResponse (..),
    newBatchGetReportGroupsResponse,

    -- * Response Lenses
    batchGetReportGroupsResponse_reportGroups,
    batchGetReportGroupsResponse_reportGroupsNotFound,
    batchGetReportGroupsResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.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:/ 'newBatchGetReportGroups' smart constructor.
data BatchGetReportGroups = BatchGetReportGroups'
  { -- | An array of report group ARNs that identify the report groups to return.
    BatchGetReportGroups -> NonEmpty Text
reportGroupArns :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetReportGroups -> BatchGetReportGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetReportGroups -> BatchGetReportGroups -> Bool
$c/= :: BatchGetReportGroups -> BatchGetReportGroups -> Bool
== :: BatchGetReportGroups -> BatchGetReportGroups -> Bool
$c== :: BatchGetReportGroups -> BatchGetReportGroups -> Bool
Prelude.Eq, ReadPrec [BatchGetReportGroups]
ReadPrec BatchGetReportGroups
Int -> ReadS BatchGetReportGroups
ReadS [BatchGetReportGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetReportGroups]
$creadListPrec :: ReadPrec [BatchGetReportGroups]
readPrec :: ReadPrec BatchGetReportGroups
$creadPrec :: ReadPrec BatchGetReportGroups
readList :: ReadS [BatchGetReportGroups]
$creadList :: ReadS [BatchGetReportGroups]
readsPrec :: Int -> ReadS BatchGetReportGroups
$creadsPrec :: Int -> ReadS BatchGetReportGroups
Prelude.Read, Int -> BatchGetReportGroups -> ShowS
[BatchGetReportGroups] -> ShowS
BatchGetReportGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetReportGroups] -> ShowS
$cshowList :: [BatchGetReportGroups] -> ShowS
show :: BatchGetReportGroups -> String
$cshow :: BatchGetReportGroups -> String
showsPrec :: Int -> BatchGetReportGroups -> ShowS
$cshowsPrec :: Int -> BatchGetReportGroups -> ShowS
Prelude.Show, forall x. Rep BatchGetReportGroups x -> BatchGetReportGroups
forall x. BatchGetReportGroups -> Rep BatchGetReportGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetReportGroups x -> BatchGetReportGroups
$cfrom :: forall x. BatchGetReportGroups -> Rep BatchGetReportGroups x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetReportGroups' 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:
--
-- 'reportGroupArns', 'batchGetReportGroups_reportGroupArns' - An array of report group ARNs that identify the report groups to return.
newBatchGetReportGroups ::
  -- | 'reportGroupArns'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetReportGroups
newBatchGetReportGroups :: NonEmpty Text -> BatchGetReportGroups
newBatchGetReportGroups NonEmpty Text
pReportGroupArns_ =
  BatchGetReportGroups'
    { $sel:reportGroupArns:BatchGetReportGroups' :: NonEmpty Text
reportGroupArns =
        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
pReportGroupArns_
    }

-- | An array of report group ARNs that identify the report groups to return.
batchGetReportGroups_reportGroupArns :: Lens.Lens' BatchGetReportGroups (Prelude.NonEmpty Prelude.Text)
batchGetReportGroups_reportGroupArns :: Lens' BatchGetReportGroups (NonEmpty Text)
batchGetReportGroups_reportGroupArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetReportGroups' {NonEmpty Text
reportGroupArns :: NonEmpty Text
$sel:reportGroupArns:BatchGetReportGroups' :: BatchGetReportGroups -> NonEmpty Text
reportGroupArns} -> NonEmpty Text
reportGroupArns) (\s :: BatchGetReportGroups
s@BatchGetReportGroups' {} NonEmpty Text
a -> BatchGetReportGroups
s {$sel:reportGroupArns:BatchGetReportGroups' :: NonEmpty Text
reportGroupArns = NonEmpty Text
a} :: BatchGetReportGroups) 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 BatchGetReportGroups where
  type
    AWSResponse BatchGetReportGroups =
      BatchGetReportGroupsResponse
  request :: (Service -> Service)
-> BatchGetReportGroups -> Request BatchGetReportGroups
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 BatchGetReportGroups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetReportGroups)))
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 ReportGroup)
-> Maybe (NonEmpty Text) -> Int -> BatchGetReportGroupsResponse
BatchGetReportGroupsResponse'
            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
"reportGroups")
            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
"reportGroupsNotFound")
            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 BatchGetReportGroups where
  hashWithSalt :: Int -> BatchGetReportGroups -> Int
hashWithSalt Int
_salt BatchGetReportGroups' {NonEmpty Text
reportGroupArns :: NonEmpty Text
$sel:reportGroupArns:BatchGetReportGroups' :: BatchGetReportGroups -> NonEmpty Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
reportGroupArns

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

instance Data.ToHeaders BatchGetReportGroups where
  toHeaders :: BatchGetReportGroups -> 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
"CodeBuild_20161006.BatchGetReportGroups" ::
                          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 BatchGetReportGroups where
  toJSON :: BatchGetReportGroups -> Value
toJSON BatchGetReportGroups' {NonEmpty Text
reportGroupArns :: NonEmpty Text
$sel:reportGroupArns:BatchGetReportGroups' :: BatchGetReportGroups -> NonEmpty Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"reportGroupArns" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
reportGroupArns)
          ]
      )

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

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

-- | /See:/ 'newBatchGetReportGroupsResponse' smart constructor.
data BatchGetReportGroupsResponse = BatchGetReportGroupsResponse'
  { -- | The array of report groups returned by @BatchGetReportGroups@.
    BatchGetReportGroupsResponse -> Maybe (NonEmpty ReportGroup)
reportGroups :: Prelude.Maybe (Prelude.NonEmpty ReportGroup),
    -- | An array of ARNs passed to @BatchGetReportGroups@ that are not
    -- associated with a @ReportGroup@.
    BatchGetReportGroupsResponse -> Maybe (NonEmpty Text)
reportGroupsNotFound :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    BatchGetReportGroupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetReportGroupsResponse
-> BatchGetReportGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetReportGroupsResponse
-> BatchGetReportGroupsResponse -> Bool
$c/= :: BatchGetReportGroupsResponse
-> BatchGetReportGroupsResponse -> Bool
== :: BatchGetReportGroupsResponse
-> BatchGetReportGroupsResponse -> Bool
$c== :: BatchGetReportGroupsResponse
-> BatchGetReportGroupsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetReportGroupsResponse]
ReadPrec BatchGetReportGroupsResponse
Int -> ReadS BatchGetReportGroupsResponse
ReadS [BatchGetReportGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetReportGroupsResponse]
$creadListPrec :: ReadPrec [BatchGetReportGroupsResponse]
readPrec :: ReadPrec BatchGetReportGroupsResponse
$creadPrec :: ReadPrec BatchGetReportGroupsResponse
readList :: ReadS [BatchGetReportGroupsResponse]
$creadList :: ReadS [BatchGetReportGroupsResponse]
readsPrec :: Int -> ReadS BatchGetReportGroupsResponse
$creadsPrec :: Int -> ReadS BatchGetReportGroupsResponse
Prelude.Read, Int -> BatchGetReportGroupsResponse -> ShowS
[BatchGetReportGroupsResponse] -> ShowS
BatchGetReportGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetReportGroupsResponse] -> ShowS
$cshowList :: [BatchGetReportGroupsResponse] -> ShowS
show :: BatchGetReportGroupsResponse -> String
$cshow :: BatchGetReportGroupsResponse -> String
showsPrec :: Int -> BatchGetReportGroupsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetReportGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetReportGroupsResponse x -> BatchGetReportGroupsResponse
forall x.
BatchGetReportGroupsResponse -> Rep BatchGetReportGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetReportGroupsResponse x -> BatchGetReportGroupsResponse
$cfrom :: forall x.
BatchGetReportGroupsResponse -> Rep BatchGetReportGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetReportGroupsResponse' 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:
--
-- 'reportGroups', 'batchGetReportGroupsResponse_reportGroups' - The array of report groups returned by @BatchGetReportGroups@.
--
-- 'reportGroupsNotFound', 'batchGetReportGroupsResponse_reportGroupsNotFound' - An array of ARNs passed to @BatchGetReportGroups@ that are not
-- associated with a @ReportGroup@.
--
-- 'httpStatus', 'batchGetReportGroupsResponse_httpStatus' - The response's http status code.
newBatchGetReportGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetReportGroupsResponse
newBatchGetReportGroupsResponse :: Int -> BatchGetReportGroupsResponse
newBatchGetReportGroupsResponse Int
pHttpStatus_ =
  BatchGetReportGroupsResponse'
    { $sel:reportGroups:BatchGetReportGroupsResponse' :: Maybe (NonEmpty ReportGroup)
reportGroups =
        forall a. Maybe a
Prelude.Nothing,
      $sel:reportGroupsNotFound:BatchGetReportGroupsResponse' :: Maybe (NonEmpty Text)
reportGroupsNotFound = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetReportGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The array of report groups returned by @BatchGetReportGroups@.
batchGetReportGroupsResponse_reportGroups :: Lens.Lens' BatchGetReportGroupsResponse (Prelude.Maybe (Prelude.NonEmpty ReportGroup))
batchGetReportGroupsResponse_reportGroups :: Lens' BatchGetReportGroupsResponse (Maybe (NonEmpty ReportGroup))
batchGetReportGroupsResponse_reportGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetReportGroupsResponse' {Maybe (NonEmpty ReportGroup)
reportGroups :: Maybe (NonEmpty ReportGroup)
$sel:reportGroups:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Maybe (NonEmpty ReportGroup)
reportGroups} -> Maybe (NonEmpty ReportGroup)
reportGroups) (\s :: BatchGetReportGroupsResponse
s@BatchGetReportGroupsResponse' {} Maybe (NonEmpty ReportGroup)
a -> BatchGetReportGroupsResponse
s {$sel:reportGroups:BatchGetReportGroupsResponse' :: Maybe (NonEmpty ReportGroup)
reportGroups = Maybe (NonEmpty ReportGroup)
a} :: BatchGetReportGroupsResponse) 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

-- | An array of ARNs passed to @BatchGetReportGroups@ that are not
-- associated with a @ReportGroup@.
batchGetReportGroupsResponse_reportGroupsNotFound :: Lens.Lens' BatchGetReportGroupsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
batchGetReportGroupsResponse_reportGroupsNotFound :: Lens' BatchGetReportGroupsResponse (Maybe (NonEmpty Text))
batchGetReportGroupsResponse_reportGroupsNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetReportGroupsResponse' {Maybe (NonEmpty Text)
reportGroupsNotFound :: Maybe (NonEmpty Text)
$sel:reportGroupsNotFound:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Maybe (NonEmpty Text)
reportGroupsNotFound} -> Maybe (NonEmpty Text)
reportGroupsNotFound) (\s :: BatchGetReportGroupsResponse
s@BatchGetReportGroupsResponse' {} Maybe (NonEmpty Text)
a -> BatchGetReportGroupsResponse
s {$sel:reportGroupsNotFound:BatchGetReportGroupsResponse' :: Maybe (NonEmpty Text)
reportGroupsNotFound = Maybe (NonEmpty Text)
a} :: BatchGetReportGroupsResponse) 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.
batchGetReportGroupsResponse_httpStatus :: Lens.Lens' BatchGetReportGroupsResponse Prelude.Int
batchGetReportGroupsResponse_httpStatus :: Lens' BatchGetReportGroupsResponse Int
batchGetReportGroupsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetReportGroupsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetReportGroupsResponse
s@BatchGetReportGroupsResponse' {} Int
a -> BatchGetReportGroupsResponse
s {$sel:httpStatus:BatchGetReportGroupsResponse' :: Int
httpStatus = Int
a} :: BatchGetReportGroupsResponse)

instance Prelude.NFData BatchGetReportGroupsResponse where
  rnf :: BatchGetReportGroupsResponse -> ()
rnf BatchGetReportGroupsResponse' {Int
Maybe (NonEmpty Text)
Maybe (NonEmpty ReportGroup)
httpStatus :: Int
reportGroupsNotFound :: Maybe (NonEmpty Text)
reportGroups :: Maybe (NonEmpty ReportGroup)
$sel:httpStatus:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Int
$sel:reportGroupsNotFound:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Maybe (NonEmpty Text)
$sel:reportGroups:BatchGetReportGroupsResponse' :: BatchGetReportGroupsResponse -> Maybe (NonEmpty ReportGroup)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ReportGroup)
reportGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
reportGroupsNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus