{-# 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.SageMaker.UpdateCodeRepository
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified Git repository with the specified values.
module Amazonka.SageMaker.UpdateCodeRepository
  ( -- * Creating a Request
    UpdateCodeRepository (..),
    newUpdateCodeRepository,

    -- * Request Lenses
    updateCodeRepository_gitConfig,
    updateCodeRepository_codeRepositoryName,

    -- * Destructuring the Response
    UpdateCodeRepositoryResponse (..),
    newUpdateCodeRepositoryResponse,

    -- * Response Lenses
    updateCodeRepositoryResponse_httpStatus,
    updateCodeRepositoryResponse_codeRepositoryArn,
  )
where

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
import Amazonka.SageMaker.Types

-- | /See:/ 'newUpdateCodeRepository' smart constructor.
data UpdateCodeRepository = UpdateCodeRepository'
  { -- | The configuration of the git repository, including the URL and the
    -- Amazon Resource Name (ARN) of the Amazon Web Services Secrets Manager
    -- secret that contains the credentials used to access the repository. The
    -- secret must have a staging label of @AWSCURRENT@ and must be in the
    -- following format:
    --
    -- @{\"username\": @/@UserName@/@, \"password\": @/@Password@/@}@
    UpdateCodeRepository -> Maybe GitConfigForUpdate
gitConfig :: Prelude.Maybe GitConfigForUpdate,
    -- | The name of the Git repository to update.
    UpdateCodeRepository -> Text
codeRepositoryName :: Prelude.Text
  }
  deriving (UpdateCodeRepository -> UpdateCodeRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCodeRepository -> UpdateCodeRepository -> Bool
$c/= :: UpdateCodeRepository -> UpdateCodeRepository -> Bool
== :: UpdateCodeRepository -> UpdateCodeRepository -> Bool
$c== :: UpdateCodeRepository -> UpdateCodeRepository -> Bool
Prelude.Eq, ReadPrec [UpdateCodeRepository]
ReadPrec UpdateCodeRepository
Int -> ReadS UpdateCodeRepository
ReadS [UpdateCodeRepository]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCodeRepository]
$creadListPrec :: ReadPrec [UpdateCodeRepository]
readPrec :: ReadPrec UpdateCodeRepository
$creadPrec :: ReadPrec UpdateCodeRepository
readList :: ReadS [UpdateCodeRepository]
$creadList :: ReadS [UpdateCodeRepository]
readsPrec :: Int -> ReadS UpdateCodeRepository
$creadsPrec :: Int -> ReadS UpdateCodeRepository
Prelude.Read, Int -> UpdateCodeRepository -> ShowS
[UpdateCodeRepository] -> ShowS
UpdateCodeRepository -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCodeRepository] -> ShowS
$cshowList :: [UpdateCodeRepository] -> ShowS
show :: UpdateCodeRepository -> String
$cshow :: UpdateCodeRepository -> String
showsPrec :: Int -> UpdateCodeRepository -> ShowS
$cshowsPrec :: Int -> UpdateCodeRepository -> ShowS
Prelude.Show, forall x. Rep UpdateCodeRepository x -> UpdateCodeRepository
forall x. UpdateCodeRepository -> Rep UpdateCodeRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCodeRepository x -> UpdateCodeRepository
$cfrom :: forall x. UpdateCodeRepository -> Rep UpdateCodeRepository x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCodeRepository' 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:
--
-- 'gitConfig', 'updateCodeRepository_gitConfig' - The configuration of the git repository, including the URL and the
-- Amazon Resource Name (ARN) of the Amazon Web Services Secrets Manager
-- secret that contains the credentials used to access the repository. The
-- secret must have a staging label of @AWSCURRENT@ and must be in the
-- following format:
--
-- @{\"username\": @/@UserName@/@, \"password\": @/@Password@/@}@
--
-- 'codeRepositoryName', 'updateCodeRepository_codeRepositoryName' - The name of the Git repository to update.
newUpdateCodeRepository ::
  -- | 'codeRepositoryName'
  Prelude.Text ->
  UpdateCodeRepository
newUpdateCodeRepository :: Text -> UpdateCodeRepository
newUpdateCodeRepository Text
pCodeRepositoryName_ =
  UpdateCodeRepository'
    { $sel:gitConfig:UpdateCodeRepository' :: Maybe GitConfigForUpdate
gitConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:codeRepositoryName:UpdateCodeRepository' :: Text
codeRepositoryName = Text
pCodeRepositoryName_
    }

-- | The configuration of the git repository, including the URL and the
-- Amazon Resource Name (ARN) of the Amazon Web Services Secrets Manager
-- secret that contains the credentials used to access the repository. The
-- secret must have a staging label of @AWSCURRENT@ and must be in the
-- following format:
--
-- @{\"username\": @/@UserName@/@, \"password\": @/@Password@/@}@
updateCodeRepository_gitConfig :: Lens.Lens' UpdateCodeRepository (Prelude.Maybe GitConfigForUpdate)
updateCodeRepository_gitConfig :: Lens' UpdateCodeRepository (Maybe GitConfigForUpdate)
updateCodeRepository_gitConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeRepository' {Maybe GitConfigForUpdate
gitConfig :: Maybe GitConfigForUpdate
$sel:gitConfig:UpdateCodeRepository' :: UpdateCodeRepository -> Maybe GitConfigForUpdate
gitConfig} -> Maybe GitConfigForUpdate
gitConfig) (\s :: UpdateCodeRepository
s@UpdateCodeRepository' {} Maybe GitConfigForUpdate
a -> UpdateCodeRepository
s {$sel:gitConfig:UpdateCodeRepository' :: Maybe GitConfigForUpdate
gitConfig = Maybe GitConfigForUpdate
a} :: UpdateCodeRepository)

-- | The name of the Git repository to update.
updateCodeRepository_codeRepositoryName :: Lens.Lens' UpdateCodeRepository Prelude.Text
updateCodeRepository_codeRepositoryName :: Lens' UpdateCodeRepository Text
updateCodeRepository_codeRepositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeRepository' {Text
codeRepositoryName :: Text
$sel:codeRepositoryName:UpdateCodeRepository' :: UpdateCodeRepository -> Text
codeRepositoryName} -> Text
codeRepositoryName) (\s :: UpdateCodeRepository
s@UpdateCodeRepository' {} Text
a -> UpdateCodeRepository
s {$sel:codeRepositoryName:UpdateCodeRepository' :: Text
codeRepositoryName = Text
a} :: UpdateCodeRepository)

instance Core.AWSRequest UpdateCodeRepository where
  type
    AWSResponse UpdateCodeRepository =
      UpdateCodeRepositoryResponse
  request :: (Service -> Service)
-> UpdateCodeRepository -> Request UpdateCodeRepository
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 UpdateCodeRepository
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateCodeRepository)))
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 -> Text -> UpdateCodeRepositoryResponse
UpdateCodeRepositoryResponse'
            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
"CodeRepositoryArn")
      )

instance Prelude.Hashable UpdateCodeRepository where
  hashWithSalt :: Int -> UpdateCodeRepository -> Int
hashWithSalt Int
_salt UpdateCodeRepository' {Maybe GitConfigForUpdate
Text
codeRepositoryName :: Text
gitConfig :: Maybe GitConfigForUpdate
$sel:codeRepositoryName:UpdateCodeRepository' :: UpdateCodeRepository -> Text
$sel:gitConfig:UpdateCodeRepository' :: UpdateCodeRepository -> Maybe GitConfigForUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GitConfigForUpdate
gitConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
codeRepositoryName

instance Prelude.NFData UpdateCodeRepository where
  rnf :: UpdateCodeRepository -> ()
rnf UpdateCodeRepository' {Maybe GitConfigForUpdate
Text
codeRepositoryName :: Text
gitConfig :: Maybe GitConfigForUpdate
$sel:codeRepositoryName:UpdateCodeRepository' :: UpdateCodeRepository -> Text
$sel:gitConfig:UpdateCodeRepository' :: UpdateCodeRepository -> Maybe GitConfigForUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe GitConfigForUpdate
gitConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
codeRepositoryName

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

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

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

-- | /See:/ 'newUpdateCodeRepositoryResponse' smart constructor.
data UpdateCodeRepositoryResponse = UpdateCodeRepositoryResponse'
  { -- | The response's http status code.
    UpdateCodeRepositoryResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ARN of the Git repository.
    UpdateCodeRepositoryResponse -> Text
codeRepositoryArn :: Prelude.Text
  }
  deriving (UpdateCodeRepositoryResponse
-> UpdateCodeRepositoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCodeRepositoryResponse
-> UpdateCodeRepositoryResponse -> Bool
$c/= :: UpdateCodeRepositoryResponse
-> UpdateCodeRepositoryResponse -> Bool
== :: UpdateCodeRepositoryResponse
-> UpdateCodeRepositoryResponse -> Bool
$c== :: UpdateCodeRepositoryResponse
-> UpdateCodeRepositoryResponse -> Bool
Prelude.Eq, ReadPrec [UpdateCodeRepositoryResponse]
ReadPrec UpdateCodeRepositoryResponse
Int -> ReadS UpdateCodeRepositoryResponse
ReadS [UpdateCodeRepositoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCodeRepositoryResponse]
$creadListPrec :: ReadPrec [UpdateCodeRepositoryResponse]
readPrec :: ReadPrec UpdateCodeRepositoryResponse
$creadPrec :: ReadPrec UpdateCodeRepositoryResponse
readList :: ReadS [UpdateCodeRepositoryResponse]
$creadList :: ReadS [UpdateCodeRepositoryResponse]
readsPrec :: Int -> ReadS UpdateCodeRepositoryResponse
$creadsPrec :: Int -> ReadS UpdateCodeRepositoryResponse
Prelude.Read, Int -> UpdateCodeRepositoryResponse -> ShowS
[UpdateCodeRepositoryResponse] -> ShowS
UpdateCodeRepositoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCodeRepositoryResponse] -> ShowS
$cshowList :: [UpdateCodeRepositoryResponse] -> ShowS
show :: UpdateCodeRepositoryResponse -> String
$cshow :: UpdateCodeRepositoryResponse -> String
showsPrec :: Int -> UpdateCodeRepositoryResponse -> ShowS
$cshowsPrec :: Int -> UpdateCodeRepositoryResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateCodeRepositoryResponse x -> UpdateCodeRepositoryResponse
forall x.
UpdateCodeRepositoryResponse -> Rep UpdateCodeRepositoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateCodeRepositoryResponse x -> UpdateCodeRepositoryResponse
$cfrom :: forall x.
UpdateCodeRepositoryResponse -> Rep UpdateCodeRepositoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCodeRepositoryResponse' 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', 'updateCodeRepositoryResponse_httpStatus' - The response's http status code.
--
-- 'codeRepositoryArn', 'updateCodeRepositoryResponse_codeRepositoryArn' - The ARN of the Git repository.
newUpdateCodeRepositoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'codeRepositoryArn'
  Prelude.Text ->
  UpdateCodeRepositoryResponse
newUpdateCodeRepositoryResponse :: Int -> Text -> UpdateCodeRepositoryResponse
newUpdateCodeRepositoryResponse
  Int
pHttpStatus_
  Text
pCodeRepositoryArn_ =
    UpdateCodeRepositoryResponse'
      { $sel:httpStatus:UpdateCodeRepositoryResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:codeRepositoryArn:UpdateCodeRepositoryResponse' :: Text
codeRepositoryArn = Text
pCodeRepositoryArn_
      }

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

-- | The ARN of the Git repository.
updateCodeRepositoryResponse_codeRepositoryArn :: Lens.Lens' UpdateCodeRepositoryResponse Prelude.Text
updateCodeRepositoryResponse_codeRepositoryArn :: Lens' UpdateCodeRepositoryResponse Text
updateCodeRepositoryResponse_codeRepositoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCodeRepositoryResponse' {Text
codeRepositoryArn :: Text
$sel:codeRepositoryArn:UpdateCodeRepositoryResponse' :: UpdateCodeRepositoryResponse -> Text
codeRepositoryArn} -> Text
codeRepositoryArn) (\s :: UpdateCodeRepositoryResponse
s@UpdateCodeRepositoryResponse' {} Text
a -> UpdateCodeRepositoryResponse
s {$sel:codeRepositoryArn:UpdateCodeRepositoryResponse' :: Text
codeRepositoryArn = Text
a} :: UpdateCodeRepositoryResponse)

instance Prelude.NFData UpdateCodeRepositoryResponse where
  rnf :: UpdateCodeRepositoryResponse -> ()
rnf UpdateCodeRepositoryResponse' {Int
Text
codeRepositoryArn :: Text
httpStatus :: Int
$sel:codeRepositoryArn:UpdateCodeRepositoryResponse' :: UpdateCodeRepositoryResponse -> Text
$sel:httpStatus:UpdateCodeRepositoryResponse' :: UpdateCodeRepositoryResponse -> 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 Text
codeRepositoryArn