{-# 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.UpdateCoreDefinition
-- 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 core definition.
module Amazonka.Greengrass.UpdateCoreDefinition
  ( -- * Creating a Request
    UpdateCoreDefinition (..),
    newUpdateCoreDefinition,

    -- * Request Lenses
    updateCoreDefinition_name,
    updateCoreDefinition_coreDefinitionId,

    -- * Destructuring the Response
    UpdateCoreDefinitionResponse (..),
    newUpdateCoreDefinitionResponse,

    -- * Response Lenses
    updateCoreDefinitionResponse_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:/ 'newUpdateCoreDefinition' smart constructor.
data UpdateCoreDefinition = UpdateCoreDefinition'
  { -- | The name of the definition.
    UpdateCoreDefinition -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The ID of the core definition.
    UpdateCoreDefinition -> Text
coreDefinitionId :: Prelude.Text
  }
  deriving (UpdateCoreDefinition -> UpdateCoreDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateCoreDefinition -> UpdateCoreDefinition -> Bool
$c/= :: UpdateCoreDefinition -> UpdateCoreDefinition -> Bool
== :: UpdateCoreDefinition -> UpdateCoreDefinition -> Bool
$c== :: UpdateCoreDefinition -> UpdateCoreDefinition -> Bool
Prelude.Eq, ReadPrec [UpdateCoreDefinition]
ReadPrec UpdateCoreDefinition
Int -> ReadS UpdateCoreDefinition
ReadS [UpdateCoreDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateCoreDefinition]
$creadListPrec :: ReadPrec [UpdateCoreDefinition]
readPrec :: ReadPrec UpdateCoreDefinition
$creadPrec :: ReadPrec UpdateCoreDefinition
readList :: ReadS [UpdateCoreDefinition]
$creadList :: ReadS [UpdateCoreDefinition]
readsPrec :: Int -> ReadS UpdateCoreDefinition
$creadsPrec :: Int -> ReadS UpdateCoreDefinition
Prelude.Read, Int -> UpdateCoreDefinition -> ShowS
[UpdateCoreDefinition] -> ShowS
UpdateCoreDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateCoreDefinition] -> ShowS
$cshowList :: [UpdateCoreDefinition] -> ShowS
show :: UpdateCoreDefinition -> String
$cshow :: UpdateCoreDefinition -> String
showsPrec :: Int -> UpdateCoreDefinition -> ShowS
$cshowsPrec :: Int -> UpdateCoreDefinition -> ShowS
Prelude.Show, forall x. Rep UpdateCoreDefinition x -> UpdateCoreDefinition
forall x. UpdateCoreDefinition -> Rep UpdateCoreDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateCoreDefinition x -> UpdateCoreDefinition
$cfrom :: forall x. UpdateCoreDefinition -> Rep UpdateCoreDefinition x
Prelude.Generic)

-- |
-- Create a value of 'UpdateCoreDefinition' 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:
--
-- 'name', 'updateCoreDefinition_name' - The name of the definition.
--
-- 'coreDefinitionId', 'updateCoreDefinition_coreDefinitionId' - The ID of the core definition.
newUpdateCoreDefinition ::
  -- | 'coreDefinitionId'
  Prelude.Text ->
  UpdateCoreDefinition
newUpdateCoreDefinition :: Text -> UpdateCoreDefinition
newUpdateCoreDefinition Text
pCoreDefinitionId_ =
  UpdateCoreDefinition'
    { $sel:name:UpdateCoreDefinition' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:coreDefinitionId:UpdateCoreDefinition' :: Text
coreDefinitionId = Text
pCoreDefinitionId_
    }

-- | The name of the definition.
updateCoreDefinition_name :: Lens.Lens' UpdateCoreDefinition (Prelude.Maybe Prelude.Text)
updateCoreDefinition_name :: Lens' UpdateCoreDefinition (Maybe Text)
updateCoreDefinition_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCoreDefinition' {Maybe Text
name :: Maybe Text
$sel:name:UpdateCoreDefinition' :: UpdateCoreDefinition -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateCoreDefinition
s@UpdateCoreDefinition' {} Maybe Text
a -> UpdateCoreDefinition
s {$sel:name:UpdateCoreDefinition' :: Maybe Text
name = Maybe Text
a} :: UpdateCoreDefinition)

-- | The ID of the core definition.
updateCoreDefinition_coreDefinitionId :: Lens.Lens' UpdateCoreDefinition Prelude.Text
updateCoreDefinition_coreDefinitionId :: Lens' UpdateCoreDefinition Text
updateCoreDefinition_coreDefinitionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateCoreDefinition' {Text
coreDefinitionId :: Text
$sel:coreDefinitionId:UpdateCoreDefinition' :: UpdateCoreDefinition -> Text
coreDefinitionId} -> Text
coreDefinitionId) (\s :: UpdateCoreDefinition
s@UpdateCoreDefinition' {} Text
a -> UpdateCoreDefinition
s {$sel:coreDefinitionId:UpdateCoreDefinition' :: Text
coreDefinitionId = Text
a} :: UpdateCoreDefinition)

instance Core.AWSRequest UpdateCoreDefinition where
  type
    AWSResponse UpdateCoreDefinition =
      UpdateCoreDefinitionResponse
  request :: (Service -> Service)
-> UpdateCoreDefinition -> Request UpdateCoreDefinition
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 UpdateCoreDefinition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateCoreDefinition)))
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 -> UpdateCoreDefinitionResponse
UpdateCoreDefinitionResponse'
            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 UpdateCoreDefinition where
  hashWithSalt :: Int -> UpdateCoreDefinition -> Int
hashWithSalt Int
_salt UpdateCoreDefinition' {Maybe Text
Text
coreDefinitionId :: Text
name :: Maybe Text
$sel:coreDefinitionId:UpdateCoreDefinition' :: UpdateCoreDefinition -> Text
$sel:name:UpdateCoreDefinition' :: UpdateCoreDefinition -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
coreDefinitionId

instance Prelude.NFData UpdateCoreDefinition where
  rnf :: UpdateCoreDefinition -> ()
rnf UpdateCoreDefinition' {Maybe Text
Text
coreDefinitionId :: Text
name :: Maybe Text
$sel:coreDefinitionId:UpdateCoreDefinition' :: UpdateCoreDefinition -> Text
$sel:name:UpdateCoreDefinition' :: UpdateCoreDefinition -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
coreDefinitionId

instance Data.ToHeaders UpdateCoreDefinition where
  toHeaders :: UpdateCoreDefinition -> 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 UpdateCoreDefinition where
  toJSON :: UpdateCoreDefinition -> Value
toJSON UpdateCoreDefinition' {Maybe Text
Text
coreDefinitionId :: Text
name :: Maybe Text
$sel:coreDefinitionId:UpdateCoreDefinition' :: UpdateCoreDefinition -> Text
$sel:name:UpdateCoreDefinition' :: UpdateCoreDefinition -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"Name" 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 Text
name]
      )

instance Data.ToPath UpdateCoreDefinition where
  toPath :: UpdateCoreDefinition -> ByteString
toPath UpdateCoreDefinition' {Maybe Text
Text
coreDefinitionId :: Text
name :: Maybe Text
$sel:coreDefinitionId:UpdateCoreDefinition' :: UpdateCoreDefinition -> Text
$sel:name:UpdateCoreDefinition' :: UpdateCoreDefinition -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/greengrass/definition/cores/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
coreDefinitionId
      ]

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

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

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

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

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