{-# 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.AMP.PutRuleGroupsNamespace
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a rule groups namespace.
module Amazonka.AMP.PutRuleGroupsNamespace
  ( -- * Creating a Request
    PutRuleGroupsNamespace (..),
    newPutRuleGroupsNamespace,

    -- * Request Lenses
    putRuleGroupsNamespace_clientToken,
    putRuleGroupsNamespace_data,
    putRuleGroupsNamespace_name,
    putRuleGroupsNamespace_workspaceId,

    -- * Destructuring the Response
    PutRuleGroupsNamespaceResponse (..),
    newPutRuleGroupsNamespaceResponse,

    -- * Response Lenses
    putRuleGroupsNamespaceResponse_tags,
    putRuleGroupsNamespaceResponse_httpStatus,
    putRuleGroupsNamespaceResponse_arn,
    putRuleGroupsNamespaceResponse_name,
    putRuleGroupsNamespaceResponse_status,
  )
where

import Amazonka.AMP.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

-- | Represents the input of a PutRuleGroupsNamespace operation.
--
-- /See:/ 'newPutRuleGroupsNamespace' smart constructor.
data PutRuleGroupsNamespace = PutRuleGroupsNamespace'
  { -- | Optional, unique, case-sensitive, user-provided identifier to ensure the
    -- idempotency of the request.
    PutRuleGroupsNamespace -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The namespace data that define the rule groups.
    PutRuleGroupsNamespace -> Base64
data' :: Data.Base64,
    -- | The rule groups namespace name.
    PutRuleGroupsNamespace -> Text
name :: Prelude.Text,
    -- | The ID of the workspace in which to update the rule group namespace.
    PutRuleGroupsNamespace -> Text
workspaceId :: Prelude.Text
  }
  deriving (PutRuleGroupsNamespace -> PutRuleGroupsNamespace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRuleGroupsNamespace -> PutRuleGroupsNamespace -> Bool
$c/= :: PutRuleGroupsNamespace -> PutRuleGroupsNamespace -> Bool
== :: PutRuleGroupsNamespace -> PutRuleGroupsNamespace -> Bool
$c== :: PutRuleGroupsNamespace -> PutRuleGroupsNamespace -> Bool
Prelude.Eq, ReadPrec [PutRuleGroupsNamespace]
ReadPrec PutRuleGroupsNamespace
Int -> ReadS PutRuleGroupsNamespace
ReadS [PutRuleGroupsNamespace]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRuleGroupsNamespace]
$creadListPrec :: ReadPrec [PutRuleGroupsNamespace]
readPrec :: ReadPrec PutRuleGroupsNamespace
$creadPrec :: ReadPrec PutRuleGroupsNamespace
readList :: ReadS [PutRuleGroupsNamespace]
$creadList :: ReadS [PutRuleGroupsNamespace]
readsPrec :: Int -> ReadS PutRuleGroupsNamespace
$creadsPrec :: Int -> ReadS PutRuleGroupsNamespace
Prelude.Read, Int -> PutRuleGroupsNamespace -> ShowS
[PutRuleGroupsNamespace] -> ShowS
PutRuleGroupsNamespace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRuleGroupsNamespace] -> ShowS
$cshowList :: [PutRuleGroupsNamespace] -> ShowS
show :: PutRuleGroupsNamespace -> String
$cshow :: PutRuleGroupsNamespace -> String
showsPrec :: Int -> PutRuleGroupsNamespace -> ShowS
$cshowsPrec :: Int -> PutRuleGroupsNamespace -> ShowS
Prelude.Show, forall x. Rep PutRuleGroupsNamespace x -> PutRuleGroupsNamespace
forall x. PutRuleGroupsNamespace -> Rep PutRuleGroupsNamespace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutRuleGroupsNamespace x -> PutRuleGroupsNamespace
$cfrom :: forall x. PutRuleGroupsNamespace -> Rep PutRuleGroupsNamespace x
Prelude.Generic)

-- |
-- Create a value of 'PutRuleGroupsNamespace' 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:
--
-- 'clientToken', 'putRuleGroupsNamespace_clientToken' - Optional, unique, case-sensitive, user-provided identifier to ensure the
-- idempotency of the request.
--
-- 'data'', 'putRuleGroupsNamespace_data' - The namespace data that define the rule groups.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'name', 'putRuleGroupsNamespace_name' - The rule groups namespace name.
--
-- 'workspaceId', 'putRuleGroupsNamespace_workspaceId' - The ID of the workspace in which to update the rule group namespace.
newPutRuleGroupsNamespace ::
  -- | 'data''
  Prelude.ByteString ->
  -- | 'name'
  Prelude.Text ->
  -- | 'workspaceId'
  Prelude.Text ->
  PutRuleGroupsNamespace
newPutRuleGroupsNamespace :: ByteString -> Text -> Text -> PutRuleGroupsNamespace
newPutRuleGroupsNamespace ByteString
pData_ Text
pName_ Text
pWorkspaceId_ =
  PutRuleGroupsNamespace'
    { $sel:clientToken:PutRuleGroupsNamespace' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:data':PutRuleGroupsNamespace' :: Base64
data' = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pData_,
      $sel:name:PutRuleGroupsNamespace' :: Text
name = Text
pName_,
      $sel:workspaceId:PutRuleGroupsNamespace' :: Text
workspaceId = Text
pWorkspaceId_
    }

-- | Optional, unique, case-sensitive, user-provided identifier to ensure the
-- idempotency of the request.
putRuleGroupsNamespace_clientToken :: Lens.Lens' PutRuleGroupsNamespace (Prelude.Maybe Prelude.Text)
putRuleGroupsNamespace_clientToken :: Lens' PutRuleGroupsNamespace (Maybe Text)
putRuleGroupsNamespace_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespace' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: PutRuleGroupsNamespace
s@PutRuleGroupsNamespace' {} Maybe Text
a -> PutRuleGroupsNamespace
s {$sel:clientToken:PutRuleGroupsNamespace' :: Maybe Text
clientToken = Maybe Text
a} :: PutRuleGroupsNamespace)

-- | The namespace data that define the rule groups.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
putRuleGroupsNamespace_data :: Lens.Lens' PutRuleGroupsNamespace Prelude.ByteString
putRuleGroupsNamespace_data :: Lens' PutRuleGroupsNamespace ByteString
putRuleGroupsNamespace_data = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespace' {Base64
data' :: Base64
$sel:data':PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Base64
data'} -> Base64
data') (\s :: PutRuleGroupsNamespace
s@PutRuleGroupsNamespace' {} Base64
a -> PutRuleGroupsNamespace
s {$sel:data':PutRuleGroupsNamespace' :: Base64
data' = Base64
a} :: PutRuleGroupsNamespace) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The rule groups namespace name.
putRuleGroupsNamespace_name :: Lens.Lens' PutRuleGroupsNamespace Prelude.Text
putRuleGroupsNamespace_name :: Lens' PutRuleGroupsNamespace Text
putRuleGroupsNamespace_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespace' {Text
name :: Text
$sel:name:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
name} -> Text
name) (\s :: PutRuleGroupsNamespace
s@PutRuleGroupsNamespace' {} Text
a -> PutRuleGroupsNamespace
s {$sel:name:PutRuleGroupsNamespace' :: Text
name = Text
a} :: PutRuleGroupsNamespace)

-- | The ID of the workspace in which to update the rule group namespace.
putRuleGroupsNamespace_workspaceId :: Lens.Lens' PutRuleGroupsNamespace Prelude.Text
putRuleGroupsNamespace_workspaceId :: Lens' PutRuleGroupsNamespace Text
putRuleGroupsNamespace_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespace' {Text
workspaceId :: Text
$sel:workspaceId:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
workspaceId} -> Text
workspaceId) (\s :: PutRuleGroupsNamespace
s@PutRuleGroupsNamespace' {} Text
a -> PutRuleGroupsNamespace
s {$sel:workspaceId:PutRuleGroupsNamespace' :: Text
workspaceId = Text
a} :: PutRuleGroupsNamespace)

