{-# 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.GetCommit
-- 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 commit, including commit message and
-- committer information.
module Amazonka.CodeCommit.GetCommit
  ( -- * Creating a Request
    GetCommit (..),
    newGetCommit,

    -- * Request Lenses
    getCommit_repositoryName,
    getCommit_commitId,

    -- * Destructuring the Response
    GetCommitResponse (..),
    newGetCommitResponse,

    -- * Response Lenses
    getCommitResponse_httpStatus,
    getCommitResponse_commit,
  )
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 commit operation.
--
-- /See:/ 'newGetCommit' smart constructor.
data GetCommit = GetCommit'
  { -- | The name of the repository to which the commit was made.
    GetCommit -> Text
repositoryName :: Prelude.Text,
    -- | The commit ID. Commit IDs are the full SHA ID of the commit.
    GetCommit -> Text
commitId :: Prelude.Text
  }
  deriving (GetCommit -> GetCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommit -> GetCommit -> Bool
$c/= :: GetCommit -> GetCommit -> Bool
== :: GetCommit -> GetCommit -> Bool
$c== :: GetCommit -> GetCommit -> Bool
Prelude.Eq, ReadPrec [GetCommit]
ReadPrec GetCommit
Int -> ReadS GetCommit
ReadS [GetCommit]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommit]
$creadListPrec :: ReadPrec [GetCommit]
readPrec :: ReadPrec GetCommit
$creadPrec :: ReadPrec GetCommit
readList :: ReadS [GetCommit]
$creadList :: ReadS [GetCommit]
readsPrec :: Int -> ReadS GetCommit
$creadsPrec :: Int -> ReadS GetCommit
Prelude.Read, Int -> GetCommit -> ShowS
[GetCommit] -> ShowS
GetCommit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommit] -> ShowS
$cshowList :: [GetCommit] -> ShowS
show :: GetCommit -> String
$cshow :: GetCommit -> String
showsPrec :: Int -> GetCommit -> ShowS
$cshowsPrec :: Int -> GetCommit -> ShowS
Prelude.Show, forall x. Rep GetCommit x -> GetCommit
forall x. GetCommit -> Rep GetCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCommit x -> GetCommit
$cfrom :: forall x. GetCommit -> Rep GetCommit x
Prelude.Generic)

-- |
-- Create a value of 'GetCommit' 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', 'getCommit_repositoryName' - The name of the repository to which the commit was made.
--
-- 'commitId', 'getCommit_commitId' - The commit ID. Commit IDs are the full SHA ID of the commit.
newGetCommit ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'commitId'
  Prelude.Text ->
  GetCommit
newGetCommit :: Text -> Text -> GetCommit
newGetCommit Text
pRepositoryName_ Text
pCommitId_ =
  GetCommit'
    { $sel:repositoryName:GetCommit' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:commitId:GetCommit' :: Text
commitId = Text
pCommitId_
    }

-- | The name of the repository to which the commit was made.
getCommit_repositoryName :: Lens.Lens' GetCommit Prelude.Text
getCommit_repositoryName :: Lens' GetCommit Text
getCommit_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommit' {Text
repositoryName :: Text
$sel:repositoryName:GetCommit' :: GetCommit -> Text
repositoryName} -> Text
repositoryName) (\s :: GetCommit
s@GetCommit' {} Text
a -> GetCommit
s {$sel:repositoryName:GetCommit' :: Text
repositoryName = Text
a} :: GetCommit)

-- | The commit ID. Commit IDs are the full SHA ID of the commit.
getCommit_commitId :: Lens.Lens' GetCommit Prelude.Text
getCommit_commitId :: Lens' GetCommit Text
getCommit_commitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommit' {Text
commitId :: Text
$sel:commitId:GetCommit' :: GetCommit -> Text
commitId} -> Text
commitId) (\s :: GetCommit
s@GetCommit' {} Text
a -> GetCommit
s {$sel:commitId:GetCommit' :: Text
commitId = Text
a} :: GetCommit)

instance Core.AWSRequest GetCommit where
  type AWSResponse GetCommit = GetCommitResponse
  request :: (Service -> Service) -> GetCommit -> Request GetCommit
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 GetCommit
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetCommit)))
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 ->
          Int -> Commit -> GetCommitResponse
GetCommitResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"commit")
      )

instance Prelude.Hashable GetCommit where
  hashWithSalt :: Int -> GetCommit -> Int
