{-# 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.GetBranch
-- 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 branch, including its name and
-- the last commit ID.
module Amazonka.CodeCommit.GetBranch
  ( -- * Creating a Request
    GetBranch (..),
    newGetBranch,

    -- * Request Lenses
    getBranch_branchName,
    getBranch_repositoryName,

    -- * Destructuring the Response
    GetBranchResponse (..),
    newGetBranchResponse,

    -- * Response Lenses
    getBranchResponse_branch,
    getBranchResponse_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 branch operation.
--
-- /See:/ 'newGetBranch' smart constructor.
data GetBranch = GetBranch'
  { -- | The name of the branch for which you want to retrieve information.
    GetBranch -> Maybe Text
branchName :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository that contains the branch for which you want
    -- to retrieve information.
    GetBranch -> Maybe Text
repositoryName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetBranch -> GetBranch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBranch -> GetBranch -> Bool
$c/= :: GetBranch -> GetBranch -> Bool
== :: GetBranch -> GetBranch -> Bool
$c== :: GetBranch -> GetBranch -> Bool
Prelude.Eq, ReadPrec [GetBranch]
ReadPrec GetBranch
Int -> ReadS GetBranch
ReadS [GetBranch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBranch]
$creadListPrec :: ReadPrec [GetBranch]
readPrec :: ReadPrec GetBranch
$creadPrec :: ReadPrec GetBranch
readList :: ReadS [GetBranch]
$creadList :: ReadS [GetBranch]
readsPrec :: Int -> ReadS GetBranch
$creadsPrec :: Int -> ReadS GetBranch
Prelude.Read, Int -> GetBranch -> ShowS
[GetBranch] -> ShowS
GetBranch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBranch] -> ShowS
$cshowList :: [GetBranch] -> ShowS
show :: GetBranch -> String
$cshow :: GetBranch -> String
showsPrec :: Int -> GetBranch -> ShowS
$cshowsPrec :: Int -> GetBranch -> ShowS
Prelude.Show, forall x. Rep GetBranch x -> GetBranch
forall x. GetBranch -> Rep GetBranch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBranch x -> GetBranch
$cfrom :: forall x. GetBranch -> Rep GetBranch x
Prelude.Generic)

-- |
-- Create a value of 'GetBranch' 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:
--
-- 'branchName', 'getBranch_branchName' - The name of the branch for which you want to retrieve information.
--
-- 'repositoryName', 'getBranch_repositoryName' - The name of the repository that contains the branch for which you want
-- to retrieve information.
newGetBranch ::
  GetBranch
newGetBranch :: GetBranch
newGetBranch =
  GetBranch'
    { $sel:branchName:GetBranch' :: Maybe Text
branchName = forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:GetBranch' :: Maybe Text
repositoryName = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the branch for which you want to retrieve information.
getBranch_branchName :: Lens.Lens' GetBranch (Prelude.Maybe Prelude.Text)
getBranch_branchName :: Lens' GetBranch (Maybe Text)
getBranch_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBranch' {Maybe Text
branchName :: Maybe Text
$sel:branchName:GetBranch' :: GetBranch -> Maybe Text
branchName} -> Maybe Text
branchName) (\s :: GetBranch
s@GetBranch' {} Maybe Text
a -> GetBranch
s {$sel:branchName:GetBranch' :: Maybe Text
branchName = Maybe Text
a} :: GetBranch)

-- | The name of the repository that contains the branch for which you want
-- to retrieve information.
getBranch_repositoryName :: Lens.Lens' GetBranch (Prelude.Maybe Prelude.Text)
getBranch_repositoryName :: Lens' GetBranch (Maybe Text)
getBranch_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBranch' {Maybe Text
repositoryName :: Maybe Text
$sel:repositoryName:GetBranch' :: GetBranch -> Maybe Text
repositoryName} -> Maybe Text
repositoryName) (\s :: GetBranch
s@GetBranch' {} Maybe Text
a -> GetBranch
s {$sel:repositoryName:GetBranch' :: Maybe Text
repositoryName = Maybe Text
a} :: GetBranch)

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

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

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

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

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

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

-- |
-- Create a value of 'GetBranchResponse' 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:
--
-- 'branch', 'getBranchResponse_branch' - The name of the branch.
--
-- 'httpStatus', 'getBranchResponse_httpStatus' - The response's http status code.
newGetBranchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBranchResponse
newGetBranchResponse :: Int -> GetBranchResponse
newGetBranchResponse Int
pHttpStatus_ =
  GetBranchResponse'
    { $sel:branch:GetBranchResponse' :: Maybe BranchInfo
branch = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBranchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the branch.
getBranchResponse_branch :: Lens.Lens' GetBranchResponse (Prelude.Maybe BranchInfo)
getBranchResponse_branch :: Lens' GetBranchResponse (Maybe BranchInfo)
getBranchResponse_branch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBranchResponse' {Maybe BranchInfo
branch :: Maybe BranchInfo
$sel:branch:GetBranchResponse' :: GetBranchResponse -> Maybe BranchInfo
branch} -> Maybe BranchInfo
branch) (\s :: GetBranchResponse
s@GetBranchResponse' {} Maybe BranchInfo
a -> GetBranchResponse
s {$sel:branch:GetBranchResponse' :: Maybe BranchInfo
branch = Maybe BranchInfo
a} :: GetBranchResponse)

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

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