{-# 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.ApplicationInsights.UpdateLogPattern
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a log pattern to a @LogPatternSet@.
module Amazonka.ApplicationInsights.UpdateLogPattern
  ( -- * Creating a Request
    UpdateLogPattern (..),
    newUpdateLogPattern,

    -- * Request Lenses
    updateLogPattern_pattern,
    updateLogPattern_rank,
    updateLogPattern_resourceGroupName,
    updateLogPattern_patternSetName,
    updateLogPattern_patternName,

    -- * Destructuring the Response
    UpdateLogPatternResponse (..),
    newUpdateLogPatternResponse,

    -- * Response Lenses
    updateLogPatternResponse_logPattern,
    updateLogPatternResponse_resourceGroupName,
    updateLogPatternResponse_httpStatus,
  )
where

import Amazonka.ApplicationInsights.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:/ 'newUpdateLogPattern' smart constructor.
data UpdateLogPattern = UpdateLogPattern'
  { -- | The log pattern. The pattern must be DFA compatible. Patterns that
    -- utilize forward lookahead or backreference constructions are not
    -- supported.
    UpdateLogPattern -> Maybe Text
pattern' :: Prelude.Maybe Prelude.Text,
    -- | Rank of the log pattern. Must be a value between @1@ and @1,000,000@.
    -- The patterns are sorted by rank, so we recommend that you set your
    -- highest priority patterns with the lowest rank. A pattern of rank @1@
    -- will be the first to get matched to a log line. A pattern of rank
    -- @1,000,000@ will be last to get matched. When you configure custom log
    -- patterns from the console, a @Low@ severity pattern translates to a
    -- @750,000@ rank. A @Medium@ severity pattern translates to a @500,000@
    -- rank. And a @High@ severity pattern translates to a @250,000@ rank. Rank
    -- values less than @1@ or greater than @1,000,000@ are reserved for
    -- AWS-provided patterns.
    UpdateLogPattern -> Maybe Int
rank :: Prelude.Maybe Prelude.Int,
    -- | The name of the resource group.
    UpdateLogPattern -> Text
resourceGroupName :: Prelude.Text,
    -- | The name of the log pattern set.
    UpdateLogPattern -> Text
patternSetName :: Prelude.Text,
    -- | The name of the log pattern.
    UpdateLogPattern -> Text
patternName :: Prelude.Text
  }
  deriving (UpdateLogPattern -> UpdateLogPattern -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLogPattern -> UpdateLogPattern -> Bool
$c/= :: UpdateLogPattern -> UpdateLogPattern -> Bool
== :: UpdateLogPattern -> UpdateLogPattern -> Bool
$c== :: UpdateLogPattern -> UpdateLogPattern -> Bool
Prelude.Eq, ReadPrec [UpdateLogPattern]
ReadPrec UpdateLogPattern
Int -> ReadS UpdateLogPattern
ReadS [UpdateLogPattern]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLogPattern]
$creadListPrec :: ReadPrec [UpdateLogPattern]
readPrec :: ReadPrec UpdateLogPattern
$creadPrec :: ReadPrec UpdateLogPattern
readList :: ReadS [UpdateLogPattern]
$creadList :: ReadS [UpdateLogPattern]
readsPrec :: Int -> ReadS UpdateLogPattern
$creadsPrec :: Int -> ReadS UpdateLogPattern
Prelude.Read, Int -> UpdateLogPattern -> ShowS
[UpdateLogPattern] -> ShowS
UpdateLogPattern -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLogPattern] -> ShowS
$cshowList :: [UpdateLogPattern] -> ShowS
show :: UpdateLogPattern -> String
$cshow :: UpdateLogPattern -> String
showsPrec :: Int -> UpdateLogPattern -> ShowS
$cshowsPrec :: Int -> UpdateLogPattern -> ShowS
Prelude.Show, forall x. Rep UpdateLogPattern x -> UpdateLogPattern
forall x. UpdateLogPattern -> Rep UpdateLogPattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLogPattern x -> UpdateLogPattern
$cfrom :: forall x. UpdateLogPattern -> Rep UpdateLogPattern x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLogPattern' 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:
--
-- 'pattern'', 'updateLogPattern_pattern' - The log pattern. The pattern must be DFA compatible. Patterns that
-- utilize forward lookahead or backreference constructions are not
-- supported.
--
-- 'rank', 'updateLogPattern_rank' - Rank of the log pattern. Must be a value between @1@ and @1,000,000@.
-- The patterns are sorted by rank, so we recommend that you set your
-- highest priority patterns with the lowest rank. A pattern of rank @1@
-- will be the first to get matched to a log line. A pattern of rank
-- @1,000,000@ will be last to get matched. When you configure custom log
-- patterns from the console, a @Low@ severity pattern translates to a
-- @750,000@ rank. A @Medium@ severity pattern translates to a @500,000@
-- rank. And a @High@ severity pattern translates to a @250,000@ rank. Rank
-- values less than @1@ or greater than @1,000,000@ are reserved for
-- AWS-provided patterns.
--
-- 'resourceGroupName', 'updateLogPattern_resourceGroupName' - The name of the resource group.
--
-- 'patternSetName', 'updateLogPattern_patternSetName' - The name of the log pattern set.
--
-- 'patternName', 'updateLogPattern_patternName' - The name of the log pattern.
newUpdateLogPattern ::
  -- | 'resourceGroupName'
  Prelude.Text ->
  -- | 'patternSetName'
  Prelude.Text ->
  -- | 'patternName'
  Prelude.Text ->
  UpdateLogPattern
newUpdateLogPattern :: Text -> Text -> Text -> UpdateLogPattern
newUpdateLogPattern
  Text
pResourceGroupName_
  Text
pPatternSetName_
  Text
pPatternName_ =
    UpdateLogPattern'
      { $sel:pattern':UpdateLogPattern' :: Maybe Text
pattern' = forall a. Maybe a
Prelude.Nothing,
        $sel:rank:UpdateLogPattern' :: Maybe Int
rank = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceGroupName:UpdateLogPattern' :: Text
resourceGroupName = Text
pResourceGroupName_,
        $sel:patternSetName:UpdateLogPattern' :: Text
patternSetName = Text
pPatternSetName_,
        $sel:patternName:UpdateLogPattern' :: Text
patternName = Text
pPatternName_
      }

-- | The log pattern. The pattern must be DFA compatible. Patterns that
-- utilize forward lookahead or backreference constructions are not
-- supported.
updateLogPattern_pattern :: Lens.Lens' UpdateLogPattern (Prelude.Maybe Prelude.Text)
updateLogPattern_pattern :: Lens' UpdateLogPattern (Maybe Text)
updateLogPattern_pattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPattern' {Maybe Text
pattern' :: Maybe Text
$sel:pattern':UpdateLogPattern' :: UpdateLogPattern -> Maybe Text
pattern'} -> Maybe Text
pattern') (\s :: UpdateLogPattern
s@UpdateLogPattern' {} Maybe Text
a -> UpdateLogPattern
s {$sel:pattern':UpdateLogPattern' :: Maybe Text
pattern' = Maybe Text
a} :: UpdateLogPattern)

-- | Rank of the log pattern. Must be a value between @1@ and @1,000,000@.
-- The patterns are sorted by rank, so we recommend that you set your
-- highest priority patterns with the lowest rank. A pattern of rank @1@
-- will be the first to get matched to a log line. A pattern of rank
-- @1,000,000@ will be last to get matched. When you configure custom log
-- patterns from the console, a @Low@ severity pattern translates to a
-- @750,000@ rank. A @Medium@ severity pattern translates to a @500,000@
-- rank. And a @High@ severity pattern translates to a @250,000@ rank. Rank
-- values less than @1@ or greater than @1,000,000@ are reserved for
-- AWS-provided patterns.
updateLogPattern_rank :: Lens.Lens' UpdateLogPattern (Prelude.Maybe Prelude.Int)
updateLogPattern_rank :: Lens' UpdateLogPattern (Maybe Int)
updateLogPattern_rank = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPattern' {Maybe Int
rank :: Maybe Int
$sel:rank:UpdateLogPattern' :: UpdateLogPattern -> Maybe Int
rank} -> Maybe Int
rank) (\s :: UpdateLogPattern
s@UpdateLogPattern' {} Maybe Int
a -> UpdateLogPattern
s {$sel:rank:UpdateLogPattern' :: Maybe Int
rank = Maybe Int
a} :: UpdateLogPattern)

-- | The name of the resource group.
updateLogPattern_resourceGroupName :: Lens.Lens' UpdateLogPattern Prelude.Text
updateLogPattern_resourceGroupName :: Lens' UpdateLogPattern Text
updateLogPattern_resourceGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPattern' {Text
resourceGroupName :: Text
$sel:resourceGroupName:UpdateLogPattern' :: UpdateLogPattern -> Text
resourceGroupName} -> Text
resourceGroupName) (\s :: UpdateLogPattern
s@UpdateLogPattern' {} Text
a -> UpdateLogPattern
s {$sel:resourceGroupName:UpdateLogPattern' :: Text
resourceGroupName = Text
a} :: UpdateLogPattern)

-- | The name of the log pattern set.
updateLogPattern_patternSetName :: Lens.Lens' UpdateLogPattern Prelude.Text
updateLogPattern_patternSetName :: Lens' UpdateLogPattern Text
updateLogPattern_patternSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPattern' {Text
patternSetName :: Text
$sel:patternSetName:UpdateLogPattern' :: UpdateLogPattern -> Text
patternSetName} -> Text
patternSetName) (\s :: UpdateLogPattern
s@UpdateLogPattern' {} Text
a -> UpdateLogPattern
s {$sel:patternSetName:UpdateLogPattern' :: Text
patternSetName = Text
a} :: UpdateLogPattern)

-- | The name of the log pattern.
updateLogPattern_patternName :: Lens.Lens' UpdateLogPattern Prelude.Text
updateLogPattern_patternName :: Lens' UpdateLogPattern Text
updateLogPattern_patternName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPattern' {Text
patternName :: Text
$sel:patternName:UpdateLogPattern' :: UpdateLogPattern -> Text
patternName} -> Text
patternName) (\s :: UpdateLogPattern
s@UpdateLogPattern' {} Text
a -> UpdateLogPattern
s {$sel:patternName:UpdateLogPattern' :: Text
patternName = Text
a} :: UpdateLogPattern)

instance Core.AWSRequest UpdateLogPattern where
  type
    AWSResponse UpdateLogPattern =
      UpdateLogPatternResponse
  request :: (Service -> Service)
-> UpdateLogPattern -> Request UpdateLogPattern
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 UpdateLogPattern
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLogPattern)))
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 LogPattern -> Maybe Text -> Int -> UpdateLogPatternResponse
UpdateLogPatternResponse'
            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
"LogPattern")
            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
"ResourceGroupName")
            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 UpdateLogPattern where
  hashWithSalt :: Int -> UpdateLogPattern -> Int
hashWithSalt Int
_salt UpdateLogPattern' {Maybe Int
Maybe Text
Text
patternName :: Text
patternSetName :: Text
resourceGroupName :: Text
rank :: Maybe Int
pattern' :: Maybe Text
$sel:patternName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:patternSetName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:resourceGroupName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:rank:UpdateLogPattern' :: UpdateLogPattern -> Maybe Int
$sel:pattern':UpdateLogPattern' :: UpdateLogPattern -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pattern'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
rank
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
patternSetName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
patternName

instance Prelude.NFData UpdateLogPattern where
  rnf :: UpdateLogPattern -> ()
rnf UpdateLogPattern' {Maybe Int
Maybe Text
Text
patternName :: Text
patternSetName :: Text
resourceGroupName :: Text
rank :: Maybe Int
pattern' :: Maybe Text
$sel:patternName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:patternSetName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:resourceGroupName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:rank:UpdateLogPattern' :: UpdateLogPattern -> Maybe Int
$sel:pattern':UpdateLogPattern' :: UpdateLogPattern -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pattern'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
rank
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
patternSetName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
patternName

instance Data.ToHeaders UpdateLogPattern where
  toHeaders :: UpdateLogPattern -> 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
"EC2WindowsBarleyService.UpdateLogPattern" ::
                          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 UpdateLogPattern where
  toJSON :: UpdateLogPattern -> Value
toJSON UpdateLogPattern' {Maybe Int
Maybe Text
Text
patternName :: Text
patternSetName :: Text
resourceGroupName :: Text
rank :: Maybe Int
pattern' :: Maybe Text
$sel:patternName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:patternSetName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:resourceGroupName:UpdateLogPattern' :: UpdateLogPattern -> Text
$sel:rank:UpdateLogPattern' :: UpdateLogPattern -> Maybe Int
$sel:pattern':UpdateLogPattern' :: UpdateLogPattern -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Pattern" 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 Text
pattern',
            (Key
"Rank" 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 Int
rank,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ResourceGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceGroupName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"PatternSetName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
patternSetName),
            forall a. a -> Maybe a
Prelude.Just (Key
"PatternName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
patternName)
          ]
      )

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

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

-- | /See:/ 'newUpdateLogPatternResponse' smart constructor.
data UpdateLogPatternResponse = UpdateLogPatternResponse'
  { -- | The successfully created log pattern.
    UpdateLogPatternResponse -> Maybe LogPattern
logPattern :: Prelude.Maybe LogPattern,
    -- | The name of the resource group.
    UpdateLogPatternResponse -> Maybe Text
resourceGroupName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateLogPatternResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateLogPatternResponse -> UpdateLogPatternResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLogPatternResponse -> UpdateLogPatternResponse -> Bool
$c/= :: UpdateLogPatternResponse -> UpdateLogPatternResponse -> Bool
== :: UpdateLogPatternResponse -> UpdateLogPatternResponse -> Bool
$c== :: UpdateLogPatternResponse -> UpdateLogPatternResponse -> Bool
Prelude.Eq, ReadPrec [UpdateLogPatternResponse]
ReadPrec UpdateLogPatternResponse
Int -> ReadS UpdateLogPatternResponse
ReadS [UpdateLogPatternResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLogPatternResponse]
$creadListPrec :: ReadPrec [UpdateLogPatternResponse]
readPrec :: ReadPrec UpdateLogPatternResponse
$creadPrec :: ReadPrec UpdateLogPatternResponse
readList :: ReadS [UpdateLogPatternResponse]
$creadList :: ReadS [UpdateLogPatternResponse]
readsPrec :: Int -> ReadS UpdateLogPatternResponse
$creadsPrec :: Int -> ReadS UpdateLogPatternResponse
Prelude.Read, Int -> UpdateLogPatternResponse -> ShowS
[UpdateLogPatternResponse] -> ShowS
UpdateLogPatternResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLogPatternResponse] -> ShowS
$cshowList :: [UpdateLogPatternResponse] -> ShowS
show :: UpdateLogPatternResponse -> String
$cshow :: UpdateLogPatternResponse -> String
showsPrec :: Int -> UpdateLogPatternResponse -> ShowS
$cshowsPrec :: Int -> UpdateLogPatternResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateLogPatternResponse x -> UpdateLogPatternResponse
forall x.
UpdateLogPatternResponse -> Rep UpdateLogPatternResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateLogPatternResponse x -> UpdateLogPatternResponse
$cfrom :: forall x.
UpdateLogPatternResponse -> Rep UpdateLogPatternResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLogPatternResponse' 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:
--
-- 'logPattern', 'updateLogPatternResponse_logPattern' - The successfully created log pattern.
--
-- 'resourceGroupName', 'updateLogPatternResponse_resourceGroupName' - The name of the resource group.
--
-- 'httpStatus', 'updateLogPatternResponse_httpStatus' - The response's http status code.
newUpdateLogPatternResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateLogPatternResponse
newUpdateLogPatternResponse :: Int -> UpdateLogPatternResponse
newUpdateLogPatternResponse Int
pHttpStatus_ =
  UpdateLogPatternResponse'
    { $sel:logPattern:UpdateLogPatternResponse' :: Maybe LogPattern
logPattern =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resourceGroupName:UpdateLogPatternResponse' :: Maybe Text
resourceGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateLogPatternResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The successfully created log pattern.
updateLogPatternResponse_logPattern :: Lens.Lens' UpdateLogPatternResponse (Prelude.Maybe LogPattern)
updateLogPatternResponse_logPattern :: Lens' UpdateLogPatternResponse (Maybe LogPattern)
updateLogPatternResponse_logPattern = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPatternResponse' {Maybe LogPattern
logPattern :: Maybe LogPattern
$sel:logPattern:UpdateLogPatternResponse' :: UpdateLogPatternResponse -> Maybe LogPattern
logPattern} -> Maybe LogPattern
logPattern) (\s :: UpdateLogPatternResponse
s@UpdateLogPatternResponse' {} Maybe LogPattern
a -> UpdateLogPatternResponse
s {$sel:logPattern:UpdateLogPatternResponse' :: Maybe LogPattern
logPattern = Maybe LogPattern
a} :: UpdateLogPatternResponse)

-- | The name of the resource group.
updateLogPatternResponse_resourceGroupName :: Lens.Lens' UpdateLogPatternResponse (Prelude.Maybe Prelude.Text)
updateLogPatternResponse_resourceGroupName :: Lens' UpdateLogPatternResponse (Maybe Text)
updateLogPatternResponse_resourceGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLogPatternResponse' {Maybe Text
resourceGroupName :: Maybe Text
$sel:resourceGroupName:UpdateLogPatternResponse' :: UpdateLogPatternResponse -> Maybe Text
resourceGroupName} -> Maybe Text
resourceGroupName) (\s :: UpdateLogPatternResponse
s@UpdateLogPatternResponse' {} Maybe Text
a -> UpdateLogPatternResponse
s {$sel:resourceGroupName:UpdateLogPatternResponse' :: Maybe Text
resourceGroupName = Maybe Text
a} :: UpdateLogPatternResponse)

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

instance Prelude.NFData UpdateLogPatternResponse where
  rnf :: UpdateLogPatternResponse -> ()
rnf UpdateLogPatternResponse' {Int
Maybe Text
Maybe LogPattern
httpStatus :: Int
resourceGroupName :: Maybe Text
logPattern :: Maybe LogPattern
$sel:httpStatus:UpdateLogPatternResponse' :: UpdateLogPatternResponse -> Int
$sel:resourceGroupName:UpdateLogPatternResponse' :: UpdateLogPatternResponse -> Maybe Text
$sel:logPattern:UpdateLogPatternResponse' :: UpdateLogPatternResponse -> Maybe LogPattern
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LogPattern
logPattern
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus