{-# 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.UpdateAppImageConfig
-- 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 properties of an AppImageConfig.
module Amazonka.SageMaker.UpdateAppImageConfig
  ( -- * Creating a Request
    UpdateAppImageConfig (..),
    newUpdateAppImageConfig,

    -- * Request Lenses
    updateAppImageConfig_kernelGatewayImageConfig,
    updateAppImageConfig_appImageConfigName,

    -- * Destructuring the Response
    UpdateAppImageConfigResponse (..),
    newUpdateAppImageConfigResponse,

    -- * Response Lenses
    updateAppImageConfigResponse_appImageConfigArn,
    updateAppImageConfigResponse_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:/ 'newUpdateAppImageConfig' smart constructor.
data UpdateAppImageConfig = UpdateAppImageConfig'
  { -- | The new KernelGateway app to run on the image.
    UpdateAppImageConfig -> Maybe KernelGatewayImageConfig
kernelGatewayImageConfig :: Prelude.Maybe KernelGatewayImageConfig,
    -- | The name of the AppImageConfig to update.
    UpdateAppImageConfig -> Text
appImageConfigName :: Prelude.Text
  }
  deriving (UpdateAppImageConfig -> UpdateAppImageConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAppImageConfig -> UpdateAppImageConfig -> Bool
$c/= :: UpdateAppImageConfig -> UpdateAppImageConfig -> Bool
== :: UpdateAppImageConfig -> UpdateAppImageConfig -> Bool
$c== :: UpdateAppImageConfig -> UpdateAppImageConfig -> Bool
Prelude.Eq, ReadPrec [UpdateAppImageConfig]
ReadPrec UpdateAppImageConfig
Int -> ReadS UpdateAppImageConfig
ReadS [UpdateAppImageConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateAppImageConfig]
$creadListPrec :: ReadPrec [UpdateAppImageConfig]
readPrec :: ReadPrec UpdateAppImageConfig
$creadPrec :: ReadPrec UpdateAppImageConfig
readList :: ReadS [UpdateAppImageConfig]
$creadList :: ReadS [UpdateAppImageConfig]
readsPrec :: Int -> ReadS UpdateAppImageConfig
$creadsPrec :: Int -> ReadS UpdateAppImageConfig
Prelude.Read, Int -> UpdateAppImageConfig -> ShowS
[UpdateAppImageConfig] -> ShowS
UpdateAppImageConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAppImageConfig] -> ShowS
$cshowList :: [UpdateAppImageConfig] -> ShowS
show :: UpdateAppImageConfig -> String
$cshow :: UpdateAppImageConfig -> String
showsPrec :: Int -> UpdateAppImageConfig -> ShowS
$cshowsPrec :: Int -> UpdateAppImageConfig -> ShowS
Prelude.Show, forall x. Rep UpdateAppImageConfig x -> UpdateAppImageConfig
forall x. UpdateAppImageConfig -> Rep UpdateAppImageConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateAppImageConfig x -> UpdateAppImageConfig
$cfrom :: forall x. UpdateAppImageConfig -> Rep UpdateAppImageConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateAppImageConfig' 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:
--
-- 'kernelGatewayImageConfig', 'updateAppImageConfig_kernelGatewayImageConfig' - The new KernelGateway app to run on the image.
--
-- 'appImageConfigName', 'updateAppImageConfig_appImageConfigName' - The name of the AppImageConfig to update.
newUpdateAppImageConfig ::
  -- | 'appImageConfigName'
  Prelude.Text ->
  UpdateAppImageConfig
newUpdateAppImageConfig :: Text -> UpdateAppImageConfig
newUpdateAppImageConfig Text
pAppImageConfigName_ =
  UpdateAppImageConfig'
    { $sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: Maybe KernelGatewayImageConfig
kernelGatewayImageConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:appImageConfigName:UpdateAppImageConfig' :: Text
appImageConfigName = Text
pAppImageConfigName_
    }

-- | The new KernelGateway app to run on the image.
updateAppImageConfig_kernelGatewayImageConfig :: Lens.Lens' UpdateAppImageConfig (Prelude.Maybe KernelGatewayImageConfig)
updateAppImageConfig_kernelGatewayImageConfig :: Lens' UpdateAppImageConfig (Maybe KernelGatewayImageConfig)
updateAppImageConfig_kernelGatewayImageConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppImageConfig' {Maybe KernelGatewayImageConfig
kernelGatewayImageConfig :: Maybe KernelGatewayImageConfig
$sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: UpdateAppImageConfig -> Maybe KernelGatewayImageConfig
kernelGatewayImageConfig} -> Maybe KernelGatewayImageConfig
kernelGatewayImageConfig) (\s :: UpdateAppImageConfig
s@UpdateAppImageConfig' {} Maybe KernelGatewayImageConfig
a -> UpdateAppImageConfig
s {$sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: Maybe KernelGatewayImageConfig
kernelGatewayImageConfig = Maybe KernelGatewayImageConfig
a} :: UpdateAppImageConfig)

-- | The name of the AppImageConfig to update.
updateAppImageConfig_appImageConfigName :: Lens.Lens' UpdateAppImageConfig Prelude.Text
updateAppImageConfig_appImageConfigName :: Lens' UpdateAppImageConfig Text
updateAppImageConfig_appImageConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppImageConfig' {Text
appImageConfigName :: Text
$sel:appImageConfigName:UpdateAppImageConfig' :: UpdateAppImageConfig -> Text
appImageConfigName} -> Text
appImageConfigName) (\s :: UpdateAppImageConfig
s@UpdateAppImageConfig' {} Text
a -> UpdateAppImageConfig
s {$sel:appImageConfigName:UpdateAppImageConfig' :: Text
appImageConfigName = Text
a} :: UpdateAppImageConfig)

instance Core.AWSRequest UpdateAppImageConfig where
  type
    AWSResponse UpdateAppImageConfig =
      UpdateAppImageConfigResponse
  request :: (Service -> Service)
-> UpdateAppImageConfig -> Request UpdateAppImageConfig
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 UpdateAppImageConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateAppImageConfig)))
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 -> UpdateAppImageConfigResponse
UpdateAppImageConfigResponse'
            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
"AppImageConfigArn")
            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 UpdateAppImageConfig where
  hashWithSalt :: Int -> UpdateAppImageConfig -> Int
hashWithSalt Int
_salt UpdateAppImageConfig' {Maybe KernelGatewayImageConfig
Text
appImageConfigName :: Text
kernelGatewayImageConfig :: Maybe KernelGatewayImageConfig
$sel:appImageConfigName:UpdateAppImageConfig' :: UpdateAppImageConfig -> Text
$sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: UpdateAppImageConfig -> Maybe KernelGatewayImageConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KernelGatewayImageConfig
kernelGatewayImageConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appImageConfigName

instance Prelude.NFData UpdateAppImageConfig where
  rnf :: UpdateAppImageConfig -> ()
rnf UpdateAppImageConfig' {Maybe KernelGatewayImageConfig
Text
appImageConfigName :: Text
kernelGatewayImageConfig :: Maybe KernelGatewayImageConfig
$sel:appImageConfigName:UpdateAppImageConfig' :: UpdateAppImageConfig -> Text
$sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: UpdateAppImageConfig -> Maybe KernelGatewayImageConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe KernelGatewayImageConfig
kernelGatewayImageConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appImageConfigName

instance Data.ToHeaders UpdateAppImageConfig where
  toHeaders :: UpdateAppImageConfig -> 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.UpdateAppImageConfig" ::
                          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 UpdateAppImageConfig where
  toJSON :: UpdateAppImageConfig -> Value
toJSON UpdateAppImageConfig' {Maybe KernelGatewayImageConfig
Text
appImageConfigName :: Text
kernelGatewayImageConfig :: Maybe KernelGatewayImageConfig
$sel:appImageConfigName:UpdateAppImageConfig' :: UpdateAppImageConfig -> Text
$sel:kernelGatewayImageConfig:UpdateAppImageConfig' :: UpdateAppImageConfig -> Maybe KernelGatewayImageConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"KernelGatewayImageConfig" 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 KernelGatewayImageConfig
kernelGatewayImageConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AppImageConfigName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
appImageConfigName)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateAppImageConfigResponse' 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:
--
-- 'appImageConfigArn', 'updateAppImageConfigResponse_appImageConfigArn' - The Amazon Resource Name (ARN) for the AppImageConfig.
--
-- 'httpStatus', 'updateAppImageConfigResponse_httpStatus' - The response's http status code.
newUpdateAppImageConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateAppImageConfigResponse
newUpdateAppImageConfigResponse :: Int -> UpdateAppImageConfigResponse
newUpdateAppImageConfigResponse Int
pHttpStatus_ =
  UpdateAppImageConfigResponse'
    { $sel:appImageConfigArn:UpdateAppImageConfigResponse' :: Maybe Text
appImageConfigArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateAppImageConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) for the AppImageConfig.
updateAppImageConfigResponse_appImageConfigArn :: Lens.Lens' UpdateAppImageConfigResponse (Prelude.Maybe Prelude.Text)
updateAppImageConfigResponse_appImageConfigArn :: Lens' UpdateAppImageConfigResponse (Maybe Text)
updateAppImageConfigResponse_appImageConfigArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateAppImageConfigResponse' {Maybe Text
appImageConfigArn :: Maybe Text
$sel:appImageConfigArn:UpdateAppImageConfigResponse' :: UpdateAppImageConfigResponse -> Maybe Text
appImageConfigArn} -> Maybe Text
appImageConfigArn) (\s :: UpdateAppImageConfigResponse
s@UpdateAppImageConfigResponse' {} Maybe Text
a -> UpdateAppImageConfigResponse
s {$sel:appImageConfigArn:UpdateAppImageConfigResponse' :: Maybe Text
appImageConfigArn = Maybe Text
a} :: UpdateAppImageConfigResponse)

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

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