instance Core.AWSRequest PutRuleGroupsNamespace where
  type
    AWSResponse PutRuleGroupsNamespace =
      PutRuleGroupsNamespaceResponse
  request :: (Service -> Service)
-> PutRuleGroupsNamespace -> Request PutRuleGroupsNamespace
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 PutRuleGroupsNamespace
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutRuleGroupsNamespace)))
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 (HashMap Text Text)
-> Int
-> Text
-> Text
-> RuleGroupsNamespaceStatus
-> PutRuleGroupsNamespaceResponse
PutRuleGroupsNamespaceResponse'
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"status")
      )

instance Prelude.Hashable PutRuleGroupsNamespace where
  hashWithSalt :: Int -> PutRuleGroupsNamespace -> Int
hashWithSalt Int
_salt PutRuleGroupsNamespace' {Maybe Text
Text
Base64
workspaceId :: Text
name :: Text
data' :: Base64
clientToken :: Maybe Text
$sel:workspaceId:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:name:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:data':PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Base64
$sel:clientToken:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
data'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId

instance Prelude.NFData PutRuleGroupsNamespace where
  rnf :: PutRuleGroupsNamespace -> ()
rnf PutRuleGroupsNamespace' {Maybe Text
Text
Base64
workspaceId :: Text
name :: Text
data' :: Base64
clientToken :: Maybe Text
$sel:workspaceId:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:name:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:data':PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Base64
$sel:clientToken:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
data'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId

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

instance Data.ToPath PutRuleGroupsNamespace where
  toPath :: PutRuleGroupsNamespace -> ByteString
toPath PutRuleGroupsNamespace' {Maybe Text
Text
Base64
workspaceId :: Text
name :: Text
data' :: Base64
clientToken :: Maybe Text
$sel:workspaceId:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:name:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Text
$sel:data':PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Base64
$sel:clientToken:PutRuleGroupsNamespace' :: PutRuleGroupsNamespace -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/rulegroupsnamespaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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

-- | Represents the output of a PutRuleGroupsNamespace operation.
--
-- /See:/ 'newPutRuleGroupsNamespaceResponse' smart constructor.
data PutRuleGroupsNamespaceResponse = PutRuleGroupsNamespaceResponse'
  { -- | The tags of this rule groups namespace.
    PutRuleGroupsNamespaceResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    PutRuleGroupsNamespaceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of this rule groups namespace.
    PutRuleGroupsNamespaceResponse -> Text
arn :: Prelude.Text,
    -- | The rule groups namespace name.
    PutRuleGroupsNamespaceResponse -> Text
name :: Prelude.Text,
    -- | The status of rule groups namespace.
    PutRuleGroupsNamespaceResponse -> RuleGroupsNamespaceStatus
status :: RuleGroupsNamespaceStatus
  }
  deriving (PutRuleGroupsNamespaceResponse
-> PutRuleGroupsNamespaceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRuleGroupsNamespaceResponse
-> PutRuleGroupsNamespaceResponse -> Bool
$c/= :: PutRuleGroupsNamespaceResponse
-> PutRuleGroupsNamespaceResponse -> Bool
== :: PutRuleGroupsNamespaceResponse
-> PutRuleGroupsNamespaceResponse -> Bool
$c== :: PutRuleGroupsNamespaceResponse
-> PutRuleGroupsNamespaceResponse -> Bool
Prelude.Eq, ReadPrec [PutRuleGroupsNamespaceResponse]
ReadPrec PutRuleGroupsNamespaceResponse
Int -> ReadS PutRuleGroupsNamespaceResponse
ReadS [PutRuleGroupsNamespaceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRuleGroupsNamespaceResponse]
$creadListPrec :: ReadPrec [PutRuleGroupsNamespaceResponse]
readPrec :: ReadPrec PutRuleGroupsNamespaceResponse
$creadPrec :: ReadPrec PutRuleGroupsNamespaceResponse
readList :: ReadS [PutRuleGroupsNamespaceResponse]
$creadList :: ReadS [PutRuleGroupsNamespaceResponse]
readsPrec :: Int -> ReadS PutRuleGroupsNamespaceResponse
$creadsPrec :: Int -> ReadS PutRuleGroupsNamespaceResponse
Prelude.Read, Int -> PutRuleGroupsNamespaceResponse -> ShowS
[PutRuleGroupsNamespaceResponse] -> ShowS
PutRuleGroupsNamespaceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRuleGroupsNamespaceResponse] -> ShowS
$cshowList :: [PutRuleGroupsNamespaceResponse] -> ShowS
show :: PutRuleGroupsNamespaceResponse -> String
$cshow :: PutRuleGroupsNamespaceResponse -> String
showsPrec :: Int -> PutRuleGroupsNamespaceResponse -> ShowS
$cshowsPrec :: Int -> PutRuleGroupsNamespaceResponse -> ShowS
Prelude.Show, forall x.
Rep PutRuleGroupsNamespaceResponse x
-> PutRuleGroupsNamespaceResponse
forall x.
PutRuleGroupsNamespaceResponse
-> Rep PutRuleGroupsNamespaceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutRuleGroupsNamespaceResponse x
-> PutRuleGroupsNamespaceResponse
$cfrom :: forall x.
PutRuleGroupsNamespaceResponse
-> Rep PutRuleGroupsNamespaceResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutRuleGroupsNamespaceResponse' 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:
--
-- 'tags', 'putRuleGroupsNamespaceResponse_tags' - The tags of this rule groups namespace.
--
-- 'httpStatus', 'putRuleGroupsNamespaceResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'putRuleGroupsNamespaceResponse_arn' - The Amazon Resource Name (ARN) of this rule groups namespace.
--
-- 'name', 'putRuleGroupsNamespaceResponse_name' - The rule groups namespace name.
--
-- 'status', 'putRuleGroupsNamespaceResponse_status' - The status of rule groups namespace.
newPutRuleGroupsNamespaceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  RuleGroupsNamespaceStatus ->
  PutRuleGroupsNamespaceResponse
newPutRuleGroupsNamespaceResponse :: Int
-> Text
-> Text
-> RuleGroupsNamespaceStatus
-> PutRuleGroupsNamespaceResponse
newPutRuleGroupsNamespaceResponse
  Int
pHttpStatus_
  Text
pArn_
  Text
pName_
  RuleGroupsNamespaceStatus
pStatus_ =
    PutRuleGroupsNamespaceResponse'
      { $sel:tags:PutRuleGroupsNamespaceResponse' :: Maybe (HashMap Text Text)
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PutRuleGroupsNamespaceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:PutRuleGroupsNamespaceResponse' :: Text
arn = Text
pArn_,
        $sel:name:PutRuleGroupsNamespaceResponse' :: Text
name = Text
pName_,
        $sel:status:PutRuleGroupsNamespaceResponse' :: RuleGroupsNamespaceStatus
status = RuleGroupsNamespaceStatus
pStatus_
      }

-- | The tags of this rule groups namespace.
putRuleGroupsNamespaceResponse_tags :: Lens.Lens' PutRuleGroupsNamespaceResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
putRuleGroupsNamespaceResponse_tags :: Lens' PutRuleGroupsNamespaceResponse (Maybe (HashMap Text Text))
putRuleGroupsNamespaceResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespaceResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: PutRuleGroupsNamespaceResponse
s@PutRuleGroupsNamespaceResponse' {} Maybe (HashMap Text Text)
a -> PutRuleGroupsNamespaceResponse
s {$sel:tags:PutRuleGroupsNamespaceResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: PutRuleGroupsNamespaceResponse) 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 response's http status code.
putRuleGroupsNamespaceResponse_httpStatus :: Lens.Lens' PutRuleGroupsNamespaceResponse Prelude.Int
putRuleGroupsNamespaceResponse_httpStatus :: Lens' PutRuleGroupsNamespaceResponse Int
putRuleGroupsNamespaceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespaceResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutRuleGroupsNamespaceResponse
s@PutRuleGroupsNamespaceResponse' {} Int
a -> PutRuleGroupsNamespaceResponse
s {$sel:httpStatus:PutRuleGroupsNamespaceResponse' :: Int
httpStatus = Int
a} :: PutRuleGroupsNamespaceResponse)

-- | The Amazon Resource Name (ARN) of this rule groups namespace.
putRuleGroupsNamespaceResponse_arn :: Lens.Lens' PutRuleGroupsNamespaceResponse Prelude.Text
putRuleGroupsNamespaceResponse_arn :: Lens' PutRuleGroupsNamespaceResponse Text
putRuleGroupsNamespaceResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespaceResponse' {Text
arn :: Text
$sel:arn:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Text
arn} -> Text
arn) (\s :: PutRuleGroupsNamespaceResponse
s@PutRuleGroupsNamespaceResponse' {} Text
a -> PutRuleGroupsNamespaceResponse
s {$sel:arn:PutRuleGroupsNamespaceResponse' :: Text
arn = Text
a} :: PutRuleGroupsNamespaceResponse)

-- | The rule groups namespace name.
putRuleGroupsNamespaceResponse_name :: Lens.Lens' PutRuleGroupsNamespaceResponse Prelude.Text
putRuleGroupsNamespaceResponse_name :: Lens' PutRuleGroupsNamespaceResponse Text
putRuleGroupsNamespaceResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespaceResponse' {Text
name :: Text
$sel:name:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Text
name} -> Text
name) (\s :: PutRuleGroupsNamespaceResponse
s@PutRuleGroupsNamespaceResponse' {} Text
a -> PutRuleGroupsNamespaceResponse
s {$sel:name:PutRuleGroupsNamespaceResponse' :: Text
name = Text
a} :: PutRuleGroupsNamespaceResponse)

-- | The status of rule groups namespace.
putRuleGroupsNamespaceResponse_status :: Lens.Lens' PutRuleGroupsNamespaceResponse RuleGroupsNamespaceStatus
putRuleGroupsNamespaceResponse_status :: Lens' PutRuleGroupsNamespaceResponse RuleGroupsNamespaceStatus
putRuleGroupsNamespaceResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRuleGroupsNamespaceResponse' {RuleGroupsNamespaceStatus
status :: RuleGroupsNamespaceStatus
$sel:status:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> RuleGroupsNamespaceStatus
status} -> RuleGroupsNamespaceStatus
status) (\s :: PutRuleGroupsNamespaceResponse
s@PutRuleGroupsNamespaceResponse' {} RuleGroupsNamespaceStatus
a -> PutRuleGroupsNamespaceResponse
s {$sel:status:PutRuleGroupsNamespaceResponse' :: RuleGroupsNamespaceStatus
status = RuleGroupsNamespaceStatus
a} :: PutRuleGroupsNamespaceResponse)

instance
  Prelude.NFData
    PutRuleGroupsNamespaceResponse
  where
  rnf :: PutRuleGroupsNamespaceResponse -> ()
rnf PutRuleGroupsNamespaceResponse' {Int
Maybe (HashMap Text Text)
Text
RuleGroupsNamespaceStatus
status :: RuleGroupsNamespaceStatus
name :: Text
arn :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
$sel:status:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> RuleGroupsNamespaceStatus
$sel:name:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Text
$sel:arn:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Text
$sel:httpStatus:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Int
$sel:tags:PutRuleGroupsNamespaceResponse' :: PutRuleGroupsNamespaceResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RuleGroupsNamespaceStatus
status