{-# 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.IVS.ImportPlaybackKeyPair
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports the public portion of a new key pair and returns its @arn@ and
-- @fingerprint@. The @privateKey@ can then be used to generate viewer
-- authorization tokens, to grant viewers access to private channels. For
-- more information, see
-- <https://docs.aws.amazon.com/ivs/latest/userguide/private-channels.html Setting Up Private Channels>
-- in the /Amazon IVS User Guide/.
module Amazonka.IVS.ImportPlaybackKeyPair
  ( -- * Creating a Request
    ImportPlaybackKeyPair (..),
    newImportPlaybackKeyPair,

    -- * Request Lenses
    importPlaybackKeyPair_name,
    importPlaybackKeyPair_tags,
    importPlaybackKeyPair_publicKeyMaterial,

    -- * Destructuring the Response
    ImportPlaybackKeyPairResponse (..),
    newImportPlaybackKeyPairResponse,

    -- * Response Lenses
    importPlaybackKeyPairResponse_keyPair,
    importPlaybackKeyPairResponse_httpStatus,
  )
where

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

-- | /See:/ 'newImportPlaybackKeyPair' smart constructor.
data ImportPlaybackKeyPair = ImportPlaybackKeyPair'
  { -- | Playback-key-pair name. The value does not need to be unique.
    ImportPlaybackKeyPair -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Any tags provided with the request are added to the playback key pair
    -- tags. See
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
    -- for more information, including restrictions that apply to tags and
    -- \"Tag naming limits and requirements\"; Amazon IVS has no
    -- service-specific constraints beyond what is documented there.
    ImportPlaybackKeyPair -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The public portion of a customer-generated key pair.
    ImportPlaybackKeyPair -> Text
publicKeyMaterial :: Prelude.Text
  }
  deriving (ImportPlaybackKeyPair -> ImportPlaybackKeyPair -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportPlaybackKeyPair -> ImportPlaybackKeyPair -> Bool
$c/= :: ImportPlaybackKeyPair -> ImportPlaybackKeyPair -> Bool
== :: ImportPlaybackKeyPair -> ImportPlaybackKeyPair -> Bool
$c== :: ImportPlaybackKeyPair -> ImportPlaybackKeyPair -> Bool
Prelude.Eq, ReadPrec [ImportPlaybackKeyPair]
ReadPrec ImportPlaybackKeyPair
Int -> ReadS ImportPlaybackKeyPair
ReadS [ImportPlaybackKeyPair]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportPlaybackKeyPair]
$creadListPrec :: ReadPrec [ImportPlaybackKeyPair]
readPrec :: ReadPrec ImportPlaybackKeyPair
$creadPrec :: ReadPrec ImportPlaybackKeyPair
readList :: ReadS [ImportPlaybackKeyPair]
$creadList :: ReadS [ImportPlaybackKeyPair]
readsPrec :: Int -> ReadS ImportPlaybackKeyPair
$creadsPrec :: Int -> ReadS ImportPlaybackKeyPair
Prelude.Read, Int -> ImportPlaybackKeyPair -> ShowS
[ImportPlaybackKeyPair] -> ShowS
ImportPlaybackKeyPair -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportPlaybackKeyPair] -> ShowS
$cshowList :: [ImportPlaybackKeyPair] -> ShowS
show :: ImportPlaybackKeyPair -> String
$cshow :: ImportPlaybackKeyPair -> String
showsPrec :: Int -> ImportPlaybackKeyPair -> ShowS
$cshowsPrec :: Int -> ImportPlaybackKeyPair -> ShowS
Prelude.Show, forall x. Rep ImportPlaybackKeyPair x -> ImportPlaybackKeyPair
forall x. ImportPlaybackKeyPair -> Rep ImportPlaybackKeyPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportPlaybackKeyPair x -> ImportPlaybackKeyPair
$cfrom :: forall x. ImportPlaybackKeyPair -> Rep ImportPlaybackKeyPair x
Prelude.Generic)

-- |
-- Create a value of 'ImportPlaybackKeyPair' 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:
--
-- 'name', 'importPlaybackKeyPair_name' - Playback-key-pair name. The value does not need to be unique.
--
-- 'tags', 'importPlaybackKeyPair_tags' - Any tags provided with the request are added to the playback key pair
-- tags. See
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- for more information, including restrictions that apply to tags and
-- \"Tag naming limits and requirements\"; Amazon IVS has no
-- service-specific constraints beyond what is documented there.
--
-- 'publicKeyMaterial', 'importPlaybackKeyPair_publicKeyMaterial' - The public portion of a customer-generated key pair.
newImportPlaybackKeyPair ::
  -- | 'publicKeyMaterial'
  Prelude.Text ->
  ImportPlaybackKeyPair
newImportPlaybackKeyPair :: Text -> ImportPlaybackKeyPair
newImportPlaybackKeyPair Text
pPublicKeyMaterial_ =
  ImportPlaybackKeyPair'
    { $sel:name:ImportPlaybackKeyPair' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ImportPlaybackKeyPair' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:publicKeyMaterial:ImportPlaybackKeyPair' :: Text
publicKeyMaterial = Text
pPublicKeyMaterial_
    }

-- | Playback-key-pair name. The value does not need to be unique.
importPlaybackKeyPair_name :: Lens.Lens' ImportPlaybackKeyPair (Prelude.Maybe Prelude.Text)
importPlaybackKeyPair_name :: Lens' ImportPlaybackKeyPair (Maybe Text)
importPlaybackKeyPair_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportPlaybackKeyPair' {Maybe Text
name :: Maybe Text
$sel:name:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe Text
name} -> Maybe Text
name) (\s :: ImportPlaybackKeyPair
s@ImportPlaybackKeyPair' {} Maybe Text
a -> ImportPlaybackKeyPair
s {$sel:name:ImportPlaybackKeyPair' :: Maybe Text
name = Maybe Text
a} :: ImportPlaybackKeyPair)

-- | Any tags provided with the request are added to the playback key pair
-- tags. See
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>
-- for more information, including restrictions that apply to tags and
-- \"Tag naming limits and requirements\"; Amazon IVS has no
-- service-specific constraints beyond what is documented there.
importPlaybackKeyPair_tags :: Lens.Lens' ImportPlaybackKeyPair (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
importPlaybackKeyPair_tags :: Lens' ImportPlaybackKeyPair (Maybe (HashMap Text Text))
importPlaybackKeyPair_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportPlaybackKeyPair' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: ImportPlaybackKeyPair
s@ImportPlaybackKeyPair' {} Maybe (HashMap Text Text)
a -> ImportPlaybackKeyPair
s {$sel:tags:ImportPlaybackKeyPair' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: ImportPlaybackKeyPair) 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 public portion of a customer-generated key pair.
importPlaybackKeyPair_publicKeyMaterial :: Lens.Lens' ImportPlaybackKeyPair Prelude.Text
importPlaybackKeyPair_publicKeyMaterial :: Lens' ImportPlaybackKeyPair Text
importPlaybackKeyPair_publicKeyMaterial = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportPlaybackKeyPair' {Text
publicKeyMaterial :: Text
$sel:publicKeyMaterial:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Text
publicKeyMaterial} -> Text
publicKeyMaterial) (\s :: ImportPlaybackKeyPair
s@ImportPlaybackKeyPair' {} Text
a -> ImportPlaybackKeyPair
s {$sel:publicKeyMaterial:ImportPlaybackKeyPair' :: Text
publicKeyMaterial = Text
a} :: ImportPlaybackKeyPair)

instance Core.AWSRequest ImportPlaybackKeyPair where
  type
    AWSResponse ImportPlaybackKeyPair =
      ImportPlaybackKeyPairResponse
  request :: (Service -> Service)
-> ImportPlaybackKeyPair -> Request ImportPlaybackKeyPair
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 ImportPlaybackKeyPair
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportPlaybackKeyPair)))
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 PlaybackKeyPair -> Int -> ImportPlaybackKeyPairResponse
ImportPlaybackKeyPairResponse'
            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
"keyPair")
            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 ImportPlaybackKeyPair where
  hashWithSalt :: Int -> ImportPlaybackKeyPair -> Int
hashWithSalt Int
_salt ImportPlaybackKeyPair' {Maybe Text
Maybe (HashMap Text Text)
Text
publicKeyMaterial :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
$sel:publicKeyMaterial:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Text
$sel:tags:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe (HashMap Text Text)
$sel:name:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
publicKeyMaterial

instance Prelude.NFData ImportPlaybackKeyPair where
  rnf :: ImportPlaybackKeyPair -> ()
rnf ImportPlaybackKeyPair' {Maybe Text
Maybe (HashMap Text Text)
Text
publicKeyMaterial :: Text
tags :: Maybe (HashMap Text Text)
name :: Maybe Text
$sel:publicKeyMaterial:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Text
$sel:tags:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe (HashMap Text Text)
$sel:name:ImportPlaybackKeyPair' :: ImportPlaybackKeyPair -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
publicKeyMaterial

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

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

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

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

-- |
-- Create a value of 'ImportPlaybackKeyPairResponse' 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:
--
-- 'keyPair', 'importPlaybackKeyPairResponse_keyPair' -
--
-- 'httpStatus', 'importPlaybackKeyPairResponse_httpStatus' - The response's http status code.
newImportPlaybackKeyPairResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportPlaybackKeyPairResponse
newImportPlaybackKeyPairResponse :: Int -> ImportPlaybackKeyPairResponse
newImportPlaybackKeyPairResponse Int
pHttpStatus_ =
  ImportPlaybackKeyPairResponse'
    { $sel:keyPair:ImportPlaybackKeyPairResponse' :: Maybe PlaybackKeyPair
keyPair =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportPlaybackKeyPairResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

importPlaybackKeyPairResponse_keyPair :: Lens.Lens' ImportPlaybackKeyPairResponse (Prelude.Maybe PlaybackKeyPair)
importPlaybackKeyPairResponse_keyPair :: Lens' ImportPlaybackKeyPairResponse (Maybe PlaybackKeyPair)
importPlaybackKeyPairResponse_keyPair = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportPlaybackKeyPairResponse' {Maybe PlaybackKeyPair
keyPair :: Maybe PlaybackKeyPair
$sel:keyPair:ImportPlaybackKeyPairResponse' :: ImportPlaybackKeyPairResponse -> Maybe PlaybackKeyPair
keyPair} -> Maybe PlaybackKeyPair
keyPair) (\s :: ImportPlaybackKeyPairResponse
s@ImportPlaybackKeyPairResponse' {} Maybe PlaybackKeyPair
a -> ImportPlaybackKeyPairResponse
s {$sel:keyPair:ImportPlaybackKeyPairResponse' :: Maybe PlaybackKeyPair
keyPair = Maybe PlaybackKeyPair
a} :: ImportPlaybackKeyPairResponse)

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

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