{-# 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.ServiceCatalog.DescribeCopyProductStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the status of the specified copy product operation.
module Amazonka.ServiceCatalog.DescribeCopyProductStatus
  ( -- * Creating a Request
    DescribeCopyProductStatus (..),
    newDescribeCopyProductStatus,

    -- * Request Lenses
    describeCopyProductStatus_acceptLanguage,
    describeCopyProductStatus_copyProductToken,

    -- * Destructuring the Response
    DescribeCopyProductStatusResponse (..),
    newDescribeCopyProductStatusResponse,

    -- * Response Lenses
    describeCopyProductStatusResponse_copyProductStatus,
    describeCopyProductStatusResponse_statusDetail,
    describeCopyProductStatusResponse_targetProductId,
    describeCopyProductStatusResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.ServiceCatalog.Types

-- | /See:/ 'newDescribeCopyProductStatus' smart constructor.
data DescribeCopyProductStatus = DescribeCopyProductStatus'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    DescribeCopyProductStatus -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The token for the copy product operation. This token is returned by
    -- CopyProduct.
    DescribeCopyProductStatus -> Text
copyProductToken :: Prelude.Text
  }
  deriving (DescribeCopyProductStatus -> DescribeCopyProductStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCopyProductStatus -> DescribeCopyProductStatus -> Bool
$c/= :: DescribeCopyProductStatus -> DescribeCopyProductStatus -> Bool
== :: DescribeCopyProductStatus -> DescribeCopyProductStatus -> Bool
$c== :: DescribeCopyProductStatus -> DescribeCopyProductStatus -> Bool
Prelude.Eq, ReadPrec [DescribeCopyProductStatus]
ReadPrec DescribeCopyProductStatus
Int -> ReadS DescribeCopyProductStatus
ReadS [DescribeCopyProductStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCopyProductStatus]
$creadListPrec :: ReadPrec [DescribeCopyProductStatus]
readPrec :: ReadPrec DescribeCopyProductStatus
$creadPrec :: ReadPrec DescribeCopyProductStatus
readList :: ReadS [DescribeCopyProductStatus]
$creadList :: ReadS [DescribeCopyProductStatus]
readsPrec :: Int -> ReadS DescribeCopyProductStatus
$creadsPrec :: Int -> ReadS DescribeCopyProductStatus
Prelude.Read, Int -> DescribeCopyProductStatus -> ShowS
[DescribeCopyProductStatus] -> ShowS
DescribeCopyProductStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCopyProductStatus] -> ShowS
$cshowList :: [DescribeCopyProductStatus] -> ShowS
show :: DescribeCopyProductStatus -> String
$cshow :: DescribeCopyProductStatus -> String
showsPrec :: Int -> DescribeCopyProductStatus -> ShowS
$cshowsPrec :: Int -> DescribeCopyProductStatus -> ShowS
Prelude.Show, forall x.
Rep DescribeCopyProductStatus x -> DescribeCopyProductStatus
forall x.
DescribeCopyProductStatus -> Rep DescribeCopyProductStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeCopyProductStatus x -> DescribeCopyProductStatus
$cfrom :: forall x.
DescribeCopyProductStatus -> Rep DescribeCopyProductStatus x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCopyProductStatus' 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:
--
-- 'acceptLanguage', 'describeCopyProductStatus_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'copyProductToken', 'describeCopyProductStatus_copyProductToken' - The token for the copy product operation. This token is returned by
-- CopyProduct.
newDescribeCopyProductStatus ::
  -- | 'copyProductToken'
  Prelude.Text ->
  DescribeCopyProductStatus
newDescribeCopyProductStatus :: Text -> DescribeCopyProductStatus
newDescribeCopyProductStatus Text
pCopyProductToken_ =
  DescribeCopyProductStatus'
    { $sel:acceptLanguage:DescribeCopyProductStatus' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:copyProductToken:DescribeCopyProductStatus' :: Text
copyProductToken = Text
pCopyProductToken_
    }

-- | The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
describeCopyProductStatus_acceptLanguage :: Lens.Lens' DescribeCopyProductStatus (Prelude.Maybe Prelude.Text)
describeCopyProductStatus_acceptLanguage :: Lens' DescribeCopyProductStatus (Maybe Text)
describeCopyProductStatus_acceptLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCopyProductStatus' {Maybe Text
acceptLanguage :: Maybe Text
$sel:acceptLanguage:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Maybe Text
acceptLanguage} -> Maybe Text
acceptLanguage) (\s :: DescribeCopyProductStatus
s@DescribeCopyProductStatus' {} Maybe Text
a -> DescribeCopyProductStatus
s {$sel:acceptLanguage:DescribeCopyProductStatus' :: Maybe Text
acceptLanguage = Maybe Text
a} :: DescribeCopyProductStatus)

-- | The token for the copy product operation. This token is returned by
-- CopyProduct.
describeCopyProductStatus_copyProductToken :: Lens.Lens' DescribeCopyProductStatus Prelude.Text
describeCopyProductStatus_copyProductToken :: Lens' DescribeCopyProductStatus Text
describeCopyProductStatus_copyProductToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCopyProductStatus' {Text
copyProductToken :: Text
$sel:copyProductToken:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Text
copyProductToken} -> Text
copyProductToken) (\s :: DescribeCopyProductStatus
s@DescribeCopyProductStatus' {} Text
a -> DescribeCopyProductStatus
s {$sel:copyProductToken:DescribeCopyProductStatus' :: Text
copyProductToken = Text
a} :: DescribeCopyProductStatus)

instance Core.AWSRequest DescribeCopyProductStatus where
  type
    AWSResponse DescribeCopyProductStatus =
      DescribeCopyProductStatusResponse
  request :: (Service -> Service)
-> DescribeCopyProductStatus -> Request DescribeCopyProductStatus
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 DescribeCopyProductStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeCopyProductStatus)))
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 CopyProductStatus
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeCopyProductStatusResponse
DescribeCopyProductStatusResponse'
            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
"CopyProductStatus")
            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
"StatusDetail")
            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
"TargetProductId")
            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 DescribeCopyProductStatus where
  hashWithSalt :: Int -> DescribeCopyProductStatus -> Int
hashWithSalt Int
_salt DescribeCopyProductStatus' {Maybe Text
Text
copyProductToken :: Text
acceptLanguage :: Maybe Text
$sel:copyProductToken:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Text
$sel:acceptLanguage:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
acceptLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
copyProductToken

instance Prelude.NFData DescribeCopyProductStatus where
  rnf :: DescribeCopyProductStatus -> ()
rnf DescribeCopyProductStatus' {Maybe Text
Text
copyProductToken :: Text
acceptLanguage :: Maybe Text
$sel:copyProductToken:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Text
$sel:acceptLanguage:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
acceptLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
copyProductToken

instance Data.ToHeaders DescribeCopyProductStatus where
  toHeaders :: DescribeCopyProductStatus -> 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
"AWS242ServiceCatalogService.DescribeCopyProductStatus" ::
                          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 DescribeCopyProductStatus where
  toJSON :: DescribeCopyProductStatus -> Value
toJSON DescribeCopyProductStatus' {Maybe Text
Text
copyProductToken :: Text
acceptLanguage :: Maybe Text
$sel:copyProductToken:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Text
$sel:acceptLanguage:DescribeCopyProductStatus' :: DescribeCopyProductStatus -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptLanguage" 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
acceptLanguage,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CopyProductToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
copyProductToken)
          ]
      )

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

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

-- | /See:/ 'newDescribeCopyProductStatusResponse' smart constructor.
data DescribeCopyProductStatusResponse = DescribeCopyProductStatusResponse'
  { -- | The status of the copy product operation.
    DescribeCopyProductStatusResponse -> Maybe CopyProductStatus
copyProductStatus :: Prelude.Maybe CopyProductStatus,
    -- | The status message.
    DescribeCopyProductStatusResponse -> Maybe Text
statusDetail :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the copied product.
    DescribeCopyProductStatusResponse -> Maybe Text
targetProductId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeCopyProductStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeCopyProductStatusResponse
-> DescribeCopyProductStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeCopyProductStatusResponse
-> DescribeCopyProductStatusResponse -> Bool
$c/= :: DescribeCopyProductStatusResponse
-> DescribeCopyProductStatusResponse -> Bool
== :: DescribeCopyProductStatusResponse
-> DescribeCopyProductStatusResponse -> Bool
$c== :: DescribeCopyProductStatusResponse
-> DescribeCopyProductStatusResponse -> Bool
Prelude.Eq, ReadPrec [DescribeCopyProductStatusResponse]
ReadPrec DescribeCopyProductStatusResponse
Int -> ReadS DescribeCopyProductStatusResponse
ReadS [DescribeCopyProductStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeCopyProductStatusResponse]
$creadListPrec :: ReadPrec [DescribeCopyProductStatusResponse]
readPrec :: ReadPrec DescribeCopyProductStatusResponse
$creadPrec :: ReadPrec DescribeCopyProductStatusResponse
readList :: ReadS [DescribeCopyProductStatusResponse]
$creadList :: ReadS [DescribeCopyProductStatusResponse]
readsPrec :: Int -> ReadS DescribeCopyProductStatusResponse
$creadsPrec :: Int -> ReadS DescribeCopyProductStatusResponse
Prelude.Read, Int -> DescribeCopyProductStatusResponse -> ShowS
[DescribeCopyProductStatusResponse] -> ShowS
DescribeCopyProductStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeCopyProductStatusResponse] -> ShowS
$cshowList :: [DescribeCopyProductStatusResponse] -> ShowS
show :: DescribeCopyProductStatusResponse -> String
$cshow :: DescribeCopyProductStatusResponse -> String
showsPrec :: Int -> DescribeCopyProductStatusResponse -> ShowS
$cshowsPrec :: Int -> DescribeCopyProductStatusResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeCopyProductStatusResponse x
-> DescribeCopyProductStatusResponse
forall x.
DescribeCopyProductStatusResponse
-> Rep DescribeCopyProductStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeCopyProductStatusResponse x
-> DescribeCopyProductStatusResponse
$cfrom :: forall x.
DescribeCopyProductStatusResponse
-> Rep DescribeCopyProductStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeCopyProductStatusResponse' 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:
--
-- 'copyProductStatus', 'describeCopyProductStatusResponse_copyProductStatus' - The status of the copy product operation.
--
-- 'statusDetail', 'describeCopyProductStatusResponse_statusDetail' - The status message.
--
-- 'targetProductId', 'describeCopyProductStatusResponse_targetProductId' - The identifier of the copied product.
--
-- 'httpStatus', 'describeCopyProductStatusResponse_httpStatus' - The response's http status code.
newDescribeCopyProductStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeCopyProductStatusResponse
newDescribeCopyProductStatusResponse :: Int -> DescribeCopyProductStatusResponse
newDescribeCopyProductStatusResponse Int
pHttpStatus_ =
  DescribeCopyProductStatusResponse'
    { $sel:copyProductStatus:DescribeCopyProductStatusResponse' :: Maybe CopyProductStatus
copyProductStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:statusDetail:DescribeCopyProductStatusResponse' :: Maybe Text
statusDetail = forall a. Maybe a
Prelude.Nothing,
      $sel:targetProductId:DescribeCopyProductStatusResponse' :: Maybe Text
targetProductId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeCopyProductStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the copy product operation.
describeCopyProductStatusResponse_copyProductStatus :: Lens.Lens' DescribeCopyProductStatusResponse (Prelude.Maybe CopyProductStatus)
describeCopyProductStatusResponse_copyProductStatus :: Lens' DescribeCopyProductStatusResponse (Maybe CopyProductStatus)
describeCopyProductStatusResponse_copyProductStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCopyProductStatusResponse' {Maybe CopyProductStatus
copyProductStatus :: Maybe CopyProductStatus
$sel:copyProductStatus:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe CopyProductStatus
copyProductStatus} -> Maybe CopyProductStatus
copyProductStatus) (\s :: DescribeCopyProductStatusResponse
s@DescribeCopyProductStatusResponse' {} Maybe CopyProductStatus
a -> DescribeCopyProductStatusResponse
s {$sel:copyProductStatus:DescribeCopyProductStatusResponse' :: Maybe CopyProductStatus
copyProductStatus = Maybe CopyProductStatus
a} :: DescribeCopyProductStatusResponse)

-- | The status message.
describeCopyProductStatusResponse_statusDetail :: Lens.Lens' DescribeCopyProductStatusResponse (Prelude.Maybe Prelude.Text)
describeCopyProductStatusResponse_statusDetail :: Lens' DescribeCopyProductStatusResponse (Maybe Text)
describeCopyProductStatusResponse_statusDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCopyProductStatusResponse' {Maybe Text
statusDetail :: Maybe Text
$sel:statusDetail:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe Text
statusDetail} -> Maybe Text
statusDetail) (\s :: DescribeCopyProductStatusResponse
s@DescribeCopyProductStatusResponse' {} Maybe Text
a -> DescribeCopyProductStatusResponse
s {$sel:statusDetail:DescribeCopyProductStatusResponse' :: Maybe Text
statusDetail = Maybe Text
a} :: DescribeCopyProductStatusResponse)

-- | The identifier of the copied product.
describeCopyProductStatusResponse_targetProductId :: Lens.Lens' DescribeCopyProductStatusResponse (Prelude.Maybe Prelude.Text)
describeCopyProductStatusResponse_targetProductId :: Lens' DescribeCopyProductStatusResponse (Maybe Text)
describeCopyProductStatusResponse_targetProductId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeCopyProductStatusResponse' {Maybe Text
targetProductId :: Maybe Text
$sel:targetProductId:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe Text
targetProductId} -> Maybe Text
targetProductId) (\s :: DescribeCopyProductStatusResponse
s@DescribeCopyProductStatusResponse' {} Maybe Text
a -> DescribeCopyProductStatusResponse
s {$sel:targetProductId:DescribeCopyProductStatusResponse' :: Maybe Text
targetProductId = Maybe Text
a} :: DescribeCopyProductStatusResponse)

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

instance
  Prelude.NFData
    DescribeCopyProductStatusResponse
  where
  rnf :: DescribeCopyProductStatusResponse -> ()
rnf DescribeCopyProductStatusResponse' {Int
Maybe Text
Maybe CopyProductStatus
httpStatus :: Int
targetProductId :: Maybe Text
statusDetail :: Maybe Text
copyProductStatus :: Maybe CopyProductStatus
$sel:httpStatus:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Int
$sel:targetProductId:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe Text
$sel:statusDetail:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe Text
$sel:copyProductStatus:DescribeCopyProductStatusResponse' :: DescribeCopyProductStatusResponse -> Maybe CopyProductStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CopyProductStatus
copyProductStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusDetail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetProductId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus