{-# 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.IoTSiteWise.PutStorageConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Configures storage settings for IoT SiteWise.
module Amazonka.IoTSiteWise.PutStorageConfiguration
  ( -- * Creating a Request
    PutStorageConfiguration (..),
    newPutStorageConfiguration,

    -- * Request Lenses
    putStorageConfiguration_disassociatedDataStorage,
    putStorageConfiguration_multiLayerStorage,
    putStorageConfiguration_retentionPeriod,
    putStorageConfiguration_storageType,

    -- * Destructuring the Response
    PutStorageConfigurationResponse (..),
    newPutStorageConfigurationResponse,

    -- * Response Lenses
    putStorageConfigurationResponse_disassociatedDataStorage,
    putStorageConfigurationResponse_multiLayerStorage,
    putStorageConfigurationResponse_retentionPeriod,
    putStorageConfigurationResponse_httpStatus,
    putStorageConfigurationResponse_storageType,
    putStorageConfigurationResponse_configurationStatus,
  )
where

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

-- | /See:/ 'newPutStorageConfiguration' smart constructor.
data PutStorageConfiguration = PutStorageConfiguration'
  { -- | Contains the storage configuration for time series (data streams) that
    -- aren\'t associated with asset properties. The @disassociatedDataStorage@
    -- can be one of the following values:
    --
    -- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
    --     with asset properties.
    --
    --     After the @disassociatedDataStorage@ is enabled, you can\'t disable
    --     it.
    --
    -- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
    --     that aren\'t associated with asset properties.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
    -- in the /IoT SiteWise User Guide/.
    PutStorageConfiguration -> Maybe DisassociatedDataStorageState
disassociatedDataStorage :: Prelude.Maybe DisassociatedDataStorageState,
    -- | Identifies a storage destination. If you specified @MULTI_LAYER_STORAGE@
    -- for the storage type, you must specify a @MultiLayerStorage@ object.
    PutStorageConfiguration -> Maybe MultiLayerStorage
multiLayerStorage :: Prelude.Maybe MultiLayerStorage,
    PutStorageConfiguration -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The storage tier that you specified for your data. The @storageType@
    -- parameter can be one of the following values:
    --
    -- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
    --     hot tier. The hot tier is a service-managed database.
    --
    -- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
    --     cold tier and the hot tier. The cold tier is a customer-managed
    --     Amazon S3 bucket.
    PutStorageConfiguration -> StorageType
storageType :: StorageType
  }
  deriving (PutStorageConfiguration -> PutStorageConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutStorageConfiguration -> PutStorageConfiguration -> Bool
$c/= :: PutStorageConfiguration -> PutStorageConfiguration -> Bool
== :: PutStorageConfiguration -> PutStorageConfiguration -> Bool
$c== :: PutStorageConfiguration -> PutStorageConfiguration -> Bool
Prelude.Eq, ReadPrec [PutStorageConfiguration]
ReadPrec PutStorageConfiguration
Int -> ReadS PutStorageConfiguration
ReadS [PutStorageConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutStorageConfiguration]
$creadListPrec :: ReadPrec [PutStorageConfiguration]
readPrec :: ReadPrec PutStorageConfiguration
$creadPrec :: ReadPrec PutStorageConfiguration
readList :: ReadS [PutStorageConfiguration]
$creadList :: ReadS [PutStorageConfiguration]
readsPrec :: Int -> ReadS PutStorageConfiguration
$creadsPrec :: Int -> ReadS PutStorageConfiguration
Prelude.Read, Int -> PutStorageConfiguration -> ShowS
[PutStorageConfiguration] -> ShowS
PutStorageConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutStorageConfiguration] -> ShowS
$cshowList :: [PutStorageConfiguration] -> ShowS
show :: PutStorageConfiguration -> String
$cshow :: PutStorageConfiguration -> String
showsPrec :: Int -> PutStorageConfiguration -> ShowS
$cshowsPrec :: Int -> PutStorageConfiguration -> ShowS
Prelude.Show, forall x. Rep PutStorageConfiguration x -> PutStorageConfiguration
forall x. PutStorageConfiguration -> Rep PutStorageConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutStorageConfiguration x -> PutStorageConfiguration
$cfrom :: forall x. PutStorageConfiguration -> Rep PutStorageConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'PutStorageConfiguration' 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:
--
-- 'disassociatedDataStorage', 'putStorageConfiguration_disassociatedDataStorage' - Contains the storage configuration for time series (data streams) that
-- aren\'t associated with asset properties. The @disassociatedDataStorage@
-- can be one of the following values:
--
-- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
--     with asset properties.
--
--     After the @disassociatedDataStorage@ is enabled, you can\'t disable
--     it.
--
-- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
--     that aren\'t associated with asset properties.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
-- in the /IoT SiteWise User Guide/.
--
-- 'multiLayerStorage', 'putStorageConfiguration_multiLayerStorage' - Identifies a storage destination. If you specified @MULTI_LAYER_STORAGE@
-- for the storage type, you must specify a @MultiLayerStorage@ object.
--
-- 'retentionPeriod', 'putStorageConfiguration_retentionPeriod' - Undocumented member.
--
-- 'storageType', 'putStorageConfiguration_storageType' - The storage tier that you specified for your data. The @storageType@
-- parameter can be one of the following values:
--
-- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
--     hot tier. The hot tier is a service-managed database.
--
-- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
--     cold tier and the hot tier. The cold tier is a customer-managed
--     Amazon S3 bucket.
newPutStorageConfiguration ::
  -- | 'storageType'
  StorageType ->
  PutStorageConfiguration
newPutStorageConfiguration :: StorageType -> PutStorageConfiguration
newPutStorageConfiguration StorageType
pStorageType_ =
  PutStorageConfiguration'
    { $sel:disassociatedDataStorage:PutStorageConfiguration' :: Maybe DisassociatedDataStorageState
disassociatedDataStorage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:multiLayerStorage:PutStorageConfiguration' :: Maybe MultiLayerStorage
multiLayerStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:PutStorageConfiguration' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:storageType:PutStorageConfiguration' :: StorageType
storageType = StorageType
pStorageType_
    }

-- | Contains the storage configuration for time series (data streams) that
-- aren\'t associated with asset properties. The @disassociatedDataStorage@
-- can be one of the following values:
--
-- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
--     with asset properties.
--
--     After the @disassociatedDataStorage@ is enabled, you can\'t disable
--     it.
--
-- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
--     that aren\'t associated with asset properties.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
-- in the /IoT SiteWise User Guide/.
putStorageConfiguration_disassociatedDataStorage :: Lens.Lens' PutStorageConfiguration (Prelude.Maybe DisassociatedDataStorageState)
putStorageConfiguration_disassociatedDataStorage :: Lens' PutStorageConfiguration (Maybe DisassociatedDataStorageState)
putStorageConfiguration_disassociatedDataStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfiguration' {Maybe DisassociatedDataStorageState
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:disassociatedDataStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe DisassociatedDataStorageState
disassociatedDataStorage} -> Maybe DisassociatedDataStorageState
disassociatedDataStorage) (\s :: PutStorageConfiguration
s@PutStorageConfiguration' {} Maybe DisassociatedDataStorageState
a -> PutStorageConfiguration
s {$sel:disassociatedDataStorage:PutStorageConfiguration' :: Maybe DisassociatedDataStorageState
disassociatedDataStorage = Maybe DisassociatedDataStorageState
a} :: PutStorageConfiguration)

-- | Identifies a storage destination. If you specified @MULTI_LAYER_STORAGE@
-- for the storage type, you must specify a @MultiLayerStorage@ object.
putStorageConfiguration_multiLayerStorage :: Lens.Lens' PutStorageConfiguration (Prelude.Maybe MultiLayerStorage)
putStorageConfiguration_multiLayerStorage :: Lens' PutStorageConfiguration (Maybe MultiLayerStorage)
putStorageConfiguration_multiLayerStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfiguration' {Maybe MultiLayerStorage
multiLayerStorage :: Maybe MultiLayerStorage
$sel:multiLayerStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe MultiLayerStorage
multiLayerStorage} -> Maybe MultiLayerStorage
multiLayerStorage) (\s :: PutStorageConfiguration
s@PutStorageConfiguration' {} Maybe MultiLayerStorage
a -> PutStorageConfiguration
s {$sel:multiLayerStorage:PutStorageConfiguration' :: Maybe MultiLayerStorage
multiLayerStorage = Maybe MultiLayerStorage
a} :: PutStorageConfiguration)

-- | Undocumented member.
putStorageConfiguration_retentionPeriod :: Lens.Lens' PutStorageConfiguration (Prelude.Maybe RetentionPeriod)
putStorageConfiguration_retentionPeriod :: Lens' PutStorageConfiguration (Maybe RetentionPeriod)
putStorageConfiguration_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfiguration' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: PutStorageConfiguration
s@PutStorageConfiguration' {} Maybe RetentionPeriod
a -> PutStorageConfiguration
s {$sel:retentionPeriod:PutStorageConfiguration' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: PutStorageConfiguration)

-- | The storage tier that you specified for your data. The @storageType@
-- parameter can be one of the following values:
--
-- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
--     hot tier. The hot tier is a service-managed database.
--
-- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
--     cold tier and the hot tier. The cold tier is a customer-managed
--     Amazon S3 bucket.
putStorageConfiguration_storageType :: Lens.Lens' PutStorageConfiguration StorageType
putStorageConfiguration_storageType :: Lens' PutStorageConfiguration StorageType
putStorageConfiguration_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfiguration' {StorageType
storageType :: StorageType
$sel:storageType:PutStorageConfiguration' :: PutStorageConfiguration -> StorageType
storageType} -> StorageType
storageType) (\s :: PutStorageConfiguration
s@PutStorageConfiguration' {} StorageType
a -> PutStorageConfiguration
s {$sel:storageType:PutStorageConfiguration' :: StorageType
storageType = StorageType
a} :: PutStorageConfiguration)

instance Core.AWSRequest PutStorageConfiguration where
  type
    AWSResponse PutStorageConfiguration =
      PutStorageConfigurationResponse
  request :: (Service -> Service)
-> PutStorageConfiguration -> Request PutStorageConfiguration
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 PutStorageConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutStorageConfiguration)))
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 DisassociatedDataStorageState
-> Maybe MultiLayerStorage
-> Maybe RetentionPeriod
-> Int
-> StorageType
-> ConfigurationStatus
-> PutStorageConfigurationResponse
PutStorageConfigurationResponse'
            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
"disassociatedDataStorage")
            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
"multiLayerStorage")
            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
"retentionPeriod")
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"storageType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"configurationStatus")
      )

instance Prelude.Hashable PutStorageConfiguration where
  hashWithSalt :: Int -> PutStorageConfiguration -> Int
hashWithSalt Int
_salt PutStorageConfiguration' {Maybe DisassociatedDataStorageState
Maybe MultiLayerStorage
Maybe RetentionPeriod
StorageType
storageType :: StorageType
retentionPeriod :: Maybe RetentionPeriod
multiLayerStorage :: Maybe MultiLayerStorage
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:storageType:PutStorageConfiguration' :: PutStorageConfiguration -> StorageType
$sel:retentionPeriod:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe RetentionPeriod
$sel:multiLayerStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe MultiLayerStorage
$sel:disassociatedDataStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe DisassociatedDataStorageState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DisassociatedDataStorageState
disassociatedDataStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MultiLayerStorage
multiLayerStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionPeriod
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StorageType
storageType

instance Prelude.NFData PutStorageConfiguration where
  rnf :: PutStorageConfiguration -> ()
rnf PutStorageConfiguration' {Maybe DisassociatedDataStorageState
Maybe MultiLayerStorage
Maybe RetentionPeriod
StorageType
storageType :: StorageType
retentionPeriod :: Maybe RetentionPeriod
multiLayerStorage :: Maybe MultiLayerStorage
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:storageType:PutStorageConfiguration' :: PutStorageConfiguration -> StorageType
$sel:retentionPeriod:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe RetentionPeriod
$sel:multiLayerStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe MultiLayerStorage
$sel:disassociatedDataStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe DisassociatedDataStorageState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DisassociatedDataStorageState
disassociatedDataStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MultiLayerStorage
multiLayerStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StorageType
storageType

instance Data.ToHeaders PutStorageConfiguration where
  toHeaders :: PutStorageConfiguration -> 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 PutStorageConfiguration where
  toJSON :: PutStorageConfiguration -> Value
toJSON PutStorageConfiguration' {Maybe DisassociatedDataStorageState
Maybe MultiLayerStorage
Maybe RetentionPeriod
StorageType
storageType :: StorageType
retentionPeriod :: Maybe RetentionPeriod
multiLayerStorage :: Maybe MultiLayerStorage
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:storageType:PutStorageConfiguration' :: PutStorageConfiguration -> StorageType
$sel:retentionPeriod:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe RetentionPeriod
$sel:multiLayerStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe MultiLayerStorage
$sel:disassociatedDataStorage:PutStorageConfiguration' :: PutStorageConfiguration -> Maybe DisassociatedDataStorageState
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"disassociatedDataStorage" 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 DisassociatedDataStorageState
disassociatedDataStorage,
            (Key
"multiLayerStorage" 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 MultiLayerStorage
multiLayerStorage,
            (Key
"retentionPeriod" 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 RetentionPeriod
retentionPeriod,
            forall a. a -> Maybe a
Prelude.Just (Key
"storageType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StorageType
storageType)
          ]
      )

instance Data.ToPath PutStorageConfiguration where
  toPath :: PutStorageConfiguration -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const ByteString
"/configuration/account/storage"

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

-- | /See:/ 'newPutStorageConfigurationResponse' smart constructor.
data PutStorageConfigurationResponse = PutStorageConfigurationResponse'
  { -- | Contains the storage configuration for time series (data streams) that
    -- aren\'t associated with asset properties. The @disassociatedDataStorage@
    -- can be one of the following values:
    --
    -- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
    --     with asset properties.
    --
    --     After the @disassociatedDataStorage@ is enabled, you can\'t disable
    --     it.
    --
    -- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
    --     that aren\'t associated with asset properties.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
    -- in the /IoT SiteWise User Guide/.
    PutStorageConfigurationResponse
-> Maybe DisassociatedDataStorageState
disassociatedDataStorage :: Prelude.Maybe DisassociatedDataStorageState,
    -- | Contains information about the storage destination.
    PutStorageConfigurationResponse -> Maybe MultiLayerStorage
multiLayerStorage :: Prelude.Maybe MultiLayerStorage,
    PutStorageConfigurationResponse -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The response's http status code.
    PutStorageConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The storage tier that you specified for your data. The @storageType@
    -- parameter can be one of the following values:
    --
    -- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
    --     hot tier. The hot tier is a service-managed database.
    --
    -- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
    --     cold tier and the hot tier. The cold tier is a customer-managed
    --     Amazon S3 bucket.
    PutStorageConfigurationResponse -> StorageType
storageType :: StorageType,
    PutStorageConfigurationResponse -> ConfigurationStatus
configurationStatus :: ConfigurationStatus
  }
  deriving (PutStorageConfigurationResponse
-> PutStorageConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutStorageConfigurationResponse
-> PutStorageConfigurationResponse -> Bool
$c/= :: PutStorageConfigurationResponse
-> PutStorageConfigurationResponse -> Bool
== :: PutStorageConfigurationResponse
-> PutStorageConfigurationResponse -> Bool
$c== :: PutStorageConfigurationResponse
-> PutStorageConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [PutStorageConfigurationResponse]
ReadPrec PutStorageConfigurationResponse
Int -> ReadS PutStorageConfigurationResponse
ReadS [PutStorageConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutStorageConfigurationResponse]
$creadListPrec :: ReadPrec [PutStorageConfigurationResponse]
readPrec :: ReadPrec PutStorageConfigurationResponse
$creadPrec :: ReadPrec PutStorageConfigurationResponse
readList :: ReadS [PutStorageConfigurationResponse]
$creadList :: ReadS [PutStorageConfigurationResponse]
readsPrec :: Int -> ReadS PutStorageConfigurationResponse
$creadsPrec :: Int -> ReadS PutStorageConfigurationResponse
Prelude.Read, Int -> PutStorageConfigurationResponse -> ShowS
[PutStorageConfigurationResponse] -> ShowS
PutStorageConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutStorageConfigurationResponse] -> ShowS
$cshowList :: [PutStorageConfigurationResponse] -> ShowS
show :: PutStorageConfigurationResponse -> String
$cshow :: PutStorageConfigurationResponse -> String
showsPrec :: Int -> PutStorageConfigurationResponse -> ShowS
$cshowsPrec :: Int -> PutStorageConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep PutStorageConfigurationResponse x
-> PutStorageConfigurationResponse
forall x.
PutStorageConfigurationResponse
-> Rep PutStorageConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutStorageConfigurationResponse x
-> PutStorageConfigurationResponse
$cfrom :: forall x.
PutStorageConfigurationResponse
-> Rep PutStorageConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutStorageConfigurationResponse' 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:
--
-- 'disassociatedDataStorage', 'putStorageConfigurationResponse_disassociatedDataStorage' - Contains the storage configuration for time series (data streams) that
-- aren\'t associated with asset properties. The @disassociatedDataStorage@
-- can be one of the following values:
--
-- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
--     with asset properties.
--
--     After the @disassociatedDataStorage@ is enabled, you can\'t disable
--     it.
--
-- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
--     that aren\'t associated with asset properties.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
-- in the /IoT SiteWise User Guide/.
--
-- 'multiLayerStorage', 'putStorageConfigurationResponse_multiLayerStorage' - Contains information about the storage destination.
--
-- 'retentionPeriod', 'putStorageConfigurationResponse_retentionPeriod' - Undocumented member.
--
-- 'httpStatus', 'putStorageConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'storageType', 'putStorageConfigurationResponse_storageType' - The storage tier that you specified for your data. The @storageType@
-- parameter can be one of the following values:
--
-- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
--     hot tier. The hot tier is a service-managed database.
--
-- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
--     cold tier and the hot tier. The cold tier is a customer-managed
--     Amazon S3 bucket.
--
-- 'configurationStatus', 'putStorageConfigurationResponse_configurationStatus' - Undocumented member.
newPutStorageConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'storageType'
  StorageType ->
  -- | 'configurationStatus'
  ConfigurationStatus ->
  PutStorageConfigurationResponse
newPutStorageConfigurationResponse :: Int
-> StorageType
-> ConfigurationStatus
-> PutStorageConfigurationResponse
newPutStorageConfigurationResponse
  Int
pHttpStatus_
  StorageType
pStorageType_
  ConfigurationStatus
pConfigurationStatus_ =
    PutStorageConfigurationResponse'
      { $sel:disassociatedDataStorage:PutStorageConfigurationResponse' :: Maybe DisassociatedDataStorageState
disassociatedDataStorage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:multiLayerStorage:PutStorageConfigurationResponse' :: Maybe MultiLayerStorage
multiLayerStorage = forall a. Maybe a
Prelude.Nothing,
        $sel:retentionPeriod:PutStorageConfigurationResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:PutStorageConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:storageType:PutStorageConfigurationResponse' :: StorageType
storageType = StorageType
pStorageType_,
        $sel:configurationStatus:PutStorageConfigurationResponse' :: ConfigurationStatus
configurationStatus =
          ConfigurationStatus
pConfigurationStatus_
      }

-- | Contains the storage configuration for time series (data streams) that
-- aren\'t associated with asset properties. The @disassociatedDataStorage@
-- can be one of the following values:
--
-- -   @ENABLED@ – IoT SiteWise accepts time series that aren\'t associated
--     with asset properties.
--
--     After the @disassociatedDataStorage@ is enabled, you can\'t disable
--     it.
--
-- -   @DISABLED@ – IoT SiteWise doesn\'t accept time series (data streams)
--     that aren\'t associated with asset properties.
--
-- For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/data-streams.html Data streams>
-- in the /IoT SiteWise User Guide/.
putStorageConfigurationResponse_disassociatedDataStorage :: Lens.Lens' PutStorageConfigurationResponse (Prelude.Maybe DisassociatedDataStorageState)
putStorageConfigurationResponse_disassociatedDataStorage :: Lens'
  PutStorageConfigurationResponse
  (Maybe DisassociatedDataStorageState)
putStorageConfigurationResponse_disassociatedDataStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfigurationResponse' {Maybe DisassociatedDataStorageState
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:disassociatedDataStorage:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse
-> Maybe DisassociatedDataStorageState
disassociatedDataStorage} -> Maybe DisassociatedDataStorageState
disassociatedDataStorage) (\s :: PutStorageConfigurationResponse
s@PutStorageConfigurationResponse' {} Maybe DisassociatedDataStorageState
a -> PutStorageConfigurationResponse
s {$sel:disassociatedDataStorage:PutStorageConfigurationResponse' :: Maybe DisassociatedDataStorageState
disassociatedDataStorage = Maybe DisassociatedDataStorageState
a} :: PutStorageConfigurationResponse)

-- | Contains information about the storage destination.
putStorageConfigurationResponse_multiLayerStorage :: Lens.Lens' PutStorageConfigurationResponse (Prelude.Maybe MultiLayerStorage)
putStorageConfigurationResponse_multiLayerStorage :: Lens' PutStorageConfigurationResponse (Maybe MultiLayerStorage)
putStorageConfigurationResponse_multiLayerStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfigurationResponse' {Maybe MultiLayerStorage
multiLayerStorage :: Maybe MultiLayerStorage
$sel:multiLayerStorage:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> Maybe MultiLayerStorage
multiLayerStorage} -> Maybe MultiLayerStorage
multiLayerStorage) (\s :: PutStorageConfigurationResponse
s@PutStorageConfigurationResponse' {} Maybe MultiLayerStorage
a -> PutStorageConfigurationResponse
s {$sel:multiLayerStorage:PutStorageConfigurationResponse' :: Maybe MultiLayerStorage
multiLayerStorage = Maybe MultiLayerStorage
a} :: PutStorageConfigurationResponse)

