{-# 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.UpdateModelCard
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update an Amazon SageMaker Model Card.
--
-- You cannot update both model card content and model card status in a
-- single call.
module Amazonka.SageMaker.UpdateModelCard
  ( -- * Creating a Request
    UpdateModelCard (..),
    newUpdateModelCard,

    -- * Request Lenses
    updateModelCard_content,
    updateModelCard_modelCardStatus,
    updateModelCard_modelCardName,

    -- * Destructuring the Response
    UpdateModelCardResponse (..),
    newUpdateModelCardResponse,

    -- * Response Lenses
    updateModelCardResponse_httpStatus,
    updateModelCardResponse_modelCardArn,
  )
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:/ 'newUpdateModelCard' smart constructor.
data UpdateModelCard = UpdateModelCard'
  { -- | The updated model card content. Content must be in
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-cards-api-json-schema.html model card JSON schema>
    -- and provided as a string.
    --
    -- When updating model card content, be sure to include the full content
    -- and not just updated content.
    UpdateModelCard -> Maybe (Sensitive Text)
content :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The approval status of the model card within your organization.
    -- Different organizations might have different criteria for model card
    -- review and approval.
    --
    -- -   @Draft@: The model card is a work in progress.
    --
    -- -   @PendingReview@: The model card is pending review.
    --
    -- -   @Approved@: The model card is approved.
    --
    -- -   @Archived@: The model card is archived. No more updates should be
    --     made to the model card, but it can still be exported.
    UpdateModelCard -> Maybe ModelCardStatus
modelCardStatus :: Prelude.Maybe ModelCardStatus,
    -- | The name of the model card to update.
    UpdateModelCard -> Text
modelCardName :: Prelude.Text
  }
  deriving (UpdateModelCard -> UpdateModelCard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateModelCard -> UpdateModelCard -> Bool
$c/= :: UpdateModelCard -> UpdateModelCard -> Bool
== :: UpdateModelCard -> UpdateModelCard -> Bool
$c== :: UpdateModelCard -> UpdateModelCard -> Bool
Prelude.Eq, Int -> UpdateModelCard -> ShowS
[UpdateModelCard] -> ShowS
UpdateModelCard -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateModelCard] -> ShowS
$cshowList :: [UpdateModelCard] -> ShowS
show :: UpdateModelCard -> String
$cshow :: UpdateModelCard -> String
showsPrec :: Int -> UpdateModelCard -> ShowS
$cshowsPrec :: Int -> UpdateModelCard -> ShowS
Prelude.Show, forall x. Rep UpdateModelCard x -> UpdateModelCard
forall x. UpdateModelCard -> Rep UpdateModelCard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateModelCard x -> UpdateModelCard
$cfrom :: forall x. UpdateModelCard -> Rep UpdateModelCard x
Prelude.Generic)

-- |
-- Create a value of 'UpdateModelCard' 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:
--
-- 'content', 'updateModelCard_content' - The updated model card content. Content must be in
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-cards-api-json-schema.html model card JSON schema>
-- and provided as a string.
--
-- When updating model card content, be sure to include the full content
-- and not just updated content.
--
-- 'modelCardStatus', 'updateModelCard_modelCardStatus' - The approval status of the model card within your organization.
-- Different organizations might have different criteria for model card
-- review and approval.
--
-- -   @Draft@: The model card is a work in progress.
--
-- -   @PendingReview@: The model card is pending review.
--
-- -   @Approved@: The model card is approved.
--
-- -   @Archived@: The model card is archived. No more updates should be
--     made to the model card, but it can still be exported.
--
-- 'modelCardName', 'updateModelCard_modelCardName' - The name of the model card to update.
newUpdateModelCard ::
  -- | 'modelCardName'
  Prelude.Text ->
  UpdateModelCard
newUpdateModelCard :: Text -> UpdateModelCard
newUpdateModelCard Text
pModelCardName_ =
  UpdateModelCard'
    { $sel:content:UpdateModelCard' :: Maybe (Sensitive Text)
content = forall a. Maybe a
Prelude.Nothing,
      $sel:modelCardStatus:UpdateModelCard' :: Maybe ModelCardStatus
modelCardStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:modelCardName:UpdateModelCard' :: Text
modelCardName = Text
pModelCardName_
    }

-- | The updated model card content. Content must be in
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/model-cards-api-json-schema.html model card JSON schema>
-- and provided as a string.
--
-- When updating model card content, be sure to include the full content
-- and not just updated content.
updateModelCard_content :: Lens.Lens' UpdateModelCard (Prelude.Maybe Prelude.Text)
updateModelCard_content :: Lens' UpdateModelCard (Maybe Text)
updateModelCard_content = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateModelCard' {Maybe (Sensitive Text)
content :: Maybe (Sensitive Text)
$sel:content:UpdateModelCard' :: UpdateModelCard -> Maybe (Sensitive Text)
content} -> Maybe (Sensitive Text)
content) (\s :: UpdateModelCard
s@UpdateModelCard' {} Maybe (Sensitive Text)
a -> UpdateModelCard
s {$sel:content:UpdateModelCard' :: Maybe (Sensitive Text)
content = Maybe (Sensitive Text)
a} :: UpdateModelCard) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The approval status of the model card within your organization.
-- Different organizations might have different criteria for model card
-- review and approval.
--
-- -   @Draft@: The model card is a work in progress.
--
-- -   @PendingReview@: The model card is pending review.
--
-- -   @Approved@: The model card is approved.
--
-- -   @Archived@: The model card is archived. No more updates should be
--     made to the model card, but it can still be exported.
updateModelCard_modelCardStatus :: Lens.Lens' UpdateModelCard (Prelude.Maybe ModelCardStatus)
updateModelCard_modelCardStatus :: Lens' UpdateModelCard (Maybe ModelCardStatus)
updateModelCard_modelCardStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateModelCard' {Maybe ModelCardStatus
modelCardStatus :: Maybe ModelCardStatus
$sel:modelCardStatus:UpdateModelCard' :: UpdateModelCard -> Maybe ModelCardStatus
modelCardStatus} -> Maybe ModelCardStatus
modelCardStatus) (\s :: UpdateModelCard
s@UpdateModelCard' {} Maybe ModelCardStatus
a -> UpdateModelCard
s {$sel:modelCardStatus:UpdateModelCard' :: Maybe ModelCardStatus
modelCardStatus = Maybe ModelCardStatus
a} :: UpdateModelCard)

-- | The name of the model card to update.
updateModelCard_modelCardName :: Lens.Lens' UpdateModelCard Prelude.Text
updateModelCard_modelCardName :: Lens' UpdateModelCard Text
updateModelCard_modelCardName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateModelCard' {Text
modelCardName :: Text
$sel:modelCardName:UpdateModelCard' :: UpdateModelCard -> Text
modelCardName} -> Text
modelCardName) (\s :: UpdateModelCard
s@UpdateModelCard' {} Text
a -> UpdateModelCard
s {$sel:modelCardName:UpdateModelCard' :: Text
modelCardName = Text
a} :: UpdateModelCard)

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

instance Prelude.Hashable UpdateModelCard where
  hashWithSalt :: Int -> UpdateModelCard -> Int
hashWithSalt Int
_salt UpdateModelCard' {Maybe (Sensitive Text)
Maybe ModelCardStatus
Text
modelCardName :: Text
modelCardStatus :: Maybe ModelCardStatus
content :: Maybe (Sensitive Text)
$sel:modelCardName:UpdateModelCard' :: UpdateModelCard -> Text
$sel:modelCardStatus:UpdateModelCard' :: UpdateModelCard -> Maybe ModelCardStatus
$sel:content:UpdateModelCard' :: UpdateModelCard -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
content
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelCardStatus
modelCardStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
modelCardName

instance Prelude.NFData UpdateModelCard where
  rnf :: UpdateModelCard -> ()
rnf UpdateModelCard' {Maybe (Sensitive Text)
Maybe ModelCardStatus
Text
modelCardName :: Text
modelCardStatus :: Maybe ModelCardStatus
content :: Maybe (Sensitive Text)
$sel:modelCardName:UpdateModelCard' :: UpdateModelCard -> Text
$sel:modelCardStatus:UpdateModelCard' :: UpdateModelCard -> Maybe ModelCardStatus
$sel:content:UpdateModelCard' :: UpdateModelCard -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
content
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelCardStatus
modelCardStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
modelCardName

instance Data.ToHeaders UpdateModelCard where
  toHeaders :: UpdateModelCard -> 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.UpdateModelCard" :: 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 UpdateModelCard where
  toJSON :: UpdateModelCard -> Value
toJSON UpdateModelCard' {Maybe (Sensitive Text)
Maybe ModelCardStatus
Text
modelCardName :: Text
modelCardStatus :: Maybe ModelCardStatus
content :: Maybe (Sensitive Text)
$sel:modelCardName:UpdateModelCard' :: UpdateModelCard -> Text
$sel:modelCardStatus:UpdateModelCard' :: UpdateModelCard -> Maybe ModelCardStatus
$sel:content:UpdateModelCard' :: UpdateModelCard -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Content" 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 (Sensitive Text)
content,
            (Key
"ModelCardStatus" 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 ModelCardStatus
modelCardStatus,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ModelCardName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
modelCardName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateModelCardResponse' 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', 'updateModelCardResponse_httpStatus' - The response's http status code.
--
-- 'modelCardArn', 'updateModelCardResponse_modelCardArn' - The Amazon Resource Name (ARN) of the updated model card.
newUpdateModelCardResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'modelCardArn'
  Prelude.Text ->
  UpdateModelCardResponse
newUpdateModelCardResponse :: Int -> Text -> UpdateModelCardResponse
newUpdateModelCardResponse
  Int
pHttpStatus_
  Text
pModelCardArn_ =
    UpdateModelCardResponse'
      { $sel:httpStatus:UpdateModelCardResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:modelCardArn:UpdateModelCardResponse' :: Text
modelCardArn = Text
pModelCardArn_
      }

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

-- | The Amazon Resource Name (ARN) of the updated model card.
updateModelCardResponse_modelCardArn :: Lens.Lens' UpdateModelCardResponse Prelude.Text
updateModelCardResponse_modelCardArn :: Lens' UpdateModelCardResponse Text
updateModelCardResponse_modelCardArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateModelCardResponse' {Text
modelCardArn :: Text
$sel:modelCardArn:UpdateModelCardResponse' :: UpdateModelCardResponse -> Text
modelCardArn} -> Text
modelCardArn) (\s :: UpdateModelCardResponse
s@UpdateModelCardResponse' {} Text
a -> UpdateModelCardResponse
s {$sel:modelCardArn:UpdateModelCardResponse' :: Text
modelCardArn = Text
a} :: UpdateModelCardResponse)

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