hashWithSalt Int
_salt GetCommit' {Text
commitId :: Text
repositoryName :: Text
$sel:commitId:GetCommit' :: GetCommit -> Text
$sel:repositoryName:GetCommit' :: GetCommit -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
commitId

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

instance Data.ToHeaders GetCommit where
  toHeaders :: GetCommit -> 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.GetCommit" ::
                          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 GetCommit where
  toJSON :: GetCommit -> Value
toJSON GetCommit' {Text
commitId :: Text
repositoryName :: Text
$sel:commitId:GetCommit' :: GetCommit -> Text
$sel:repositoryName:GetCommit' :: GetCommit -> 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),
            forall a. a -> Maybe a
Prelude.Just (Key
"commitId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
commitId)
          ]
      )

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

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

-- | Represents the output of a get commit operation.
--
-- /See:/ 'newGetCommitResponse' smart constructor.
data GetCommitResponse = GetCommitResponse'
  { -- | The response's http status code.
    GetCommitResponse -> Int
httpStatus :: Prelude.Int,
    -- | A commit data type object that contains information about the specified
    -- commit.
    GetCommitResponse -> Commit
commit :: Commit
  }
  deriving (GetCommitResponse -> GetCommitResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCommitResponse -> GetCommitResponse -> Bool
$c/= :: GetCommitResponse -> GetCommitResponse -> Bool
== :: GetCommitResponse -> GetCommitResponse -> Bool
$c== :: GetCommitResponse -> GetCommitResponse -> Bool
Prelude.Eq, ReadPrec [GetCommitResponse]
ReadPrec GetCommitResponse
Int -> ReadS GetCommitResponse
ReadS [GetCommitResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCommitResponse]
$creadListPrec :: ReadPrec [GetCommitResponse]
readPrec :: ReadPrec GetCommitResponse
$creadPrec :: ReadPrec GetCommitResponse
readList :: ReadS [GetCommitResponse]
$creadList :: ReadS [GetCommitResponse]
readsPrec :: Int -> ReadS GetCommitResponse
$creadsPrec :: Int -> ReadS GetCommitResponse
Prelude.Read, Int -> GetCommitResponse -> ShowS
[GetCommitResponse] -> ShowS
GetCommitResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCommitResponse] -> ShowS
$cshowList :: [GetCommitResponse] -> ShowS
show :: GetCommitResponse -> String
$cshow :: GetCommitResponse -> String
showsPrec :: Int -> GetCommitResponse -> ShowS
$cshowsPrec :: Int -> GetCommitResponse -> ShowS
Prelude.Show, forall x. Rep GetCommitResponse x -> GetCommitResponse
forall x. GetCommitResponse -> Rep GetCommitResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCommitResponse x -> GetCommitResponse
$cfrom :: forall x. GetCommitResponse -> Rep GetCommitResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCommitResponse' 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:
--
-- 'httpStatus', 'getCommitResponse_httpStatus' - The response's http status code.
--
-- 'commit', 'getCommitResponse_commit' - A commit data type object that contains information about the specified
-- commit.
newGetCommitResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'commit'
  Commit ->
  GetCommitResponse
newGetCommitResponse :: Int -> Commit -> GetCommitResponse
newGetCommitResponse Int
pHttpStatus_ Commit
pCommit_ =
  GetCommitResponse'
    { $sel:httpStatus:GetCommitResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:commit:GetCommitResponse' :: Commit
commit = Commit
pCommit_
    }

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

-- | A commit data type object that contains information about the specified
-- commit.
getCommitResponse_commit :: Lens.Lens' GetCommitResponse Commit
getCommitResponse_commit :: Lens' GetCommitResponse Commit
getCommitResponse_commit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCommitResponse' {Commit
commit :: Commit
$sel:commit:GetCommitResponse' :: GetCommitResponse -> Commit
commit} -> Commit
commit) (\s :: GetCommitResponse
s@GetCommitResponse' {} Commit
a -> GetCommitResponse
s {$sel:commit:GetCommitResponse' :: Commit
commit = Commit
a} :: GetCommitResponse)

instance Prelude.NFData GetCommitResponse where
  rnf :: GetCommitResponse -> ()
rnf GetCommitResponse' {Int
Commit
commit :: Commit
httpStatus :: Int
$sel:commit:GetCommitResponse' :: GetCommitResponse -> Commit
$sel:httpStatus:GetCommitResponse' :: GetCommitResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Commit
commit