{-# 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.CreateBranch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a branch in a repository and points the branch to a commit.
--
-- Calling the create branch operation does not set a repository\'s default
-- branch. To do this, call the update default branch operation.
module Amazonka.CodeCommit.CreateBranch
  ( -- * Creating a Request
    CreateBranch (..),
    newCreateBranch,

    -- * Request Lenses
    createBranch_repositoryName,
    createBranch_branchName,
    createBranch_commitId,

    -- * Destructuring the Response
    CreateBranchResponse (..),
    newCreateBranchResponse,
  )
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 create branch operation.
--
-- /See:/ 'newCreateBranch' smart constructor.
data CreateBranch = CreateBranch'
  { -- | The name of the repository in which you want to create the new branch.
    CreateBranch -> Text
repositoryName :: Prelude.Text,
    -- | The name of the new branch to create.
    CreateBranch -> Text
branchName :: Prelude.Text,
    -- | The ID of the commit to point the new branch to.
    CreateBranch -> Text
commitId :: Prelude.Text
  }
  deriving (CreateBranch -> CreateBranch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBranch -> CreateBranch -> Bool
$c/= :: CreateBranch -> CreateBranch -> Bool
== :: CreateBranch -> CreateBranch -> Bool
$c== :: CreateBranch -> CreateBranch -> Bool
Prelude.Eq, ReadPrec [CreateBranch]
ReadPrec CreateBranch
Int -> ReadS CreateBranch
ReadS [CreateBranch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBranch]
$creadListPrec :: ReadPrec [CreateBranch]
readPrec :: ReadPrec CreateBranch
$creadPrec :: ReadPrec CreateBranch
readList :: ReadS [CreateBranch]
$creadList :: ReadS [CreateBranch]
readsPrec :: Int -> ReadS CreateBranch
$creadsPrec :: Int -> ReadS CreateBranch
Prelude.Read, Int -> CreateBranch -> ShowS
[CreateBranch] -> ShowS
CreateBranch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBranch] -> ShowS
$cshowList :: [CreateBranch] -> ShowS
show :: CreateBranch -> String
$cshow :: CreateBranch -> String
showsPrec :: Int -> CreateBranch -> ShowS
$cshowsPrec :: Int -> CreateBranch -> ShowS
Prelude.Show, forall x. Rep CreateBranch x -> CreateBranch
forall x. CreateBranch -> Rep CreateBranch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBranch x -> CreateBranch
$cfrom :: forall x. CreateBranch -> Rep CreateBranch x
Prelude.Generic)

-- |
-- Create a value of 'CreateBranch' 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', 'createBranch_repositoryName' - The name of the repository in which you want to create the new branch.
--
-- 'branchName', 'createBranch_branchName' - The name of the new branch to create.
--
-- 'commitId', 'createBranch_commitId' - The ID of the commit to point the new branch to.
newCreateBranch ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'branchName'
  Prelude.Text ->
  -- | 'commitId'
  Prelude.Text ->
  CreateBranch
newCreateBranch :: Text -> Text -> Text -> CreateBranch
newCreateBranch
  Text
pRepositoryName_
  Text
pBranchName_
  Text
pCommitId_ =
    CreateBranch'
      { $sel:repositoryName:CreateBranch' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:branchName:CreateBranch' :: Text
branchName = Text
pBranchName_,
        $sel:commitId:CreateBranch' :: Text
commitId = Text
pCommitId_
      }

-- | The name of the repository in which you want to create the new branch.
createBranch_repositoryName :: Lens.Lens' CreateBranch Prelude.Text
createBranch_repositoryName :: Lens' CreateBranch Text
createBranch_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBranch' {Text
repositoryName :: Text
$sel:repositoryName:CreateBranch' :: CreateBranch -> Text
repositoryName} -> Text
repositoryName) (\s :: CreateBranch
s@CreateBranch' {} Text
a -> CreateBranch
s {$sel:repositoryName:CreateBranch' :: Text
repositoryName = Text
a} :: CreateBranch)

-- | The name of the new branch to create.
createBranch_branchName :: Lens.Lens' CreateBranch Prelude.Text
createBranch_branchName :: Lens' CreateBranch Text
createBranch_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBranch' {Text
branchName :: Text
$sel:branchName:CreateBranch' :: CreateBranch -> Text
branchName} -> Text
branchName) (\s :: CreateBranch
s@CreateBranch' {} Text
a -> CreateBranch
s {$sel:branchName:CreateBranch' :: Text
branchName = Text
a} :: CreateBranch)

-- | The ID of the commit to point the new branch to.
createBranch_commitId :: Lens.Lens' CreateBranch Prelude.Text
createBranch_commitId :: Lens' CreateBranch Text
createBranch_commitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBranch' {Text
commitId :: Text
$sel:commitId:CreateBranch' :: CreateBranch -> Text
commitId} -> Text
commitId) (\s :: CreateBranch
s@CreateBranch' {} Text
a -> CreateBranch
s {$sel:commitId:CreateBranch' :: Text
commitId = Text
a} :: CreateBranch)

instance Core.AWSRequest CreateBranch where
  type AWSResponse CreateBranch = CreateBranchResponse
  request :: (Service -> Service) -> CreateBranch -> Request CreateBranch
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 CreateBranch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateBranch)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull CreateBranchResponse
CreateBranchResponse'

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

instance Prelude.NFData CreateBranch where
  rnf :: CreateBranch -> ()
rnf CreateBranch' {Text
commitId :: Text
branchName :: Text
repositoryName :: Text
$sel:commitId:CreateBranch' :: CreateBranch -> Text
$sel:branchName:CreateBranch' :: CreateBranch -> Text
$sel:repositoryName:CreateBranch' :: CreateBranch -> 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
branchName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commitId

instance Data.ToHeaders CreateBranch where
  toHeaders :: CreateBranch -> [Header]
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 -> [Header]
Data.=# ( ByteString
"CodeCommit_20150413.CreateBranch" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateBranch where
  toJSON :: CreateBranch -> Value
toJSON CreateBranch' {Text
commitId :: Text
branchName :: Text
repositoryName :: Text
$sel:commitId:CreateBranch' :: CreateBranch -> Text
$sel:branchName:CreateBranch' :: CreateBranch -> Text
$sel:repositoryName:CreateBranch' :: CreateBranch -> 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
"branchName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
branchName),
            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 CreateBranch where
  toPath :: CreateBranch -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newCreateBranchResponse' smart constructor.
data CreateBranchResponse = CreateBranchResponse'
  {
  }
  deriving (CreateBranchResponse -> CreateBranchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBranchResponse -> CreateBranchResponse -> Bool
$c/= :: CreateBranchResponse -> CreateBranchResponse -> Bool
== :: CreateBranchResponse -> CreateBranchResponse -> Bool
$c== :: CreateBranchResponse -> CreateBranchResponse -> Bool
Prelude.Eq, ReadPrec [CreateBranchResponse]
ReadPrec CreateBranchResponse
Int -> ReadS CreateBranchResponse
ReadS [CreateBranchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBranchResponse]
$creadListPrec :: ReadPrec [CreateBranchResponse]
readPrec :: ReadPrec CreateBranchResponse
$creadPrec :: ReadPrec CreateBranchResponse
readList :: ReadS [CreateBranchResponse]
$creadList :: ReadS [CreateBranchResponse]
readsPrec :: Int -> ReadS CreateBranchResponse
$creadsPrec :: Int -> ReadS CreateBranchResponse
Prelude.Read, Int -> CreateBranchResponse -> ShowS
[CreateBranchResponse] -> ShowS
CreateBranchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBranchResponse] -> ShowS
$cshowList :: [CreateBranchResponse] -> ShowS
show :: CreateBranchResponse -> String
$cshow :: CreateBranchResponse -> String
showsPrec :: Int -> CreateBranchResponse -> ShowS
$cshowsPrec :: Int -> CreateBranchResponse -> ShowS
Prelude.Show, forall x. Rep CreateBranchResponse x -> CreateBranchResponse
forall x. CreateBranchResponse -> Rep CreateBranchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBranchResponse x -> CreateBranchResponse
$cfrom :: forall x. CreateBranchResponse -> Rep CreateBranchResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBranchResponse' 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.
newCreateBranchResponse ::
  CreateBranchResponse
newCreateBranchResponse :: CreateBranchResponse
newCreateBranchResponse = CreateBranchResponse
CreateBranchResponse'

instance Prelude.NFData CreateBranchResponse where
  rnf :: CreateBranchResponse -> ()
rnf CreateBranchResponse
_ = ()