{-# 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.BatchGetRepositories
-- 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 one or more repositories.
--
-- The description field for a repository accepts all HTML characters and
-- all valid Unicode characters. Applications that do not HTML-encode the
-- description and display it in a webpage can expose users to potentially
-- malicious code. Make sure that you HTML-encode the description field in
-- any application that uses this API to display the repository description
-- on a webpage.
module Amazonka.CodeCommit.BatchGetRepositories
  ( -- * Creating a Request
    BatchGetRepositories (..),
    newBatchGetRepositories,

    -- * Request Lenses
    batchGetRepositories_repositoryNames,

    -- * Destructuring the Response
    BatchGetRepositoriesResponse (..),
    newBatchGetRepositoriesResponse,

    -- * Response Lenses
    batchGetRepositoriesResponse_repositories,
    batchGetRepositoriesResponse_repositoriesNotFound,
    batchGetRepositoriesResponse_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

-- | Represents the input of a batch get repositories operation.
--
-- /See:/ 'newBatchGetRepositories' smart constructor.
data BatchGetRepositories = BatchGetRepositories'
  { -- | The names of the repositories to get information about.
    --
    -- The length constraint limit is for each string in the array. The array
    -- itself can be empty.
    BatchGetRepositories -> [Text]
repositoryNames :: [Prelude.Text]
  }
  deriving (BatchGetRepositories -> BatchGetRepositories -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetRepositories -> BatchGetRepositories -> Bool
$c/= :: BatchGetRepositories -> BatchGetRepositories -> Bool
== :: BatchGetRepositories -> BatchGetRepositories -> Bool
$c== :: BatchGetRepositories -> BatchGetRepositories -> Bool
Prelude.Eq, ReadPrec [BatchGetRepositories]
ReadPrec BatchGetRepositories
Int -> ReadS BatchGetRepositories
ReadS [BatchGetRepositories]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetRepositories]
$creadListPrec :: ReadPrec [BatchGetRepositories]
readPrec :: ReadPrec BatchGetRepositories
$creadPrec :: ReadPrec BatchGetRepositories
readList :: ReadS [BatchGetRepositories]
$creadList :: ReadS [BatchGetRepositories]
readsPrec :: Int -> ReadS BatchGetRepositories
$creadsPrec :: Int -> ReadS BatchGetRepositories
Prelude.Read, Int -> BatchGetRepositories -> ShowS
[BatchGetRepositories] -> ShowS
BatchGetRepositories -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetRepositories] -> ShowS
$cshowList :: [BatchGetRepositories] -> ShowS
show :: BatchGetRepositories -> String
$cshow :: BatchGetRepositories -> String
showsPrec :: Int -> BatchGetRepositories -> ShowS
$cshowsPrec :: Int -> BatchGetRepositories -> ShowS
Prelude.Show, forall x. Rep BatchGetRepositories x -> BatchGetRepositories
forall x. BatchGetRepositories -> Rep BatchGetRepositories x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetRepositories x -> BatchGetRepositories
$cfrom :: forall x. BatchGetRepositories -> Rep BatchGetRepositories x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetRepositories' 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:
--
-- 'repositoryNames', 'batchGetRepositories_repositoryNames' - The names of the repositories to get information about.
--
-- The length constraint limit is for each string in the array. The array
-- itself can be empty.
newBatchGetRepositories ::
  BatchGetRepositories
newBatchGetRepositories :: BatchGetRepositories
newBatchGetRepositories =
  BatchGetRepositories'
    { $sel:repositoryNames:BatchGetRepositories' :: [Text]
repositoryNames =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The names of the repositories to get information about.
--
-- The length constraint limit is for each string in the array. The array
-- itself can be empty.
batchGetRepositories_repositoryNames :: Lens.Lens' BatchGetRepositories [Prelude.Text]
batchGetRepositories_repositoryNames :: Lens' BatchGetRepositories [Text]
batchGetRepositories_repositoryNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetRepositories' {[Text]
repositoryNames :: [Text]
$sel:repositoryNames:BatchGetRepositories' :: BatchGetRepositories -> [Text]
repositoryNames} -> [Text]
repositoryNames) (\s :: BatchGetRepositories
s@BatchGetRepositories' {} [Text]
a -> BatchGetRepositories
s {$sel:repositoryNames:BatchGetRepositories' :: [Text]
repositoryNames = [Text]
a} :: BatchGetRepositories) 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 BatchGetRepositories where
  type
    AWSResponse BatchGetRepositories =
      BatchGetRepositoriesResponse
  request :: (Service -> Service)
-> BatchGetRepositories -> Request BatchGetRepositories
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 BatchGetRepositories
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetRepositories)))
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 [RepositoryMetadata]
-> Maybe [Text] -> Int -> BatchGetRepositoriesResponse
BatchGetRepositoriesResponse'
            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
"repositories" 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
"repositoriesNotFound"
                            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 BatchGetRepositories where
  hashWithSalt :: Int -> BatchGetRepositories -> Int
hashWithSalt Int
_salt BatchGetRepositories' {[Text]
repositoryNames :: [Text]
$sel:repositoryNames:BatchGetRepositories' :: BatchGetRepositories -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
repositoryNames

instance Prelude.NFData BatchGetRepositories where
  rnf :: BatchGetRepositories -> ()
rnf BatchGetRepositories' {[Text]
repositoryNames :: [Text]
$sel:repositoryNames:BatchGetRepositories' :: BatchGetRepositories -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
repositoryNames

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

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

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

-- | Represents the output of a batch get repositories operation.
--
-- /See:/ 'newBatchGetRepositoriesResponse' smart constructor.
data BatchGetRepositoriesResponse = BatchGetRepositoriesResponse'
  { -- | A list of repositories returned by the batch get repositories operation.
    BatchGetRepositoriesResponse -> Maybe [RepositoryMetadata]
repositories :: Prelude.Maybe [RepositoryMetadata],
    -- | Returns a list of repository names for which information could not be
    -- found.
    BatchGetRepositoriesResponse -> Maybe [Text]
repositoriesNotFound :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    BatchGetRepositoriesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetRepositoriesResponse
-> BatchGetRepositoriesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetRepositoriesResponse
-> BatchGetRepositoriesResponse -> Bool
$c/= :: BatchGetRepositoriesResponse
-> BatchGetRepositoriesResponse -> Bool
== :: BatchGetRepositoriesResponse
-> BatchGetRepositoriesResponse -> Bool
$c== :: BatchGetRepositoriesResponse
-> BatchGetRepositoriesResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetRepositoriesResponse]
ReadPrec BatchGetRepositoriesResponse
Int -> ReadS BatchGetRepositoriesResponse
ReadS [BatchGetRepositoriesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetRepositoriesResponse]
$creadListPrec :: ReadPrec [BatchGetRepositoriesResponse]
readPrec :: ReadPrec BatchGetRepositoriesResponse
$creadPrec :: ReadPrec BatchGetRepositoriesResponse
readList :: ReadS [BatchGetRepositoriesResponse]
$creadList :: ReadS [BatchGetRepositoriesResponse]
readsPrec :: Int -> ReadS BatchGetRepositoriesResponse
$creadsPrec :: Int -> ReadS BatchGetRepositoriesResponse
Prelude.Read, Int -> BatchGetRepositoriesResponse -> ShowS
[BatchGetRepositoriesResponse] -> ShowS
BatchGetRepositoriesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetRepositoriesResponse] -> ShowS
$cshowList :: [BatchGetRepositoriesResponse] -> ShowS
show :: BatchGetRepositoriesResponse -> String
$cshow :: BatchGetRepositoriesResponse -> String
showsPrec :: Int -> BatchGetRepositoriesResponse -> ShowS
$cshowsPrec :: Int -> BatchGetRepositoriesResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetRepositoriesResponse x -> BatchGetRepositoriesResponse
forall x.
BatchGetRepositoriesResponse -> Rep BatchGetRepositoriesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetRepositoriesResponse x -> BatchGetRepositoriesResponse
$cfrom :: forall x.
BatchGetRepositoriesResponse -> Rep BatchGetRepositoriesResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetRepositoriesResponse' 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:
--
-- 'repositories', 'batchGetRepositoriesResponse_repositories' - A list of repositories returned by the batch get repositories operation.
--
-- 'repositoriesNotFound', 'batchGetRepositoriesResponse_repositoriesNotFound' - Returns a list of repository names for which information could not be
-- found.
--
-- 'httpStatus', 'batchGetRepositoriesResponse_httpStatus' - The response's http status code.
newBatchGetRepositoriesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetRepositoriesResponse
newBatchGetRepositoriesResponse :: Int -> BatchGetRepositoriesResponse
newBatchGetRepositoriesResponse Int
pHttpStatus_ =
  BatchGetRepositoriesResponse'
    { $sel:repositories:BatchGetRepositoriesResponse' :: Maybe [RepositoryMetadata]
repositories =
        forall a. Maybe a
Prelude.Nothing,
      $sel:repositoriesNotFound:BatchGetRepositoriesResponse' :: Maybe [Text]
repositoriesNotFound = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetRepositoriesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of repositories returned by the batch get repositories operation.
batchGetRepositoriesResponse_repositories :: Lens.Lens' BatchGetRepositoriesResponse (Prelude.Maybe [RepositoryMetadata])
batchGetRepositoriesResponse_repositories :: Lens' BatchGetRepositoriesResponse (Maybe [RepositoryMetadata])
batchGetRepositoriesResponse_repositories = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetRepositoriesResponse' {Maybe [RepositoryMetadata]
repositories :: Maybe [RepositoryMetadata]
$sel:repositories:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Maybe [RepositoryMetadata]
repositories} -> Maybe [RepositoryMetadata]
repositories) (\s :: BatchGetRepositoriesResponse
s@BatchGetRepositoriesResponse' {} Maybe [RepositoryMetadata]
a -> BatchGetRepositoriesResponse
s {$sel:repositories:BatchGetRepositoriesResponse' :: Maybe [RepositoryMetadata]
repositories = Maybe [RepositoryMetadata]
a} :: BatchGetRepositoriesResponse) 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 a list of repository names for which information could not be
-- found.
batchGetRepositoriesResponse_repositoriesNotFound :: Lens.Lens' BatchGetRepositoriesResponse (Prelude.Maybe [Prelude.Text])
batchGetRepositoriesResponse_repositoriesNotFound :: Lens' BatchGetRepositoriesResponse (Maybe [Text])
batchGetRepositoriesResponse_repositoriesNotFound = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetRepositoriesResponse' {Maybe [Text]
repositoriesNotFound :: Maybe [Text]
$sel:repositoriesNotFound:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Maybe [Text]
repositoriesNotFound} -> Maybe [Text]
repositoriesNotFound) (\s :: BatchGetRepositoriesResponse
s@BatchGetRepositoriesResponse' {} Maybe [Text]
a -> BatchGetRepositoriesResponse
s {$sel:repositoriesNotFound:BatchGetRepositoriesResponse' :: Maybe [Text]
repositoriesNotFound = Maybe [Text]
a} :: BatchGetRepositoriesResponse) 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.
batchGetRepositoriesResponse_httpStatus :: Lens.Lens' BatchGetRepositoriesResponse Prelude.Int
batchGetRepositoriesResponse_httpStatus :: Lens' BatchGetRepositoriesResponse Int
batchGetRepositoriesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetRepositoriesResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetRepositoriesResponse
s@BatchGetRepositoriesResponse' {} Int
a -> BatchGetRepositoriesResponse
s {$sel:httpStatus:BatchGetRepositoriesResponse' :: Int
httpStatus = Int
a} :: BatchGetRepositoriesResponse)

instance Prelude.NFData BatchGetRepositoriesResponse where
  rnf :: BatchGetRepositoriesResponse -> ()
rnf BatchGetRepositoriesResponse' {Int
Maybe [Text]
Maybe [RepositoryMetadata]
httpStatus :: Int
repositoriesNotFound :: Maybe [Text]
repositories :: Maybe [RepositoryMetadata]
$sel:httpStatus:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Int
$sel:repositoriesNotFound:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Maybe [Text]
$sel:repositories:BatchGetRepositoriesResponse' :: BatchGetRepositoriesResponse -> Maybe [RepositoryMetadata]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [RepositoryMetadata]
repositories
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
repositoriesNotFound
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus