{-# 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.RDS.CopyOptionGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Copies the specified option group.
module Amazonka.RDS.CopyOptionGroup
  ( -- * Creating a Request
    CopyOptionGroup (..),
    newCopyOptionGroup,

    -- * Request Lenses
    copyOptionGroup_tags,
    copyOptionGroup_sourceOptionGroupIdentifier,
    copyOptionGroup_targetOptionGroupIdentifier,
    copyOptionGroup_targetOptionGroupDescription,

    -- * Destructuring the Response
    CopyOptionGroupResponse (..),
    newCopyOptionGroupResponse,

    -- * Response Lenses
    copyOptionGroupResponse_optionGroup,
    copyOptionGroupResponse_httpStatus,
  )
where

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 Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newCopyOptionGroup' smart constructor.
data CopyOptionGroup = CopyOptionGroup'
  { CopyOptionGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier for the source option group.
    --
    -- Constraints:
    --
    -- -   Must specify a valid option group.
    CopyOptionGroup -> Text
sourceOptionGroupIdentifier :: Prelude.Text,
    -- | The identifier for the copied option group.
    --
    -- Constraints:
    --
    -- -   Can\'t be null, empty, or blank
    --
    -- -   Must contain from 1 to 255 letters, numbers, or hyphens
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- Example: @my-option-group@
    CopyOptionGroup -> Text
targetOptionGroupIdentifier :: Prelude.Text,
    -- | The description for the copied option group.
    CopyOptionGroup -> Text
targetOptionGroupDescription :: Prelude.Text
  }
  deriving (CopyOptionGroup -> CopyOptionGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyOptionGroup -> CopyOptionGroup -> Bool
$c/= :: CopyOptionGroup -> CopyOptionGroup -> Bool
== :: CopyOptionGroup -> CopyOptionGroup -> Bool
$c== :: CopyOptionGroup -> CopyOptionGroup -> Bool
Prelude.Eq, ReadPrec [CopyOptionGroup]
ReadPrec CopyOptionGroup
Int -> ReadS CopyOptionGroup
ReadS [CopyOptionGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyOptionGroup]
$creadListPrec :: ReadPrec [CopyOptionGroup]
readPrec :: ReadPrec CopyOptionGroup
$creadPrec :: ReadPrec CopyOptionGroup
readList :: ReadS [CopyOptionGroup]
$creadList :: ReadS [CopyOptionGroup]
readsPrec :: Int -> ReadS CopyOptionGroup
$creadsPrec :: Int -> ReadS CopyOptionGroup
Prelude.Read, Int -> CopyOptionGroup -> ShowS
[CopyOptionGroup] -> ShowS
CopyOptionGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyOptionGroup] -> ShowS
$cshowList :: [CopyOptionGroup] -> ShowS
show :: CopyOptionGroup -> String
$cshow :: CopyOptionGroup -> String
showsPrec :: Int -> CopyOptionGroup -> ShowS
$cshowsPrec :: Int -> CopyOptionGroup -> ShowS
Prelude.Show, forall x. Rep CopyOptionGroup x -> CopyOptionGroup
forall x. CopyOptionGroup -> Rep CopyOptionGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyOptionGroup x -> CopyOptionGroup
$cfrom :: forall x. CopyOptionGroup -> Rep CopyOptionGroup x
Prelude.Generic)

-- |
-- Create a value of 'CopyOptionGroup' 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', 'copyOptionGroup_tags' - Undocumented member.
--
-- 'sourceOptionGroupIdentifier', 'copyOptionGroup_sourceOptionGroupIdentifier' - The identifier for the source option group.
--
-- Constraints:
--
-- -   Must specify a valid option group.
--
-- 'targetOptionGroupIdentifier', 'copyOptionGroup_targetOptionGroupIdentifier' - The identifier for the copied option group.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-option-group@
--
-- 'targetOptionGroupDescription', 'copyOptionGroup_targetOptionGroupDescription' - The description for the copied option group.
newCopyOptionGroup ::
  -- | 'sourceOptionGroupIdentifier'
  Prelude.Text ->
  -- | 'targetOptionGroupIdentifier'
  Prelude.Text ->
  -- | 'targetOptionGroupDescription'
  Prelude.Text ->
  CopyOptionGroup
newCopyOptionGroup :: Text -> Text -> Text -> CopyOptionGroup
newCopyOptionGroup
  Text
pSourceOptionGroupIdentifier_
  Text
pTargetOptionGroupIdentifier_
  Text
pTargetOptionGroupDescription_ =
    CopyOptionGroup'
      { $sel:tags:CopyOptionGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: Text
sourceOptionGroupIdentifier =
          Text
pSourceOptionGroupIdentifier_,
        $sel:targetOptionGroupIdentifier:CopyOptionGroup' :: Text
targetOptionGroupIdentifier =
          Text
pTargetOptionGroupIdentifier_,
        $sel:targetOptionGroupDescription:CopyOptionGroup' :: Text
targetOptionGroupDescription =
          Text
pTargetOptionGroupDescription_
      }

-- | Undocumented member.
copyOptionGroup_tags :: Lens.Lens' CopyOptionGroup (Prelude.Maybe [Tag])
copyOptionGroup_tags :: Lens' CopyOptionGroup (Maybe [Tag])
copyOptionGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyOptionGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CopyOptionGroup' :: CopyOptionGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CopyOptionGroup
s@CopyOptionGroup' {} Maybe [Tag]
a -> CopyOptionGroup
s {$sel:tags:CopyOptionGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CopyOptionGroup) 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 identifier for the source option group.
--
-- Constraints:
--
-- -   Must specify a valid option group.
copyOptionGroup_sourceOptionGroupIdentifier :: Lens.Lens' CopyOptionGroup Prelude.Text
copyOptionGroup_sourceOptionGroupIdentifier :: Lens' CopyOptionGroup Text
copyOptionGroup_sourceOptionGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyOptionGroup' {Text
sourceOptionGroupIdentifier :: Text
$sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
sourceOptionGroupIdentifier} -> Text
sourceOptionGroupIdentifier) (\s :: CopyOptionGroup
s@CopyOptionGroup' {} Text
a -> CopyOptionGroup
s {$sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: Text
sourceOptionGroupIdentifier = Text
a} :: CopyOptionGroup)

-- | The identifier for the copied option group.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-option-group@
copyOptionGroup_targetOptionGroupIdentifier :: Lens.Lens' CopyOptionGroup Prelude.Text
copyOptionGroup_targetOptionGroupIdentifier :: Lens' CopyOptionGroup Text
copyOptionGroup_targetOptionGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyOptionGroup' {Text
targetOptionGroupIdentifier :: Text
$sel:targetOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
targetOptionGroupIdentifier} -> Text
targetOptionGroupIdentifier) (\s :: CopyOptionGroup
s@CopyOptionGroup' {} Text
a -> CopyOptionGroup
s {$sel:targetOptionGroupIdentifier:CopyOptionGroup' :: Text
targetOptionGroupIdentifier = Text
a} :: CopyOptionGroup)

-- | The description for the copied option group.
copyOptionGroup_targetOptionGroupDescription :: Lens.Lens' CopyOptionGroup Prelude.Text
copyOptionGroup_targetOptionGroupDescription :: Lens' CopyOptionGroup Text
copyOptionGroup_targetOptionGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyOptionGroup' {Text
targetOptionGroupDescription :: Text
$sel:targetOptionGroupDescription:CopyOptionGroup' :: CopyOptionGroup -> Text
targetOptionGroupDescription} -> Text
targetOptionGroupDescription) (\s :: CopyOptionGroup
s@CopyOptionGroup' {} Text
a -> CopyOptionGroup
s {$sel:targetOptionGroupDescription:CopyOptionGroup' :: Text
targetOptionGroupDescription = Text
a} :: CopyOptionGroup)

instance Core.AWSRequest CopyOptionGroup where
  type
    AWSResponse CopyOptionGroup =
      CopyOptionGroupResponse
  request :: (Service -> Service) -> CopyOptionGroup -> Request CopyOptionGroup
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CopyOptionGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CopyOptionGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"CopyOptionGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe OptionGroup -> Int -> CopyOptionGroupResponse
CopyOptionGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"OptionGroup")
            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 CopyOptionGroup where
  hashWithSalt :: Int -> CopyOptionGroup -> Int
hashWithSalt Int
_salt CopyOptionGroup' {Maybe [Tag]
Text
targetOptionGroupDescription :: Text
targetOptionGroupIdentifier :: Text
sourceOptionGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetOptionGroupDescription:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:targetOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:tags:CopyOptionGroup' :: CopyOptionGroup -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceOptionGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetOptionGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetOptionGroupDescription

instance Prelude.NFData CopyOptionGroup where
  rnf :: CopyOptionGroup -> ()
rnf CopyOptionGroup' {Maybe [Tag]
Text
targetOptionGroupDescription :: Text
targetOptionGroupIdentifier :: Text
sourceOptionGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetOptionGroupDescription:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:targetOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:tags:CopyOptionGroup' :: CopyOptionGroup -> Maybe [Tag]
..} =
    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
sourceOptionGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetOptionGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetOptionGroupDescription

instance Data.ToHeaders CopyOptionGroup where
  toHeaders :: CopyOptionGroup -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery CopyOptionGroup where
  toQuery :: CopyOptionGroup -> QueryString
toQuery CopyOptionGroup' {Maybe [Tag]
Text
targetOptionGroupDescription :: Text
targetOptionGroupIdentifier :: Text
sourceOptionGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetOptionGroupDescription:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:targetOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:sourceOptionGroupIdentifier:CopyOptionGroup' :: CopyOptionGroup -> Text
$sel:tags:CopyOptionGroup' :: CopyOptionGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CopyOptionGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"SourceOptionGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceOptionGroupIdentifier,
        ByteString
"TargetOptionGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetOptionGroupIdentifier,
        ByteString
"TargetOptionGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetOptionGroupDescription
      ]

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

-- |
-- Create a value of 'CopyOptionGroupResponse' 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:
--
-- 'optionGroup', 'copyOptionGroupResponse_optionGroup' - Undocumented member.
--
-- 'httpStatus', 'copyOptionGroupResponse_httpStatus' - The response's http status code.
newCopyOptionGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyOptionGroupResponse
newCopyOptionGroupResponse :: Int -> CopyOptionGroupResponse
newCopyOptionGroupResponse Int
pHttpStatus_ =
  CopyOptionGroupResponse'
    { $sel:optionGroup:CopyOptionGroupResponse' :: Maybe OptionGroup
optionGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyOptionGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyOptionGroupResponse_optionGroup :: Lens.Lens' CopyOptionGroupResponse (Prelude.Maybe OptionGroup)
copyOptionGroupResponse_optionGroup :: Lens' CopyOptionGroupResponse (Maybe OptionGroup)
copyOptionGroupResponse_optionGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyOptionGroupResponse' {Maybe OptionGroup
optionGroup :: Maybe OptionGroup
$sel:optionGroup:CopyOptionGroupResponse' :: CopyOptionGroupResponse -> Maybe OptionGroup
optionGroup} -> Maybe OptionGroup
optionGroup) (\s :: CopyOptionGroupResponse
s@CopyOptionGroupResponse' {} Maybe OptionGroup
a -> CopyOptionGroupResponse
s {$sel:optionGroup:CopyOptionGroupResponse' :: Maybe OptionGroup
optionGroup = Maybe OptionGroup
a} :: CopyOptionGroupResponse)

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

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