{-# 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.RegisterDevices
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Register devices.
module Amazonka.SageMaker.RegisterDevices
  ( -- * Creating a Request
    RegisterDevices (..),
    newRegisterDevices,

    -- * Request Lenses
    registerDevices_tags,
    registerDevices_deviceFleetName,
    registerDevices_devices,

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

-- |
-- Create a value of 'RegisterDevices' 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:
--
-- 'tags', 'registerDevices_tags' - The tags associated with devices.
--
-- 'deviceFleetName', 'registerDevices_deviceFleetName' - The name of the fleet.
--
-- 'devices', 'registerDevices_devices' - A list of devices to register with SageMaker Edge Manager.
newRegisterDevices ::
  -- | 'deviceFleetName'
  Prelude.Text ->
  RegisterDevices
newRegisterDevices :: Text -> RegisterDevices
newRegisterDevices Text
pDeviceFleetName_ =
  RegisterDevices'
    { $sel:tags:RegisterDevices' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceFleetName:RegisterDevices' :: Text
deviceFleetName = Text
pDeviceFleetName_,
      $sel:devices:RegisterDevices' :: [Device]
devices = forall a. Monoid a => a
Prelude.mempty
    }

-- | The tags associated with devices.
registerDevices_tags :: Lens.Lens' RegisterDevices (Prelude.Maybe [Tag])
registerDevices_tags :: Lens' RegisterDevices (Maybe [Tag])
registerDevices_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDevices' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:RegisterDevices' :: RegisterDevices -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: RegisterDevices
s@RegisterDevices' {} Maybe [Tag]
a -> RegisterDevices
s {$sel:tags:RegisterDevices' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: RegisterDevices) 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 fleet.
registerDevices_deviceFleetName :: Lens.Lens' RegisterDevices Prelude.Text
registerDevices_deviceFleetName :: Lens' RegisterDevices Text
registerDevices_deviceFleetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDevices' {Text
deviceFleetName :: Text
$sel:deviceFleetName:RegisterDevices' :: RegisterDevices -> Text
deviceFleetName} -> Text
deviceFleetName) (\s :: RegisterDevices
s@RegisterDevices' {} Text
a -> RegisterDevices
s {$sel:deviceFleetName:RegisterDevices' :: Text
deviceFleetName = Text
a} :: RegisterDevices)

-- | A list of devices to register with SageMaker Edge Manager.
registerDevices_devices :: Lens.Lens' RegisterDevices [Device]
registerDevices_devices :: Lens' RegisterDevices [Device]
registerDevices_devices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RegisterDevices' {[Device]
devices :: [Device]
$sel:devices:RegisterDevices' :: RegisterDevices -> [Device]
devices} -> [Device]
devices) (\s :: RegisterDevices
s@RegisterDevices' {} [Device]
a -> RegisterDevices
s {$sel:devices:RegisterDevices' :: [Device]
devices = [Device]
a} :: RegisterDevices) 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 RegisterDevices where
  type
    AWSResponse RegisterDevices =
      RegisterDevicesResponse
  request :: (Service -> Service) -> RegisterDevices -> Request RegisterDevices
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 RegisterDevices
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RegisterDevices)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RegisterDevicesResponse
RegisterDevicesResponse'

instance Prelude.Hashable RegisterDevices where
  hashWithSalt :: Int -> RegisterDevices -> Int
hashWithSalt Int
_salt RegisterDevices' {[Device]
Maybe [Tag]
Text
devices :: [Device]
deviceFleetName :: Text
tags :: Maybe [Tag]
$sel:devices:RegisterDevices' :: RegisterDevices -> [Device]
$sel:deviceFleetName:RegisterDevices' :: RegisterDevices -> Text
$sel:tags:RegisterDevices' :: RegisterDevices -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      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 RegisterDevices where
  rnf :: RegisterDevices -> ()
rnf RegisterDevices' {[Device]
Maybe [Tag]
Text
devices :: [Device]
deviceFleetName :: Text
tags :: Maybe [Tag]
$sel:devices:RegisterDevices' :: RegisterDevices -> [Device]
$sel:deviceFleetName:RegisterDevices' :: RegisterDevices -> Text
$sel:tags:RegisterDevices' :: RegisterDevices -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 RegisterDevices where
  toHeaders :: RegisterDevices -> [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.RegisterDevices" :: 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 RegisterDevices where
  toJSON :: RegisterDevices -> Value
toJSON RegisterDevices' {[Device]
Maybe [Tag]
Text
devices :: [Device]
deviceFleetName :: Text
tags :: Maybe [Tag]
$sel:devices:RegisterDevices' :: RegisterDevices -> [Device]
$sel:deviceFleetName:RegisterDevices' :: RegisterDevices -> Text
$sel:tags:RegisterDevices' :: RegisterDevices -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Tags" 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 [Tag]
tags,
            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 RegisterDevices where
  toPath :: RegisterDevices -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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