{-# 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.UpdateNotebookInstanceLifecycleConfig
-- 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 a notebook instance lifecycle configuration created with the
-- CreateNotebookInstanceLifecycleConfig API.
module Amazonka.SageMaker.UpdateNotebookInstanceLifecycleConfig
  ( -- * Creating a Request
    UpdateNotebookInstanceLifecycleConfig (..),
    newUpdateNotebookInstanceLifecycleConfig,

    -- * Request Lenses
    updateNotebookInstanceLifecycleConfig_onCreate,
    updateNotebookInstanceLifecycleConfig_onStart,
    updateNotebookInstanceLifecycleConfig_notebookInstanceLifecycleConfigName,

    -- * Destructuring the Response
    UpdateNotebookInstanceLifecycleConfigResponse (..),
    newUpdateNotebookInstanceLifecycleConfigResponse,

    -- * Response Lenses
    updateNotebookInstanceLifecycleConfigResponse_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:/ 'newUpdateNotebookInstanceLifecycleConfig' smart constructor.
data UpdateNotebookInstanceLifecycleConfig = UpdateNotebookInstanceLifecycleConfig'
  { -- | The shell script that runs only once, when you create a notebook
    -- instance. The shell script must be a base64-encoded string.
    UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
onCreate :: Prelude.Maybe [NotebookInstanceLifecycleHook],
    -- | The shell script that runs every time you start a notebook instance,
    -- including when you create the notebook instance. The shell script must
    -- be a base64-encoded string.
    UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
onStart :: Prelude.Maybe [NotebookInstanceLifecycleHook],
    -- | The name of the lifecycle configuration.
    UpdateNotebookInstanceLifecycleConfig -> Text
notebookInstanceLifecycleConfigName :: Prelude.Text
  }
  deriving (UpdateNotebookInstanceLifecycleConfig
-> UpdateNotebookInstanceLifecycleConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotebookInstanceLifecycleConfig
-> UpdateNotebookInstanceLifecycleConfig -> Bool
$c/= :: UpdateNotebookInstanceLifecycleConfig
-> UpdateNotebookInstanceLifecycleConfig -> Bool
== :: UpdateNotebookInstanceLifecycleConfig
-> UpdateNotebookInstanceLifecycleConfig -> Bool
$c== :: UpdateNotebookInstanceLifecycleConfig
-> UpdateNotebookInstanceLifecycleConfig -> Bool
Prelude.Eq, ReadPrec [UpdateNotebookInstanceLifecycleConfig]
ReadPrec UpdateNotebookInstanceLifecycleConfig
Int -> ReadS UpdateNotebookInstanceLifecycleConfig
ReadS [UpdateNotebookInstanceLifecycleConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotebookInstanceLifecycleConfig]
$creadListPrec :: ReadPrec [UpdateNotebookInstanceLifecycleConfig]
readPrec :: ReadPrec UpdateNotebookInstanceLifecycleConfig
$creadPrec :: ReadPrec UpdateNotebookInstanceLifecycleConfig
readList :: ReadS [UpdateNotebookInstanceLifecycleConfig]
$creadList :: ReadS [UpdateNotebookInstanceLifecycleConfig]
readsPrec :: Int -> ReadS UpdateNotebookInstanceLifecycleConfig
$creadsPrec :: Int -> ReadS UpdateNotebookInstanceLifecycleConfig
Prelude.Read, Int -> UpdateNotebookInstanceLifecycleConfig -> ShowS
[UpdateNotebookInstanceLifecycleConfig] -> ShowS
UpdateNotebookInstanceLifecycleConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotebookInstanceLifecycleConfig] -> ShowS
$cshowList :: [UpdateNotebookInstanceLifecycleConfig] -> ShowS
show :: UpdateNotebookInstanceLifecycleConfig -> String
$cshow :: UpdateNotebookInstanceLifecycleConfig -> String
showsPrec :: Int -> UpdateNotebookInstanceLifecycleConfig -> ShowS
$cshowsPrec :: Int -> UpdateNotebookInstanceLifecycleConfig -> ShowS
Prelude.Show, forall x.
Rep UpdateNotebookInstanceLifecycleConfig x
-> UpdateNotebookInstanceLifecycleConfig
forall x.
UpdateNotebookInstanceLifecycleConfig
-> Rep UpdateNotebookInstanceLifecycleConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateNotebookInstanceLifecycleConfig x
-> UpdateNotebookInstanceLifecycleConfig
$cfrom :: forall x.
UpdateNotebookInstanceLifecycleConfig
-> Rep UpdateNotebookInstanceLifecycleConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateNotebookInstanceLifecycleConfig' 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:
--
-- 'onCreate', 'updateNotebookInstanceLifecycleConfig_onCreate' - The shell script that runs only once, when you create a notebook
-- instance. The shell script must be a base64-encoded string.
--
-- 'onStart', 'updateNotebookInstanceLifecycleConfig_onStart' - The shell script that runs every time you start a notebook instance,
-- including when you create the notebook instance. The shell script must
-- be a base64-encoded string.
--
-- 'notebookInstanceLifecycleConfigName', 'updateNotebookInstanceLifecycleConfig_notebookInstanceLifecycleConfigName' - The name of the lifecycle configuration.
newUpdateNotebookInstanceLifecycleConfig ::
  -- | 'notebookInstanceLifecycleConfigName'
  Prelude.Text ->
  UpdateNotebookInstanceLifecycleConfig
newUpdateNotebookInstanceLifecycleConfig :: Text -> UpdateNotebookInstanceLifecycleConfig
newUpdateNotebookInstanceLifecycleConfig
  Text
pNotebookInstanceLifecycleConfigName_ =
    UpdateNotebookInstanceLifecycleConfig'
      { $sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: Maybe [NotebookInstanceLifecycleHook]
onCreate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: Maybe [NotebookInstanceLifecycleHook]
onStart = forall a. Maybe a
Prelude.Nothing,
        $sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: Text
notebookInstanceLifecycleConfigName =
          Text
pNotebookInstanceLifecycleConfigName_
      }

-- | The shell script that runs only once, when you create a notebook
-- instance. The shell script must be a base64-encoded string.
updateNotebookInstanceLifecycleConfig_onCreate :: Lens.Lens' UpdateNotebookInstanceLifecycleConfig (Prelude.Maybe [NotebookInstanceLifecycleHook])
updateNotebookInstanceLifecycleConfig_onCreate :: Lens'
  UpdateNotebookInstanceLifecycleConfig
  (Maybe [NotebookInstanceLifecycleHook])
updateNotebookInstanceLifecycleConfig_onCreate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebookInstanceLifecycleConfig' {Maybe [NotebookInstanceLifecycleHook]
onCreate :: Maybe [NotebookInstanceLifecycleHook]
$sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
onCreate} -> Maybe [NotebookInstanceLifecycleHook]
onCreate) (\s :: UpdateNotebookInstanceLifecycleConfig
s@UpdateNotebookInstanceLifecycleConfig' {} Maybe [NotebookInstanceLifecycleHook]
a -> UpdateNotebookInstanceLifecycleConfig
s {$sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: Maybe [NotebookInstanceLifecycleHook]
onCreate = Maybe [NotebookInstanceLifecycleHook]
a} :: UpdateNotebookInstanceLifecycleConfig) 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 shell script that runs every time you start a notebook instance,
-- including when you create the notebook instance. The shell script must
-- be a base64-encoded string.
updateNotebookInstanceLifecycleConfig_onStart :: Lens.Lens' UpdateNotebookInstanceLifecycleConfig (Prelude.Maybe [NotebookInstanceLifecycleHook])
updateNotebookInstanceLifecycleConfig_onStart :: Lens'
  UpdateNotebookInstanceLifecycleConfig
  (Maybe [NotebookInstanceLifecycleHook])
