{-# 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.EC2.CreateSpotDatafeedSubscription
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a data feed for Spot Instances, enabling you to view Spot
-- Instance usage logs. You can create one data feed per Amazon Web
-- Services account. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-data-feeds.html Spot Instance data feed>
-- in the /Amazon EC2 User Guide for Linux Instances/.
module Amazonka.EC2.CreateSpotDatafeedSubscription
  ( -- * Creating a Request
    CreateSpotDatafeedSubscription (..),
    newCreateSpotDatafeedSubscription,

    -- * Request Lenses
    createSpotDatafeedSubscription_dryRun,
    createSpotDatafeedSubscription_prefix,
    createSpotDatafeedSubscription_bucket,

    -- * Destructuring the Response
    CreateSpotDatafeedSubscriptionResponse (..),
    newCreateSpotDatafeedSubscriptionResponse,

    -- * Response Lenses
    createSpotDatafeedSubscriptionResponse_spotDatafeedSubscription,
    createSpotDatafeedSubscriptionResponse_httpStatus,
  )
where

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

-- | Contains the parameters for CreateSpotDatafeedSubscription.
--
-- /See:/ 'newCreateSpotDatafeedSubscription' smart constructor.
data CreateSpotDatafeedSubscription = CreateSpotDatafeedSubscription'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateSpotDatafeedSubscription -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The prefix for the data feed file names.
    CreateSpotDatafeedSubscription -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | The name of the Amazon S3 bucket in which to store the Spot Instance
    -- data feed. For more information about bucket names, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/BucketRestrictions.html#bucketnamingrules Rules for bucket naming>
    -- in the /Amazon S3 Developer Guide/.
    CreateSpotDatafeedSubscription -> Text
bucket :: Prelude.Text
  }
  deriving (CreateSpotDatafeedSubscription
-> CreateSpotDatafeedSubscription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSpotDatafeedSubscription
-> CreateSpotDatafeedSubscription -> Bool
$c/= :: CreateSpotDatafeedSubscription
-> CreateSpotDatafeedSubscription -> Bool
== :: CreateSpotDatafeedSubscription
-> CreateSpotDatafeedSubscription -> Bool
$c== :: CreateSpotDatafeedSubscription
-> CreateSpotDatafeedSubscription -> Bool
Prelude.Eq, ReadPrec [CreateSpotDatafeedSubscription]
ReadPrec CreateSpotDatafeedSubscription
Int -> ReadS CreateSpotDatafeedSubscription
ReadS [CreateSpotDatafeedSubscription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSpotDatafeedSubscription]
$creadListPrec :: ReadPrec [CreateSpotDatafeedSubscription]
readPrec :: ReadPrec CreateSpotDatafeedSubscription
$creadPrec :: ReadPrec CreateSpotDatafeedSubscription
readList :: ReadS [CreateSpotDatafeedSubscription]
$creadList :: ReadS [CreateSpotDatafeedSubscription]
readsPrec :: Int -> ReadS CreateSpotDatafeedSubscription
$creadsPrec :: Int -> ReadS CreateSpotDatafeedSubscription
Prelude.Read, Int -> CreateSpotDatafeedSubscription -> ShowS
[CreateSpotDatafeedSubscription] -> ShowS
CreateSpotDatafeedSubscription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSpotDatafeedSubscription] -> ShowS
$cshowList :: [CreateSpotDatafeedSubscription] -> ShowS
show :: CreateSpotDatafeedSubscription -> String
$cshow :: CreateSpotDatafeedSubscription -> String
showsPrec :: Int -> CreateSpotDatafeedSubscription -> ShowS
$cshowsPrec :: Int -> CreateSpotDatafeedSubscription -> ShowS
Prelude.Show, forall x.
Rep CreateSpotDatafeedSubscription x
-> CreateSpotDatafeedSubscription
forall x.
CreateSpotDatafeedSubscription
-> Rep CreateSpotDatafeedSubscription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSpotDatafeedSubscription x
-> CreateSpotDatafeedSubscription
$cfrom :: forall x.
CreateSpotDatafeedSubscription
-> Rep CreateSpotDatafeedSubscription x
Prelude.Generic)

-- |
-- Create a value of 'CreateSpotDatafeedSubscription' 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:
--
-- 'dryRun', 'createSpotDatafeedSubscription_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'prefix', 'createSpotDatafeedSubscription_prefix' - The prefix for the data feed file names.
--
-- 'bucket', 'createSpotDatafeedSubscription_bucket' - The name of the Amazon S3 bucket in which to store the Spot Instance
-- data feed. For more information about bucket names, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/BucketRestrictions.html#bucketnamingrules Rules for bucket naming>
-- in the /Amazon S3 Developer Guide/.
newCreateSpotDatafeedSubscription ::
  -- | 'bucket'
  Prelude.Text ->
  CreateSpotDatafeedSubscription
newCreateSpotDatafeedSubscription :: Text -> CreateSpotDatafeedSubscription
newCreateSpotDatafeedSubscription Text
pBucket_ =
  CreateSpotDatafeedSubscription'
    { $sel:dryRun:CreateSpotDatafeedSubscription' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:CreateSpotDatafeedSubscription' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:CreateSpotDatafeedSubscription' :: Text
bucket = Text
pBucket_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createSpotDatafeedSubscription_dryRun :: Lens.Lens' CreateSpotDatafeedSubscription (Prelude.Maybe Prelude.Bool)
createSpotDatafeedSubscription_dryRun :: Lens' CreateSpotDatafeedSubscription (Maybe Bool)
createSpotDatafeedSubscription_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSpotDatafeedSubscription' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateSpotDatafeedSubscription
s@CreateSpotDatafeedSubscription' {} Maybe Bool
a -> CreateSpotDatafeedSubscription
s {$sel:dryRun:CreateSpotDatafeedSubscription' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateSpotDatafeedSubscription)

-- | The prefix for the data feed file names.
createSpotDatafeedSubscription_prefix :: Lens.Lens' CreateSpotDatafeedSubscription (Prelude.Maybe Prelude.Text)
createSpotDatafeedSubscription_prefix :: Lens' CreateSpotDatafeedSubscription (Maybe Text)
createSpotDatafeedSubscription_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSpotDatafeedSubscription' {Maybe Text
prefix :: Maybe Text
$sel:prefix:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: CreateSpotDatafeedSubscription
s@CreateSpotDatafeedSubscription' {} Maybe Text
a -> CreateSpotDatafeedSubscription
s {$sel:prefix:CreateSpotDatafeedSubscription' :: Maybe Text
prefix = Maybe Text
a} :: CreateSpotDatafeedSubscription)

-- | The name of the Amazon S3 bucket in which to store the Spot Instance
-- data feed. For more information about bucket names, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/BucketRestrictions.html#bucketnamingrules Rules for bucket naming>
-- in the /Amazon S3 Developer Guide/.
createSpotDatafeedSubscription_bucket :: Lens.Lens' CreateSpotDatafeedSubscription Prelude.Text
createSpotDatafeedSubscription_bucket :: Lens' CreateSpotDatafeedSubscription Text
createSpotDatafeedSubscription_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSpotDatafeedSubscription' {Text
bucket :: Text
$sel:bucket:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Text
bucket} -> Text
bucket) (\s :: CreateSpotDatafeedSubscription
s@CreateSpotDatafeedSubscription' {} Text
a -> CreateSpotDatafeedSubscription
s {$sel:bucket:CreateSpotDatafeedSubscription' :: Text
bucket = Text
a} :: CreateSpotDatafeedSubscription)

instance
  Core.AWSRequest
    CreateSpotDatafeedSubscription
  where
  type
    AWSResponse CreateSpotDatafeedSubscription =
      CreateSpotDatafeedSubscriptionResponse
  request :: (Service -> Service)
-> CreateSpotDatafeedSubscription
-> Request CreateSpotDatafeedSubscription
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 CreateSpotDatafeedSubscription
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse CreateSpotDatafeedSubscription)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe SpotDatafeedSubscription
-> Int -> CreateSpotDatafeedSubscriptionResponse
CreateSpotDatafeedSubscriptionResponse'
            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
"spotDatafeedSubscription")
            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
    CreateSpotDatafeedSubscription
  where
  hashWithSalt :: Int -> CreateSpotDatafeedSubscription -> Int
hashWithSalt
    Int
_salt
    CreateSpotDatafeedSubscription' {Maybe Bool
Maybe Text
Text
bucket :: Text
prefix :: Maybe Text
dryRun :: Maybe Bool
$sel:bucket:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Text
$sel:prefix:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Text
$sel:dryRun:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Bool
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bucket

instance
  Prelude.NFData
    CreateSpotDatafeedSubscription
  where
  rnf :: CreateSpotDatafeedSubscription -> ()
rnf CreateSpotDatafeedSubscription' {Maybe Bool
Maybe Text
Text
bucket :: Text
prefix :: Maybe Text
dryRun :: Maybe Bool
$sel:bucket:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Text
$sel:prefix:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Text
$sel:dryRun:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bucket

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

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

instance Data.ToQuery CreateSpotDatafeedSubscription where
  toQuery :: CreateSpotDatafeedSubscription -> QueryString
toQuery CreateSpotDatafeedSubscription' {Maybe Bool
Maybe Text
Text
bucket :: Text
prefix :: Maybe Text
dryRun :: Maybe Bool
$sel:bucket:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Text
$sel:prefix:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Text
$sel:dryRun:CreateSpotDatafeedSubscription' :: CreateSpotDatafeedSubscription -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CreateSpotDatafeedSubscription" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"Prefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
prefix,
        ByteString
"Bucket" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
bucket
      ]

-- | Contains the output of CreateSpotDatafeedSubscription.
--
-- /See:/ 'newCreateSpotDatafeedSubscriptionResponse' smart constructor.
data CreateSpotDatafeedSubscriptionResponse = CreateSpotDatafeedSubscriptionResponse'
  { -- | The Spot Instance data feed subscription.
    CreateSpotDatafeedSubscriptionResponse
-> Maybe SpotDatafeedSubscription
spotDatafeedSubscription :: Prelude.Maybe SpotDatafeedSubscription,
    -- | The response's http status code.
    CreateSpotDatafeedSubscriptionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateSpotDatafeedSubscriptionResponse
-> CreateSpotDatafeedSubscriptionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateSpotDatafeedSubscriptionResponse
-> CreateSpotDatafeedSubscriptionResponse -> Bool
$c/= :: CreateSpotDatafeedSubscriptionResponse
-> CreateSpotDatafeedSubscriptionResponse -> Bool
== :: CreateSpotDatafeedSubscriptionResponse
-> CreateSpotDatafeedSubscriptionResponse -> Bool
$c== :: CreateSpotDatafeedSubscriptionResponse
-> CreateSpotDatafeedSubscriptionResponse -> Bool
Prelude.Eq, ReadPrec [CreateSpotDatafeedSubscriptionResponse]
ReadPrec CreateSpotDatafeedSubscriptionResponse
Int -> ReadS CreateSpotDatafeedSubscriptionResponse
ReadS [CreateSpotDatafeedSubscriptionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateSpotDatafeedSubscriptionResponse]
$creadListPrec :: ReadPrec [CreateSpotDatafeedSubscriptionResponse]
readPrec :: ReadPrec CreateSpotDatafeedSubscriptionResponse
$creadPrec :: ReadPrec CreateSpotDatafeedSubscriptionResponse
readList :: ReadS [CreateSpotDatafeedSubscriptionResponse]
$creadList :: ReadS [CreateSpotDatafeedSubscriptionResponse]
readsPrec :: Int -> ReadS CreateSpotDatafeedSubscriptionResponse
$creadsPrec :: Int -> ReadS CreateSpotDatafeedSubscriptionResponse
Prelude.Read, Int -> CreateSpotDatafeedSubscriptionResponse -> ShowS
[CreateSpotDatafeedSubscriptionResponse] -> ShowS
CreateSpotDatafeedSubscriptionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateSpotDatafeedSubscriptionResponse] -> ShowS
$cshowList :: [CreateSpotDatafeedSubscriptionResponse] -> ShowS
show :: CreateSpotDatafeedSubscriptionResponse -> String
$cshow :: CreateSpotDatafeedSubscriptionResponse -> String
showsPrec :: Int -> CreateSpotDatafeedSubscriptionResponse -> ShowS
$cshowsPrec :: Int -> CreateSpotDatafeedSubscriptionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateSpotDatafeedSubscriptionResponse x
-> CreateSpotDatafeedSubscriptionResponse
forall x.
CreateSpotDatafeedSubscriptionResponse
-> Rep CreateSpotDatafeedSubscriptionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateSpotDatafeedSubscriptionResponse x
-> CreateSpotDatafeedSubscriptionResponse
$cfrom :: forall x.
CreateSpotDatafeedSubscriptionResponse
-> Rep CreateSpotDatafeedSubscriptionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateSpotDatafeedSubscriptionResponse' 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:
--
-- 'spotDatafeedSubscription', 'createSpotDatafeedSubscriptionResponse_spotDatafeedSubscription' - The Spot Instance data feed subscription.
--
-- 'httpStatus', 'createSpotDatafeedSubscriptionResponse_httpStatus' - The response's http status code.
newCreateSpotDatafeedSubscriptionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateSpotDatafeedSubscriptionResponse
newCreateSpotDatafeedSubscriptionResponse :: Int -> CreateSpotDatafeedSubscriptionResponse
newCreateSpotDatafeedSubscriptionResponse
  Int
pHttpStatus_ =
    CreateSpotDatafeedSubscriptionResponse'
      { $sel:spotDatafeedSubscription:CreateSpotDatafeedSubscriptionResponse' :: Maybe SpotDatafeedSubscription
spotDatafeedSubscription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateSpotDatafeedSubscriptionResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Spot Instance data feed subscription.
createSpotDatafeedSubscriptionResponse_spotDatafeedSubscription :: Lens.Lens' CreateSpotDatafeedSubscriptionResponse (Prelude.Maybe SpotDatafeedSubscription)
createSpotDatafeedSubscriptionResponse_spotDatafeedSubscription :: Lens'
  CreateSpotDatafeedSubscriptionResponse
  (Maybe SpotDatafeedSubscription)
createSpotDatafeedSubscriptionResponse_spotDatafeedSubscription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateSpotDatafeedSubscriptionResponse' {Maybe SpotDatafeedSubscription
spotDatafeedSubscription :: Maybe SpotDatafeedSubscription
$sel:spotDatafeedSubscription:CreateSpotDatafeedSubscriptionResponse' :: CreateSpotDatafeedSubscriptionResponse
-> Maybe SpotDatafeedSubscription
spotDatafeedSubscription} -> Maybe SpotDatafeedSubscription
spotDatafeedSubscription) (\s :: CreateSpotDatafeedSubscriptionResponse
s@CreateSpotDatafeedSubscriptionResponse' {} Maybe SpotDatafeedSubscription
a -> CreateSpotDatafeedSubscriptionResponse
s {$sel:spotDatafeedSubscription:CreateSpotDatafeedSubscriptionResponse' :: Maybe SpotDatafeedSubscription
spotDatafeedSubscription = Maybe SpotDatafeedSubscription
a} :: CreateSpotDatafeedSubscriptionResponse)

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

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