{-# 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.IoTAnalytics.CreateDatastore
-- 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 store, which is a repository for messages.
module Amazonka.IoTAnalytics.CreateDatastore
  ( -- * Creating a Request
    CreateDatastore (..),
    newCreateDatastore,

    -- * Request Lenses
    createDatastore_datastorePartitions,
    createDatastore_datastoreStorage,
    createDatastore_fileFormatConfiguration,
    createDatastore_retentionPeriod,
    createDatastore_tags,
    createDatastore_datastoreName,

    -- * Destructuring the Response
    CreateDatastoreResponse (..),
    newCreateDatastoreResponse,

    -- * Response Lenses
    createDatastoreResponse_datastoreArn,
    createDatastoreResponse_datastoreName,
    createDatastoreResponse_retentionPeriod,
    createDatastoreResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateDatastore' smart constructor.
data CreateDatastore = CreateDatastore'
  { -- | Contains information about the partition dimensions in a data store.
    CreateDatastore -> Maybe DatastorePartitions
datastorePartitions :: Prelude.Maybe DatastorePartitions,
    -- | Where data in a data store is stored.. You can choose @serviceManagedS3@
    -- storage, @customerManagedS3@ storage, or @iotSiteWiseMultiLayerStorage@
    -- storage. The default is @serviceManagedS3@. You can\'t change the choice
    -- of Amazon S3 storage after your data store is created.
    CreateDatastore -> Maybe DatastoreStorage
datastoreStorage :: Prelude.Maybe DatastoreStorage,
    -- | Contains the configuration information of file formats. IoT Analytics
    -- data stores support JSON and <https://parquet.apache.org/ Parquet>.
    --
    -- The default file format is JSON. You can specify only one format.
    --
    -- You can\'t change the file format after you create the data store.
    CreateDatastore -> Maybe FileFormatConfiguration
fileFormatConfiguration :: Prelude.Maybe FileFormatConfiguration,
    -- | How long, in days, message data is kept for the data store. When
    -- @customerManagedS3@ storage is selected, this parameter is ignored.
    CreateDatastore -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | Metadata which can be used to manage the data store.
    CreateDatastore -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | The name of the data store.
    CreateDatastore -> Text
datastoreName :: Prelude.Text
  }
  deriving (CreateDatastore -> CreateDatastore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDatastore -> CreateDatastore -> Bool
$c/= :: CreateDatastore -> CreateDatastore -> Bool
== :: CreateDatastore -> CreateDatastore -> Bool
$c== :: CreateDatastore -> CreateDatastore -> Bool
Prelude.Eq, ReadPrec [CreateDatastore]
ReadPrec CreateDatastore
Int -> ReadS CreateDatastore
ReadS [CreateDatastore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDatastore]
$creadListPrec :: ReadPrec [CreateDatastore]
readPrec :: ReadPrec CreateDatastore
$creadPrec :: ReadPrec CreateDatastore
readList :: ReadS [CreateDatastore]
$creadList :: ReadS [CreateDatastore]
readsPrec :: Int -> ReadS CreateDatastore
$creadsPrec :: Int -> ReadS CreateDatastore
Prelude.Read, Int -> CreateDatastore -> ShowS
[CreateDatastore] -> ShowS
CreateDatastore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDatastore] -> ShowS
$cshowList :: [CreateDatastore] -> ShowS
show :: CreateDatastore -> String
$cshow :: CreateDatastore -> String
showsPrec :: Int -> CreateDatastore -> ShowS
$cshowsPrec :: Int -> CreateDatastore -> ShowS
Prelude.Show, forall x. Rep CreateDatastore x -> CreateDatastore
forall x. CreateDatastore -> Rep CreateDatastore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDatastore x -> CreateDatastore
$cfrom :: forall x. CreateDatastore -> Rep CreateDatastore x
Prelude.Generic)

-- |
-- Create a value of 'CreateDatastore' 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:
--
-- 'datastorePartitions', 'createDatastore_datastorePartitions' - Contains information about the partition dimensions in a data store.
--
-- 'datastoreStorage', 'createDatastore_datastoreStorage' - Where data in a data store is stored.. You can choose @serviceManagedS3@
-- storage, @customerManagedS3@ storage, or @iotSiteWiseMultiLayerStorage@
-- storage. The default is @serviceManagedS3@. You can\'t change the choice
-- of Amazon S3 storage after your data store is created.
--
-- 'fileFormatConfiguration', 'createDatastore_fileFormatConfiguration' - Contains the configuration information of file formats. IoT Analytics
-- data stores support JSON and <https://parquet.apache.org/ Parquet>.
--
-- The default file format is JSON. You can specify only one format.
--
-- You can\'t change the file format after you create the data store.
--
-- 'retentionPeriod', 'createDatastore_retentionPeriod' - How long, in days, message data is kept for the data store. When
-- @customerManagedS3@ storage is selected, this parameter is ignored.
--
-- 'tags', 'createDatastore_tags' - Metadata which can be used to manage the data store.
--
-- 'datastoreName', 'createDatastore_datastoreName' - The name of the data store.
newCreateDatastore ::
  -- | 'datastoreName'
  Prelude.Text ->
  CreateDatastore
newCreateDatastore :: Text -> CreateDatastore
newCreateDatastore Text
pDatastoreName_ =
  CreateDatastore'
    { $sel:datastorePartitions:CreateDatastore' :: Maybe DatastorePartitions
datastorePartitions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:datastoreStorage:CreateDatastore' :: Maybe DatastoreStorage
datastoreStorage = forall a. Maybe a
Prelude.Nothing,
      $sel:fileFormatConfiguration:CreateDatastore' :: Maybe FileFormatConfiguration
fileFormatConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:CreateDatastore' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateDatastore' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:datastoreName:CreateDatastore' :: Text
datastoreName = Text
pDatastoreName_
    }

-- | Contains information about the partition dimensions in a data store.
createDatastore_datastorePartitions :: Lens.Lens' CreateDatastore (Prelude.Maybe DatastorePartitions)
createDatastore_datastorePartitions :: Lens' CreateDatastore (Maybe DatastorePartitions)
createDatastore_datastorePartitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Maybe DatastorePartitions
datastorePartitions :: Maybe DatastorePartitions
$sel:datastorePartitions:CreateDatastore' :: CreateDatastore -> Maybe DatastorePartitions
datastorePartitions} -> Maybe DatastorePartitions
datastorePartitions) (\s :: CreateDatastore
s@CreateDatastore' {} Maybe DatastorePartitions
a -> CreateDatastore
s {$sel:datastorePartitions:CreateDatastore' :: Maybe DatastorePartitions
datastorePartitions = Maybe DatastorePartitions
a} :: CreateDatastore)

-- | Where data in a data store is stored.. You can choose @serviceManagedS3@
-- storage, @customerManagedS3@ storage, or @iotSiteWiseMultiLayerStorage@
-- storage. The default is @serviceManagedS3@. You can\'t change the choice
-- of Amazon S3 storage after your data store is created.
createDatastore_datastoreStorage :: Lens.Lens' CreateDatastore (Prelude.Maybe DatastoreStorage)
createDatastore_datastoreStorage :: Lens' CreateDatastore (Maybe DatastoreStorage)
createDatastore_datastoreStorage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Maybe DatastoreStorage
datastoreStorage :: Maybe DatastoreStorage
$sel:datastoreStorage:CreateDatastore' :: CreateDatastore -> Maybe DatastoreStorage
datastoreStorage} -> Maybe DatastoreStorage
datastoreStorage) (\s :: CreateDatastore
s@CreateDatastore' {} Maybe DatastoreStorage
a -> CreateDatastore
s {$sel:datastoreStorage:CreateDatastore' :: Maybe DatastoreStorage
datastoreStorage = Maybe DatastoreStorage
a} :: CreateDatastore)

-- | Contains the configuration information of file formats. IoT Analytics
-- data stores support JSON and <https://parquet.apache.org/ Parquet>.
--
-- The default file format is JSON. You can specify only one format.
--
-- You can\'t change the file format after you create the data store.
createDatastore_fileFormatConfiguration :: Lens.Lens' CreateDatastore (Prelude.Maybe FileFormatConfiguration)
createDatastore_fileFormatConfiguration :: Lens' CreateDatastore (Maybe FileFormatConfiguration)
createDatastore_fileFormatConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Maybe FileFormatConfiguration
fileFormatConfiguration :: Maybe FileFormatConfiguration
$sel:fileFormatConfiguration:CreateDatastore' :: CreateDatastore -> Maybe FileFormatConfiguration
fileFormatConfiguration} -> Maybe FileFormatConfiguration
fileFormatConfiguration) (\s :: CreateDatastore
s@CreateDatastore' {} Maybe FileFormatConfiguration
a -> CreateDatastore
s {$sel:fileFormatConfiguration:CreateDatastore' :: Maybe FileFormatConfiguration
fileFormatConfiguration = Maybe FileFormatConfiguration
a} :: CreateDatastore)

-- | How long, in days, message data is kept for the data store. When
-- @customerManagedS3@ storage is selected, this parameter is ignored.
createDatastore_retentionPeriod :: Lens.Lens' CreateDatastore (Prelude.Maybe RetentionPeriod)
createDatastore_retentionPeriod :: Lens' CreateDatastore (Maybe RetentionPeriod)
createDatastore_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:CreateDatastore' :: CreateDatastore -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: CreateDatastore
s@CreateDatastore' {} Maybe RetentionPeriod
a -> CreateDatastore
s {$sel:retentionPeriod:CreateDatastore' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: CreateDatastore)

-- | Metadata which can be used to manage the data store.
createDatastore_tags :: Lens.Lens' CreateDatastore (Prelude.Maybe (Prelude.NonEmpty Tag))
createDatastore_tags :: Lens' CreateDatastore (Maybe (NonEmpty Tag))
createDatastore_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:CreateDatastore' :: CreateDatastore -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: CreateDatastore
s@CreateDatastore' {} Maybe (NonEmpty Tag)
a -> CreateDatastore
s {$sel:tags:CreateDatastore' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: CreateDatastore) 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 name of the data store.
createDatastore_datastoreName :: Lens.Lens' CreateDatastore Prelude.Text
createDatastore_datastoreName :: Lens' CreateDatastore Text
createDatastore_datastoreName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastore' {Text
datastoreName :: Text
$sel:datastoreName:CreateDatastore' :: CreateDatastore -> Text
datastoreName} -> Text
datastoreName) (\s :: CreateDatastore
s@CreateDatastore' {} Text
a -> CreateDatastore
s {$sel:datastoreName:CreateDatastore' :: Text
datastoreName = Text
a} :: CreateDatastore)

instance Core.AWSRequest CreateDatastore where
  type
    AWSResponse CreateDatastore =
      CreateDatastoreResponse
  request :: (Service -> Service) -> CreateDatastore -> Request CreateDatastore
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 CreateDatastore
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDatastore)))
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
-> Maybe Text
-> Maybe RetentionPeriod
-> Int
-> CreateDatastoreResponse
CreateDatastoreResponse'
            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
"datastoreArn")
            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
"datastoreName")
            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))
      )

instance Prelude.Hashable CreateDatastore where
  hashWithSalt :: Int -> CreateDatastore -> Int
hashWithSalt Int
_salt CreateDatastore' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe FileFormatConfiguration
Maybe DatastoreStorage
Maybe DatastorePartitions
Text
datastoreName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
fileFormatConfiguration :: Maybe FileFormatConfiguration
datastoreStorage :: Maybe DatastoreStorage
datastorePartitions :: Maybe DatastorePartitions
$sel:datastoreName:CreateDatastore' :: CreateDatastore -> Text
$sel:tags:CreateDatastore' :: CreateDatastore -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateDatastore' :: CreateDatastore -> Maybe RetentionPeriod
$sel:fileFormatConfiguration:CreateDatastore' :: CreateDatastore -> Maybe FileFormatConfiguration
$sel:datastoreStorage:CreateDatastore' :: CreateDatastore -> Maybe DatastoreStorage
$sel:datastorePartitions:CreateDatastore' :: CreateDatastore -> Maybe DatastorePartitions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DatastorePartitions
datastorePartitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DatastoreStorage
datastoreStorage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FileFormatConfiguration
fileFormatConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionPeriod
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datastoreName

instance Prelude.NFData CreateDatastore where
  rnf :: CreateDatastore -> ()
rnf CreateDatastore' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe FileFormatConfiguration
Maybe DatastoreStorage
Maybe DatastorePartitions
Text
datastoreName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
fileFormatConfiguration :: Maybe FileFormatConfiguration
datastoreStorage :: Maybe DatastoreStorage
datastorePartitions :: Maybe DatastorePartitions
$sel:datastoreName:CreateDatastore' :: CreateDatastore -> Text
$sel:tags:CreateDatastore' :: CreateDatastore -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateDatastore' :: CreateDatastore -> Maybe RetentionPeriod
$sel:fileFormatConfiguration:CreateDatastore' :: CreateDatastore -> Maybe FileFormatConfiguration
$sel:datastoreStorage:CreateDatastore' :: CreateDatastore -> Maybe DatastoreStorage
$sel:datastorePartitions:CreateDatastore' :: CreateDatastore -> Maybe DatastorePartitions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DatastorePartitions
datastorePartitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DatastoreStorage
datastoreStorage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FileFormatConfiguration
fileFormatConfiguration
      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 Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datastoreName

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

instance Data.ToJSON CreateDatastore where
  toJSON :: CreateDatastore -> Value
toJSON CreateDatastore' {Maybe (NonEmpty Tag)
Maybe RetentionPeriod
Maybe FileFormatConfiguration
Maybe DatastoreStorage
Maybe DatastorePartitions
Text
datastoreName :: Text
tags :: Maybe (NonEmpty Tag)
retentionPeriod :: Maybe RetentionPeriod
fileFormatConfiguration :: Maybe FileFormatConfiguration
datastoreStorage :: Maybe DatastoreStorage
datastorePartitions :: Maybe DatastorePartitions
$sel:datastoreName:CreateDatastore' :: CreateDatastore -> Text
$sel:tags:CreateDatastore' :: CreateDatastore -> Maybe (NonEmpty Tag)
$sel:retentionPeriod:CreateDatastore' :: CreateDatastore -> Maybe RetentionPeriod
$sel:fileFormatConfiguration:CreateDatastore' :: CreateDatastore -> Maybe FileFormatConfiguration
$sel:datastoreStorage:CreateDatastore' :: CreateDatastore -> Maybe DatastoreStorage
$sel:datastorePartitions:CreateDatastore' :: CreateDatastore -> Maybe DatastorePartitions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"datastorePartitions" 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 DatastorePartitions
datastorePartitions,
            (Key
"datastoreStorage" 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 DatastoreStorage
datastoreStorage,
            (Key
"fileFormatConfiguration" 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 FileFormatConfiguration
fileFormatConfiguration,
            (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,
            (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 (NonEmpty Tag)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"datastoreName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
datastoreName)
          ]
      )

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

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

-- | /See:/ 'newCreateDatastoreResponse' smart constructor.
data CreateDatastoreResponse = CreateDatastoreResponse'
  { -- | The ARN of the data store.
    CreateDatastoreResponse -> Maybe Text
datastoreArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the data store.
    CreateDatastoreResponse -> Maybe Text
datastoreName :: Prelude.Maybe Prelude.Text,
    -- | How long, in days, message data is kept for the data store.
    CreateDatastoreResponse -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The response's http status code.
    CreateDatastoreResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDatastoreResponse -> CreateDatastoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDatastoreResponse -> CreateDatastoreResponse -> Bool
$c/= :: CreateDatastoreResponse -> CreateDatastoreResponse -> Bool
== :: CreateDatastoreResponse -> CreateDatastoreResponse -> Bool
$c== :: CreateDatastoreResponse -> CreateDatastoreResponse -> Bool
Prelude.Eq, ReadPrec [CreateDatastoreResponse]
ReadPrec CreateDatastoreResponse
Int -> ReadS CreateDatastoreResponse
ReadS [CreateDatastoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDatastoreResponse]
$creadListPrec :: ReadPrec [CreateDatastoreResponse]
readPrec :: ReadPrec CreateDatastoreResponse
$creadPrec :: ReadPrec CreateDatastoreResponse
readList :: ReadS [CreateDatastoreResponse]
$creadList :: ReadS [CreateDatastoreResponse]
readsPrec :: Int -> ReadS CreateDatastoreResponse
$creadsPrec :: Int -> ReadS CreateDatastoreResponse
Prelude.Read, Int -> CreateDatastoreResponse -> ShowS
[CreateDatastoreResponse] -> ShowS
CreateDatastoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDatastoreResponse] -> ShowS
$cshowList :: [CreateDatastoreResponse] -> ShowS
show :: CreateDatastoreResponse -> String
$cshow :: CreateDatastoreResponse -> String
showsPrec :: Int -> CreateDatastoreResponse -> ShowS
$cshowsPrec :: Int -> CreateDatastoreResponse -> ShowS
Prelude.Show, forall x. Rep CreateDatastoreResponse x -> CreateDatastoreResponse
forall x. CreateDatastoreResponse -> Rep CreateDatastoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDatastoreResponse x -> CreateDatastoreResponse
$cfrom :: forall x. CreateDatastoreResponse -> Rep CreateDatastoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDatastoreResponse' 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:
--
-- 'datastoreArn', 'createDatastoreResponse_datastoreArn' - The ARN of the data store.
--
-- 'datastoreName', 'createDatastoreResponse_datastoreName' - The name of the data store.
--
-- 'retentionPeriod', 'createDatastoreResponse_retentionPeriod' - How long, in days, message data is kept for the data store.
--
-- 'httpStatus', 'createDatastoreResponse_httpStatus' - The response's http status code.
newCreateDatastoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDatastoreResponse
newCreateDatastoreResponse :: Int -> CreateDatastoreResponse
newCreateDatastoreResponse Int
pHttpStatus_ =
  CreateDatastoreResponse'
    { $sel:datastoreArn:CreateDatastoreResponse' :: Maybe Text
datastoreArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:datastoreName:CreateDatastoreResponse' :: Maybe Text
datastoreName = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:CreateDatastoreResponse' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDatastoreResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the data store.
createDatastoreResponse_datastoreArn :: Lens.Lens' CreateDatastoreResponse (Prelude.Maybe Prelude.Text)
createDatastoreResponse_datastoreArn :: Lens' CreateDatastoreResponse (Maybe Text)
createDatastoreResponse_datastoreArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastoreResponse' {Maybe Text
datastoreArn :: Maybe Text
$sel:datastoreArn:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe Text
datastoreArn} -> Maybe Text
datastoreArn) (\s :: CreateDatastoreResponse
s@CreateDatastoreResponse' {} Maybe Text
a -> CreateDatastoreResponse
s {$sel:datastoreArn:CreateDatastoreResponse' :: Maybe Text
datastoreArn = Maybe Text
a} :: CreateDatastoreResponse)

-- | The name of the data store.
createDatastoreResponse_datastoreName :: Lens.Lens' CreateDatastoreResponse (Prelude.Maybe Prelude.Text)
createDatastoreResponse_datastoreName :: Lens' CreateDatastoreResponse (Maybe Text)
createDatastoreResponse_datastoreName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastoreResponse' {Maybe Text
datastoreName :: Maybe Text
$sel:datastoreName:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe Text
datastoreName} -> Maybe Text
datastoreName) (\s :: CreateDatastoreResponse
s@CreateDatastoreResponse' {} Maybe Text
a -> CreateDatastoreResponse
s {$sel:datastoreName:CreateDatastoreResponse' :: Maybe Text
datastoreName = Maybe Text
a} :: CreateDatastoreResponse)

-- | How long, in days, message data is kept for the data store.
createDatastoreResponse_retentionPeriod :: Lens.Lens' CreateDatastoreResponse (Prelude.Maybe RetentionPeriod)
createDatastoreResponse_retentionPeriod :: Lens' CreateDatastoreResponse (Maybe RetentionPeriod)
createDatastoreResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDatastoreResponse' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: CreateDatastoreResponse
s@CreateDatastoreResponse' {} Maybe RetentionPeriod
a -> CreateDatastoreResponse
s {$sel:retentionPeriod:CreateDatastoreResponse' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: CreateDatastoreResponse)

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

instance Prelude.NFData CreateDatastoreResponse where
  rnf :: CreateDatastoreResponse -> ()
rnf CreateDatastoreResponse' {Int
Maybe Text
Maybe RetentionPeriod
httpStatus :: Int
retentionPeriod :: Maybe RetentionPeriod
datastoreName :: Maybe Text
datastoreArn :: Maybe Text
$sel:httpStatus:CreateDatastoreResponse' :: CreateDatastoreResponse -> Int
$sel:retentionPeriod:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe RetentionPeriod
$sel:datastoreName:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe Text
$sel:datastoreArn:CreateDatastoreResponse' :: CreateDatastoreResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
datastoreArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
datastoreName
      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