{-# 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.UpdateArtifact
-- 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 an artifact.
module Amazonka.SageMaker.UpdateArtifact
  ( -- * Creating a Request
    UpdateArtifact (..),
    newUpdateArtifact,

    -- * Request Lenses
    updateArtifact_artifactName,
    updateArtifact_properties,
    updateArtifact_propertiesToRemove,
    updateArtifact_artifactArn,

    -- * Destructuring the Response
    UpdateArtifactResponse (..),
    newUpdateArtifactResponse,

    -- * Response Lenses
    updateArtifactResponse_artifactArn,
    updateArtifactResponse_httpStatus,
  )
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:/ 'newUpdateArtifact' smart constructor.
data UpdateArtifact = UpdateArtifact'
  { -- | The new name for the artifact.
    UpdateArtifact -> Maybe Text
artifactName :: Prelude.Maybe Prelude.Text,
    -- | The new list of properties. Overwrites the current property list.
    UpdateArtifact -> Maybe (HashMap Text Text)
properties :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A list of properties to remove.
    UpdateArtifact -> Maybe [Text]
propertiesToRemove :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon Resource Name (ARN) of the artifact to update.
    UpdateArtifact -> Text
artifactArn :: Prelude.Text
  }
  deriving (UpdateArtifact -> UpdateArtifact -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateArtifact -> UpdateArtifact -> Bool
$c/= :: UpdateArtifact -> UpdateArtifact -> Bool
== :: UpdateArtifact -> UpdateArtifact -> Bool
$c== :: UpdateArtifact -> UpdateArtifact -> Bool
Prelude.Eq, ReadPrec [UpdateArtifact]
ReadPrec UpdateArtifact
Int -> ReadS UpdateArtifact
ReadS [UpdateArtifact]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateArtifact]
$creadListPrec :: ReadPrec [UpdateArtifact]
readPrec :: ReadPrec UpdateArtifact
$creadPrec :: ReadPrec UpdateArtifact
readList :: ReadS [UpdateArtifact]
$creadList :: ReadS [UpdateArtifact]
readsPrec :: Int -> ReadS UpdateArtifact
$creadsPrec :: Int -> ReadS UpdateArtifact
Prelude.Read, Int -> UpdateArtifact -> ShowS
[UpdateArtifact] -> ShowS
UpdateArtifact -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateArtifact] -> ShowS
$cshowList :: [UpdateArtifact] -> ShowS
show :: UpdateArtifact -> String
$cshow :: UpdateArtifact -> String
showsPrec :: Int -> UpdateArtifact -> ShowS
$cshowsPrec :: Int -> UpdateArtifact -> ShowS
Prelude.Show, forall x. Rep UpdateArtifact x -> UpdateArtifact
forall x. UpdateArtifact -> Rep UpdateArtifact x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateArtifact x -> UpdateArtifact
$cfrom :: forall x. UpdateArtifact -> Rep UpdateArtifact x
Prelude.Generic)

-- |
-- Create a value of 'UpdateArtifact' 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:
--
-- 'artifactName', 'updateArtifact_artifactName' - The new name for the artifact.
--
-- 'properties', 'updateArtifact_properties' - The new list of properties. Overwrites the current property list.
--
-- 'propertiesToRemove', 'updateArtifact_propertiesToRemove' - A list of properties to remove.
--
-- 'artifactArn', 'updateArtifact_artifactArn' - The Amazon Resource Name (ARN) of the artifact to update.
newUpdateArtifact ::
  -- | 'artifactArn'
  Prelude.Text ->
  UpdateArtifact
newUpdateArtifact :: Text -> UpdateArtifact
newUpdateArtifact Text
pArtifactArn_ =
  UpdateArtifact'
    { $sel:artifactName:UpdateArtifact' :: Maybe Text
artifactName = forall a. Maybe a
Prelude.Nothing,
      $sel:properties:UpdateArtifact' :: Maybe (HashMap Text Text)
properties = forall a. Maybe a
Prelude.Nothing,
      $sel:propertiesToRemove:UpdateArtifact' :: Maybe [Text]
propertiesToRemove = forall a. Maybe a
Prelude.Nothing,
      $sel:artifactArn:UpdateArtifact' :: Text
artifactArn = Text
pArtifactArn_
    }

-- | The new name for the artifact.
updateArtifact_artifactName :: Lens.Lens' UpdateArtifact (Prelude.Maybe Prelude.Text)
updateArtifact_artifactName :: Lens' UpdateArtifact (Maybe Text)
updateArtifact_artifactName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArtifact' {Maybe Text
artifactName :: Maybe Text
$sel:artifactName:UpdateArtifact' :: UpdateArtifact -> Maybe Text
artifactName} -> Maybe Text
artifactName) (\s :: UpdateArtifact
s@UpdateArtifact' {} Maybe Text
a -> UpdateArtifact
s {$sel:artifactName:UpdateArtifact' :: Maybe Text
artifactName = Maybe Text
a} :: UpdateArtifact)

-- | The new list of properties. Overwrites the current property list.
updateArtifact_properties :: Lens.Lens' UpdateArtifact (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateArtifact_properties :: Lens' UpdateArtifact (Maybe (HashMap Text Text))
updateArtifact_properties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArtifact' {Maybe (HashMap Text Text)
properties :: Maybe (HashMap Text Text)
$sel:properties:UpdateArtifact' :: UpdateArtifact -> Maybe (HashMap Text Text)
properties} -> Maybe (HashMap Text Text)
properties) (\s :: UpdateArtifact
s@UpdateArtifact' {} Maybe (HashMap Text Text)
a -> UpdateArtifact
s {$sel:properties:UpdateArtifact' :: Maybe (HashMap Text Text)
properties = Maybe (HashMap Text Text)
a} :: UpdateArtifact) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of properties to remove.
updateArtifact_propertiesToRemove :: Lens.Lens' UpdateArtifact (Prelude.Maybe [Prelude.Text])
updateArtifact_propertiesToRemove :: Lens' UpdateArtifact (Maybe [Text])
updateArtifact_propertiesToRemove = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArtifact' {Maybe [Text]
propertiesToRemove :: Maybe [Text]
$sel:propertiesToRemove:UpdateArtifact' :: UpdateArtifact -> Maybe [Text]
propertiesToRemove} -> Maybe [Text]
propertiesToRemove) (\s :: UpdateArtifact
s@UpdateArtifact' {} Maybe [Text]
a -> UpdateArtifact
s {$sel:propertiesToRemove:UpdateArtifact' :: Maybe [Text]
propertiesToRemove = Maybe [Text]
a} :: UpdateArtifact) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name (ARN) of the artifact to update.
updateArtifact_artifactArn :: Lens.Lens' UpdateArtifact Prelude.Text
updateArtifact_artifactArn :: Lens' UpdateArtifact Text
updateArtifact_artifactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArtifact' {Text
artifactArn :: Text
$sel:artifactArn:UpdateArtifact' :: UpdateArtifact -> Text
artifactArn} -> Text
artifactArn) (\s :: UpdateArtifact
s@UpdateArtifact' {} Text
a -> UpdateArtifact
s {$sel:artifactArn:UpdateArtifact' :: Text
artifactArn = Text
a} :: UpdateArtifact)

instance Core.AWSRequest UpdateArtifact where
  type
    AWSResponse UpdateArtifact =
      UpdateArtifactResponse
  request :: (Service -> Service) -> UpdateArtifact -> Request UpdateArtifact
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 UpdateArtifact
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateArtifact)))
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 Text -> Int -> UpdateArtifactResponse
UpdateArtifactResponse'
            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
"ArtifactArn")
            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 UpdateArtifact where
  hashWithSalt :: Int -> UpdateArtifact -> Int
hashWithSalt Int
_salt UpdateArtifact' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Text
artifactArn :: Text
propertiesToRemove :: Maybe [Text]
properties :: Maybe (HashMap Text Text)
artifactName :: Maybe Text
$sel:artifactArn:UpdateArtifact' :: UpdateArtifact -> Text
$sel:propertiesToRemove:UpdateArtifact' :: UpdateArtifact -> Maybe [Text]
$sel:properties:UpdateArtifact' :: UpdateArtifact -> Maybe (HashMap Text Text)
$sel:artifactName:UpdateArtifact' :: UpdateArtifact -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
artifactName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
properties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
propertiesToRemove
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
artifactArn

instance Prelude.NFData UpdateArtifact where
  rnf :: UpdateArtifact -> ()
rnf UpdateArtifact' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Text
artifactArn :: Text
propertiesToRemove :: Maybe [Text]
properties :: Maybe (HashMap Text Text)
artifactName :: Maybe Text
$sel:artifactArn:UpdateArtifact' :: UpdateArtifact -> Text
$sel:propertiesToRemove:UpdateArtifact' :: UpdateArtifact -> Maybe [Text]
$sel:properties:UpdateArtifact' :: UpdateArtifact -> Maybe (HashMap Text Text)
$sel:artifactName:UpdateArtifact' :: UpdateArtifact -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
artifactName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
properties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
propertiesToRemove
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
artifactArn

instance Data.ToHeaders UpdateArtifact where
  toHeaders :: UpdateArtifact -> 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.UpdateArtifact" :: 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 UpdateArtifact where
  toJSON :: UpdateArtifact -> Value
toJSON UpdateArtifact' {Maybe [Text]
Maybe Text
Maybe (HashMap Text Text)
Text
artifactArn :: Text
propertiesToRemove :: Maybe [Text]
properties :: Maybe (HashMap Text Text)
artifactName :: Maybe Text
$sel:artifactArn:UpdateArtifact' :: UpdateArtifact -> Text
$sel:propertiesToRemove:UpdateArtifact' :: UpdateArtifact -> Maybe [Text]
$sel:properties:UpdateArtifact' :: UpdateArtifact -> Maybe (HashMap Text Text)
$sel:artifactName:UpdateArtifact' :: UpdateArtifact -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ArtifactName" 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
artifactName,
            (Key
"Properties" 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 (HashMap Text Text)
properties,
            (Key
"PropertiesToRemove" 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]
propertiesToRemove,
            forall a. a -> Maybe a
Prelude.Just (Key
"ArtifactArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
artifactArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateArtifactResponse' 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:
--
-- 'artifactArn', 'updateArtifactResponse_artifactArn' - The Amazon Resource Name (ARN) of the artifact.
--
-- 'httpStatus', 'updateArtifactResponse_httpStatus' - The response's http status code.
newUpdateArtifactResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateArtifactResponse
newUpdateArtifactResponse :: Int -> UpdateArtifactResponse
newUpdateArtifactResponse Int
pHttpStatus_ =
  UpdateArtifactResponse'
    { $sel:artifactArn:UpdateArtifactResponse' :: Maybe Text
artifactArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateArtifactResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the artifact.
updateArtifactResponse_artifactArn :: Lens.Lens' UpdateArtifactResponse (Prelude.Maybe Prelude.Text)
updateArtifactResponse_artifactArn :: Lens' UpdateArtifactResponse (Maybe Text)
updateArtifactResponse_artifactArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateArtifactResponse' {Maybe Text
artifactArn :: Maybe Text
$sel:artifactArn:UpdateArtifactResponse' :: UpdateArtifactResponse -> Maybe Text
artifactArn} -> Maybe Text
artifactArn) (\s :: UpdateArtifactResponse
s@UpdateArtifactResponse' {} Maybe Text
a -> UpdateArtifactResponse
s {$sel:artifactArn:UpdateArtifactResponse' :: Maybe Text
artifactArn = Maybe Text
a} :: UpdateArtifactResponse)

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

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