{-# 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.CloudWatchLogs.PutDestination
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates a destination. This operation is used only to create
-- destinations for cross-account subscriptions.
--
-- A destination encapsulates a physical resource (such as an Amazon
-- Kinesis stream). With a destination, you can subscribe to a real-time
-- stream of log events for a different account, ingested using
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_PutLogEvents.html PutLogEvents>.
--
-- Through an access policy, a destination controls what is written to it.
-- By default, @PutDestination@ does not set any access policy with the
-- destination, which means a cross-account user cannot call
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_PutSubscriptionFilter.html PutSubscriptionFilter>
-- against this destination. To enable this, the destination owner must
-- call
-- <https://docs.aws.amazon.com/AmazonCloudWatchLogs/latest/APIReference/API_PutDestinationPolicy.html PutDestinationPolicy>
-- after @PutDestination@.
--
-- To perform a @PutDestination@ operation, you must also have the
-- @iam:PassRole@ permission.
module Amazonka.CloudWatchLogs.PutDestination
  ( -- * Creating a Request
    PutDestination (..),
    newPutDestination,

    -- * Request Lenses
    putDestination_tags,
    putDestination_destinationName,
    putDestination_targetArn,
    putDestination_roleArn,

    -- * Destructuring the Response
    PutDestinationResponse (..),
    newPutDestinationResponse,

    -- * Response Lenses
    putDestinationResponse_destination,
    putDestinationResponse_httpStatus,
  )
where

import Amazonka.CloudWatchLogs.Types
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

-- | /See:/ 'newPutDestination' smart constructor.
data PutDestination = PutDestination'
  { -- | An optional list of key-value pairs to associate with the resource.
    --
    -- For more information about tagging, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
    PutDestination -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the destination.
    PutDestination -> Text
destinationName :: Prelude.Text,
    -- | The ARN of an Amazon Kinesis stream to which to deliver matching log
    -- events.
    PutDestination -> Text
targetArn :: Prelude.Text,
    -- | The ARN of an IAM role that grants CloudWatch Logs permissions to call
    -- the Amazon Kinesis @PutRecord@ operation on the destination stream.
    PutDestination -> Text
roleArn :: Prelude.Text
  }
  deriving (PutDestination -> PutDestination -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutDestination -> PutDestination -> Bool
$c/= :: PutDestination -> PutDestination -> Bool
== :: PutDestination -> PutDestination -> Bool
$c== :: PutDestination -> PutDestination -> Bool
Prelude.Eq, ReadPrec [PutDestination]
ReadPrec PutDestination
Int -> ReadS PutDestination
ReadS [PutDestination]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutDestination]
$creadListPrec :: ReadPrec [PutDestination]
readPrec :: ReadPrec PutDestination
$creadPrec :: ReadPrec PutDestination
readList :: ReadS [PutDestination]
$creadList :: ReadS [PutDestination]
readsPrec :: Int -> ReadS PutDestination
$creadsPrec :: Int -> ReadS PutDestination
Prelude.Read, Int -> PutDestination -> ShowS
[PutDestination] -> ShowS
PutDestination -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutDestination] -> ShowS
$cshowList :: [PutDestination] -> ShowS
show :: PutDestination -> String
$cshow :: PutDestination -> String
showsPrec :: Int -> PutDestination -> ShowS
$cshowsPrec :: Int -> PutDestination -> ShowS
Prelude.Show, forall x. Rep PutDestination x -> PutDestination
forall x. PutDestination -> Rep PutDestination x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutDestination x -> PutDestination
$cfrom :: forall x. PutDestination -> Rep PutDestination x
Prelude.Generic)

-- |
-- Create a value of 'PutDestination' 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', 'putDestination_tags' - An optional list of key-value pairs to associate with the resource.
--
-- For more information about tagging, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
--
-- 'destinationName', 'putDestination_destinationName' - A name for the destination.
--
-- 'targetArn', 'putDestination_targetArn' - The ARN of an Amazon Kinesis stream to which to deliver matching log
-- events.
--
-- 'roleArn', 'putDestination_roleArn' - The ARN of an IAM role that grants CloudWatch Logs permissions to call
-- the Amazon Kinesis @PutRecord@ operation on the destination stream.
newPutDestination ::
  -- | 'destinationName'
  Prelude.Text ->
  -- | 'targetArn'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  PutDestination
newPutDestination :: Text -> Text -> Text -> PutDestination
newPutDestination
  Text
pDestinationName_
  Text
pTargetArn_
  Text
pRoleArn_ =
    PutDestination'
      { $sel:tags:PutDestination' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationName:PutDestination' :: Text
destinationName = Text
pDestinationName_,
        $sel:targetArn:PutDestination' :: Text
targetArn = Text
pTargetArn_,
        $sel:roleArn:PutDestination' :: Text
roleArn = Text
pRoleArn_
      }

-- | An optional list of key-value pairs to associate with the resource.
--
-- For more information about tagging, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
putDestination_tags :: Lens.Lens' PutDestination (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putDestination_tags :: Lens' PutDestination (Maybe (HashMap Text Text))
putDestination_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDestination' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutDestination' :: PutDestination -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutDestination
s@PutDestination' {} Maybe (HashMap Text Text)
a -> PutDestination
s {$sel:tags:PutDestination' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutDestination) 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

-- | A name for the destination.
putDestination_destinationName :: Lens.Lens' PutDestination Prelude.Text
putDestination_destinationName :: Lens' PutDestination Text
putDestination_destinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDestination' {Text
destinationName :: Text
$sel:destinationName:PutDestination' :: PutDestination -> Text
destinationName} -> Text
destinationName) (\s :: PutDestination
s@PutDestination' {} Text
a -> PutDestination
s {$sel:destinationName:PutDestination' :: Text
destinationName = Text
a} :: PutDestination)

-- | The ARN of an Amazon Kinesis stream to which to deliver matching log
-- events.
putDestination_targetArn :: Lens.Lens' PutDestination Prelude.Text
putDestination_targetArn :: Lens' PutDestination Text
putDestination_targetArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDestination' {Text
targetArn :: Text
$sel:targetArn:PutDestination' :: PutDestination -> Text
targetArn} -> Text
targetArn) (\s :: PutDestination
s@PutDestination' {} Text
a -> PutDestination
s {$sel:targetArn:PutDestination' :: Text
targetArn = Text
a} :: PutDestination)

-- | The ARN of an IAM role that grants CloudWatch Logs permissions to call
-- the Amazon Kinesis @PutRecord@ operation on the destination stream.
putDestination_roleArn :: Lens.Lens' PutDestination Prelude.Text
putDestination_roleArn :: Lens' PutDestination Text
putDestination_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDestination' {Text
roleArn :: Text
$sel:roleArn:PutDestination' :: PutDestination -> Text
roleArn} -> Text
roleArn) (\s :: PutDestination
s@PutDestination' {} Text
a -> PutDestination
s {$sel:roleArn:PutDestination' :: Text
roleArn = Text
a} :: PutDestination)

instance Core.AWSRequest PutDestination where
  type
    AWSResponse PutDestination =
      PutDestinationResponse
  request :: (Service -> Service) -> PutDestination -> Request PutDestination
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 PutDestination
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutDestination)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Destination -> Int -> PutDestinationResponse
PutDestinationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"destination")
            forall (f :: * -> *) a b. Applicative f => 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 PutDestination where
  hashWithSalt :: Int -> PutDestination -> Int
hashWithSalt Int
_salt PutDestination' {Maybe (HashMap Text Text)
Text
roleArn :: Text
targetArn :: Text
destinationName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:PutDestination' :: PutDestination -> Text
$sel:targetArn:PutDestination' :: PutDestination -> Text
$sel:destinationName:PutDestination' :: PutDestination -> Text
$sel:tags:PutDestination' :: PutDestination -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData PutDestination where
  rnf :: PutDestination -> ()
rnf PutDestination' {Maybe (HashMap Text Text)
Text
roleArn :: Text
targetArn :: Text
destinationName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:PutDestination' :: PutDestination -> Text
$sel:targetArn:PutDestination' :: PutDestination -> Text
$sel:destinationName:PutDestination' :: PutDestination -> Text
$sel:tags:PutDestination' :: PutDestination -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

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

instance Data.ToJSON PutDestination where
  toJSON :: PutDestination -> Value
toJSON PutDestination' {Maybe (HashMap Text Text)
Text
roleArn :: Text
targetArn :: Text
destinationName :: Text
tags :: Maybe (HashMap Text Text)
$sel:roleArn:PutDestination' :: PutDestination -> Text
$sel:targetArn:PutDestination' :: PutDestination -> Text
$sel:destinationName:PutDestination' :: PutDestination -> Text
$sel:tags:PutDestination' :: PutDestination -> Maybe (HashMap Text Text)
..} =
    [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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"destinationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationName),
            forall a. a -> Maybe a
Prelude.Just (Key
"targetArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'PutDestinationResponse' 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:
--
-- 'destination', 'putDestinationResponse_destination' - The destination.
--
-- 'httpStatus', 'putDestinationResponse_httpStatus' - The response's http status code.
newPutDestinationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutDestinationResponse
newPutDestinationResponse :: Int -> PutDestinationResponse
newPutDestinationResponse Int
pHttpStatus_ =
  PutDestinationResponse'
    { $sel:destination:PutDestinationResponse' :: Maybe Destination
destination =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutDestinationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The destination.
putDestinationResponse_destination :: Lens.Lens' PutDestinationResponse (Prelude.Maybe Destination)
putDestinationResponse_destination :: Lens' PutDestinationResponse (Maybe Destination)
putDestinationResponse_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutDestinationResponse' {Maybe Destination
destination :: Maybe Destination
$sel:destination:PutDestinationResponse' :: PutDestinationResponse -> Maybe Destination
destination} -> Maybe Destination
destination) (\s :: PutDestinationResponse
s@PutDestinationResponse' {} Maybe Destination
a -> PutDestinationResponse
s {$sel:destination:PutDestinationResponse' :: Maybe Destination
destination = Maybe Destination
a} :: PutDestinationResponse)

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

instance Prelude.NFData PutDestinationResponse where
  rnf :: PutDestinationResponse -> ()
rnf PutDestinationResponse' {Int
Maybe Destination
httpStatus :: Int
destination :: Maybe Destination
$sel:httpStatus:PutDestinationResponse' :: PutDestinationResponse -> Int
$sel:destination:PutDestinationResponse' :: PutDestinationResponse -> Maybe Destination
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Destination
destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus