{-# 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.CodeCommit.BatchGetCommits
-- 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 information about the contents of one or more commits in a
-- repository.
module Amazonka.CodeCommit.BatchGetCommits
  ( -- * Creating a Request
    BatchGetCommits (..),
    newBatchGetCommits,

    -- * Request Lenses
    batchGetCommits_commitIds,
    batchGetCommits_repositoryName,

    -- * Destructuring the Response
    BatchGetCommitsResponse (..),
    newBatchGetCommitsResponse,

    -- * Response Lenses
    batchGetCommitsResponse_commits,
    batchGetCommitsResponse_errors,
    batchGetCommitsResponse_httpStatus,
  )
where

import Amazonka.CodeCommit.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:/ 'newBatchGetCommits' smart constructor.
data BatchGetCommits = BatchGetCommits'
  { -- | The full commit IDs of the commits to get information about.
    --
    -- You must supply the full SHA IDs of each commit. You cannot use
    -- shortened SHA IDs.
    BatchGetCommits -> [Text]
commitIds :: [Prelude.Text],
    -- | The name of the repository that contains the commits.
    BatchGetCommits -> Text
repositoryName :: Prelude.Text
  }
  deriving (BatchGetCommits -> BatchGetCommits -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetCommits -> BatchGetCommits -> Bool
$c/= :: BatchGetCommits -> BatchGetCommits -> Bool
== :: BatchGetCommits -> BatchGetCommits -> Bool
$c== :: BatchGetCommits -> BatchGetCommits -> Bool
Prelude.Eq, ReadPrec [BatchGetCommits]
ReadPrec BatchGetCommits
Int -> ReadS BatchGetCommits
ReadS [BatchGetCommits]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetCommits]
$creadListPrec :: ReadPrec [BatchGetCommits]
readPrec :: ReadPrec BatchGetCommits
$creadPrec :: ReadPrec BatchGetCommits
readList :: ReadS [BatchGetCommits]
$creadList :: ReadS [BatchGetCommits]
readsPrec :: Int -> ReadS BatchGetCommits
$creadsPrec :: Int -> ReadS BatchGetCommits
Prelude.Read, Int -> BatchGetCommits -> ShowS
[BatchGetCommits] -> ShowS
BatchGetCommits -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetCommits] -> ShowS
$cshowList :: [BatchGetCommits] -> ShowS
show :: BatchGetCommits -> String
$cshow :: BatchGetCommits -> String
showsPrec :: Int -> BatchGetCommits -> ShowS
$cshowsPrec :: Int -> BatchGetCommits -> ShowS
Prelude.Show, forall x. Rep BatchGetCommits x -> BatchGetCommits
forall x. BatchGetCommits -> Rep BatchGetCommits x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetCommits x -> BatchGetCommits
$cfrom :: forall x. BatchGetCommits -> Rep BatchGetCommits x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetCommits' 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:
--
-- 'commitIds', 'batchGetCommits_commitIds' - The full commit IDs of the commits to get information about.
--
-- You must supply the full SHA IDs of each commit. You cannot use
-- shortened SHA IDs.
--
-- 'repositoryName', 'batchGetCommits_repositoryName' - The name of the repository that contains the commits.
newBatchGetCommits ::
  -- | 'repositoryName'
  Prelude.Text ->
  BatchGetCommits
newBatchGetCommits :: Text -> BatchGetCommits
newBatchGetCommits Text
pRepositoryName_ =
  BatchGetCommits'
    { $sel:commitIds:BatchGetCommits' :: [Text]
commitIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:repositoryName:BatchGetCommits' :: Text
repositoryName = Text
pRepositoryName_
    }

-- | The full commit IDs of the commits to get information about.
--
-- You must supply the full SHA IDs of each commit. You cannot use
-- shortened SHA IDs.
batchGetCommits_commitIds :: Lens.Lens' BatchGetCommits [Prelude.Text]
batchGetCommits_commitIds :: Lens' BatchGetCommits [Text]
batchGetCommits_commitIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetCommits' {[Text]
commitIds :: [Text]
$sel:commitIds:BatchGetCommits' :: BatchGetCommits -> [Text]
commitIds} -> [Text]
commitIds) (\s :: BatchGetCommits
s@BatchGetCommits' {} [Text]
a -> BatchGetCommits
s {$sel:commitIds:BatchGetCommits' :: [Text]
commitIds = [Text]
a} :: BatchGetCommits) 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

