{-# 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.GetRepository
-- 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 a repository.
--
-- 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.GetRepository
  ( -- * Creating a Request
    GetRepository (..),
    newGetRepository,

    -- * Request Lenses
    getRepository_repositoryName,

    -- * Destructuring the Response
    GetRepositoryResponse (..),
    newGetRepositoryResponse,

    -- * Response Lenses
    getRepositoryResponse_repositoryMetadata,
    getRepositoryResponse_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 get repository operation.
--
-- /See:/ 'newGetRepository' smart constructor.
data GetRepository = GetRepository'
  { -- | The name of the repository to get information about.
    GetRepository -> Text
repositoryName :: Prelude.Text
  }
  deriving (GetRepository -> GetRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRepository -> GetRepository -> Bool
$c/= :: GetRepository -> GetRepository -> Bool
== :: GetRepository -> GetRepository -> Bool
$c== :: GetRepository -> GetRepository -> Bool
Prelude.Eq, ReadPrec [GetRepository]
ReadPrec GetRepository
Int -> ReadS GetRepository
ReadS [GetRepository]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRepository]
$creadListPrec :: ReadPrec [GetRepository]
readPrec :: ReadPrec GetRepository
$creadPrec :: ReadPrec GetRepository
readList :: ReadS [GetRepository]
$creadList :: ReadS [GetRepository]
readsPrec :: Int -> ReadS GetRepository
$creadsPrec :: Int -> ReadS GetRepository
Prelude.Read, Int -> GetRepository -> ShowS
[GetRepository] -> ShowS
GetRepository -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRepository] -> ShowS
$cshowList :: [GetRepository] -> ShowS
show :: GetRepository -> String
$cshow :: GetRepository -> String
showsPrec :: Int -> GetRepository -> ShowS
$cshowsPrec :: Int -> GetRepository -> ShowS
Prelude.Show, forall x. Rep GetRepository x -> GetRepository
forall x. GetRepository -> Rep GetRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRepository x -> GetRepository
$cfrom :: forall x. GetRepository -> Rep GetRepository x
Prelude.Generic)

-- |
-- Create a value of 'GetRepository' 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:
--
-- 'repositoryName', 'getRepository_repositoryName' - The name of the repository to get information about.
newGetRepository ::
  -- | 'repositoryName'
  Prelude.Text ->
  GetRepository
newGetRepository :: Text -> GetRepository
newGetRepository Text
pRepositoryName_ =
  GetRepository' {$sel:repositoryName:GetRepository' :: Text
repositoryName = Text
pRepositoryName_}

-- | The name of the repository to get information about.
getRepository_repositoryName :: Lens.Lens' GetRepository Prelude.Text
getRepository_repositoryName :: Lens' GetRepository Text
getRepository_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRepository' {Text
repositoryName :: Text
$sel:repositoryName:GetRepository' :: GetRepository -> Text
repositoryName} -> Text
repositoryName) (\s :: GetRepository
s@GetRepository' {} Text
a -> GetRepository
s {$sel:repositoryName:GetRepository' :: Text
repositoryName = Text
a} :: GetRepository)

instance Core.AWSRequest GetRepository where
  type
    AWSResponse GetRepository =
      GetRepositoryResponse
  request :: (Service -> Service) -> GetRepository -> Request GetRepository
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 GetRepository
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetRepository)))
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 -> Int -> GetRepositoryResponse
GetRepositoryResponse'
            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
"repositoryMetadata")
            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 GetRepository where
  hashWithSalt :: Int -> GetRepository -> Int
hashWithSalt Int
_salt GetRepository' {Text
repositoryName :: Text
$sel:repositoryName:GetRepository' :: GetRepository -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName

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

instance Data.ToHeaders GetRepository where
  toHeaders :: GetRepository -> 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.GetRepository" ::
                          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 GetRepository where
  toJSON :: GetRepository -> Value
toJSON GetRepository' {Text
repositoryName :: Text
$sel:repositoryName:GetRepository' :: GetRepository -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 GetRepository where
  toPath :: GetRepository -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | Represents the output of a get repository operation.
--
-- /See:/ 'newGetRepositoryResponse' smart constructor.
data GetRepositoryResponse = GetRepositoryResponse'
  { -- | Information about the repository.
    GetRepositoryResponse -> Maybe RepositoryMetadata
repositoryMetadata :: Prelude.Maybe RepositoryMetadata,
    -- | The response's http status code.
    GetRepositoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRepositoryResponse -> GetRepositoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRepositoryResponse -> GetRepositoryResponse -> Bool
$c/= :: GetRepositoryResponse -> GetRepositoryResponse -> Bool
== :: GetRepositoryResponse -> GetRepositoryResponse -> Bool
$c== :: GetRepositoryResponse -> GetRepositoryResponse -> Bool
Prelude.Eq, ReadPrec [GetRepositoryResponse]
ReadPrec GetRepositoryResponse
Int -> ReadS GetRepositoryResponse
ReadS [GetRepositoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRepositoryResponse]
$creadListPrec :: ReadPrec [GetRepositoryResponse]
readPrec :: ReadPrec GetRepositoryResponse
$creadPrec :: ReadPrec GetRepositoryResponse
readList :: ReadS [GetRepositoryResponse]
$creadList :: ReadS [GetRepositoryResponse]
readsPrec :: Int -> ReadS GetRepositoryResponse
$creadsPrec :: Int -> ReadS GetRepositoryResponse
Prelude.Read, Int -> GetRepositoryResponse -> ShowS
[GetRepositoryResponse] -> ShowS
GetRepositoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRepositoryResponse] -> ShowS
$cshowList :: [GetRepositoryResponse] -> ShowS
show :: GetRepositoryResponse -> String
$cshow :: GetRepositoryResponse -> String
showsPrec :: Int -> GetRepositoryResponse -> ShowS
$cshowsPrec :: Int -> GetRepositoryResponse -> ShowS
Prelude.Show, forall x. Rep GetRepositoryResponse x -> GetRepositoryResponse
forall x. GetRepositoryResponse -> Rep GetRepositoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetRepositoryResponse x -> GetRepositoryResponse
$cfrom :: forall x. GetRepositoryResponse -> Rep GetRepositoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRepositoryResponse' 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:
--
-- 'repositoryMetadata', 'getRepositoryResponse_repositoryMetadata' - Information about the repository.
--
-- 'httpStatus', 'getRepositoryResponse_httpStatus' - The response's http status code.
newGetRepositoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRepositoryResponse
newGetRepositoryResponse :: Int -> GetRepositoryResponse
newGetRepositoryResponse Int
pHttpStatus_ =
  GetRepositoryResponse'
    { $sel:repositoryMetadata:GetRepositoryResponse' :: Maybe RepositoryMetadata
repositoryMetadata =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetRepositoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the repository.
getRepositoryResponse_repositoryMetadata :: Lens.Lens' GetRepositoryResponse (Prelude.Maybe RepositoryMetadata)
getRepositoryResponse_repositoryMetadata :: Lens' GetRepositoryResponse (Maybe RepositoryMetadata)
getRepositoryResponse_repositoryMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRepositoryResponse' {Maybe RepositoryMetadata
repositoryMetadata :: Maybe RepositoryMetadata
$sel:repositoryMetadata:GetRepositoryResponse' :: GetRepositoryResponse -> Maybe RepositoryMetadata
repositoryMetadata} -> Maybe RepositoryMetadata
repositoryMetadata) (\s :: GetRepositoryResponse
s@GetRepositoryResponse' {} Maybe RepositoryMetadata
a -> GetRepositoryResponse
s {$sel:repositoryMetadata:GetRepositoryResponse' :: Maybe RepositoryMetadata
repositoryMetadata = Maybe RepositoryMetadata
a} :: GetRepositoryResponse)

-- | The response's http status code.
getRepositoryResponse_httpStatus :: Lens.Lens' GetRepositoryResponse Prelude.Int
getRepositoryResponse_httpStatus :: Lens' GetRepositoryResponse Int
getRepositoryResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRepositoryResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetRepositoryResponse' :: GetRepositoryResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetRepositoryResponse
s@GetRepositoryResponse' {} Int
a -> GetRepositoryResponse
s {$sel:httpStatus:GetRepositoryResponse' :: Int
httpStatus = Int
a} :: GetRepositoryResponse)

instance Prelude.NFData GetRepositoryResponse where
  rnf :: GetRepositoryResponse -> ()
rnf GetRepositoryResponse' {Int
Maybe RepositoryMetadata
httpStatus :: Int
repositoryMetadata :: Maybe RepositoryMetadata
$sel:httpStatus:GetRepositoryResponse' :: GetRepositoryResponse -> Int
$sel:repositoryMetadata:GetRepositoryResponse' :: GetRepositoryResponse -> Maybe RepositoryMetadata
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RepositoryMetadata
repositoryMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus