{-# 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.OAM.CreateSink
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this to create a /sink/ in the current account, so that it can be
-- used as a monitoring account in CloudWatch cross-account observability.
-- A sink is a resource that represents an attachment point in a monitoring
-- account. Source accounts can link to the sink to send observability
-- data.
--
-- After you create a sink, you must create a sink policy that allows
-- source accounts to attach to it. For more information, see
-- <https://docs.aws.amazon.com/OAM/latest/APIReference/API_PutSinkPolicy.html PutSinkPolicy>.
--
-- Each account can contain one sink. If you delete a sink, you can then
-- create a new one in that account.
module Amazonka.OAM.CreateSink
  ( -- * Creating a Request
    CreateSink (..),
    newCreateSink,

    -- * Request Lenses
    createSink_tags,
    createSink_name,

    -- * Destructuring the Response
    CreateSinkResponse (..),
    newCreateSinkResponse,

    -- * Response Lenses
    createSinkResponse_arn,
    createSinkResponse_id,
    createSinkResponse_name,
    createSinkResponse_tags,
    createSinkResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateSink' smart constructor.
data CreateSink = CreateSink'
  { -- | Assigns one or more tags (key-value pairs) to the link.
    --
    -- Tags can help you organize and categorize your resources. You can also
    -- use them to scope user permissions by granting a user permission to
    -- access or change only resources with certain tag values.
    --
    -- For more information about using tags to control access, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_tags.html Controlling access to Amazon Web Services resources using tags>.
    CreateSink -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the sink.
    CreateSink -> Text
name :: Prelude.Text
  }
  deriving (CreateSink -> CreateSink -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSink -> CreateSink -> Bool
$c/= :: CreateSink -> CreateSink -> Bool
== :: CreateSink -> CreateSink -> Bool
$c== :: CreateSink -> CreateSink -> Bool
Prelude.Eq, ReadPrec [CreateSink]
ReadPrec CreateSink
Int -> ReadS CreateSink
ReadS [CreateSink]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSink]
$creadListPrec :: ReadPrec [CreateSink]
readPrec :: ReadPrec CreateSink
$creadPrec :: ReadPrec CreateSink
readList :: ReadS [CreateSink]
$creadList :: ReadS [CreateSink]
readsPrec :: Int -> ReadS CreateSink
$creadsPrec :: Int -> ReadS CreateSink
Prelude.Read, Int -> CreateSink -> ShowS
[CreateSink] -> ShowS
CreateSink -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSink] -> ShowS
$cshowList :: [CreateSink] -> ShowS
show :: CreateSink -> String
$cshow :: CreateSink -> String
showsPrec :: Int -> CreateSink -> ShowS
$cshowsPrec :: Int -> CreateSink -> ShowS
Prelude.Show, forall x. Rep CreateSink x -> CreateSink
forall x. CreateSink -> Rep CreateSink x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSink x -> CreateSink
$cfrom :: forall x. CreateSink -> Rep CreateSink x
Prelude.Generic)

-- |
-- Create a value of 'CreateSink' 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', 'createSink_tags' - Assigns one or more tags (key-value pairs) to the link.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- For more information about using tags to control access, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_tags.html Controlling access to Amazon Web Services resources using tags>.
--
-- 'name', 'createSink_name' - A name for the sink.
newCreateSink ::
  -- | 'name'
  Prelude.Text ->
  CreateSink
newCreateSink :: Text -> CreateSink
newCreateSink Text
pName_ =
  CreateSink' {$sel:tags:CreateSink' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing, $sel:name:CreateSink' :: Text
name = Text
pName_}

-- | Assigns one or more tags (key-value pairs) to the link.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- For more information about using tags to control access, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_tags.html Controlling access to Amazon Web Services resources using tags>.
createSink_tags :: Lens.Lens' CreateSink (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSink_tags :: Lens' CreateSink (Maybe (HashMap Text Text))
createSink_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSink' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSink' :: CreateSink -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSink
s@CreateSink' {} Maybe (HashMap Text Text)
a -> CreateSink
s {$sel:tags:CreateSink' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSink) 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 sink.
createSink_name :: Lens.Lens' CreateSink Prelude.Text
createSink_name :: Lens' CreateSink Text
createSink_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSink' {Text
name :: Text
$sel:name:CreateSink' :: CreateSink -> Text
name} -> Text
name) (\s :: CreateSink
s@CreateSink' {} Text
a -> CreateSink
s {$sel:name:CreateSink' :: Text
name = Text
a} :: CreateSink)

instance Core.AWSRequest CreateSink where
  type AWSResponse CreateSink = CreateSinkResponse
  request :: (Service -> Service) -> CreateSink -> Request CreateSink
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 CreateSink
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateSink)))
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 Text
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> CreateSinkResponse
CreateSinkResponse'
            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
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 CreateSink where
  hashWithSalt :: Int -> CreateSink -> Int
hashWithSalt Int
_salt CreateSink' {Maybe (HashMap Text Text)
Text
name :: Text
tags :: Maybe (HashMap Text Text)
$sel:name:CreateSink' :: CreateSink -> Text
$sel:tags:CreateSink' :: CreateSink -> 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
name

instance Prelude.NFData CreateSink where
  rnf :: CreateSink -> ()
rnf CreateSink' {Maybe (HashMap Text Text)
Text
name :: Text
tags :: Maybe (HashMap Text Text)
$sel:name:CreateSink' :: CreateSink -> Text
$sel:tags:CreateSink' :: CreateSink -> 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
name

instance Data.ToHeaders CreateSink where
  toHeaders :: CreateSink -> 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 CreateSink where
  toJSON :: CreateSink -> Value
toJSON CreateSink' {Maybe (HashMap Text Text)
Text
name :: Text
tags :: Maybe (HashMap Text Text)
$sel:name:CreateSink' :: CreateSink -> Text
$sel:tags:CreateSink' :: CreateSink -> 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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

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

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

-- | /See:/ 'newCreateSinkResponse' smart constructor.
data CreateSinkResponse = CreateSinkResponse'
  { -- | The ARN of the sink that is newly created.
    CreateSinkResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The random ID string that Amazon Web Services generated as part of the
    -- sink ARN.
    CreateSinkResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The name of the sink.
    CreateSinkResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The tags assigned to the sink.
    CreateSinkResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    CreateSinkResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSinkResponse -> CreateSinkResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSinkResponse -> CreateSinkResponse -> Bool
$c/= :: CreateSinkResponse -> CreateSinkResponse -> Bool
== :: CreateSinkResponse -> CreateSinkResponse -> Bool
$c== :: CreateSinkResponse -> CreateSinkResponse -> Bool
Prelude.Eq, ReadPrec [CreateSinkResponse]
ReadPrec CreateSinkResponse
Int -> ReadS CreateSinkResponse
ReadS [CreateSinkResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSinkResponse]
$creadListPrec :: ReadPrec [CreateSinkResponse]
readPrec :: ReadPrec CreateSinkResponse
$creadPrec :: ReadPrec CreateSinkResponse
readList :: ReadS [CreateSinkResponse]
$creadList :: ReadS [CreateSinkResponse]
readsPrec :: Int -> ReadS CreateSinkResponse
$creadsPrec :: Int -> ReadS CreateSinkResponse
Prelude.Read, Int -> CreateSinkResponse -> ShowS
[CreateSinkResponse] -> ShowS
CreateSinkResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSinkResponse] -> ShowS
$cshowList :: [CreateSinkResponse] -> ShowS
show :: CreateSinkResponse -> String
$cshow :: CreateSinkResponse -> String
showsPrec :: Int -> CreateSinkResponse -> ShowS
$cshowsPrec :: Int -> CreateSinkResponse -> ShowS
Prelude.Show, forall x. Rep CreateSinkResponse x -> CreateSinkResponse
forall x. CreateSinkResponse -> Rep CreateSinkResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateSinkResponse x -> CreateSinkResponse
$cfrom :: forall x. CreateSinkResponse -> Rep CreateSinkResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSinkResponse' 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:
--
-- 'arn', 'createSinkResponse_arn' - The ARN of the sink that is newly created.
--
-- 'id', 'createSinkResponse_id' - The random ID string that Amazon Web Services generated as part of the
-- sink ARN.
--
-- 'name', 'createSinkResponse_name' - The name of the sink.
--
-- 'tags', 'createSinkResponse_tags' - The tags assigned to the sink.
--
-- 'httpStatus', 'createSinkResponse_httpStatus' - The response's http status code.
newCreateSinkResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSinkResponse
newCreateSinkResponse :: Int -> CreateSinkResponse
newCreateSinkResponse Int
pHttpStatus_ =
  CreateSinkResponse'
    { $sel:arn:CreateSinkResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:id:CreateSinkResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateSinkResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateSinkResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateSinkResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the sink that is newly created.
createSinkResponse_arn :: Lens.Lens' CreateSinkResponse (Prelude.Maybe Prelude.Text)
createSinkResponse_arn :: Lens' CreateSinkResponse (Maybe Text)
createSinkResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSinkResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:CreateSinkResponse' :: CreateSinkResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: CreateSinkResponse
s@CreateSinkResponse' {} Maybe Text
a -> CreateSinkResponse
s {$sel:arn:CreateSinkResponse' :: Maybe Text
arn = Maybe Text
a} :: CreateSinkResponse)

-- | The random ID string that Amazon Web Services generated as part of the
-- sink ARN.
createSinkResponse_id :: Lens.Lens' CreateSinkResponse (Prelude.Maybe Prelude.Text)
createSinkResponse_id :: Lens' CreateSinkResponse (Maybe Text)
createSinkResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSinkResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateSinkResponse' :: CreateSinkResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateSinkResponse
s@CreateSinkResponse' {} Maybe Text
a -> CreateSinkResponse
s {$sel:id:CreateSinkResponse' :: Maybe Text
id = Maybe Text
a} :: CreateSinkResponse)

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

-- | The tags assigned to the sink.
createSinkResponse_tags :: Lens.Lens' CreateSinkResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createSinkResponse_tags :: Lens' CreateSinkResponse (Maybe (HashMap Text Text))
createSinkResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSinkResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateSinkResponse' :: CreateSinkResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateSinkResponse
s@CreateSinkResponse' {} Maybe (HashMap Text Text)
a -> CreateSinkResponse
s {$sel:tags:CreateSinkResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateSinkResponse) 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 response's http status code.
createSinkResponse_httpStatus :: Lens.Lens' CreateSinkResponse Prelude.Int
createSinkResponse_httpStatus :: Lens' CreateSinkResponse Int
createSinkResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSinkResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateSinkResponse' :: CreateSinkResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateSinkResponse
s@CreateSinkResponse' {} Int
a -> CreateSinkResponse
s {$sel:httpStatus:CreateSinkResponse' :: Int
httpStatus = Int
a} :: CreateSinkResponse)

instance Prelude.NFData CreateSinkResponse where
  rnf :: CreateSinkResponse -> ()
rnf CreateSinkResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
id :: Maybe Text
arn :: Maybe Text
$sel:httpStatus:CreateSinkResponse' :: CreateSinkResponse -> Int
$sel:tags:CreateSinkResponse' :: CreateSinkResponse -> Maybe (HashMap Text Text)
$sel:name:CreateSinkResponse' :: CreateSinkResponse -> Maybe Text
$sel:id:CreateSinkResponse' :: CreateSinkResponse -> Maybe Text
$sel:arn:CreateSinkResponse' :: CreateSinkResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus