{-# 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.Omics.CreateReferenceStore
-- 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 reference store.
module Amazonka.Omics.CreateReferenceStore
  ( -- * Creating a Request
    CreateReferenceStore (..),
    newCreateReferenceStore,

    -- * Request Lenses
    createReferenceStore_clientToken,
    createReferenceStore_description,
    createReferenceStore_sseConfig,
    createReferenceStore_tags,
    createReferenceStore_name,

    -- * Destructuring the Response
    CreateReferenceStoreResponse (..),
    newCreateReferenceStoreResponse,

    -- * Response Lenses
    createReferenceStoreResponse_description,
    createReferenceStoreResponse_name,
    createReferenceStoreResponse_sseConfig,
    createReferenceStoreResponse_httpStatus,
    createReferenceStoreResponse_arn,
    createReferenceStoreResponse_creationTime,
    createReferenceStoreResponse_id,
  )
where

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

-- | /See:/ 'newCreateReferenceStore' smart constructor.
data CreateReferenceStore = CreateReferenceStore'
  { -- | To ensure that requests don\'t run multiple times, specify a unique
    -- token for each request.
    CreateReferenceStore -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the store.
    CreateReferenceStore -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Server-side encryption (SSE) settings for the store.
    CreateReferenceStore -> Maybe SseConfig
sseConfig :: Prelude.Maybe SseConfig,
    -- | Tags for the store.
    CreateReferenceStore -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A name for the store.
    CreateReferenceStore -> Text
name :: Prelude.Text
  }
  deriving (CreateReferenceStore -> CreateReferenceStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReferenceStore -> CreateReferenceStore -> Bool
$c/= :: CreateReferenceStore -> CreateReferenceStore -> Bool
== :: CreateReferenceStore -> CreateReferenceStore -> Bool
$c== :: CreateReferenceStore -> CreateReferenceStore -> Bool
Prelude.Eq, ReadPrec [CreateReferenceStore]
ReadPrec CreateReferenceStore
Int -> ReadS CreateReferenceStore
ReadS [CreateReferenceStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReferenceStore]
$creadListPrec :: ReadPrec [CreateReferenceStore]
readPrec :: ReadPrec CreateReferenceStore
$creadPrec :: ReadPrec CreateReferenceStore
readList :: ReadS [CreateReferenceStore]
$creadList :: ReadS [CreateReferenceStore]
readsPrec :: Int -> ReadS CreateReferenceStore
$creadsPrec :: Int -> ReadS CreateReferenceStore
Prelude.Read, Int -> CreateReferenceStore -> ShowS
[CreateReferenceStore] -> ShowS
CreateReferenceStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReferenceStore] -> ShowS
$cshowList :: [CreateReferenceStore] -> ShowS
show :: CreateReferenceStore -> String
$cshow :: CreateReferenceStore -> String
showsPrec :: Int -> CreateReferenceStore -> ShowS
$cshowsPrec :: Int -> CreateReferenceStore -> ShowS
Prelude.Show, forall x. Rep CreateReferenceStore x -> CreateReferenceStore
forall x. CreateReferenceStore -> Rep CreateReferenceStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateReferenceStore x -> CreateReferenceStore
$cfrom :: forall x. CreateReferenceStore -> Rep CreateReferenceStore x
Prelude.Generic)

-- |
-- Create a value of 'CreateReferenceStore' 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:
--
-- 'clientToken', 'createReferenceStore_clientToken' - To ensure that requests don\'t run multiple times, specify a unique
-- token for each request.
--
-- 'description', 'createReferenceStore_description' - A description for the store.
--
-- 'sseConfig', 'createReferenceStore_sseConfig' - Server-side encryption (SSE) settings for the store.
--
-- 'tags', 'createReferenceStore_tags' - Tags for the store.
--
-- 'name', 'createReferenceStore_name' - A name for the store.
newCreateReferenceStore ::
  -- | 'name'
  Prelude.Text ->
  CreateReferenceStore
newCreateReferenceStore :: Text -> CreateReferenceStore
newCreateReferenceStore Text
pName_ =
  CreateReferenceStore'
    { $sel:clientToken:CreateReferenceStore' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateReferenceStore' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:sseConfig:CreateReferenceStore' :: Maybe SseConfig
sseConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateReferenceStore' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateReferenceStore' :: Text
name = Text
pName_
    }

-- | To ensure that requests don\'t run multiple times, specify a unique
-- token for each request.
createReferenceStore_clientToken :: Lens.Lens' CreateReferenceStore (Prelude.Maybe Prelude.Text)
createReferenceStore_clientToken :: Lens' CreateReferenceStore (Maybe Text)
createReferenceStore_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStore' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateReferenceStore
s@CreateReferenceStore' {} Maybe Text
a -> CreateReferenceStore
s {$sel:clientToken:CreateReferenceStore' :: Maybe Text
clientToken = Maybe Text
a} :: CreateReferenceStore)

-- | A description for the store.
createReferenceStore_description :: Lens.Lens' CreateReferenceStore (Prelude.Maybe Prelude.Text)
createReferenceStore_description :: Lens' CreateReferenceStore (Maybe Text)
createReferenceStore_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStore' {Maybe Text
description :: Maybe Text
$sel:description:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateReferenceStore
s@CreateReferenceStore' {} Maybe Text
a -> CreateReferenceStore
s {$sel:description:CreateReferenceStore' :: Maybe Text
description = Maybe Text
a} :: CreateReferenceStore)

-- | Server-side encryption (SSE) settings for the store.
createReferenceStore_sseConfig :: Lens.Lens' CreateReferenceStore (Prelude.Maybe SseConfig)
createReferenceStore_sseConfig :: Lens' CreateReferenceStore (Maybe SseConfig)
createReferenceStore_sseConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStore' {Maybe SseConfig
sseConfig :: Maybe SseConfig
$sel:sseConfig:CreateReferenceStore' :: CreateReferenceStore -> Maybe SseConfig
sseConfig} -> Maybe SseConfig
sseConfig) (\s :: CreateReferenceStore
s@CreateReferenceStore' {} Maybe SseConfig
a -> CreateReferenceStore
s {$sel:sseConfig:CreateReferenceStore' :: Maybe SseConfig
sseConfig = Maybe SseConfig
a} :: CreateReferenceStore)

-- | Tags for the store.
createReferenceStore_tags :: Lens.Lens' CreateReferenceStore (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createReferenceStore_tags :: Lens' CreateReferenceStore (Maybe (HashMap Text Text))
createReferenceStore_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStore' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateReferenceStore' :: CreateReferenceStore -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateReferenceStore
s@CreateReferenceStore' {} Maybe (HashMap Text Text)
a -> CreateReferenceStore
s {$sel:tags:CreateReferenceStore' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateReferenceStore) 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

-- | A name for the store.
createReferenceStore_name :: Lens.Lens' CreateReferenceStore Prelude.Text
createReferenceStore_name :: Lens' CreateReferenceStore Text
createReferenceStore_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStore' {Text
name :: Text
$sel:name:CreateReferenceStore' :: CreateReferenceStore -> Text
name} -> Text
name) (\s :: CreateReferenceStore
s@CreateReferenceStore' {} Text
a -> CreateReferenceStore
s {$sel:name:CreateReferenceStore' :: Text
name = Text
a} :: CreateReferenceStore)

instance Core.AWSRequest CreateReferenceStore where
  type
    AWSResponse CreateReferenceStore =
      CreateReferenceStoreResponse
  request :: (Service -> Service)
-> CreateReferenceStore -> Request CreateReferenceStore
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 CreateReferenceStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateReferenceStore)))
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 SseConfig
-> Int
-> Text
-> ISO8601
-> Text
-> CreateReferenceStoreResponse
CreateReferenceStoreResponse'
            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
"description")
            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
"name")
            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
"sseConfig")
            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
"arn")
            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
"creationTime")
            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
"id")
      )

instance Prelude.Hashable CreateReferenceStore where
  hashWithSalt :: Int -> CreateReferenceStore -> Int
hashWithSalt Int
_salt CreateReferenceStore' {Maybe Text
Maybe (HashMap Text Text)
Maybe SseConfig
Text
name :: Text
tags :: Maybe (HashMap Text Text)
sseConfig :: Maybe SseConfig
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateReferenceStore' :: CreateReferenceStore -> Text
$sel:tags:CreateReferenceStore' :: CreateReferenceStore -> Maybe (HashMap Text Text)
$sel:sseConfig:CreateReferenceStore' :: CreateReferenceStore -> Maybe SseConfig
$sel:description:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
$sel:clientToken:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SseConfig
sseConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData CreateReferenceStore where
  rnf :: CreateReferenceStore -> ()
rnf CreateReferenceStore' {Maybe Text
Maybe (HashMap Text Text)
Maybe SseConfig
Text
name :: Text
tags :: Maybe (HashMap Text Text)
sseConfig :: Maybe SseConfig
description :: Maybe Text
clientToken :: Maybe Text
$sel:name:CreateReferenceStore' :: CreateReferenceStore -> Text
$sel:tags:CreateReferenceStore' :: CreateReferenceStore -> Maybe (HashMap Text Text)
$sel:sseConfig:CreateReferenceStore' :: CreateReferenceStore -> Maybe SseConfig
$sel:description:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
$sel:clientToken:CreateReferenceStore' :: CreateReferenceStore -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SseConfig
sseConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

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

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

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

-- | /See:/ 'newCreateReferenceStoreResponse' smart constructor.
data CreateReferenceStoreResponse = CreateReferenceStoreResponse'
  { -- | The store\'s description.
    CreateReferenceStoreResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The store\'s name.
    CreateReferenceStoreResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The store\'s SSE settings.
    CreateReferenceStoreResponse -> Maybe SseConfig
sseConfig :: Prelude.Maybe SseConfig,
    -- | The response's http status code.
    CreateReferenceStoreResponse -> Int
httpStatus :: Prelude.Int,
    -- | The store\'s ARN.
    CreateReferenceStoreResponse -> Text
arn :: Prelude.Text,
    -- | When the store was created.
    CreateReferenceStoreResponse -> ISO8601
creationTime :: Data.ISO8601,
    -- | The store\'s ID.
    CreateReferenceStoreResponse -> Text
id :: Prelude.Text
  }
  deriving (CreateReferenceStoreResponse
-> CreateReferenceStoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReferenceStoreResponse
-> CreateReferenceStoreResponse -> Bool
$c/= :: CreateReferenceStoreResponse
-> CreateReferenceStoreResponse -> Bool
== :: CreateReferenceStoreResponse
-> CreateReferenceStoreResponse -> Bool
$c== :: CreateReferenceStoreResponse
-> CreateReferenceStoreResponse -> Bool
Prelude.Eq, ReadPrec [CreateReferenceStoreResponse]
ReadPrec CreateReferenceStoreResponse
Int -> ReadS CreateReferenceStoreResponse
ReadS [CreateReferenceStoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReferenceStoreResponse]
$creadListPrec :: ReadPrec [CreateReferenceStoreResponse]
readPrec :: ReadPrec CreateReferenceStoreResponse
$creadPrec :: ReadPrec CreateReferenceStoreResponse
readList :: ReadS [CreateReferenceStoreResponse]
$creadList :: ReadS [CreateReferenceStoreResponse]
readsPrec :: Int -> ReadS CreateReferenceStoreResponse
$creadsPrec :: Int -> ReadS CreateReferenceStoreResponse
Prelude.Read, Int -> CreateReferenceStoreResponse -> ShowS
[CreateReferenceStoreResponse] -> ShowS
CreateReferenceStoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReferenceStoreResponse] -> ShowS
$cshowList :: [CreateReferenceStoreResponse] -> ShowS
show :: CreateReferenceStoreResponse -> String
$cshow :: CreateReferenceStoreResponse -> String
showsPrec :: Int -> CreateReferenceStoreResponse -> ShowS
$cshowsPrec :: Int -> CreateReferenceStoreResponse -> ShowS
Prelude.Show, forall x.
Rep CreateReferenceStoreResponse x -> CreateReferenceStoreResponse
forall x.
CreateReferenceStoreResponse -> Rep CreateReferenceStoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateReferenceStoreResponse x -> CreateReferenceStoreResponse
$cfrom :: forall x.
CreateReferenceStoreResponse -> Rep CreateReferenceStoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateReferenceStoreResponse' 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:
--
-- 'description', 'createReferenceStoreResponse_description' - The store\'s description.
--
-- 'name', 'createReferenceStoreResponse_name' - The store\'s name.
--
-- 'sseConfig', 'createReferenceStoreResponse_sseConfig' - The store\'s SSE settings.
--
-- 'httpStatus', 'createReferenceStoreResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'createReferenceStoreResponse_arn' - The store\'s ARN.
--
-- 'creationTime', 'createReferenceStoreResponse_creationTime' - When the store was created.
--
-- 'id', 'createReferenceStoreResponse_id' - The store\'s ID.
newCreateReferenceStoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'id'
  Prelude.Text ->
  CreateReferenceStoreResponse
newCreateReferenceStoreResponse :: Int -> Text -> UTCTime -> Text -> CreateReferenceStoreResponse
newCreateReferenceStoreResponse
  Int
pHttpStatus_
  Text
pArn_
  UTCTime
pCreationTime_
  Text
pId_ =
    CreateReferenceStoreResponse'
      { $sel:description:CreateReferenceStoreResponse' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateReferenceStoreResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:sseConfig:CreateReferenceStoreResponse' :: Maybe SseConfig
sseConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateReferenceStoreResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:CreateReferenceStoreResponse' :: Text
arn = Text
pArn_,
        $sel:creationTime:CreateReferenceStoreResponse' :: ISO8601
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:id:CreateReferenceStoreResponse' :: Text
id = Text
pId_
      }

-- | The store\'s description.
createReferenceStoreResponse_description :: Lens.Lens' CreateReferenceStoreResponse (Prelude.Maybe Prelude.Text)
createReferenceStoreResponse_description :: Lens' CreateReferenceStoreResponse (Maybe Text)
createReferenceStoreResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {Maybe Text
description :: Maybe Text
$sel:description:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} Maybe Text
a -> CreateReferenceStoreResponse
s {$sel:description:CreateReferenceStoreResponse' :: Maybe Text
description = Maybe Text
a} :: CreateReferenceStoreResponse)

-- | The store\'s name.
createReferenceStoreResponse_name :: Lens.Lens' CreateReferenceStoreResponse (Prelude.Maybe Prelude.Text)
createReferenceStoreResponse_name :: Lens' CreateReferenceStoreResponse (Maybe Text)
createReferenceStoreResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {Maybe Text
name :: Maybe Text
$sel:name:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} Maybe Text
a -> CreateReferenceStoreResponse
s {$sel:name:CreateReferenceStoreResponse' :: Maybe Text
name = Maybe Text
a} :: CreateReferenceStoreResponse)

-- | The store\'s SSE settings.
createReferenceStoreResponse_sseConfig :: Lens.Lens' CreateReferenceStoreResponse (Prelude.Maybe SseConfig)
createReferenceStoreResponse_sseConfig :: Lens' CreateReferenceStoreResponse (Maybe SseConfig)
createReferenceStoreResponse_sseConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {Maybe SseConfig
sseConfig :: Maybe SseConfig
$sel:sseConfig:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe SseConfig
sseConfig} -> Maybe SseConfig
sseConfig) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} Maybe SseConfig
a -> CreateReferenceStoreResponse
s {$sel:sseConfig:CreateReferenceStoreResponse' :: Maybe SseConfig
sseConfig = Maybe SseConfig
a} :: CreateReferenceStoreResponse)

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

-- | The store\'s ARN.
createReferenceStoreResponse_arn :: Lens.Lens' CreateReferenceStoreResponse Prelude.Text
createReferenceStoreResponse_arn :: Lens' CreateReferenceStoreResponse Text
createReferenceStoreResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {Text
arn :: Text
$sel:arn:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Text
arn} -> Text
arn) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} Text
a -> CreateReferenceStoreResponse
s {$sel:arn:CreateReferenceStoreResponse' :: Text
arn = Text
a} :: CreateReferenceStoreResponse)

-- | When the store was created.
createReferenceStoreResponse_creationTime :: Lens.Lens' CreateReferenceStoreResponse Prelude.UTCTime
createReferenceStoreResponse_creationTime :: Lens' CreateReferenceStoreResponse UTCTime
createReferenceStoreResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {ISO8601
creationTime :: ISO8601
$sel:creationTime:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> ISO8601
creationTime} -> ISO8601
creationTime) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} ISO8601
a -> CreateReferenceStoreResponse
s {$sel:creationTime:CreateReferenceStoreResponse' :: ISO8601
creationTime = ISO8601
a} :: CreateReferenceStoreResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The store\'s ID.
createReferenceStoreResponse_id :: Lens.Lens' CreateReferenceStoreResponse Prelude.Text
createReferenceStoreResponse_id :: Lens' CreateReferenceStoreResponse Text
createReferenceStoreResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReferenceStoreResponse' {Text
id :: Text
$sel:id:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Text
id} -> Text
id) (\s :: CreateReferenceStoreResponse
s@CreateReferenceStoreResponse' {} Text
a -> CreateReferenceStoreResponse
s {$sel:id:CreateReferenceStoreResponse' :: Text
id = Text
a} :: CreateReferenceStoreResponse)

instance Prelude.NFData CreateReferenceStoreResponse where
  rnf :: CreateReferenceStoreResponse -> ()
rnf CreateReferenceStoreResponse' {Int
Maybe Text
Maybe SseConfig
Text
ISO8601
id :: Text
creationTime :: ISO8601
arn :: Text
httpStatus :: Int
sseConfig :: Maybe SseConfig
name :: Maybe Text
description :: Maybe Text
$sel:id:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Text
$sel:creationTime:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> ISO8601
$sel:arn:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Text
$sel:httpStatus:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Int
$sel:sseConfig:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe SseConfig
$sel:name:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe Text
$sel:description:CreateReferenceStoreResponse' :: CreateReferenceStoreResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SseConfig
sseConfig
      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 Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id