{-# 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.UpdateMonitoringSchedule
-- 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 previously created schedule.
module Amazonka.SageMaker.UpdateMonitoringSchedule
  ( -- * Creating a Request
    UpdateMonitoringSchedule (..),
    newUpdateMonitoringSchedule,

    -- * Request Lenses
    updateMonitoringSchedule_monitoringScheduleName,
    updateMonitoringSchedule_monitoringScheduleConfig,

    -- * Destructuring the Response
    UpdateMonitoringScheduleResponse (..),
    newUpdateMonitoringScheduleResponse,

    -- * Response Lenses
    updateMonitoringScheduleResponse_httpStatus,
    updateMonitoringScheduleResponse_monitoringScheduleArn,
  )
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:/ 'newUpdateMonitoringSchedule' smart constructor.
data UpdateMonitoringSchedule = UpdateMonitoringSchedule'
  { -- | The name of the monitoring schedule. The name must be unique within an
    -- Amazon Web Services Region within an Amazon Web Services account.
    UpdateMonitoringSchedule -> Text
monitoringScheduleName :: Prelude.Text,
    -- | The configuration object that specifies the monitoring schedule and
    -- defines the monitoring job.
    UpdateMonitoringSchedule -> MonitoringScheduleConfig
monitoringScheduleConfig :: MonitoringScheduleConfig
  }
  deriving (UpdateMonitoringSchedule -> UpdateMonitoringSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateMonitoringSchedule -> UpdateMonitoringSchedule -> Bool
$c/= :: UpdateMonitoringSchedule -> UpdateMonitoringSchedule -> Bool
== :: UpdateMonitoringSchedule -> UpdateMonitoringSchedule -> Bool
$c== :: UpdateMonitoringSchedule -> UpdateMonitoringSchedule -> Bool
Prelude.Eq, ReadPrec [UpdateMonitoringSchedule]
ReadPrec UpdateMonitoringSchedule
Int -> ReadS UpdateMonitoringSchedule
ReadS [UpdateMonitoringSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateMonitoringSchedule]
$creadListPrec :: ReadPrec [UpdateMonitoringSchedule]
readPrec :: ReadPrec UpdateMonitoringSchedule
$creadPrec :: ReadPrec UpdateMonitoringSchedule
readList :: ReadS [UpdateMonitoringSchedule]
$creadList :: ReadS [UpdateMonitoringSchedule]
readsPrec :: Int -> ReadS UpdateMonitoringSchedule
$creadsPrec :: Int -> ReadS UpdateMonitoringSchedule
Prelude.Read, Int -> UpdateMonitoringSchedule -> ShowS
[UpdateMonitoringSchedule] -> ShowS
UpdateMonitoringSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateMonitoringSchedule] -> ShowS
$cshowList :: [UpdateMonitoringSchedule] -> ShowS
show :: UpdateMonitoringSchedule -> String
$cshow :: UpdateMonitoringSchedule -> String
showsPrec :: Int -> UpdateMonitoringSchedule -> ShowS
$cshowsPrec :: Int -> UpdateMonitoringSchedule -> ShowS
Prelude.Show, forall x.
Rep UpdateMonitoringSchedule x -> UpdateMonitoringSchedule
forall x.
UpdateMonitoringSchedule -> Rep UpdateMonitoringSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateMonitoringSchedule x -> UpdateMonitoringSchedule
$cfrom :: forall x.
UpdateMonitoringSchedule -> Rep UpdateMonitoringSchedule x
Prelude.Generic)

-- |
-- Create a value of 'UpdateMonitoringSchedule' 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:
--
-- 'monitoringScheduleName', 'updateMonitoringSchedule_monitoringScheduleName' - The name of the monitoring schedule. The name must be unique within an
-- Amazon Web Services Region within an Amazon Web Services account.
--
-- 'monitoringScheduleConfig', 'updateMonitoringSchedule_monitoringScheduleConfig' - The configuration object that specifies the monitoring schedule and
-- defines the monitoring job.
newUpdateMonitoringSchedule ::
  -- | 'monitoringScheduleName'
  Prelude.Text ->
  -- | 'monitoringScheduleConfig'
  MonitoringScheduleConfig ->
  UpdateMonitoringSchedule
newUpdateMonitoringSchedule :: Text -> MonitoringScheduleConfig -> UpdateMonitoringSchedule
newUpdateMonitoringSchedule
  Text
pMonitoringScheduleName_
  MonitoringScheduleConfig
pMonitoringScheduleConfig_ =
    UpdateMonitoringSchedule'
      { $sel:monitoringScheduleName:UpdateMonitoringSchedule' :: Text
monitoringScheduleName =
          Text
pMonitoringScheduleName_,
        $sel:monitoringScheduleConfig:UpdateMonitoringSchedule' :: MonitoringScheduleConfig
monitoringScheduleConfig =
          MonitoringScheduleConfig
pMonitoringScheduleConfig_
      }

-- | The name of the monitoring schedule. The name must be unique within an
-- Amazon Web Services Region within an Amazon Web Services account.
updateMonitoringSchedule_monitoringScheduleName :: Lens.Lens' UpdateMonitoringSchedule Prelude.Text
updateMonitoringSchedule_monitoringScheduleName :: Lens' UpdateMonitoringSchedule Text
updateMonitoringSchedule_monitoringScheduleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringSchedule' {Text
monitoringScheduleName :: Text
$sel:monitoringScheduleName:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> Text
monitoringScheduleName} -> Text
monitoringScheduleName) (\s :: UpdateMonitoringSchedule
s@UpdateMonitoringSchedule' {} Text
a -> UpdateMonitoringSchedule
s {$sel:monitoringScheduleName:UpdateMonitoringSchedule' :: Text
monitoringScheduleName = Text
a} :: UpdateMonitoringSchedule)

-- | The configuration object that specifies the monitoring schedule and
-- defines the monitoring job.
updateMonitoringSchedule_monitoringScheduleConfig :: Lens.Lens' UpdateMonitoringSchedule MonitoringScheduleConfig
updateMonitoringSchedule_monitoringScheduleConfig :: Lens' UpdateMonitoringSchedule MonitoringScheduleConfig
updateMonitoringSchedule_monitoringScheduleConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringSchedule' {MonitoringScheduleConfig
monitoringScheduleConfig :: MonitoringScheduleConfig
$sel:monitoringScheduleConfig:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> MonitoringScheduleConfig
monitoringScheduleConfig} -> MonitoringScheduleConfig
monitoringScheduleConfig) (\s :: UpdateMonitoringSchedule
s@UpdateMonitoringSchedule' {} MonitoringScheduleConfig
a -> UpdateMonitoringSchedule
s {$sel:monitoringScheduleConfig:UpdateMonitoringSchedule' :: MonitoringScheduleConfig
monitoringScheduleConfig = MonitoringScheduleConfig
a} :: UpdateMonitoringSchedule)

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

instance Prelude.Hashable UpdateMonitoringSchedule where
  hashWithSalt :: Int -> UpdateMonitoringSchedule -> Int
hashWithSalt Int
_salt UpdateMonitoringSchedule' {Text
MonitoringScheduleConfig
monitoringScheduleConfig :: MonitoringScheduleConfig
monitoringScheduleName :: Text
$sel:monitoringScheduleConfig:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> MonitoringScheduleConfig
$sel:monitoringScheduleName:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
monitoringScheduleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` MonitoringScheduleConfig
monitoringScheduleConfig

instance Prelude.NFData UpdateMonitoringSchedule where
  rnf :: UpdateMonitoringSchedule -> ()
rnf UpdateMonitoringSchedule' {Text
MonitoringScheduleConfig
monitoringScheduleConfig :: MonitoringScheduleConfig
monitoringScheduleName :: Text
$sel:monitoringScheduleConfig:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> MonitoringScheduleConfig
$sel:monitoringScheduleName:UpdateMonitoringSchedule' :: UpdateMonitoringSchedule -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
monitoringScheduleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf MonitoringScheduleConfig
monitoringScheduleConfig

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

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

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

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

-- |
-- Create a value of 'UpdateMonitoringScheduleResponse' 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', 'updateMonitoringScheduleResponse_httpStatus' - The response's http status code.
--
-- 'monitoringScheduleArn', 'updateMonitoringScheduleResponse_monitoringScheduleArn' - The Amazon Resource Name (ARN) of the monitoring schedule.
newUpdateMonitoringScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'monitoringScheduleArn'
  Prelude.Text ->
  UpdateMonitoringScheduleResponse
newUpdateMonitoringScheduleResponse :: Int -> Text -> UpdateMonitoringScheduleResponse
newUpdateMonitoringScheduleResponse
  Int
pHttpStatus_
  Text
pMonitoringScheduleArn_ =
    UpdateMonitoringScheduleResponse'
      { $sel:httpStatus:UpdateMonitoringScheduleResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:monitoringScheduleArn:UpdateMonitoringScheduleResponse' :: Text
monitoringScheduleArn =
          Text
pMonitoringScheduleArn_
      }

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

-- | The Amazon Resource Name (ARN) of the monitoring schedule.
updateMonitoringScheduleResponse_monitoringScheduleArn :: Lens.Lens' UpdateMonitoringScheduleResponse Prelude.Text
updateMonitoringScheduleResponse_monitoringScheduleArn :: Lens' UpdateMonitoringScheduleResponse Text
updateMonitoringScheduleResponse_monitoringScheduleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateMonitoringScheduleResponse' {Text
monitoringScheduleArn :: Text
$sel:monitoringScheduleArn:UpdateMonitoringScheduleResponse' :: UpdateMonitoringScheduleResponse -> Text
monitoringScheduleArn} -> Text
monitoringScheduleArn) (\s :: UpdateMonitoringScheduleResponse
s@UpdateMonitoringScheduleResponse' {} Text
a -> UpdateMonitoringScheduleResponse
s {$sel:monitoringScheduleArn:UpdateMonitoringScheduleResponse' :: Text
monitoringScheduleArn = Text
a} :: UpdateMonitoringScheduleResponse)

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