-- | The name of the repository that contains the commits.
batchGetCommits_repositoryName :: Lens.Lens' BatchGetCommits Prelude.Text
batchGetCommits_repositoryName :: Lens' BatchGetCommits Text
batchGetCommits_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetCommits' {Text
repositoryName :: Text
$sel:repositoryName:BatchGetCommits' :: BatchGetCommits -> Text
repositoryName} -> Text
repositoryName) (\s :: BatchGetCommits
s@BatchGetCommits' {} Text
a -> BatchGetCommits
s {$sel:repositoryName:BatchGetCommits' :: Text
repositoryName = Text
a} :: BatchGetCommits)

instance Core.AWSRequest BatchGetCommits where
  type
    AWSResponse BatchGetCommits =
      BatchGetCommitsResponse
  request :: (Service -> Service) -> BatchGetCommits -> Request BatchGetCommits
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 BatchGetCommits
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchGetCommits)))
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 [Commit]
-> Maybe [BatchGetCommitsError] -> Int -> BatchGetCommitsResponse
BatchGetCommitsResponse'
            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
"commits" 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
"errors" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable BatchGetCommits where
  hashWithSalt :: Int -> BatchGetCommits -> Int
hashWithSalt Int
_salt BatchGetCommits' {[Text]
Text
repositoryName :: Text
commitIds :: [Text]
$sel:repositoryName:BatchGetCommits' :: BatchGetCommits -> Text
$sel:commitIds:BatchGetCommits' :: BatchGetCommits -> [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
commitIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName

instance Prelude.NFData BatchGetCommits where
  rnf :: BatchGetCommits -> ()
rnf BatchGetCommits' {[Text]
Text
repositoryName :: Text
commitIds :: [Text]
$sel:repositoryName:BatchGetCommits' :: BatchGetCommits -> Text
$sel:commitIds:BatchGetCommits' :: BatchGetCommits -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
commitIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName

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

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

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

-- | /See:/ 'newBatchGetCommitsResponse' smart constructor.
data BatchGetCommitsResponse = BatchGetCommitsResponse'
  { -- | An array of commit data type objects, each of which contains information
    -- about a specified commit.
    BatchGetCommitsResponse -> Maybe [Commit]
commits :: Prelude.Maybe [Commit],
    -- | Returns any commit IDs for which information could not be found. For
    -- example, if one of the commit IDs was a shortened SHA ID or that commit
    -- was not found in the specified repository, the ID returns an error
    -- object with more information.
    BatchGetCommitsResponse -> Maybe [BatchGetCommitsError]
errors :: Prelude.Maybe [BatchGetCommitsError],
    -- | The response's http status code.
    BatchGetCommitsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetCommitsResponse -> BatchGetCommitsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetCommitsResponse -> BatchGetCommitsResponse -> Bool
$c/= :: BatchGetCommitsResponse -> BatchGetCommitsResponse -> Bool
== :: BatchGetCommitsResponse -> BatchGetCommitsResponse -> Bool
$c== :: BatchGetCommitsResponse -> BatchGetCommitsResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetCommitsResponse]
ReadPrec BatchGetCommitsResponse
Int -> ReadS BatchGetCommitsResponse
ReadS [BatchGetCommitsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetCommitsResponse]
$creadListPrec :: ReadPrec [BatchGetCommitsResponse]
readPrec :: ReadPrec BatchGetCommitsResponse
$creadPrec :: ReadPrec BatchGetCommitsResponse
readList :: ReadS [BatchGetCommitsResponse]
$creadList :: ReadS [BatchGetCommitsResponse]
readsPrec :: Int -> ReadS BatchGetCommitsResponse
$creadsPrec :: Int -> ReadS BatchGetCommitsResponse
Prelude.Read, Int -> BatchGetCommitsResponse -> ShowS
[BatchGetCommitsResponse] -> ShowS
BatchGetCommitsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetCommitsResponse] -> ShowS
$cshowList :: [BatchGetCommitsResponse] -> ShowS
show :: BatchGetCommitsResponse -> String
$cshow :: BatchGetCommitsResponse -> String
showsPrec :: Int -> BatchGetCommitsResponse -> ShowS
$cshowsPrec :: Int -> BatchGetCommitsResponse -> ShowS
Prelude.Show, forall x. Rep BatchGetCommitsResponse x -> BatchGetCommitsResponse
forall x. BatchGetCommitsResponse -> Rep BatchGetCommitsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetCommitsResponse x -> BatchGetCommitsResponse
$cfrom :: forall x. BatchGetCommitsResponse -> Rep BatchGetCommitsResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetCommitsResponse' 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:
--
-- 'commits', 'batchGetCommitsResponse_commits' - An array of commit data type objects, each of which contains information
-- about a specified commit.
--
-- 'errors', 'batchGetCommitsResponse_errors' - Returns any commit IDs for which information could not be found. For
-- example, if one of the commit IDs was a shortened SHA ID or that commit
-- was not found in the specified repository, the ID returns an error
-- object with more information.
--
-- 'httpStatus', 'batchGetCommitsResponse_httpStatus' - The response's http status code.
newBatchGetCommitsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetCommitsResponse
newBatchGetCommitsResponse :: Int -> BatchGetCommitsResponse
newBatchGetCommitsResponse Int
pHttpStatus_ =
  BatchGetCommitsResponse'
    { $sel:commits:BatchGetCommitsResponse' :: Maybe [Commit]
commits = forall a. Maybe a
Prelude.Nothing,
      $sel:errors:BatchGetCommitsResponse' :: Maybe [BatchGetCommitsError]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetCommitsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of commit data type objects, each of which contains information
-- about a specified commit.
batchGetCommitsResponse_commits :: Lens.Lens' BatchGetCommitsResponse (Prelude.Maybe [Commit])
batchGetCommitsResponse_commits :: Lens' BatchGetCommitsResponse (Maybe [Commit])
batchGetCommitsResponse_commits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetCommitsResponse' {Maybe [Commit]
commits :: Maybe [Commit]
$sel:commits:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Maybe [Commit]
commits} -> Maybe [Commit]
commits) (\s :: BatchGetCommitsResponse
s@BatchGetCommitsResponse' {} Maybe [Commit]
a -> BatchGetCommitsResponse
s {$sel:commits:BatchGetCommitsResponse' :: Maybe [Commit]
commits = Maybe [Commit]
a} :: BatchGetCommitsResponse) 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

-- | Returns any commit IDs for which information could not be found. For
-- example, if one of the commit IDs was a shortened SHA ID or that commit
-- was not found in the specified repository, the ID returns an error
-- object with more information.
batchGetCommitsResponse_errors :: Lens.Lens' BatchGetCommitsResponse (Prelude.Maybe [BatchGetCommitsError])
batchGetCommitsResponse_errors :: Lens' BatchGetCommitsResponse (Maybe [BatchGetCommitsError])
batchGetCommitsResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetCommitsResponse' {Maybe [BatchGetCommitsError]
errors :: Maybe [BatchGetCommitsError]
$sel:errors:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Maybe [BatchGetCommitsError]
errors} -> Maybe [BatchGetCommitsError]
errors) (\s :: BatchGetCommitsResponse
s@BatchGetCommitsResponse' {} Maybe [BatchGetCommitsError]
a -> BatchGetCommitsResponse
s {$sel:errors:BatchGetCommitsResponse' :: Maybe [BatchGetCommitsError]
errors = Maybe [BatchGetCommitsError]
a} :: BatchGetCommitsResponse) 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.
batchGetCommitsResponse_httpStatus :: Lens.Lens' BatchGetCommitsResponse Prelude.Int
batchGetCommitsResponse_httpStatus :: Lens' BatchGetCommitsResponse Int
batchGetCommitsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetCommitsResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetCommitsResponse
s@BatchGetCommitsResponse' {} Int
a -> BatchGetCommitsResponse
s {$sel:httpStatus:BatchGetCommitsResponse' :: Int
httpStatus = Int
a} :: BatchGetCommitsResponse)

instance Prelude.NFData BatchGetCommitsResponse where
  rnf :: BatchGetCommitsResponse -> ()
rnf BatchGetCommitsResponse' {Int
Maybe [BatchGetCommitsError]
Maybe [Commit]
httpStatus :: Int
errors :: Maybe [BatchGetCommitsError]
commits :: Maybe [Commit]
$sel:httpStatus:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Int
$sel:errors:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Maybe [BatchGetCommitsError]
$sel:commits:BatchGetCommitsResponse' :: BatchGetCommitsResponse -> Maybe [Commit]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Commit]
commits
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BatchGetCommitsError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus