{-# 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.Snowball.CreateLongTermPricing
-- 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 job with the long-term usage option for a device. The
-- long-term usage is a 1-year or 3-year long-term pricing type for the
-- device. You are billed upfront, and Amazon Web Services provides
-- discounts for long-term pricing.
module Amazonka.Snowball.CreateLongTermPricing
  ( -- * Creating a Request
    CreateLongTermPricing (..),
    newCreateLongTermPricing,

    -- * Request Lenses
    createLongTermPricing_isLongTermPricingAutoRenew,
    createLongTermPricing_snowballType,
    createLongTermPricing_longTermPricingType,

    -- * Destructuring the Response
    CreateLongTermPricingResponse (..),
    newCreateLongTermPricingResponse,

    -- * Response Lenses
    createLongTermPricingResponse_longTermPricingId,
    createLongTermPricingResponse_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.Snowball.Types

-- | /See:/ 'newCreateLongTermPricing' smart constructor.
data CreateLongTermPricing = CreateLongTermPricing'
  { -- | snowballty
    --
    -- Specifies whether the current long-term pricing type for the device
    -- should be renewed.
    CreateLongTermPricing -> Maybe Bool
isLongTermPricingAutoRenew :: Prelude.Maybe Prelude.Bool,
    -- | The type of Snow Family devices to use for the long-term pricing job.
    CreateLongTermPricing -> Maybe SnowballType
snowballType :: Prelude.Maybe SnowballType,
    -- | The type of long-term pricing option you want for the device, either
    -- 1-year or 3-year long-term pricing.
    CreateLongTermPricing -> LongTermPricingType
longTermPricingType :: LongTermPricingType
  }
  deriving (CreateLongTermPricing -> CreateLongTermPricing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLongTermPricing -> CreateLongTermPricing -> Bool
$c/= :: CreateLongTermPricing -> CreateLongTermPricing -> Bool
== :: CreateLongTermPricing -> CreateLongTermPricing -> Bool
$c== :: CreateLongTermPricing -> CreateLongTermPricing -> Bool
Prelude.Eq, ReadPrec [CreateLongTermPricing]
ReadPrec CreateLongTermPricing
Int -> ReadS CreateLongTermPricing
ReadS [CreateLongTermPricing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLongTermPricing]
$creadListPrec :: ReadPrec [CreateLongTermPricing]
readPrec :: ReadPrec CreateLongTermPricing
$creadPrec :: ReadPrec CreateLongTermPricing
readList :: ReadS [CreateLongTermPricing]
$creadList :: ReadS [CreateLongTermPricing]
readsPrec :: Int -> ReadS CreateLongTermPricing
$creadsPrec :: Int -> ReadS CreateLongTermPricing
Prelude.Read, Int -> CreateLongTermPricing -> ShowS
[CreateLongTermPricing] -> ShowS
CreateLongTermPricing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLongTermPricing] -> ShowS
$cshowList :: [CreateLongTermPricing] -> ShowS
show :: CreateLongTermPricing -> String
$cshow :: CreateLongTermPricing -> String
showsPrec :: Int -> CreateLongTermPricing -> ShowS
$cshowsPrec :: Int -> CreateLongTermPricing -> ShowS
Prelude.Show, forall x. Rep CreateLongTermPricing x -> CreateLongTermPricing
forall x. CreateLongTermPricing -> Rep CreateLongTermPricing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLongTermPricing x -> CreateLongTermPricing
$cfrom :: forall x. CreateLongTermPricing -> Rep CreateLongTermPricing x
Prelude.Generic)

-- |
-- Create a value of 'CreateLongTermPricing' 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:
--
-- 'isLongTermPricingAutoRenew', 'createLongTermPricing_isLongTermPricingAutoRenew' - snowballty
--
-- Specifies whether the current long-term pricing type for the device
-- should be renewed.
--
-- 'snowballType', 'createLongTermPricing_snowballType' - The type of Snow Family devices to use for the long-term pricing job.
--
-- 'longTermPricingType', 'createLongTermPricing_longTermPricingType' - The type of long-term pricing option you want for the device, either
-- 1-year or 3-year long-term pricing.
newCreateLongTermPricing ::
  -- | 'longTermPricingType'
  LongTermPricingType ->
  CreateLongTermPricing
newCreateLongTermPricing :: LongTermPricingType -> CreateLongTermPricing
newCreateLongTermPricing LongTermPricingType
pLongTermPricingType_ =
  CreateLongTermPricing'
    { $sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: Maybe Bool
isLongTermPricingAutoRenew =
        forall a. Maybe a
Prelude.Nothing,
      $sel:snowballType:CreateLongTermPricing' :: Maybe SnowballType
snowballType = forall a. Maybe a
Prelude.Nothing,
      $sel:longTermPricingType:CreateLongTermPricing' :: LongTermPricingType
longTermPricingType = LongTermPricingType
pLongTermPricingType_
    }

-- | snowballty
--
-- Specifies whether the current long-term pricing type for the device
-- should be renewed.
createLongTermPricing_isLongTermPricingAutoRenew :: Lens.Lens' CreateLongTermPricing (Prelude.Maybe Prelude.Bool)
createLongTermPricing_isLongTermPricingAutoRenew :: Lens' CreateLongTermPricing (Maybe Bool)
createLongTermPricing_isLongTermPricingAutoRenew = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLongTermPricing' {Maybe Bool
isLongTermPricingAutoRenew :: Maybe Bool
$sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe Bool
isLongTermPricingAutoRenew} -> Maybe Bool
isLongTermPricingAutoRenew) (\s :: CreateLongTermPricing
s@CreateLongTermPricing' {} Maybe Bool
a -> CreateLongTermPricing
s {$sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: Maybe Bool
isLongTermPricingAutoRenew = Maybe Bool
a} :: CreateLongTermPricing)

-- | The type of Snow Family devices to use for the long-term pricing job.
createLongTermPricing_snowballType :: Lens.Lens' CreateLongTermPricing (Prelude.Maybe SnowballType)
createLongTermPricing_snowballType :: Lens' CreateLongTermPricing (Maybe SnowballType)
createLongTermPricing_snowballType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLongTermPricing' {Maybe SnowballType
snowballType :: Maybe SnowballType
$sel:snowballType:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe SnowballType
snowballType} -> Maybe SnowballType
snowballType) (\s :: CreateLongTermPricing
s@CreateLongTermPricing' {} Maybe SnowballType
a -> CreateLongTermPricing
s {$sel:snowballType:CreateLongTermPricing' :: Maybe SnowballType
snowballType = Maybe SnowballType
a} :: CreateLongTermPricing)

-- | The type of long-term pricing option you want for the device, either
-- 1-year or 3-year long-term pricing.
createLongTermPricing_longTermPricingType :: Lens.Lens' CreateLongTermPricing LongTermPricingType
createLongTermPricing_longTermPricingType :: Lens' CreateLongTermPricing LongTermPricingType
createLongTermPricing_longTermPricingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLongTermPricing' {LongTermPricingType
longTermPricingType :: LongTermPricingType
$sel:longTermPricingType:CreateLongTermPricing' :: CreateLongTermPricing -> LongTermPricingType
longTermPricingType} -> LongTermPricingType
longTermPricingType) (\s :: CreateLongTermPricing
s@CreateLongTermPricing' {} LongTermPricingType
a -> CreateLongTermPricing
s {$sel:longTermPricingType:CreateLongTermPricing' :: LongTermPricingType
longTermPricingType = LongTermPricingType
a} :: CreateLongTermPricing)

instance Core.AWSRequest CreateLongTermPricing where
  type
    AWSResponse CreateLongTermPricing =
      CreateLongTermPricingResponse
  request :: (Service -> Service)
-> CreateLongTermPricing -> Request CreateLongTermPricing
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 CreateLongTermPricing
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLongTermPricing)))
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 Text -> Int -> CreateLongTermPricingResponse
CreateLongTermPricingResponse'
            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
"LongTermPricingId")
            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 CreateLongTermPricing where
  hashWithSalt :: Int -> CreateLongTermPricing -> Int
hashWithSalt Int
_salt CreateLongTermPricing' {Maybe Bool
Maybe SnowballType
LongTermPricingType
longTermPricingType :: LongTermPricingType
snowballType :: Maybe SnowballType
isLongTermPricingAutoRenew :: Maybe Bool
$sel:longTermPricingType:CreateLongTermPricing' :: CreateLongTermPricing -> LongTermPricingType
$sel:snowballType:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe SnowballType
$sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isLongTermPricingAutoRenew
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SnowballType
snowballType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LongTermPricingType
longTermPricingType

instance Prelude.NFData CreateLongTermPricing where
  rnf :: CreateLongTermPricing -> ()
rnf CreateLongTermPricing' {Maybe Bool
Maybe SnowballType
LongTermPricingType
longTermPricingType :: LongTermPricingType
snowballType :: Maybe SnowballType
isLongTermPricingAutoRenew :: Maybe Bool
$sel:longTermPricingType:CreateLongTermPricing' :: CreateLongTermPricing -> LongTermPricingType
$sel:snowballType:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe SnowballType
$sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isLongTermPricingAutoRenew
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SnowballType
snowballType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LongTermPricingType
longTermPricingType

instance Data.ToHeaders CreateLongTermPricing where
  toHeaders :: CreateLongTermPricing -> 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
"AWSIESnowballJobManagementService.CreateLongTermPricing" ::
                          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 CreateLongTermPricing where
  toJSON :: CreateLongTermPricing -> Value
toJSON CreateLongTermPricing' {Maybe Bool
Maybe SnowballType
LongTermPricingType
longTermPricingType :: LongTermPricingType
snowballType :: Maybe SnowballType
isLongTermPricingAutoRenew :: Maybe Bool
$sel:longTermPricingType:CreateLongTermPricing' :: CreateLongTermPricing -> LongTermPricingType
$sel:snowballType:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe SnowballType
$sel:isLongTermPricingAutoRenew:CreateLongTermPricing' :: CreateLongTermPricing -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IsLongTermPricingAutoRenew" 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 Bool
isLongTermPricingAutoRenew,
            (Key
"SnowballType" 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 SnowballType
snowballType,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"LongTermPricingType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LongTermPricingType
longTermPricingType)
          ]
      )

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

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

-- | /See:/ 'newCreateLongTermPricingResponse' smart constructor.
data CreateLongTermPricingResponse = CreateLongTermPricingResponse'
  { -- | The ID of the long-term pricing type for the device.
    CreateLongTermPricingResponse -> Maybe Text
longTermPricingId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateLongTermPricingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateLongTermPricingResponse
-> CreateLongTermPricingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLongTermPricingResponse
-> CreateLongTermPricingResponse -> Bool
$c/= :: CreateLongTermPricingResponse
-> CreateLongTermPricingResponse -> Bool
== :: CreateLongTermPricingResponse
-> CreateLongTermPricingResponse -> Bool
$c== :: CreateLongTermPricingResponse
-> CreateLongTermPricingResponse -> Bool
Prelude.Eq, ReadPrec [CreateLongTermPricingResponse]
ReadPrec CreateLongTermPricingResponse
Int -> ReadS CreateLongTermPricingResponse
ReadS [CreateLongTermPricingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLongTermPricingResponse]
$creadListPrec :: ReadPrec [CreateLongTermPricingResponse]
readPrec :: ReadPrec CreateLongTermPricingResponse
$creadPrec :: ReadPrec CreateLongTermPricingResponse
readList :: ReadS [CreateLongTermPricingResponse]
$creadList :: ReadS [CreateLongTermPricingResponse]
readsPrec :: Int -> ReadS CreateLongTermPricingResponse
$creadsPrec :: Int -> ReadS CreateLongTermPricingResponse
Prelude.Read, Int -> CreateLongTermPricingResponse -> ShowS
[CreateLongTermPricingResponse] -> ShowS
CreateLongTermPricingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLongTermPricingResponse] -> ShowS
$cshowList :: [CreateLongTermPricingResponse] -> ShowS
show :: CreateLongTermPricingResponse -> String
$cshow :: CreateLongTermPricingResponse -> String
showsPrec :: Int -> CreateLongTermPricingResponse -> ShowS
$cshowsPrec :: Int -> CreateLongTermPricingResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLongTermPricingResponse x
-> CreateLongTermPricingResponse
forall x.
CreateLongTermPricingResponse
-> Rep CreateLongTermPricingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLongTermPricingResponse x
-> CreateLongTermPricingResponse
$cfrom :: forall x.
CreateLongTermPricingResponse
-> Rep CreateLongTermPricingResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLongTermPricingResponse' 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:
--
-- 'longTermPricingId', 'createLongTermPricingResponse_longTermPricingId' - The ID of the long-term pricing type for the device.
--
-- 'httpStatus', 'createLongTermPricingResponse_httpStatus' - The response's http status code.
newCreateLongTermPricingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateLongTermPricingResponse
newCreateLongTermPricingResponse :: Int -> CreateLongTermPricingResponse
newCreateLongTermPricingResponse Int
pHttpStatus_ =
  CreateLongTermPricingResponse'
    { $sel:longTermPricingId:CreateLongTermPricingResponse' :: Maybe Text
longTermPricingId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateLongTermPricingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the long-term pricing type for the device.
createLongTermPricingResponse_longTermPricingId :: Lens.Lens' CreateLongTermPricingResponse (Prelude.Maybe Prelude.Text)
createLongTermPricingResponse_longTermPricingId :: Lens' CreateLongTermPricingResponse (Maybe Text)
createLongTermPricingResponse_longTermPricingId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLongTermPricingResponse' {Maybe Text
longTermPricingId :: Maybe Text
$sel:longTermPricingId:CreateLongTermPricingResponse' :: CreateLongTermPricingResponse -> Maybe Text
longTermPricingId} -> Maybe Text
longTermPricingId) (\s :: CreateLongTermPricingResponse
s@CreateLongTermPricingResponse' {} Maybe Text
a -> CreateLongTermPricingResponse
s {$sel:longTermPricingId:CreateLongTermPricingResponse' :: Maybe Text
longTermPricingId = Maybe Text
a} :: CreateLongTermPricingResponse)

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

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