-- | Undocumented member.
putStorageConfigurationResponse_retentionPeriod :: Lens.Lens' PutStorageConfigurationResponse (Prelude.Maybe RetentionPeriod)
putStorageConfigurationResponse_retentionPeriod :: Lens' PutStorageConfigurationResponse (Maybe RetentionPeriod)
putStorageConfigurationResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfigurationResponse' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: PutStorageConfigurationResponse
s@PutStorageConfigurationResponse' {} Maybe RetentionPeriod
a -> PutStorageConfigurationResponse
s {$sel:retentionPeriod:PutStorageConfigurationResponse' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: PutStorageConfigurationResponse)

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

-- | The storage tier that you specified for your data. The @storageType@
-- parameter can be one of the following values:
--
-- -   @SITEWISE_DEFAULT_STORAGE@ – IoT SiteWise saves your data into the
--     hot tier. The hot tier is a service-managed database.
--
-- -   @MULTI_LAYER_STORAGE@ – IoT SiteWise saves your data in both the
--     cold tier and the hot tier. The cold tier is a customer-managed
--     Amazon S3 bucket.
putStorageConfigurationResponse_storageType :: Lens.Lens' PutStorageConfigurationResponse StorageType
putStorageConfigurationResponse_storageType :: Lens' PutStorageConfigurationResponse StorageType
putStorageConfigurationResponse_storageType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfigurationResponse' {StorageType
storageType :: StorageType
$sel:storageType:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> StorageType
storageType} -> StorageType
storageType) (\s :: PutStorageConfigurationResponse
s@PutStorageConfigurationResponse' {} StorageType
a -> PutStorageConfigurationResponse
s {$sel:storageType:PutStorageConfigurationResponse' :: StorageType
storageType = StorageType
a} :: PutStorageConfigurationResponse)

-- | Undocumented member.
putStorageConfigurationResponse_configurationStatus :: Lens.Lens' PutStorageConfigurationResponse ConfigurationStatus
putStorageConfigurationResponse_configurationStatus :: Lens' PutStorageConfigurationResponse ConfigurationStatus
putStorageConfigurationResponse_configurationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutStorageConfigurationResponse' {ConfigurationStatus
configurationStatus :: ConfigurationStatus
$sel:configurationStatus:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> ConfigurationStatus
configurationStatus} -> ConfigurationStatus
configurationStatus) (\s :: PutStorageConfigurationResponse
s@PutStorageConfigurationResponse' {} ConfigurationStatus
a -> PutStorageConfigurationResponse
s {$sel:configurationStatus:PutStorageConfigurationResponse' :: ConfigurationStatus
configurationStatus = ConfigurationStatus
a} :: PutStorageConfigurationResponse)

instance
  Prelude.NFData
    PutStorageConfigurationResponse
  where
  rnf :: PutStorageConfigurationResponse -> ()
rnf PutStorageConfigurationResponse' {Int
Maybe DisassociatedDataStorageState
Maybe MultiLayerStorage
Maybe RetentionPeriod
ConfigurationStatus
StorageType
configurationStatus :: ConfigurationStatus
storageType :: StorageType
httpStatus :: Int
retentionPeriod :: Maybe RetentionPeriod
multiLayerStorage :: Maybe MultiLayerStorage
disassociatedDataStorage :: Maybe DisassociatedDataStorageState
$sel:configurationStatus:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> ConfigurationStatus
$sel:storageType:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> StorageType
$sel:httpStatus:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> Int
$sel:retentionPeriod:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> Maybe RetentionPeriod
$sel:multiLayerStorage:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse -> Maybe MultiLayerStorage
$sel:disassociatedDataStorage:PutStorageConfigurationResponse' :: PutStorageConfigurationResponse
-> Maybe DisassociatedDataStorageState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DisassociatedDataStorageState
disassociatedDataStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MultiLayerStorage
multiLayerStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StorageType
storageType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConfigurationStatus
configurationStatus