{-# 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.ConnectCases.PutCaseEventConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- API for adding case event publishing configuration
module Amazonka.ConnectCases.PutCaseEventConfiguration
  ( -- * Creating a Request
    PutCaseEventConfiguration (..),
    newPutCaseEventConfiguration,

    -- * Request Lenses
    putCaseEventConfiguration_domainId,
    putCaseEventConfiguration_eventBridge,

    -- * Destructuring the Response
    PutCaseEventConfigurationResponse (..),
    newPutCaseEventConfigurationResponse,

    -- * Response Lenses
    putCaseEventConfigurationResponse_httpStatus,
  )
where

import Amazonka.ConnectCases.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:/ 'newPutCaseEventConfiguration' smart constructor.
data PutCaseEventConfiguration = PutCaseEventConfiguration'
  { -- | The unique identifier of the Cases domain.
    PutCaseEventConfiguration -> Text
domainId :: Prelude.Text,
    -- | Configuration to enable EventBridge case event delivery and determine
    -- what data is delivered.
    PutCaseEventConfiguration -> EventBridgeConfiguration
eventBridge :: EventBridgeConfiguration
  }
  deriving (PutCaseEventConfiguration -> PutCaseEventConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutCaseEventConfiguration -> PutCaseEventConfiguration -> Bool
$c/= :: PutCaseEventConfiguration -> PutCaseEventConfiguration -> Bool
== :: PutCaseEventConfiguration -> PutCaseEventConfiguration -> Bool
$c== :: PutCaseEventConfiguration -> PutCaseEventConfiguration -> Bool
Prelude.Eq, ReadPrec [PutCaseEventConfiguration]
ReadPrec PutCaseEventConfiguration
Int -> ReadS PutCaseEventConfiguration
ReadS [PutCaseEventConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutCaseEventConfiguration]
$creadListPrec :: ReadPrec [PutCaseEventConfiguration]
readPrec :: ReadPrec PutCaseEventConfiguration
$creadPrec :: ReadPrec PutCaseEventConfiguration
readList :: ReadS [PutCaseEventConfiguration]
$creadList :: ReadS [PutCaseEventConfiguration]
readsPrec :: Int -> ReadS PutCaseEventConfiguration
$creadsPrec :: Int -> ReadS PutCaseEventConfiguration
Prelude.Read, Int -> PutCaseEventConfiguration -> ShowS
[PutCaseEventConfiguration] -> ShowS
PutCaseEventConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutCaseEventConfiguration] -> ShowS
$cshowList :: [PutCaseEventConfiguration] -> ShowS
show :: PutCaseEventConfiguration -> String
$cshow :: PutCaseEventConfiguration -> String
showsPrec :: Int -> PutCaseEventConfiguration -> ShowS
$cshowsPrec :: Int -> PutCaseEventConfiguration -> ShowS
Prelude.Show, forall x.
Rep PutCaseEventConfiguration x -> PutCaseEventConfiguration
forall x.
PutCaseEventConfiguration -> Rep PutCaseEventConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutCaseEventConfiguration x -> PutCaseEventConfiguration
$cfrom :: forall x.
PutCaseEventConfiguration -> Rep PutCaseEventConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutCaseEventConfiguration' 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:
--
-- 'domainId', 'putCaseEventConfiguration_domainId' - The unique identifier of the Cases domain.
--
-- 'eventBridge', 'putCaseEventConfiguration_eventBridge' - Configuration to enable EventBridge case event delivery and determine
-- what data is delivered.
newPutCaseEventConfiguration ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'eventBridge'
  EventBridgeConfiguration ->
  PutCaseEventConfiguration
newPutCaseEventConfiguration :: Text -> EventBridgeConfiguration -> PutCaseEventConfiguration
newPutCaseEventConfiguration Text
pDomainId_ EventBridgeConfiguration
pEventBridge_ =
  PutCaseEventConfiguration'
    { $sel:domainId:PutCaseEventConfiguration' :: Text
domainId = Text
pDomainId_,
      $sel:eventBridge:PutCaseEventConfiguration' :: EventBridgeConfiguration
eventBridge = EventBridgeConfiguration
pEventBridge_
    }

-- | The unique identifier of the Cases domain.
putCaseEventConfiguration_domainId :: Lens.Lens' PutCaseEventConfiguration Prelude.Text
putCaseEventConfiguration_domainId :: Lens' PutCaseEventConfiguration Text
putCaseEventConfiguration_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutCaseEventConfiguration' {Text
domainId :: Text
$sel:domainId:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> Text
domainId} -> Text
domainId) (\s :: PutCaseEventConfiguration
s@PutCaseEventConfiguration' {} Text
a -> PutCaseEventConfiguration
s {$sel:domainId:PutCaseEventConfiguration' :: Text
domainId = Text
a} :: PutCaseEventConfiguration)

-- | Configuration to enable EventBridge case event delivery and determine
-- what data is delivered.
putCaseEventConfiguration_eventBridge :: Lens.Lens' PutCaseEventConfiguration EventBridgeConfiguration
putCaseEventConfiguration_eventBridge :: Lens' PutCaseEventConfiguration EventBridgeConfiguration
putCaseEventConfiguration_eventBridge = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutCaseEventConfiguration' {EventBridgeConfiguration
eventBridge :: EventBridgeConfiguration
$sel:eventBridge:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> EventBridgeConfiguration
eventBridge} -> EventBridgeConfiguration
eventBridge) (\s :: PutCaseEventConfiguration
s@PutCaseEventConfiguration' {} EventBridgeConfiguration
a -> PutCaseEventConfiguration
s {$sel:eventBridge:PutCaseEventConfiguration' :: EventBridgeConfiguration
eventBridge = EventBridgeConfiguration
a} :: PutCaseEventConfiguration)

instance Core.AWSRequest PutCaseEventConfiguration where
  type
    AWSResponse PutCaseEventConfiguration =
      PutCaseEventConfigurationResponse
  request :: (Service -> Service)
-> PutCaseEventConfiguration -> Request PutCaseEventConfiguration
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutCaseEventConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutCaseEventConfiguration)))
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 -> PutCaseEventConfigurationResponse
PutCaseEventConfigurationResponse'
            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 PutCaseEventConfiguration where
  hashWithSalt :: Int -> PutCaseEventConfiguration -> Int
hashWithSalt Int
_salt PutCaseEventConfiguration' {Text
EventBridgeConfiguration
eventBridge :: EventBridgeConfiguration
domainId :: Text
$sel:eventBridge:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> EventBridgeConfiguration
$sel:domainId:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` EventBridgeConfiguration
eventBridge

instance Prelude.NFData PutCaseEventConfiguration where
  rnf :: PutCaseEventConfiguration -> ()
rnf PutCaseEventConfiguration' {Text
EventBridgeConfiguration
eventBridge :: EventBridgeConfiguration
domainId :: Text
$sel:eventBridge:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> EventBridgeConfiguration
$sel:domainId:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf EventBridgeConfiguration
eventBridge

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

instance Data.ToPath PutCaseEventConfiguration where
  toPath :: PutCaseEventConfiguration -> ByteString
toPath PutCaseEventConfiguration' {Text
EventBridgeConfiguration
eventBridge :: EventBridgeConfiguration
domainId :: Text
$sel:eventBridge:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> EventBridgeConfiguration
$sel:domainId:PutCaseEventConfiguration' :: PutCaseEventConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/domains/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainId,
        ByteString
"/case-event-configuration"
      ]

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

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

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

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

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