{-# 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.GuardDuty.UpdatePublishingDestination
-- 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 information about the publishing destination specified by the
-- @destinationId@.
module Amazonka.GuardDuty.UpdatePublishingDestination
  ( -- * Creating a Request
    UpdatePublishingDestination (..),
    newUpdatePublishingDestination,

    -- * Request Lenses
    updatePublishingDestination_destinationProperties,
    updatePublishingDestination_detectorId,
    updatePublishingDestination_destinationId,

    -- * Destructuring the Response
    UpdatePublishingDestinationResponse (..),
    newUpdatePublishingDestinationResponse,

    -- * Response Lenses
    updatePublishingDestinationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdatePublishingDestination' smart constructor.
data UpdatePublishingDestination = UpdatePublishingDestination'
  { -- | A @DestinationProperties@ object that includes the @DestinationArn@ and
    -- @KmsKeyArn@ of the publishing destination.
    UpdatePublishingDestination -> Maybe DestinationProperties
destinationProperties :: Prelude.Maybe DestinationProperties,
    -- | The ID of the detector associated with the publishing destinations to
    -- update.
    UpdatePublishingDestination -> Text
detectorId :: Prelude.Text,
    -- | The ID of the publishing destination to update.
    UpdatePublishingDestination -> Text
destinationId :: Prelude.Text
  }
  deriving (UpdatePublishingDestination -> UpdatePublishingDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePublishingDestination -> UpdatePublishingDestination -> Bool
$c/= :: UpdatePublishingDestination -> UpdatePublishingDestination -> Bool
== :: UpdatePublishingDestination -> UpdatePublishingDestination -> Bool
$c== :: UpdatePublishingDestination -> UpdatePublishingDestination -> Bool
Prelude.Eq, ReadPrec [UpdatePublishingDestination]
ReadPrec UpdatePublishingDestination
Int -> ReadS UpdatePublishingDestination
ReadS [UpdatePublishingDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdatePublishingDestination]
$creadListPrec :: ReadPrec [UpdatePublishingDestination]
readPrec :: ReadPrec UpdatePublishingDestination
$creadPrec :: ReadPrec UpdatePublishingDestination
readList :: ReadS [UpdatePublishingDestination]
$creadList :: ReadS [UpdatePublishingDestination]
readsPrec :: Int -> ReadS UpdatePublishingDestination
$creadsPrec :: Int -> ReadS UpdatePublishingDestination
Prelude.Read, Int -> UpdatePublishingDestination -> ShowS
[UpdatePublishingDestination] -> ShowS
UpdatePublishingDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePublishingDestination] -> ShowS
$cshowList :: [UpdatePublishingDestination] -> ShowS
show :: UpdatePublishingDestination -> String
$cshow :: UpdatePublishingDestination -> String
showsPrec :: Int -> UpdatePublishingDestination -> ShowS
$cshowsPrec :: Int -> UpdatePublishingDestination -> ShowS
Prelude.Show, forall x.
Rep UpdatePublishingDestination x -> UpdatePublishingDestination
forall x.
UpdatePublishingDestination -> Rep UpdatePublishingDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdatePublishingDestination x -> UpdatePublishingDestination
$cfrom :: forall x.
UpdatePublishingDestination -> Rep UpdatePublishingDestination x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePublishingDestination' 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:
--
-- 'destinationProperties', 'updatePublishingDestination_destinationProperties' - A @DestinationProperties@ object that includes the @DestinationArn@ and
-- @KmsKeyArn@ of the publishing destination.
--
-- 'detectorId', 'updatePublishingDestination_detectorId' - The ID of the detector associated with the publishing destinations to
-- update.
--
-- 'destinationId', 'updatePublishingDestination_destinationId' - The ID of the publishing destination to update.
newUpdatePublishingDestination ::
  -- | 'detectorId'
  Prelude.Text ->
  -- | 'destinationId'
  Prelude.Text ->
  UpdatePublishingDestination
newUpdatePublishingDestination :: Text -> Text -> UpdatePublishingDestination
newUpdatePublishingDestination
  Text
pDetectorId_
  Text
pDestinationId_ =
    UpdatePublishingDestination'
      { $sel:destinationProperties:UpdatePublishingDestination' :: Maybe DestinationProperties
destinationProperties =
          forall a. Maybe a
Prelude.Nothing,
        $sel:detectorId:UpdatePublishingDestination' :: Text
detectorId = Text
pDetectorId_,
        $sel:destinationId:UpdatePublishingDestination' :: Text
destinationId = Text
pDestinationId_
      }

-- | A @DestinationProperties@ object that includes the @DestinationArn@ and
-- @KmsKeyArn@ of the publishing destination.
updatePublishingDestination_destinationProperties :: Lens.Lens' UpdatePublishingDestination (Prelude.Maybe DestinationProperties)
updatePublishingDestination_destinationProperties :: Lens' UpdatePublishingDestination (Maybe DestinationProperties)
updatePublishingDestination_destinationProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePublishingDestination' {Maybe DestinationProperties
destinationProperties :: Maybe DestinationProperties
$sel:destinationProperties:UpdatePublishingDestination' :: UpdatePublishingDestination -> Maybe DestinationProperties
destinationProperties} -> Maybe DestinationProperties
destinationProperties) (\s :: UpdatePublishingDestination
s@UpdatePublishingDestination' {} Maybe DestinationProperties
a -> UpdatePublishingDestination
s {$sel:destinationProperties:UpdatePublishingDestination' :: Maybe DestinationProperties
destinationProperties = Maybe DestinationProperties
a} :: UpdatePublishingDestination)

-- | The ID of the detector associated with the publishing destinations to
-- update.
updatePublishingDestination_detectorId :: Lens.Lens' UpdatePublishingDestination Prelude.Text
updatePublishingDestination_detectorId :: Lens' UpdatePublishingDestination Text
updatePublishingDestination_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePublishingDestination' {Text
detectorId :: Text
$sel:detectorId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
detectorId} -> Text
detectorId) (\s :: UpdatePublishingDestination
s@UpdatePublishingDestination' {} Text
a -> UpdatePublishingDestination
s {$sel:detectorId:UpdatePublishingDestination' :: Text
detectorId = Text
a} :: UpdatePublishingDestination)

-- | The ID of the publishing destination to update.
updatePublishingDestination_destinationId :: Lens.Lens' UpdatePublishingDestination Prelude.Text
updatePublishingDestination_destinationId :: Lens' UpdatePublishingDestination Text
updatePublishingDestination_destinationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePublishingDestination' {Text
destinationId :: Text
$sel:destinationId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
destinationId} -> Text
destinationId) (\s :: UpdatePublishingDestination
s@UpdatePublishingDestination' {} Text
a -> UpdatePublishingDestination
s {$sel:destinationId:UpdatePublishingDestination' :: Text
destinationId = Text
a} :: UpdatePublishingDestination)

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

instance Prelude.NFData UpdatePublishingDestination where
  rnf :: UpdatePublishingDestination -> ()
rnf UpdatePublishingDestination' {Maybe DestinationProperties
Text
destinationId :: Text
detectorId :: Text
destinationProperties :: Maybe DestinationProperties
$sel:destinationId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
$sel:detectorId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
$sel:destinationProperties:UpdatePublishingDestination' :: UpdatePublishingDestination -> Maybe DestinationProperties
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DestinationProperties
destinationProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
detectorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationId

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

instance Data.ToPath UpdatePublishingDestination where
  toPath :: UpdatePublishingDestination -> ByteString
toPath UpdatePublishingDestination' {Maybe DestinationProperties
Text
destinationId :: Text
detectorId :: Text
destinationProperties :: Maybe DestinationProperties
$sel:destinationId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
$sel:detectorId:UpdatePublishingDestination' :: UpdatePublishingDestination -> Text
$sel:destinationProperties:UpdatePublishingDestination' :: UpdatePublishingDestination -> Maybe DestinationProperties
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/detector/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId,
        ByteString
"/publishingDestination/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
destinationId
      ]

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

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

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

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

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