{-# 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.DirectoryService.CreateLogSubscription
-- 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 a subscription to forward real-time Directory Service domain
-- controller security logs to the specified Amazon CloudWatch log group in
-- your Amazon Web Services account.
module Amazonka.DirectoryService.CreateLogSubscription
  ( -- * Creating a Request
    CreateLogSubscription (..),
    newCreateLogSubscription,

    -- * Request Lenses
    createLogSubscription_directoryId,
    createLogSubscription_logGroupName,

    -- * Destructuring the Response
    CreateLogSubscriptionResponse (..),
    newCreateLogSubscriptionResponse,

    -- * Response Lenses
    createLogSubscriptionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateLogSubscription' smart constructor.
data CreateLogSubscription = CreateLogSubscription'
  { -- | Identifier of the directory to which you want to subscribe and receive
    -- real-time logs to your specified CloudWatch log group.
    CreateLogSubscription -> Text
directoryId :: Prelude.Text,
    -- | The name of the CloudWatch log group where the real-time domain
    -- controller logs are forwarded.
    CreateLogSubscription -> Text
logGroupName :: Prelude.Text
  }
  deriving (CreateLogSubscription -> CreateLogSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLogSubscription -> CreateLogSubscription -> Bool
$c/= :: CreateLogSubscription -> CreateLogSubscription -> Bool
== :: CreateLogSubscription -> CreateLogSubscription -> Bool
$c== :: CreateLogSubscription -> CreateLogSubscription -> Bool
Prelude.Eq, ReadPrec [CreateLogSubscription]
ReadPrec CreateLogSubscription
Int -> ReadS CreateLogSubscription
ReadS [CreateLogSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLogSubscription]
$creadListPrec :: ReadPrec [CreateLogSubscription]
readPrec :: ReadPrec CreateLogSubscription
$creadPrec :: ReadPrec CreateLogSubscription
readList :: ReadS [CreateLogSubscription]
$creadList :: ReadS [CreateLogSubscription]
readsPrec :: Int -> ReadS CreateLogSubscription
$creadsPrec :: Int -> ReadS CreateLogSubscription
Prelude.Read, Int -> CreateLogSubscription -> ShowS
[CreateLogSubscription] -> ShowS
CreateLogSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLogSubscription] -> ShowS
$cshowList :: [CreateLogSubscription] -> ShowS
show :: CreateLogSubscription -> String
$cshow :: CreateLogSubscription -> String
showsPrec :: Int -> CreateLogSubscription -> ShowS
$cshowsPrec :: Int -> CreateLogSubscription -> ShowS
Prelude.Show, forall x. Rep CreateLogSubscription x -> CreateLogSubscription
forall x. CreateLogSubscription -> Rep CreateLogSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLogSubscription x -> CreateLogSubscription
$cfrom :: forall x. CreateLogSubscription -> Rep CreateLogSubscription x
Prelude.Generic)

-- |
-- Create a value of 'CreateLogSubscription' 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:
--
-- 'directoryId', 'createLogSubscription_directoryId' - Identifier of the directory to which you want to subscribe and receive
-- real-time logs to your specified CloudWatch log group.
--
-- 'logGroupName', 'createLogSubscription_logGroupName' - The name of the CloudWatch log group where the real-time domain
-- controller logs are forwarded.
newCreateLogSubscription ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'logGroupName'
  Prelude.Text ->
  CreateLogSubscription
newCreateLogSubscription :: Text -> Text -> CreateLogSubscription
newCreateLogSubscription Text
pDirectoryId_ Text
pLogGroupName_ =
  CreateLogSubscription'
    { $sel:directoryId:CreateLogSubscription' :: Text
directoryId = Text
pDirectoryId_,
      $sel:logGroupName:CreateLogSubscription' :: Text
logGroupName = Text
pLogGroupName_
    }

-- | Identifier of the directory to which you want to subscribe and receive
-- real-time logs to your specified CloudWatch log group.
createLogSubscription_directoryId :: Lens.Lens' CreateLogSubscription Prelude.Text
createLogSubscription_directoryId :: Lens' CreateLogSubscription Text
createLogSubscription_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLogSubscription' {Text
directoryId :: Text
$sel:directoryId:CreateLogSubscription' :: CreateLogSubscription -> Text
directoryId} -> Text
directoryId) (\s :: CreateLogSubscription
s@CreateLogSubscription' {} Text
a -> CreateLogSubscription
s {$sel:directoryId:CreateLogSubscription' :: Text
directoryId = Text
a} :: CreateLogSubscription)

-- | The name of the CloudWatch log group where the real-time domain
-- controller logs are forwarded.
createLogSubscription_logGroupName :: Lens.Lens' CreateLogSubscription Prelude.Text
createLogSubscription_logGroupName :: Lens' CreateLogSubscription Text
createLogSubscription_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLogSubscription' {Text
logGroupName :: Text
$sel:logGroupName:CreateLogSubscription' :: CreateLogSubscription -> Text
logGroupName} -> Text
logGroupName) (\s :: CreateLogSubscription
s@CreateLogSubscription' {} Text
a -> CreateLogSubscription
s {$sel:logGroupName:CreateLogSubscription' :: Text
logGroupName = Text
a} :: CreateLogSubscription)

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

instance Prelude.NFData CreateLogSubscription where
  rnf :: CreateLogSubscription -> ()
rnf CreateLogSubscription' {Text
logGroupName :: Text
directoryId :: Text
$sel:logGroupName:CreateLogSubscription' :: CreateLogSubscription -> Text
$sel:directoryId:CreateLogSubscription' :: CreateLogSubscription -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logGroupName

instance Data.ToHeaders CreateLogSubscription where
  toHeaders :: CreateLogSubscription -> 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
"DirectoryService_20150416.CreateLogSubscription" ::
                          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 CreateLogSubscription where
  toJSON :: CreateLogSubscription -> Value
toJSON CreateLogSubscription' {Text
logGroupName :: Text
directoryId :: Text
$sel:logGroupName:CreateLogSubscription' :: CreateLogSubscription -> Text
$sel:directoryId:CreateLogSubscription' :: CreateLogSubscription -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just (Key
"LogGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
logGroupName)
          ]
      )

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

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

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

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

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

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