{-# 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.CodeBuild.UpdateReportGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a report group.
module Amazonka.CodeBuild.UpdateReportGroup
  ( -- * Creating a Request
    UpdateReportGroup (..),
    newUpdateReportGroup,

    -- * Request Lenses
    updateReportGroup_exportConfig,
    updateReportGroup_tags,
    updateReportGroup_arn,

    -- * Destructuring the Response
    UpdateReportGroupResponse (..),
    newUpdateReportGroupResponse,

    -- * Response Lenses
    updateReportGroupResponse_reportGroup,
    updateReportGroupResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.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:/ 'newUpdateReportGroup' smart constructor.
data UpdateReportGroup = UpdateReportGroup'
  { -- | Used to specify an updated export type. Valid values are:
    --
    -- -   @S3@: The report results are exported to an S3 bucket.
    --
    -- -   @NO_EXPORT@: The report results are not exported.
    UpdateReportGroup -> Maybe ReportExportConfig
exportConfig :: Prelude.Maybe ReportExportConfig,
    -- | An updated list of tag key and value pairs associated with this report
    -- group.
    --
    -- These tags are available for use by Amazon Web Services services that
    -- support CodeBuild report group tags.
    UpdateReportGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The ARN of the report group to update.
    UpdateReportGroup -> Text
arn :: Prelude.Text
  }
  deriving (UpdateReportGroup -> UpdateReportGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateReportGroup -> UpdateReportGroup -> Bool
$c/= :: UpdateReportGroup -> UpdateReportGroup -> Bool
== :: UpdateReportGroup -> UpdateReportGroup -> Bool
$c== :: UpdateReportGroup -> UpdateReportGroup -> Bool
Prelude.Eq, ReadPrec [UpdateReportGroup]
ReadPrec UpdateReportGroup
Int -> ReadS UpdateReportGroup
ReadS [UpdateReportGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateReportGroup]
$creadListPrec :: ReadPrec [UpdateReportGroup]
readPrec :: ReadPrec UpdateReportGroup
$creadPrec :: ReadPrec UpdateReportGroup
readList :: ReadS [UpdateReportGroup]
$creadList :: ReadS [UpdateReportGroup]
readsPrec :: Int -> ReadS UpdateReportGroup
$creadsPrec :: Int -> ReadS UpdateReportGroup
Prelude.Read, Int -> UpdateReportGroup -> ShowS
[UpdateReportGroup] -> ShowS
UpdateReportGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateReportGroup] -> ShowS
$cshowList :: [UpdateReportGroup] -> ShowS
show :: UpdateReportGroup -> String
$cshow :: UpdateReportGroup -> String
showsPrec :: Int -> UpdateReportGroup -> ShowS
$cshowsPrec :: Int -> UpdateReportGroup -> ShowS
Prelude.Show, forall x. Rep UpdateReportGroup x -> UpdateReportGroup
forall x. UpdateReportGroup -> Rep UpdateReportGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateReportGroup x -> UpdateReportGroup
$cfrom :: forall x. UpdateReportGroup -> Rep UpdateReportGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateReportGroup' 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:
--
-- 'exportConfig', 'updateReportGroup_exportConfig' - Used to specify an updated export type. Valid values are:
--
-- -   @S3@: The report results are exported to an S3 bucket.
--
-- -   @NO_EXPORT@: The report results are not exported.
--
-- 'tags', 'updateReportGroup_tags' - An updated list of tag key and value pairs associated with this report
-- group.
--
-- These tags are available for use by Amazon Web Services services that
-- support CodeBuild report group tags.
--
-- 'arn', 'updateReportGroup_arn' - The ARN of the report group to update.
newUpdateReportGroup ::
  -- | 'arn'
  Prelude.Text ->
  UpdateReportGroup
newUpdateReportGroup :: Text -> UpdateReportGroup
newUpdateReportGroup Text
pArn_ =
  UpdateReportGroup'
    { $sel:exportConfig:UpdateReportGroup' :: Maybe ReportExportConfig
exportConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UpdateReportGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:UpdateReportGroup' :: Text
arn = Text
pArn_
    }

-- | Used to specify an updated export type. Valid values are:
--
-- -   @S3@: The report results are exported to an S3 bucket.
--
-- -   @NO_EXPORT@: The report results are not exported.
updateReportGroup_exportConfig :: Lens.Lens' UpdateReportGroup (Prelude.Maybe ReportExportConfig)
updateReportGroup_exportConfig :: Lens' UpdateReportGroup (Maybe ReportExportConfig)
updateReportGroup_exportConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReportGroup' {Maybe ReportExportConfig
exportConfig :: Maybe ReportExportConfig
$sel:exportConfig:UpdateReportGroup' :: UpdateReportGroup -> Maybe ReportExportConfig
exportConfig} -> Maybe ReportExportConfig
exportConfig) (\s :: UpdateReportGroup
s@UpdateReportGroup' {} Maybe ReportExportConfig
a -> UpdateReportGroup
s {$sel:exportConfig:UpdateReportGroup' :: Maybe ReportExportConfig
exportConfig = Maybe ReportExportConfig
a} :: UpdateReportGroup)

-- | An updated list of tag key and value pairs associated with this report
-- group.
--
-- These tags are available for use by Amazon Web Services services that
-- support CodeBuild report group tags.
updateReportGroup_tags :: Lens.Lens' UpdateReportGroup (Prelude.Maybe [Tag])
updateReportGroup_tags :: Lens' UpdateReportGroup (Maybe [Tag])
updateReportGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReportGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UpdateReportGroup' :: UpdateReportGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UpdateReportGroup
s@UpdateReportGroup' {} Maybe [Tag]
a -> UpdateReportGroup
s {$sel:tags:UpdateReportGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UpdateReportGroup) 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 ARN of the report group to update.
updateReportGroup_arn :: Lens.Lens' UpdateReportGroup Prelude.Text
updateReportGroup_arn :: Lens' UpdateReportGroup Text
updateReportGroup_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReportGroup' {Text
arn :: Text
$sel:arn:UpdateReportGroup' :: UpdateReportGroup -> Text
arn} -> Text
arn) (\s :: UpdateReportGroup
s@UpdateReportGroup' {} Text
a -> UpdateReportGroup
s {$sel:arn:UpdateReportGroup' :: Text
arn = Text
a} :: UpdateReportGroup)

instance Core.AWSRequest UpdateReportGroup where
  type
    AWSResponse UpdateReportGroup =
      UpdateReportGroupResponse
  request :: (Service -> Service)
-> UpdateReportGroup -> Request UpdateReportGroup
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 UpdateReportGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateReportGroup)))
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 ReportGroup -> Int -> UpdateReportGroupResponse
UpdateReportGroupResponse'
            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
"reportGroup")
            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 UpdateReportGroup where
  hashWithSalt :: Int -> UpdateReportGroup -> Int
hashWithSalt Int
_salt UpdateReportGroup' {Maybe [Tag]
Maybe ReportExportConfig
Text
arn :: Text
tags :: Maybe [Tag]
exportConfig :: Maybe ReportExportConfig
$sel:arn:UpdateReportGroup' :: UpdateReportGroup -> Text
$sel:tags:UpdateReportGroup' :: UpdateReportGroup -> Maybe [Tag]
$sel:exportConfig:UpdateReportGroup' :: UpdateReportGroup -> Maybe ReportExportConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReportExportConfig
exportConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData UpdateReportGroup where
  rnf :: UpdateReportGroup -> ()
rnf UpdateReportGroup' {Maybe [Tag]
Maybe ReportExportConfig
Text
arn :: Text
tags :: Maybe [Tag]
exportConfig :: Maybe ReportExportConfig
$sel:arn:UpdateReportGroup' :: UpdateReportGroup -> Text
$sel:tags:UpdateReportGroup' :: UpdateReportGroup -> Maybe [Tag]
$sel:exportConfig:UpdateReportGroup' :: UpdateReportGroup -> Maybe ReportExportConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReportExportConfig
exportConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn

instance Data.ToHeaders UpdateReportGroup where
  toHeaders :: UpdateReportGroup -> 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
"CodeBuild_20161006.UpdateReportGroup" ::
                          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 UpdateReportGroup where
  toJSON :: UpdateReportGroup -> Value
toJSON UpdateReportGroup' {Maybe [Tag]
Maybe ReportExportConfig
Text
arn :: Text
tags :: Maybe [Tag]
exportConfig :: Maybe ReportExportConfig
$sel:arn:UpdateReportGroup' :: UpdateReportGroup -> Text
$sel:tags:UpdateReportGroup' :: UpdateReportGroup -> Maybe [Tag]
$sel:exportConfig:UpdateReportGroup' :: UpdateReportGroup -> Maybe ReportExportConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"exportConfig" 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 ReportExportConfig
exportConfig,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"arn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
arn)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateReportGroupResponse' 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:
--
-- 'reportGroup', 'updateReportGroupResponse_reportGroup' - Information about the updated report group.
--
-- 'httpStatus', 'updateReportGroupResponse_httpStatus' - The response's http status code.
newUpdateReportGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateReportGroupResponse
newUpdateReportGroupResponse :: Int -> UpdateReportGroupResponse
newUpdateReportGroupResponse Int
pHttpStatus_ =
  UpdateReportGroupResponse'
    { $sel:reportGroup:UpdateReportGroupResponse' :: Maybe ReportGroup
reportGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateReportGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the updated report group.
updateReportGroupResponse_reportGroup :: Lens.Lens' UpdateReportGroupResponse (Prelude.Maybe ReportGroup)
updateReportGroupResponse_reportGroup :: Lens' UpdateReportGroupResponse (Maybe ReportGroup)
updateReportGroupResponse_reportGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReportGroupResponse' {Maybe ReportGroup
reportGroup :: Maybe ReportGroup
$sel:reportGroup:UpdateReportGroupResponse' :: UpdateReportGroupResponse -> Maybe ReportGroup
reportGroup} -> Maybe ReportGroup
reportGroup) (\s :: UpdateReportGroupResponse
s@UpdateReportGroupResponse' {} Maybe ReportGroup
a -> UpdateReportGroupResponse
s {$sel:reportGroup:UpdateReportGroupResponse' :: Maybe ReportGroup
reportGroup = Maybe ReportGroup
a} :: UpdateReportGroupResponse)

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

instance Prelude.NFData UpdateReportGroupResponse where
  rnf :: UpdateReportGroupResponse -> ()
rnf UpdateReportGroupResponse' {Int
Maybe ReportGroup
httpStatus :: Int
reportGroup :: Maybe ReportGroup
$sel:httpStatus:UpdateReportGroupResponse' :: UpdateReportGroupResponse -> Int
$sel:reportGroup:UpdateReportGroupResponse' :: UpdateReportGroupResponse -> Maybe ReportGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReportGroup
reportGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus