{-# 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.UpdateDevices
-- 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 one or more devices in a fleet.
module Amazonka.SageMaker.UpdateDevices
  ( -- * Creating a Request
    UpdateDevices (..),
    newUpdateDevices,

    -- * Request Lenses
    updateDevices_deviceFleetName,
    updateDevices_devices,

    -- * Destructuring the Response
    UpdateDevicesResponse (..),
    newUpdateDevicesResponse,
  )
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:/ 'newUpdateDevices' smart constructor.
data UpdateDevices = UpdateDevices'
  { -- | The name of the fleet the devices belong to.
    UpdateDevices -> Text
deviceFleetName :: Prelude.Text,
    -- | List of devices to register with Edge Manager agent.
    UpdateDevices -> [Device]
devices :: [Device]
  }
  deriving (UpdateDevices -> UpdateDevices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDevices -> UpdateDevices -> Bool
$c/= :: UpdateDevices -> UpdateDevices -> Bool
== :: UpdateDevices -> UpdateDevices -> Bool
$c== :: UpdateDevices -> UpdateDevices -> Bool
Prelude.Eq, ReadPrec [UpdateDevices]
ReadPrec UpdateDevices
Int -> ReadS UpdateDevices
ReadS [UpdateDevices]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDevices]
$creadListPrec :: ReadPrec [UpdateDevices]
readPrec :: ReadPrec UpdateDevices
$creadPrec :: ReadPrec UpdateDevices
readList :: ReadS [UpdateDevices]
$creadList :: ReadS [UpdateDevices]
readsPrec :: Int -> ReadS UpdateDevices
$creadsPrec :: Int -> ReadS UpdateDevices
Prelude.Read, Int -> UpdateDevices -> ShowS
[UpdateDevices] -> ShowS
UpdateDevices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDevices] -> ShowS
$cshowList :: [UpdateDevices] -> ShowS
show :: UpdateDevices -> String
$cshow :: UpdateDevices -> String
showsPrec :: Int -> UpdateDevices -> ShowS
$cshowsPrec :: Int -> UpdateDevices -> ShowS
Prelude.Show, forall x. Rep UpdateDevices x -> UpdateDevices
forall x. UpdateDevices -> Rep UpdateDevices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDevices x -> UpdateDevices
$cfrom :: forall x. UpdateDevices -> Rep UpdateDevices x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDevices' 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:
--
-- 'deviceFleetName', 'updateDevices_deviceFleetName' - The name of the fleet the devices belong to.
--
-- 'devices', 'updateDevices_devices' - List of devices to register with Edge Manager agent.
newUpdateDevices ::
  -- | 'deviceFleetName'
  Prelude.Text ->
  UpdateDevices
newUpdateDevices :: Text -> UpdateDevices
newUpdateDevices Text
pDeviceFleetName_ =
  UpdateDevices'
    { $sel:deviceFleetName:UpdateDevices' :: Text
deviceFleetName = Text
pDeviceFleetName_,
      $sel:devices:UpdateDevices' :: [Device]
devices = forall a. Monoid a => a
Prelude.mempty
    }

-- | The name of the fleet the devices belong to.
updateDevices_deviceFleetName :: Lens.Lens' UpdateDevices Prelude.Text
updateDevices_deviceFleetName :: Lens' UpdateDevices Text
updateDevices_deviceFleetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevices' {Text
deviceFleetName :: Text
$sel:deviceFleetName:UpdateDevices' :: UpdateDevices -> Text
deviceFleetName} -> Text
deviceFleetName) (\s :: UpdateDevices
s@UpdateDevices' {} Text
a -> UpdateDevices
s {$sel:deviceFleetName:UpdateDevices' :: Text
deviceFleetName = Text
a} :: UpdateDevices)

-- | List of devices to register with Edge Manager agent.
updateDevices_devices :: Lens.Lens' UpdateDevices [Device]
updateDevices_devices :: Lens' UpdateDevices [Device]
updateDevices_devices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDevices' {[Device]
devices :: [Device]
$sel:devices:UpdateDevices' :: UpdateDevices -> [Device]
devices} -> [Device]
devices) (\s :: UpdateDevices
s@UpdateDevices' {} [Device]
a -> UpdateDevices
s {$sel:devices:UpdateDevices' :: [Device]
devices = [Device]
a} :: UpdateDevices) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest UpdateDevices where
  type
    AWSResponse UpdateDevices =
      UpdateDevicesResponse
  request :: (Service -> Service) -> UpdateDevices -> Request UpdateDevices
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 UpdateDevices
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDevices)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateDevicesResponse
UpdateDevicesResponse'

instance Prelude.Hashable UpdateDevices where
  hashWithSalt :: Int -> UpdateDevices -> Int
hashWithSalt Int
_salt UpdateDevices' {[Device]
Text
devices :: [Device]
deviceFleetName :: Text
$sel:devices:UpdateDevices' :: UpdateDevices -> [Device]
$sel:deviceFleetName:UpdateDevices' :: UpdateDevices -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceFleetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Device]
devices

instance Prelude.NFData UpdateDevices where
  rnf :: UpdateDevices -> ()
rnf UpdateDevices' {[Device]
Text
devices :: [Device]
deviceFleetName :: Text
$sel:devices:UpdateDevices' :: UpdateDevices -> [Device]
$sel:deviceFleetName:UpdateDevices' :: UpdateDevices -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
deviceFleetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Device]
devices

instance Data.ToHeaders UpdateDevices where
  toHeaders :: UpdateDevices -> [Header]
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 -> [Header]
Data.=# (ByteString
"SageMaker.UpdateDevices" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDevices where
  toJSON :: UpdateDevices -> Value
toJSON UpdateDevices' {[Device]
Text
devices :: [Device]
deviceFleetName :: Text
$sel:devices:UpdateDevices' :: UpdateDevices -> [Device]
$sel:deviceFleetName:UpdateDevices' :: UpdateDevices -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"DeviceFleetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
deviceFleetName),
            forall a. a -> Maybe a
Prelude.Just (Key
"Devices" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Device]
devices)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateDevicesResponse' 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.
newUpdateDevicesResponse ::
  UpdateDevicesResponse
newUpdateDevicesResponse :: UpdateDevicesResponse
newUpdateDevicesResponse = UpdateDevicesResponse
UpdateDevicesResponse'

instance Prelude.NFData UpdateDevicesResponse where
  rnf :: UpdateDevicesResponse -> ()
rnf UpdateDevicesResponse
_ = ()