{-# 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.Greengrass.UpdateThingRuntimeConfiguration
-- 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 runtime configuration of a thing.
module Amazonka.Greengrass.UpdateThingRuntimeConfiguration
  ( -- * Creating a Request
    UpdateThingRuntimeConfiguration (..),
    newUpdateThingRuntimeConfiguration,

    -- * Request Lenses
    updateThingRuntimeConfiguration_telemetryConfiguration,
    updateThingRuntimeConfiguration_thingName,

    -- * Destructuring the Response
    UpdateThingRuntimeConfigurationResponse (..),
    newUpdateThingRuntimeConfigurationResponse,

    -- * Response Lenses
    updateThingRuntimeConfigurationResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Greengrass.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateThingRuntimeConfiguration' smart constructor.
data UpdateThingRuntimeConfiguration = UpdateThingRuntimeConfiguration'
  { -- | Configuration for telemetry service.
    UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
telemetryConfiguration :: Prelude.Maybe TelemetryConfigurationUpdate,
    -- | The thing name.
    UpdateThingRuntimeConfiguration -> Text
thingName :: Prelude.Text
  }
  deriving (UpdateThingRuntimeConfiguration
-> UpdateThingRuntimeConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateThingRuntimeConfiguration
-> UpdateThingRuntimeConfiguration -> Bool
$c/= :: UpdateThingRuntimeConfiguration
-> UpdateThingRuntimeConfiguration -> Bool
== :: UpdateThingRuntimeConfiguration
-> UpdateThingRuntimeConfiguration -> Bool
$c== :: UpdateThingRuntimeConfiguration
-> UpdateThingRuntimeConfiguration -> Bool
Prelude.Eq, ReadPrec [UpdateThingRuntimeConfiguration]
ReadPrec UpdateThingRuntimeConfiguration
Int -> ReadS UpdateThingRuntimeConfiguration
ReadS [UpdateThingRuntimeConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateThingRuntimeConfiguration]
$creadListPrec :: ReadPrec [UpdateThingRuntimeConfiguration]
readPrec :: ReadPrec UpdateThingRuntimeConfiguration
$creadPrec :: ReadPrec UpdateThingRuntimeConfiguration
readList :: ReadS [UpdateThingRuntimeConfiguration]
$creadList :: ReadS [UpdateThingRuntimeConfiguration]
readsPrec :: Int -> ReadS UpdateThingRuntimeConfiguration
$creadsPrec :: Int -> ReadS UpdateThingRuntimeConfiguration
Prelude.Read, Int -> UpdateThingRuntimeConfiguration -> ShowS
[UpdateThingRuntimeConfiguration] -> ShowS
UpdateThingRuntimeConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateThingRuntimeConfiguration] -> ShowS
$cshowList :: [UpdateThingRuntimeConfiguration] -> ShowS
show :: UpdateThingRuntimeConfiguration -> String
$cshow :: UpdateThingRuntimeConfiguration -> String
showsPrec :: Int -> UpdateThingRuntimeConfiguration -> ShowS
$cshowsPrec :: Int -> UpdateThingRuntimeConfiguration -> ShowS
Prelude.Show, forall x.
Rep UpdateThingRuntimeConfiguration x
-> UpdateThingRuntimeConfiguration
forall x.
UpdateThingRuntimeConfiguration
-> Rep UpdateThingRuntimeConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateThingRuntimeConfiguration x
-> UpdateThingRuntimeConfiguration
$cfrom :: forall x.
UpdateThingRuntimeConfiguration
-> Rep UpdateThingRuntimeConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateThingRuntimeConfiguration' 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:
--
-- 'telemetryConfiguration', 'updateThingRuntimeConfiguration_telemetryConfiguration' - Configuration for telemetry service.
--
-- 'thingName', 'updateThingRuntimeConfiguration_thingName' - The thing name.
newUpdateThingRuntimeConfiguration ::
  -- | 'thingName'
  Prelude.Text ->
  UpdateThingRuntimeConfiguration
newUpdateThingRuntimeConfiguration :: Text -> UpdateThingRuntimeConfiguration
newUpdateThingRuntimeConfiguration Text
pThingName_ =
  UpdateThingRuntimeConfiguration'
    { $sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: Maybe TelemetryConfigurationUpdate
telemetryConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:thingName:UpdateThingRuntimeConfiguration' :: Text
thingName = Text
pThingName_
    }

-- | Configuration for telemetry service.
updateThingRuntimeConfiguration_telemetryConfiguration :: Lens.Lens' UpdateThingRuntimeConfiguration (Prelude.Maybe TelemetryConfigurationUpdate)
updateThingRuntimeConfiguration_telemetryConfiguration :: Lens'
  UpdateThingRuntimeConfiguration
  (Maybe TelemetryConfigurationUpdate)
updateThingRuntimeConfiguration_telemetryConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingRuntimeConfiguration' {Maybe TelemetryConfigurationUpdate
telemetryConfiguration :: Maybe TelemetryConfigurationUpdate
$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
telemetryConfiguration} -> Maybe TelemetryConfigurationUpdate
telemetryConfiguration) (\s :: UpdateThingRuntimeConfiguration
s@UpdateThingRuntimeConfiguration' {} Maybe TelemetryConfigurationUpdate
a -> UpdateThingRuntimeConfiguration
s {$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: Maybe TelemetryConfigurationUpdate
telemetryConfiguration = Maybe TelemetryConfigurationUpdate
a} :: UpdateThingRuntimeConfiguration)

-- | The thing name.
updateThingRuntimeConfiguration_thingName :: Lens.Lens' UpdateThingRuntimeConfiguration Prelude.Text
updateThingRuntimeConfiguration_thingName :: Lens' UpdateThingRuntimeConfiguration Text
updateThingRuntimeConfiguration_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateThingRuntimeConfiguration' {Text
thingName :: Text
$sel:thingName:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration -> Text
thingName} -> Text
thingName) (\s :: UpdateThingRuntimeConfiguration
s@UpdateThingRuntimeConfiguration' {} Text
a -> UpdateThingRuntimeConfiguration
s {$sel:thingName:UpdateThingRuntimeConfiguration' :: Text
thingName = Text
a} :: UpdateThingRuntimeConfiguration)

instance
  Core.AWSRequest
    UpdateThingRuntimeConfiguration
  where
  type
    AWSResponse UpdateThingRuntimeConfiguration =
      UpdateThingRuntimeConfigurationResponse
  request :: (Service -> Service)
-> UpdateThingRuntimeConfiguration
-> Request UpdateThingRuntimeConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateThingRuntimeConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse UpdateThingRuntimeConfiguration)))
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 -> UpdateThingRuntimeConfigurationResponse
UpdateThingRuntimeConfigurationResponse'
            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
    UpdateThingRuntimeConfiguration
  where
  hashWithSalt :: Int -> UpdateThingRuntimeConfiguration -> Int
hashWithSalt
    Int
_salt
    UpdateThingRuntimeConfiguration' {Maybe TelemetryConfigurationUpdate
Text
thingName :: Text
telemetryConfiguration :: Maybe TelemetryConfigurationUpdate
$sel:thingName:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration -> Text
$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TelemetryConfigurationUpdate
telemetryConfiguration
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName

instance
  Prelude.NFData
    UpdateThingRuntimeConfiguration
  where
  rnf :: UpdateThingRuntimeConfiguration -> ()
rnf UpdateThingRuntimeConfiguration' {Maybe TelemetryConfigurationUpdate
Text
thingName :: Text
telemetryConfiguration :: Maybe TelemetryConfigurationUpdate
$sel:thingName:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration -> Text
$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe TelemetryConfigurationUpdate
telemetryConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingName

instance
  Data.ToHeaders
    UpdateThingRuntimeConfiguration
  where
  toHeaders :: UpdateThingRuntimeConfiguration -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateThingRuntimeConfiguration where
  toJSON :: UpdateThingRuntimeConfiguration -> Value
toJSON UpdateThingRuntimeConfiguration' {Maybe TelemetryConfigurationUpdate
Text
thingName :: Text
telemetryConfiguration :: Maybe TelemetryConfigurationUpdate
$sel:thingName:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration -> Text
$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"TelemetryConfiguration" 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 TelemetryConfigurationUpdate
telemetryConfiguration
          ]
      )

instance Data.ToPath UpdateThingRuntimeConfiguration where
  toPath :: UpdateThingRuntimeConfiguration -> ByteString
toPath UpdateThingRuntimeConfiguration' {Maybe TelemetryConfigurationUpdate
Text
thingName :: Text
telemetryConfiguration :: Maybe TelemetryConfigurationUpdate
$sel:thingName:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration -> Text
$sel:telemetryConfiguration:UpdateThingRuntimeConfiguration' :: UpdateThingRuntimeConfiguration
-> Maybe TelemetryConfigurationUpdate
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/greengrass/things/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
thingName,
        ByteString
"/runtimeconfig"
      ]

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

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

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

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

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