updateNotebookInstanceLifecycleConfig_onStart = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebookInstanceLifecycleConfig' {Maybe [NotebookInstanceLifecycleHook]
onStart :: Maybe [NotebookInstanceLifecycleHook]
$sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
onStart} -> Maybe [NotebookInstanceLifecycleHook]
onStart) (\s :: UpdateNotebookInstanceLifecycleConfig
s@UpdateNotebookInstanceLifecycleConfig' {} Maybe [NotebookInstanceLifecycleHook]
a -> UpdateNotebookInstanceLifecycleConfig
s {$sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: Maybe [NotebookInstanceLifecycleHook]
onStart = Maybe [NotebookInstanceLifecycleHook]
a} :: UpdateNotebookInstanceLifecycleConfig) 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 name of the lifecycle configuration.
updateNotebookInstanceLifecycleConfig_notebookInstanceLifecycleConfigName :: Lens.Lens' UpdateNotebookInstanceLifecycleConfig Prelude.Text
updateNotebookInstanceLifecycleConfig_notebookInstanceLifecycleConfigName :: Lens' UpdateNotebookInstanceLifecycleConfig Text
updateNotebookInstanceLifecycleConfig_notebookInstanceLifecycleConfigName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebookInstanceLifecycleConfig' {Text
notebookInstanceLifecycleConfigName :: Text
$sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig -> Text
notebookInstanceLifecycleConfigName} -> Text
notebookInstanceLifecycleConfigName) (\s :: UpdateNotebookInstanceLifecycleConfig
s@UpdateNotebookInstanceLifecycleConfig' {} Text
a -> UpdateNotebookInstanceLifecycleConfig
s {$sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: Text
notebookInstanceLifecycleConfigName = Text
a} :: UpdateNotebookInstanceLifecycleConfig)

instance
  Core.AWSRequest
    UpdateNotebookInstanceLifecycleConfig
  where
  type
    AWSResponse
      UpdateNotebookInstanceLifecycleConfig =
      UpdateNotebookInstanceLifecycleConfigResponse
  request :: (Service -> Service)
-> UpdateNotebookInstanceLifecycleConfig
-> Request UpdateNotebookInstanceLifecycleConfig
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 UpdateNotebookInstanceLifecycleConfig
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse
           (AWSResponse UpdateNotebookInstanceLifecycleConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateNotebookInstanceLifecycleConfigResponse
UpdateNotebookInstanceLifecycleConfigResponse'
            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))
      )

instance
  Prelude.Hashable
    UpdateNotebookInstanceLifecycleConfig
  where
  hashWithSalt :: Int -> UpdateNotebookInstanceLifecycleConfig -> Int
hashWithSalt
    Int
_salt
    UpdateNotebookInstanceLifecycleConfig' {Maybe [NotebookInstanceLifecycleHook]
Text
notebookInstanceLifecycleConfigName :: Text
onStart :: Maybe [NotebookInstanceLifecycleHook]
onCreate :: Maybe [NotebookInstanceLifecycleHook]
$sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig -> Text
$sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
$sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NotebookInstanceLifecycleHook]
onCreate
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [NotebookInstanceLifecycleHook]
onStart
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
notebookInstanceLifecycleConfigName

instance
  Prelude.NFData
    UpdateNotebookInstanceLifecycleConfig
  where
  rnf :: UpdateNotebookInstanceLifecycleConfig -> ()
rnf UpdateNotebookInstanceLifecycleConfig' {Maybe [NotebookInstanceLifecycleHook]
Text
notebookInstanceLifecycleConfigName :: Text
onStart :: Maybe [NotebookInstanceLifecycleHook]
onCreate :: Maybe [NotebookInstanceLifecycleHook]
$sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig -> Text
$sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
$sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotebookInstanceLifecycleHook]
onCreate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotebookInstanceLifecycleHook]
onStart
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
notebookInstanceLifecycleConfigName

instance
  Data.ToHeaders
    UpdateNotebookInstanceLifecycleConfig
  where
  toHeaders :: UpdateNotebookInstanceLifecycleConfig -> 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.UpdateNotebookInstanceLifecycleConfig" ::
                          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
    UpdateNotebookInstanceLifecycleConfig
  where
  toJSON :: UpdateNotebookInstanceLifecycleConfig -> Value
toJSON UpdateNotebookInstanceLifecycleConfig' {Maybe [NotebookInstanceLifecycleHook]
Text
notebookInstanceLifecycleConfigName :: Text
onStart :: Maybe [NotebookInstanceLifecycleHook]
onCreate :: Maybe [NotebookInstanceLifecycleHook]
$sel:notebookInstanceLifecycleConfigName:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig -> Text
$sel:onStart:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
$sel:onCreate:UpdateNotebookInstanceLifecycleConfig' :: UpdateNotebookInstanceLifecycleConfig
-> Maybe [NotebookInstanceLifecycleHook]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"OnCreate" 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 [NotebookInstanceLifecycleHook]
onCreate,
            (Key
"OnStart" 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 [NotebookInstanceLifecycleHook]
onStart,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"NotebookInstanceLifecycleConfigName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
notebookInstanceLifecycleConfigName
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateNotebookInstanceLifecycleConfigResponse' 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', 'updateNotebookInstanceLifecycleConfigResponse_httpStatus' - The response's http status code.
newUpdateNotebookInstanceLifecycleConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateNotebookInstanceLifecycleConfigResponse
newUpdateNotebookInstanceLifecycleConfigResponse :: Int -> UpdateNotebookInstanceLifecycleConfigResponse
newUpdateNotebookInstanceLifecycleConfigResponse
  Int
pHttpStatus_ =
    UpdateNotebookInstanceLifecycleConfigResponse'
      { $sel:httpStatus:UpdateNotebookInstanceLifecycleConfigResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    UpdateNotebookInstanceLifecycleConfigResponse
  where
  rnf :: UpdateNotebookInstanceLifecycleConfigResponse -> ()
rnf
    UpdateNotebookInstanceLifecycleConfigResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateNotebookInstanceLifecycleConfigResponse' :: UpdateNotebookInstanceLifecycleConfigResponse -> Int
..} =
      forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus