{-# 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.BatchGetBuilds
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about one or more builds.
module Amazonka.CodeBuild.BatchGetBuilds
  ( -- * Creating a Request
    BatchGetBuilds (..),
    newBatchGetBuilds,

    -- * Request Lenses
    batchGetBuilds_ids,

    -- * Destructuring the Response
    BatchGetBuildsResponse (..),
    newBatchGetBuildsResponse,

    -- * Response Lenses
    batchGetBuildsResponse_builds,
    batchGetBuildsResponse_buildsNotFound,
    batchGetBuildsResponse_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:/ 'newBatchGetBuilds' smart constructor.
data BatchGetBuilds = BatchGetBuilds'
  { -- | The IDs of the builds.
    BatchGetBuilds -> NonEmpty Text
ids :: Prelude.NonEmpty Prelude.Text
  }
  deriving (BatchGetBuilds -> BatchGetBuilds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetBuilds -> BatchGetBuilds -> Bool
$c/= :: BatchGetBuilds -> BatchGetBuilds -> Bool
== :: BatchGetBuilds -> BatchGetBuilds -> Bool
$c== :: BatchGetBuilds -> BatchGetBuilds -> Bool
Prelude.Eq, ReadPrec [BatchGetBuilds]
ReadPrec BatchGetBuilds
Int -> ReadS BatchGetBuilds
ReadS [BatchGetBuilds]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetBuilds]
$creadListPrec :: ReadPrec [BatchGetBuilds]
readPrec :: ReadPrec BatchGetBuilds
$creadPrec :: ReadPrec BatchGetBuilds
readList :: ReadS [BatchGetBuilds]
$creadList :: ReadS [BatchGetBuilds]
readsPrec :: Int -> ReadS BatchGetBuilds
$creadsPrec :: Int -> ReadS BatchGetBuilds
Prelude.Read, Int -> BatchGetBuilds -> ShowS
[BatchGetBuilds] -> ShowS
BatchGetBuilds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetBuilds] -> ShowS
$cshowList :: [BatchGetBuilds] -> ShowS
show :: BatchGetBuilds -> String
$cshow :: BatchGetBuilds -> String
showsPrec :: Int -> BatchGetBuilds -> ShowS
$cshowsPrec :: Int -> BatchGetBuilds -> ShowS
Prelude.Show, forall x. Rep BatchGetBuilds x -> BatchGetBuilds
forall x. BatchGetBuilds -> Rep BatchGetBuilds x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetBuilds x -> BatchGetBuilds
$cfrom :: forall x. BatchGetBuilds -> Rep BatchGetBuilds x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetBuilds' 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:
--
-- 'ids', 'batchGetBuilds_ids' - The IDs of the builds.
newBatchGetBuilds ::
  -- | 'ids'
  Prelude.NonEmpty Prelude.Text ->
  BatchGetBuilds
newBatchGetBuilds :: NonEmpty Text -> BatchGetBuilds
newBatchGetBuilds NonEmpty Text
pIds_ =
  BatchGetBuilds' {$sel:ids:BatchGetBuilds' :: NonEmpty Text
ids = 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
pIds_}

-- | The IDs of the builds.
batchGetBuilds_ids :: Lens.Lens' BatchGetBuilds (Prelude.NonEmpty Prelude.Text)
batchGetBuilds_ids :: Lens' BatchGetBuilds (NonEmpty Text)
batchGetBuilds_ids = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBuilds' {NonEmpty Text
ids :: NonEmpty Text
$sel:ids:BatchGetBuilds' :: BatchGetBuilds -> NonEmpty Text
ids} -> NonEmpty Text
ids) (\s :: BatchGetBuilds
s@BatchGetBuilds' {} NonEmpty Text
a -> BatchGetBuilds
s {$sel:ids:BatchGetBuilds' :: NonEmpty Text
ids = NonEmpty Text
a} :: BatchGetBuilds) 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 BatchGetBuilds where
  type
    AWSResponse BatchGetBuilds =
      BatchGetBuildsResponse
  request :: (Service -> Service) -> BatchGetBuilds -> Request BatchGetBuilds
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 BatchGetBuilds
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchGetBuilds)))
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 [Build]
-> Maybe (NonEmpty Text) -> Int -> BatchGetBuildsResponse
BatchGetBuildsResponse'
            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
"builds" 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
"buildsNotFound")
            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 BatchGetBuilds where
  hashWithSalt :: Int -> BatchGetBuilds -> Int
hashWithSalt Int
_salt BatchGetBuilds' {NonEmpty Text
ids :: NonEmpty Text
$sel:ids:BatchGetBuilds' :: BatchGetBuilds -> NonEmpty Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
ids

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

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

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

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

-- | /See:/ 'newBatchGetBuildsResponse' smart constructor.
data BatchGetBuildsResponse = BatchGetBuildsResponse'
  { -- | Information about the requested builds.
    BatchGetBuildsResponse -> Maybe [Build]
builds :: Prelude.Maybe [Build],
    -- | The IDs of builds for which information could not be found.
    BatchGetBuildsResponse -> Maybe (NonEmpty Text)
buildsNotFound :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | The response's http status code.
    BatchGetBuildsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetBuildsResponse -> BatchGetBuildsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetBuildsResponse -> BatchGetBuildsResponse -> Bool
$c/= :: BatchGetBuildsResponse -> BatchGetBuildsResponse -> Bool
== :: BatchGetBuildsResponse -> BatchGetBuildsResponse -> Bool
$c== :: BatchGetBuildsResponse -> BatchGetBuildsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetBuildsResponse]
ReadPrec BatchGetBuildsResponse
Int -> ReadS BatchGetBuildsResponse
ReadS [BatchGetBuildsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetBuildsResponse]
$creadListPrec :: ReadPrec [BatchGetBuildsResponse]
readPrec :: ReadPrec BatchGetBuildsResponse
$creadPrec :: ReadPrec BatchGetBuildsResponse
readList :: ReadS [BatchGetBuildsResponse]
$creadList :: ReadS [BatchGetBuildsResponse]
readsPrec :: Int -> ReadS BatchGetBuildsResponse
$creadsPrec :: Int -> ReadS BatchGetBuildsResponse
Prelude.Read, Int -> BatchGetBuildsResponse -> ShowS
[BatchGetBuildsResponse] -> ShowS
BatchGetBuildsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetBuildsResponse] -> ShowS
$cshowList :: [BatchGetBuildsResponse] -> ShowS
show :: BatchGetBuildsResponse -> String
$cshow :: BatchGetBuildsResponse -> String
showsPrec :: Int -> BatchGetBuildsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetBuildsResponse -> ShowS
Prelude.Show, forall x. Rep BatchGetBuildsResponse x -> BatchGetBuildsResponse
forall x. BatchGetBuildsResponse -> Rep BatchGetBuildsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetBuildsResponse x -> BatchGetBuildsResponse
$cfrom :: forall x. BatchGetBuildsResponse -> Rep BatchGetBuildsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetBuildsResponse' 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:
--
-- 'builds', 'batchGetBuildsResponse_builds' - Information about the requested builds.
--
-- 'buildsNotFound', 'batchGetBuildsResponse_buildsNotFound' - The IDs of builds for which information could not be found.
--
-- 'httpStatus', 'batchGetBuildsResponse_httpStatus' - The response's http status code.
newBatchGetBuildsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetBuildsResponse
newBatchGetBuildsResponse :: Int -> BatchGetBuildsResponse
newBatchGetBuildsResponse Int
pHttpStatus_ =
  BatchGetBuildsResponse'
    { $sel:builds:BatchGetBuildsResponse' :: Maybe [Build]
builds = forall a. Maybe a
Prelude.Nothing,
      $sel:buildsNotFound:BatchGetBuildsResponse' :: Maybe (NonEmpty Text)
buildsNotFound = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetBuildsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the requested builds.
batchGetBuildsResponse_builds :: Lens.Lens' BatchGetBuildsResponse (Prelude.Maybe [Build])
batchGetBuildsResponse_builds :: Lens' BatchGetBuildsResponse (Maybe [Build])
batchGetBuildsResponse_builds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBuildsResponse' {Maybe [Build]
builds :: Maybe [Build]
$sel:builds:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Maybe [Build]
builds} -> Maybe [Build]
builds) (\s :: BatchGetBuildsResponse
s@BatchGetBuildsResponse' {} Maybe [Build]
a -> BatchGetBuildsResponse
s {$sel:builds:BatchGetBuildsResponse' :: Maybe [Build]
builds = Maybe [Build]
a} :: BatchGetBuildsResponse) 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 IDs of builds for which information could not be found.
batchGetBuildsResponse_buildsNotFound :: Lens.Lens' BatchGetBuildsResponse (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
batchGetBuildsResponse_buildsNotFound :: Lens' BatchGetBuildsResponse (Maybe (NonEmpty Text))
batchGetBuildsResponse_buildsNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBuildsResponse' {Maybe (NonEmpty Text)
buildsNotFound :: Maybe (NonEmpty Text)
$sel:buildsNotFound:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Maybe (NonEmpty Text)
buildsNotFound} -> Maybe (NonEmpty Text)
buildsNotFound) (\s :: BatchGetBuildsResponse
s@BatchGetBuildsResponse' {} Maybe (NonEmpty Text)
a -> BatchGetBuildsResponse
s {$sel:buildsNotFound:BatchGetBuildsResponse' :: Maybe (NonEmpty Text)
buildsNotFound = Maybe (NonEmpty Text)
a} :: BatchGetBuildsResponse) 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.
batchGetBuildsResponse_httpStatus :: Lens.Lens' BatchGetBuildsResponse Prelude.Int
batchGetBuildsResponse_httpStatus :: Lens' BatchGetBuildsResponse Int
batchGetBuildsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetBuildsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetBuildsResponse
s@BatchGetBuildsResponse' {} Int
a -> BatchGetBuildsResponse
s {$sel:httpStatus:BatchGetBuildsResponse' :: Int
httpStatus = Int
a} :: BatchGetBuildsResponse)

instance Prelude.NFData BatchGetBuildsResponse where
  rnf :: BatchGetBuildsResponse -> ()
rnf BatchGetBuildsResponse' {Int
Maybe [Build]
Maybe (NonEmpty Text)
httpStatus :: Int
buildsNotFound :: Maybe (NonEmpty Text)
builds :: Maybe [Build]
$sel:httpStatus:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Int
$sel:buildsNotFound:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Maybe (NonEmpty Text)
$sel:builds:BatchGetBuildsResponse' :: BatchGetBuildsResponse -> Maybe [Build]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Build]
builds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
buildsNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus