{-# 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.DevOpsGuru.UpdateServiceIntegration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables or disables integration with a service that can be integrated
-- with DevOps Guru. The one service that can be integrated with DevOps
-- Guru is Amazon Web Services Systems Manager, which can be used to create
-- an OpsItem for each generated insight.
module Amazonka.DevOpsGuru.UpdateServiceIntegration
  ( -- * Creating a Request
    UpdateServiceIntegration (..),
    newUpdateServiceIntegration,

    -- * Request Lenses
    updateServiceIntegration_serviceIntegration,

    -- * Destructuring the Response
    UpdateServiceIntegrationResponse (..),
    newUpdateServiceIntegrationResponse,

    -- * Response Lenses
    updateServiceIntegrationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateServiceIntegration' smart constructor.
data UpdateServiceIntegration = UpdateServiceIntegration'
  { -- | An @IntegratedServiceConfig@ object used to specify the integrated
    -- service you want to update, and whether you want to update it to enabled
    -- or disabled.
    UpdateServiceIntegration -> UpdateServiceIntegrationConfig
serviceIntegration :: UpdateServiceIntegrationConfig
  }
  deriving (UpdateServiceIntegration -> UpdateServiceIntegration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceIntegration -> UpdateServiceIntegration -> Bool
$c/= :: UpdateServiceIntegration -> UpdateServiceIntegration -> Bool
== :: UpdateServiceIntegration -> UpdateServiceIntegration -> Bool
$c== :: UpdateServiceIntegration -> UpdateServiceIntegration -> Bool
Prelude.Eq, ReadPrec [UpdateServiceIntegration]
ReadPrec UpdateServiceIntegration
Int -> ReadS UpdateServiceIntegration
ReadS [UpdateServiceIntegration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateServiceIntegration]
$creadListPrec :: ReadPrec [UpdateServiceIntegration]
readPrec :: ReadPrec UpdateServiceIntegration
$creadPrec :: ReadPrec UpdateServiceIntegration
readList :: ReadS [UpdateServiceIntegration]
$creadList :: ReadS [UpdateServiceIntegration]
readsPrec :: Int -> ReadS UpdateServiceIntegration
$creadsPrec :: Int -> ReadS UpdateServiceIntegration
Prelude.Read, Int -> UpdateServiceIntegration -> ShowS
[UpdateServiceIntegration] -> ShowS
UpdateServiceIntegration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceIntegration] -> ShowS
$cshowList :: [UpdateServiceIntegration] -> ShowS
show :: UpdateServiceIntegration -> String
$cshow :: UpdateServiceIntegration -> String
showsPrec :: Int -> UpdateServiceIntegration -> ShowS
$cshowsPrec :: Int -> UpdateServiceIntegration -> ShowS
Prelude.Show, forall x.
Rep UpdateServiceIntegration x -> UpdateServiceIntegration
forall x.
UpdateServiceIntegration -> Rep UpdateServiceIntegration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateServiceIntegration x -> UpdateServiceIntegration
$cfrom :: forall x.
UpdateServiceIntegration -> Rep UpdateServiceIntegration x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceIntegration' 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:
--
-- 'serviceIntegration', 'updateServiceIntegration_serviceIntegration' - An @IntegratedServiceConfig@ object used to specify the integrated
-- service you want to update, and whether you want to update it to enabled
-- or disabled.
newUpdateServiceIntegration ::
  -- | 'serviceIntegration'
  UpdateServiceIntegrationConfig ->
  UpdateServiceIntegration
newUpdateServiceIntegration :: UpdateServiceIntegrationConfig -> UpdateServiceIntegration
newUpdateServiceIntegration UpdateServiceIntegrationConfig
pServiceIntegration_ =
  UpdateServiceIntegration'
    { $sel:serviceIntegration:UpdateServiceIntegration' :: UpdateServiceIntegrationConfig
serviceIntegration =
        UpdateServiceIntegrationConfig
pServiceIntegration_
    }

-- | An @IntegratedServiceConfig@ object used to specify the integrated
-- service you want to update, and whether you want to update it to enabled
-- or disabled.
updateServiceIntegration_serviceIntegration :: Lens.Lens' UpdateServiceIntegration UpdateServiceIntegrationConfig
updateServiceIntegration_serviceIntegration :: Lens' UpdateServiceIntegration UpdateServiceIntegrationConfig
updateServiceIntegration_serviceIntegration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceIntegration' {UpdateServiceIntegrationConfig
serviceIntegration :: UpdateServiceIntegrationConfig
$sel:serviceIntegration:UpdateServiceIntegration' :: UpdateServiceIntegration -> UpdateServiceIntegrationConfig
serviceIntegration} -> UpdateServiceIntegrationConfig
serviceIntegration) (\s :: UpdateServiceIntegration
s@UpdateServiceIntegration' {} UpdateServiceIntegrationConfig
a -> UpdateServiceIntegration
s {$sel:serviceIntegration:UpdateServiceIntegration' :: UpdateServiceIntegrationConfig
serviceIntegration = UpdateServiceIntegrationConfig
a} :: UpdateServiceIntegration)

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

instance Prelude.NFData UpdateServiceIntegration where
  rnf :: UpdateServiceIntegration -> ()
rnf UpdateServiceIntegration' {UpdateServiceIntegrationConfig
serviceIntegration :: UpdateServiceIntegrationConfig
$sel:serviceIntegration:UpdateServiceIntegration' :: UpdateServiceIntegration -> UpdateServiceIntegrationConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf UpdateServiceIntegrationConfig
serviceIntegration

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

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

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

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

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

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

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