{-# 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.GuardDuty.UpdateDetector
-- 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 the Amazon GuardDuty detector specified by the detectorId.
module Amazonka.GuardDuty.UpdateDetector
  ( -- * Creating a Request
    UpdateDetector (..),
    newUpdateDetector,

    -- * Request Lenses
    updateDetector_dataSources,
    updateDetector_enable,
    updateDetector_findingPublishingFrequency,
    updateDetector_detectorId,

    -- * Destructuring the Response
    UpdateDetectorResponse (..),
    newUpdateDetectorResponse,

    -- * Response Lenses
    updateDetectorResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDetector' smart constructor.
data UpdateDetector = UpdateDetector'
  { -- | Describes which data sources will be updated.
    UpdateDetector -> Maybe DataSourceConfigurations
dataSources :: Prelude.Maybe DataSourceConfigurations,
    -- | Specifies whether the detector is enabled or not enabled.
    UpdateDetector -> Maybe Bool
enable :: Prelude.Maybe Prelude.Bool,
    -- | An enum value that specifies how frequently findings are exported, such
    -- as to CloudWatch Events.
    UpdateDetector -> Maybe FindingPublishingFrequency
findingPublishingFrequency :: Prelude.Maybe FindingPublishingFrequency,
    -- | The unique ID of the detector to update.
    UpdateDetector -> Text
detectorId :: Prelude.Text
  }
  deriving (UpdateDetector -> UpdateDetector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDetector -> UpdateDetector -> Bool
$c/= :: UpdateDetector -> UpdateDetector -> Bool
== :: UpdateDetector -> UpdateDetector -> Bool
$c== :: UpdateDetector -> UpdateDetector -> Bool
Prelude.Eq, ReadPrec [UpdateDetector]
ReadPrec UpdateDetector
Int -> ReadS UpdateDetector
ReadS [UpdateDetector]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDetector]
$creadListPrec :: ReadPrec [UpdateDetector]
readPrec :: ReadPrec UpdateDetector
$creadPrec :: ReadPrec UpdateDetector
readList :: ReadS [UpdateDetector]
$creadList :: ReadS [UpdateDetector]
readsPrec :: Int -> ReadS UpdateDetector
$creadsPrec :: Int -> ReadS UpdateDetector
Prelude.Read, Int -> UpdateDetector -> ShowS
[UpdateDetector] -> ShowS
UpdateDetector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDetector] -> ShowS
$cshowList :: [UpdateDetector] -> ShowS
show :: UpdateDetector -> String
$cshow :: UpdateDetector -> String
showsPrec :: Int -> UpdateDetector -> ShowS
$cshowsPrec :: Int -> UpdateDetector -> ShowS
Prelude.Show, forall x. Rep UpdateDetector x -> UpdateDetector
forall x. UpdateDetector -> Rep UpdateDetector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDetector x -> UpdateDetector
$cfrom :: forall x. UpdateDetector -> Rep UpdateDetector x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDetector' 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:
--
-- 'dataSources', 'updateDetector_dataSources' - Describes which data sources will be updated.
--
-- 'enable', 'updateDetector_enable' - Specifies whether the detector is enabled or not enabled.
--
-- 'findingPublishingFrequency', 'updateDetector_findingPublishingFrequency' - An enum value that specifies how frequently findings are exported, such
-- as to CloudWatch Events.
--
-- 'detectorId', 'updateDetector_detectorId' - The unique ID of the detector to update.
newUpdateDetector ::
  -- | 'detectorId'
  Prelude.Text ->
  UpdateDetector
newUpdateDetector :: Text -> UpdateDetector
newUpdateDetector Text
pDetectorId_ =
  UpdateDetector'
    { $sel:dataSources:UpdateDetector' :: Maybe DataSourceConfigurations
dataSources = forall a. Maybe a
Prelude.Nothing,
      $sel:enable:UpdateDetector' :: Maybe Bool
enable = forall a. Maybe a
Prelude.Nothing,
      $sel:findingPublishingFrequency:UpdateDetector' :: Maybe FindingPublishingFrequency
findingPublishingFrequency = forall a. Maybe a
Prelude.Nothing,
      $sel:detectorId:UpdateDetector' :: Text
detectorId = Text
pDetectorId_
    }

-- | Describes which data sources will be updated.
updateDetector_dataSources :: Lens.Lens' UpdateDetector (Prelude.Maybe DataSourceConfigurations)
updateDetector_dataSources :: Lens' UpdateDetector (Maybe DataSourceConfigurations)
updateDetector_dataSources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDetector' {Maybe DataSourceConfigurations
dataSources :: Maybe DataSourceConfigurations
$sel:dataSources:UpdateDetector' :: UpdateDetector -> Maybe DataSourceConfigurations
dataSources} -> Maybe DataSourceConfigurations
dataSources) (\s :: UpdateDetector
s@UpdateDetector' {} Maybe DataSourceConfigurations
a -> UpdateDetector
s {$sel:dataSources:UpdateDetector' :: Maybe DataSourceConfigurations
dataSources = Maybe DataSourceConfigurations
a} :: UpdateDetector)

-- | Specifies whether the detector is enabled or not enabled.
updateDetector_enable :: Lens.Lens' UpdateDetector (Prelude.Maybe Prelude.Bool)
updateDetector_enable :: Lens' UpdateDetector (Maybe Bool)
updateDetector_enable = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDetector' {Maybe Bool
enable :: Maybe Bool
$sel:enable:UpdateDetector' :: UpdateDetector -> Maybe Bool
enable} -> Maybe Bool
enable) (\s :: UpdateDetector
s@UpdateDetector' {} Maybe Bool
a -> UpdateDetector
s {$sel:enable:UpdateDetector' :: Maybe Bool
enable = Maybe Bool
a} :: UpdateDetector)

-- | An enum value that specifies how frequently findings are exported, such
-- as to CloudWatch Events.
updateDetector_findingPublishingFrequency :: Lens.Lens' UpdateDetector (Prelude.Maybe FindingPublishingFrequency)
updateDetector_findingPublishingFrequency :: Lens' UpdateDetector (Maybe FindingPublishingFrequency)
updateDetector_findingPublishingFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDetector' {Maybe FindingPublishingFrequency
findingPublishingFrequency :: Maybe FindingPublishingFrequency
$sel:findingPublishingFrequency:UpdateDetector' :: UpdateDetector -> Maybe FindingPublishingFrequency
findingPublishingFrequency} -> Maybe FindingPublishingFrequency
findingPublishingFrequency) (\s :: UpdateDetector
s@UpdateDetector' {} Maybe FindingPublishingFrequency
a -> UpdateDetector
s {$sel:findingPublishingFrequency:UpdateDetector' :: Maybe FindingPublishingFrequency
findingPublishingFrequency = Maybe FindingPublishingFrequency
a} :: UpdateDetector)

-- | The unique ID of the detector to update.
updateDetector_detectorId :: Lens.Lens' UpdateDetector Prelude.Text
updateDetector_detectorId :: Lens' UpdateDetector Text
updateDetector_detectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDetector' {Text
detectorId :: Text
$sel:detectorId:UpdateDetector' :: UpdateDetector -> Text
detectorId} -> Text
detectorId) (\s :: UpdateDetector
s@UpdateDetector' {} Text
a -> UpdateDetector
s {$sel:detectorId:UpdateDetector' :: Text
detectorId = Text
a} :: UpdateDetector)

instance Core.AWSRequest UpdateDetector where
  type
    AWSResponse UpdateDetector =
      UpdateDetectorResponse
  request :: (Service -> Service) -> UpdateDetector -> Request UpdateDetector
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 UpdateDetector
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateDetector)))
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 -> UpdateDetectorResponse
UpdateDetectorResponse'
            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 UpdateDetector where
  hashWithSalt :: Int -> UpdateDetector -> Int
hashWithSalt Int
_salt UpdateDetector' {Maybe Bool
Maybe FindingPublishingFrequency
Maybe DataSourceConfigurations
Text
detectorId :: Text
findingPublishingFrequency :: Maybe FindingPublishingFrequency
enable :: Maybe Bool
dataSources :: Maybe DataSourceConfigurations
$sel:detectorId:UpdateDetector' :: UpdateDetector -> Text
$sel:findingPublishingFrequency:UpdateDetector' :: UpdateDetector -> Maybe FindingPublishingFrequency
$sel:enable:UpdateDetector' :: UpdateDetector -> Maybe Bool
$sel:dataSources:UpdateDetector' :: UpdateDetector -> Maybe DataSourceConfigurations
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSourceConfigurations
dataSources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enable
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FindingPublishingFrequency
findingPublishingFrequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
detectorId

instance Prelude.NFData UpdateDetector where
  rnf :: UpdateDetector -> ()
rnf UpdateDetector' {Maybe Bool
Maybe FindingPublishingFrequency
Maybe DataSourceConfigurations
Text
detectorId :: Text
findingPublishingFrequency :: Maybe FindingPublishingFrequency
enable :: Maybe Bool
dataSources :: Maybe DataSourceConfigurations
$sel:detectorId:UpdateDetector' :: UpdateDetector -> Text
$sel:findingPublishingFrequency:UpdateDetector' :: UpdateDetector -> Maybe FindingPublishingFrequency
$sel:enable:UpdateDetector' :: UpdateDetector -> Maybe Bool
$sel:dataSources:UpdateDetector' :: UpdateDetector -> Maybe DataSourceConfigurations
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSourceConfigurations
dataSources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enable
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FindingPublishingFrequency
findingPublishingFrequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
detectorId

instance Data.ToHeaders UpdateDetector where
  toHeaders :: UpdateDetector -> 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 UpdateDetector where
  toJSON :: UpdateDetector -> Value
toJSON UpdateDetector' {Maybe Bool
Maybe FindingPublishingFrequency
Maybe DataSourceConfigurations
Text
detectorId :: Text
findingPublishingFrequency :: Maybe FindingPublishingFrequency
enable :: Maybe Bool
dataSources :: Maybe DataSourceConfigurations
$sel:detectorId:UpdateDetector' :: UpdateDetector -> Text
$sel:findingPublishingFrequency:UpdateDetector' :: UpdateDetector -> Maybe FindingPublishingFrequency
$sel:enable:UpdateDetector' :: UpdateDetector -> Maybe Bool
$sel:dataSources:UpdateDetector' :: UpdateDetector -> Maybe DataSourceConfigurations
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"dataSources" 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 DataSourceConfigurations
dataSources,
            (Key
"enable" 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 Bool
enable,
            (Key
"findingPublishingFrequency" 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 FindingPublishingFrequency
findingPublishingFrequency
          ]
      )

instance Data.ToPath UpdateDetector where
  toPath :: UpdateDetector -> ByteString
toPath UpdateDetector' {Maybe Bool
Maybe FindingPublishingFrequency
Maybe DataSourceConfigurations
Text
detectorId :: Text
findingPublishingFrequency :: Maybe FindingPublishingFrequency
enable :: Maybe Bool
dataSources :: Maybe DataSourceConfigurations
$sel:detectorId:UpdateDetector' :: UpdateDetector -> Text
$sel:findingPublishingFrequency:UpdateDetector' :: UpdateDetector -> Maybe FindingPublishingFrequency
$sel:enable:UpdateDetector' :: UpdateDetector -> Maybe Bool
$sel:dataSources:UpdateDetector' :: UpdateDetector -> Maybe DataSourceConfigurations
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/detector/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
detectorId]

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

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

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

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

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