{-# 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.CloudTrail.GetChannel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about a specific channel. Amazon Web Services
-- services create service-linked channels to get information about
-- CloudTrail events on your behalf. For more information about
-- service-linked channels, see
-- <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/viewing-service-linked-channels.html Viewing service-linked channels for CloudTrail by using the CLI>.
module Amazonka.CloudTrail.GetChannel
  ( -- * Creating a Request
    GetChannel (..),
    newGetChannel,

    -- * Request Lenses
    getChannel_channel,

    -- * Destructuring the Response
    GetChannelResponse (..),
    newGetChannelResponse,

    -- * Response Lenses
    getChannelResponse_channelArn,
    getChannelResponse_destinations,
    getChannelResponse_name,
    getChannelResponse_source,
    getChannelResponse_sourceConfig,
    getChannelResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.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:/ 'newGetChannel' smart constructor.
data GetChannel = GetChannel'
  { -- | The ARN or @UUID@ of a channel.
    GetChannel -> Text
channel :: Prelude.Text
  }
  deriving (GetChannel -> GetChannel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannel -> GetChannel -> Bool
$c/= :: GetChannel -> GetChannel -> Bool
== :: GetChannel -> GetChannel -> Bool
$c== :: GetChannel -> GetChannel -> Bool
Prelude.Eq, ReadPrec [GetChannel]
ReadPrec GetChannel
Int -> ReadS GetChannel
ReadS [GetChannel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannel]
$creadListPrec :: ReadPrec [GetChannel]
readPrec :: ReadPrec GetChannel
$creadPrec :: ReadPrec GetChannel
readList :: ReadS [GetChannel]
$creadList :: ReadS [GetChannel]
readsPrec :: Int -> ReadS GetChannel
$creadsPrec :: Int -> ReadS GetChannel
Prelude.Read, Int -> GetChannel -> ShowS
[GetChannel] -> ShowS
GetChannel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannel] -> ShowS
$cshowList :: [GetChannel] -> ShowS
show :: GetChannel -> String
$cshow :: GetChannel -> String
showsPrec :: Int -> GetChannel -> ShowS
$cshowsPrec :: Int -> GetChannel -> ShowS
Prelude.Show, forall x. Rep GetChannel x -> GetChannel
forall x. GetChannel -> Rep GetChannel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetChannel x -> GetChannel
$cfrom :: forall x. GetChannel -> Rep GetChannel x
Prelude.Generic)

-- |
-- Create a value of 'GetChannel' 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:
--
-- 'channel', 'getChannel_channel' - The ARN or @UUID@ of a channel.
newGetChannel ::
  -- | 'channel'
  Prelude.Text ->
  GetChannel
newGetChannel :: Text -> GetChannel
newGetChannel Text
pChannel_ =
  GetChannel' {$sel:channel:GetChannel' :: Text
channel = Text
pChannel_}

-- | The ARN or @UUID@ of a channel.
getChannel_channel :: Lens.Lens' GetChannel Prelude.Text
getChannel_channel :: Lens' GetChannel Text
getChannel_channel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannel' {Text
channel :: Text
$sel:channel:GetChannel' :: GetChannel -> Text
channel} -> Text
channel) (\s :: GetChannel
s@GetChannel' {} Text
a -> GetChannel
s {$sel:channel:GetChannel' :: Text
channel = Text
a} :: GetChannel)

instance Core.AWSRequest GetChannel where
  type AWSResponse GetChannel = GetChannelResponse
  request :: (Service -> Service) -> GetChannel -> Request GetChannel
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 GetChannel
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetChannel)))
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 (NonEmpty Destination)
-> Maybe Text
-> Maybe Text
-> Maybe SourceConfig
-> Int
-> GetChannelResponse
GetChannelResponse'
            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
"ChannelArn")
            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
"Destinations")
            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
"Source")
            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
"SourceConfig")
            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 GetChannel where
  hashWithSalt :: Int -> GetChannel -> Int
hashWithSalt Int
_salt GetChannel' {Text
channel :: Text
$sel:channel:GetChannel' :: GetChannel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
channel

instance Prelude.NFData GetChannel where
  rnf :: GetChannel -> ()
rnf GetChannel' {Text
channel :: Text
$sel:channel:GetChannel' :: GetChannel -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
channel

instance Data.ToHeaders GetChannel where
  toHeaders :: GetChannel -> 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
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.GetChannel" ::
                          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 GetChannel where
  toJSON :: GetChannel -> Value
toJSON GetChannel' {Text
channel :: Text
$sel:channel:GetChannel' :: GetChannel -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Channel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
channel)]
      )

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

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

-- | /See:/ 'newGetChannelResponse' smart constructor.
data GetChannelResponse = GetChannelResponse'
  { -- | The ARN of an channel returned by a @GetChannel@ request.
    GetChannelResponse -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services service that created the service-linked channel.
    GetChannelResponse -> Maybe (NonEmpty Destination)
destinations :: Prelude.Maybe (Prelude.NonEmpty Destination),
    -- | The name of the CloudTrail channel. For service-linked channels, the
    -- value is @aws-service-channel\/service-name\/custom-suffix@ where
    -- @service-name@ represents the name of the Amazon Web Services service
    -- that created the channel and @custom-suffix@ represents the suffix
    -- generated by the Amazon Web Services service.
    GetChannelResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The event source for the CloudTrail channel.
    GetChannelResponse -> Maybe Text
source :: Prelude.Maybe Prelude.Text,
    -- | Provides information about the advanced event selectors configured for
    -- the channel, and whether the channel applies to all regions or a single
    -- region.
    GetChannelResponse -> Maybe SourceConfig
sourceConfig :: Prelude.Maybe SourceConfig,
    -- | The response's http status code.
    GetChannelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetChannelResponse -> GetChannelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetChannelResponse -> GetChannelResponse -> Bool
$c/= :: GetChannelResponse -> GetChannelResponse -> Bool
== :: GetChannelResponse -> GetChannelResponse -> Bool
$c== :: GetChannelResponse -> GetChannelResponse -> Bool
Prelude.Eq, ReadPrec [GetChannelResponse]
ReadPrec GetChannelResponse
Int -> ReadS GetChannelResponse
ReadS [GetChannelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetChannelResponse]
$creadListPrec :: ReadPrec [GetChannelResponse]
readPrec :: ReadPrec GetChannelResponse
$creadPrec :: ReadPrec GetChannelResponse
readList :: ReadS [GetChannelResponse]
$creadList :: ReadS [GetChannelResponse]
readsPrec :: Int -> ReadS GetChannelResponse
$creadsPrec :: Int -> ReadS GetChannelResponse
Prelude.Read, Int -> GetChannelResponse -> ShowS
[GetChannelResponse] -> ShowS
GetChannelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetChannelResponse] -> ShowS
$cshowList :: [GetChannelResponse] -> ShowS
show :: GetChannelResponse -> String
$cshow :: GetChannelResponse -> String
showsPrec :: Int -> GetChannelResponse -> ShowS
$cshowsPrec :: Int -> GetChannelResponse -> ShowS
Prelude.Show, forall x. Rep GetChannelResponse x -> GetChannelResponse
forall x. GetChannelResponse -> Rep GetChannelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetChannelResponse x -> GetChannelResponse
$cfrom :: forall x. GetChannelResponse -> Rep GetChannelResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetChannelResponse' 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:
--
-- 'channelArn', 'getChannelResponse_channelArn' - The ARN of an channel returned by a @GetChannel@ request.
--
-- 'destinations', 'getChannelResponse_destinations' - The Amazon Web Services service that created the service-linked channel.
--
-- 'name', 'getChannelResponse_name' - The name of the CloudTrail channel. For service-linked channels, the
-- value is @aws-service-channel\/service-name\/custom-suffix@ where
-- @service-name@ represents the name of the Amazon Web Services service
-- that created the channel and @custom-suffix@ represents the suffix
-- generated by the Amazon Web Services service.
--
-- 'source', 'getChannelResponse_source' - The event source for the CloudTrail channel.
--
-- 'sourceConfig', 'getChannelResponse_sourceConfig' - Provides information about the advanced event selectors configured for
-- the channel, and whether the channel applies to all regions or a single
-- region.
--
-- 'httpStatus', 'getChannelResponse_httpStatus' - The response's http status code.
newGetChannelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetChannelResponse
newGetChannelResponse :: Int -> GetChannelResponse
newGetChannelResponse Int
pHttpStatus_ =
  GetChannelResponse'
    { $sel:channelArn:GetChannelResponse' :: Maybe Text
channelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:GetChannelResponse' :: Maybe (NonEmpty Destination)
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:name:GetChannelResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:source:GetChannelResponse' :: Maybe Text
source = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceConfig:GetChannelResponse' :: Maybe SourceConfig
sourceConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetChannelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of an channel returned by a @GetChannel@ request.
getChannelResponse_channelArn :: Lens.Lens' GetChannelResponse (Prelude.Maybe Prelude.Text)
getChannelResponse_channelArn :: Lens' GetChannelResponse (Maybe Text)
getChannelResponse_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelResponse' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:GetChannelResponse' :: GetChannelResponse -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: GetChannelResponse
s@GetChannelResponse' {} Maybe Text
a -> GetChannelResponse
s {$sel:channelArn:GetChannelResponse' :: Maybe Text
channelArn = Maybe Text
a} :: GetChannelResponse)

-- | The Amazon Web Services service that created the service-linked channel.
getChannelResponse_destinations :: Lens.Lens' GetChannelResponse (Prelude.Maybe (Prelude.NonEmpty Destination))
getChannelResponse_destinations :: Lens' GetChannelResponse (Maybe (NonEmpty Destination))
getChannelResponse_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelResponse' {Maybe (NonEmpty Destination)
destinations :: Maybe (NonEmpty Destination)
$sel:destinations:GetChannelResponse' :: GetChannelResponse -> Maybe (NonEmpty Destination)
destinations} -> Maybe (NonEmpty Destination)
destinations) (\s :: GetChannelResponse
s@GetChannelResponse' {} Maybe (NonEmpty Destination)
a -> GetChannelResponse
s {$sel:destinations:GetChannelResponse' :: Maybe (NonEmpty Destination)
destinations = Maybe (NonEmpty Destination)
a} :: GetChannelResponse) 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 name of the CloudTrail channel. For service-linked channels, the
-- value is @aws-service-channel\/service-name\/custom-suffix@ where
-- @service-name@ represents the name of the Amazon Web Services service
-- that created the channel and @custom-suffix@ represents the suffix
-- generated by the Amazon Web Services service.
getChannelResponse_name :: Lens.Lens' GetChannelResponse (Prelude.Maybe Prelude.Text)
getChannelResponse_name :: Lens' GetChannelResponse (Maybe Text)
getChannelResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelResponse' {Maybe Text
name :: Maybe Text
$sel:name:GetChannelResponse' :: GetChannelResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: GetChannelResponse
s@GetChannelResponse' {} Maybe Text
a -> GetChannelResponse
s {$sel:name:GetChannelResponse' :: Maybe Text
name = Maybe Text
a} :: GetChannelResponse)

-- | The event source for the CloudTrail channel.
getChannelResponse_source :: Lens.Lens' GetChannelResponse (Prelude.Maybe Prelude.Text)
getChannelResponse_source :: Lens' GetChannelResponse (Maybe Text)
getChannelResponse_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelResponse' {Maybe Text
source :: Maybe Text
$sel:source:GetChannelResponse' :: GetChannelResponse -> Maybe Text
source} -> Maybe Text
source) (\s :: GetChannelResponse
s@GetChannelResponse' {} Maybe Text
a -> GetChannelResponse
s {$sel:source:GetChannelResponse' :: Maybe Text
source = Maybe Text
a} :: GetChannelResponse)

-- | Provides information about the advanced event selectors configured for
-- the channel, and whether the channel applies to all regions or a single
-- region.
getChannelResponse_sourceConfig :: Lens.Lens' GetChannelResponse (Prelude.Maybe SourceConfig)
getChannelResponse_sourceConfig :: Lens' GetChannelResponse (Maybe SourceConfig)
getChannelResponse_sourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetChannelResponse' {Maybe SourceConfig
sourceConfig :: Maybe SourceConfig
$sel:sourceConfig:GetChannelResponse' :: GetChannelResponse -> Maybe SourceConfig
sourceConfig} -> Maybe SourceConfig
sourceConfig) (\s :: GetChannelResponse
s@GetChannelResponse' {} Maybe SourceConfig
a -> GetChannelResponse
s {$sel:sourceConfig:GetChannelResponse' :: Maybe SourceConfig
sourceConfig = Maybe SourceConfig
a} :: GetChannelResponse)

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

instance Prelude.NFData GetChannelResponse where
  rnf :: GetChannelResponse -> ()
rnf GetChannelResponse' {Int
Maybe (NonEmpty Destination)
Maybe Text
Maybe SourceConfig
httpStatus :: Int
sourceConfig :: Maybe SourceConfig
source :: Maybe Text
name :: Maybe Text
destinations :: Maybe (NonEmpty Destination)
channelArn :: Maybe Text
$sel:httpStatus:GetChannelResponse' :: GetChannelResponse -> Int
$sel:sourceConfig:GetChannelResponse' :: GetChannelResponse -> Maybe SourceConfig
$sel:source:GetChannelResponse' :: GetChannelResponse -> Maybe Text
$sel:name:GetChannelResponse' :: GetChannelResponse -> Maybe Text
$sel:destinations:GetChannelResponse' :: GetChannelResponse -> Maybe (NonEmpty Destination)
$sel:channelArn:GetChannelResponse' :: GetChannelResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Destination)
destinations
      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 Text
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourceConfig
sourceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus