{-# 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.GetVariantStore
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a variant store.
module Amazonka.Omics.GetVariantStore
  ( -- * Creating a Request
    GetVariantStore (..),
    newGetVariantStore,

    -- * Request Lenses
    getVariantStore_name,

    -- * Destructuring the Response
    GetVariantStoreResponse (..),
    newGetVariantStoreResponse,

    -- * Response Lenses
    getVariantStoreResponse_httpStatus,
    getVariantStoreResponse_creationTime,
    getVariantStoreResponse_description,
    getVariantStoreResponse_id,
    getVariantStoreResponse_name,
    getVariantStoreResponse_reference,
    getVariantStoreResponse_sseConfig,
    getVariantStoreResponse_status,
    getVariantStoreResponse_statusMessage,
    getVariantStoreResponse_storeArn,
    getVariantStoreResponse_storeSizeBytes,
    getVariantStoreResponse_tags,
    getVariantStoreResponse_updateTime,
  )
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:/ 'newGetVariantStore' smart constructor.
data GetVariantStore = GetVariantStore'
  { -- | The store\'s name.
    GetVariantStore -> Text
name :: Prelude.Text
  }
  deriving (GetVariantStore -> GetVariantStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVariantStore -> GetVariantStore -> Bool
$c/= :: GetVariantStore -> GetVariantStore -> Bool
== :: GetVariantStore -> GetVariantStore -> Bool
$c== :: GetVariantStore -> GetVariantStore -> Bool
Prelude.Eq, ReadPrec [GetVariantStore]
ReadPrec GetVariantStore
Int -> ReadS GetVariantStore
ReadS [GetVariantStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVariantStore]
$creadListPrec :: ReadPrec [GetVariantStore]
readPrec :: ReadPrec GetVariantStore
$creadPrec :: ReadPrec GetVariantStore
readList :: ReadS [GetVariantStore]
$creadList :: ReadS [GetVariantStore]
readsPrec :: Int -> ReadS GetVariantStore
$creadsPrec :: Int -> ReadS GetVariantStore
Prelude.Read, Int -> GetVariantStore -> ShowS
[GetVariantStore] -> ShowS
GetVariantStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVariantStore] -> ShowS
$cshowList :: [GetVariantStore] -> ShowS
show :: GetVariantStore -> String
$cshow :: GetVariantStore -> String
showsPrec :: Int -> GetVariantStore -> ShowS
$cshowsPrec :: Int -> GetVariantStore -> ShowS
Prelude.Show, forall x. Rep GetVariantStore x -> GetVariantStore
forall x. GetVariantStore -> Rep GetVariantStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVariantStore x -> GetVariantStore
$cfrom :: forall x. GetVariantStore -> Rep GetVariantStore x
Prelude.Generic)

-- |
-- Create a value of 'GetVariantStore' 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:
--
-- 'name', 'getVariantStore_name' - The store\'s name.
newGetVariantStore ::
  -- | 'name'
  Prelude.Text ->
  GetVariantStore
newGetVariantStore :: Text -> GetVariantStore
newGetVariantStore Text
pName_ =
  GetVariantStore' {$sel:name:GetVariantStore' :: Text
name = Text
pName_}

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

instance Core.AWSRequest GetVariantStore where
  type
    AWSResponse GetVariantStore =
      GetVariantStoreResponse
  request :: (Service -> Service) -> GetVariantStore -> Request GetVariantStore
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetVariantStore
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetVariantStore)))
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 ->
          Int
-> ISO8601
-> Text
-> Text
-> Text
-> ReferenceItem
-> SseConfig
-> StoreStatus
-> Text
-> Text
-> Integer
-> HashMap Text Text
-> ISO8601
-> GetVariantStoreResponse
GetVariantStoreResponse'
            forall (f :: * -> *) a b. Functor 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
"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
"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 a
Data..:> Key
"id")
            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
"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 a
Data..:> Key
"reference")
            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
"sseConfig")
            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
"status")
            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
"statusMessage")
            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
"storeArn")
            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
"storeSizeBytes")
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"updateTime")
      )

instance Prelude.Hashable GetVariantStore where
  hashWithSalt :: Int -> GetVariantStore -> Int
hashWithSalt Int
_salt GetVariantStore' {Text
name :: Text
$sel:name:GetVariantStore' :: GetVariantStore -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData GetVariantStore where
  rnf :: GetVariantStore -> ()
rnf GetVariantStore' {Text
name :: Text
$sel:name:GetVariantStore' :: GetVariantStore -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders GetVariantStore where
  toHeaders :: GetVariantStore -> 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.ToPath GetVariantStore where
  toPath :: GetVariantStore -> ByteString
toPath GetVariantStore' {Text
name :: Text
$sel:name:GetVariantStore' :: GetVariantStore -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/variantStore/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newGetVariantStoreResponse' smart constructor.
data GetVariantStoreResponse = GetVariantStoreResponse'
  { -- | The response's http status code.
    GetVariantStoreResponse -> Int
httpStatus :: Prelude.Int,
    -- | When the store was created.
    GetVariantStoreResponse -> ISO8601
creationTime :: Data.ISO8601,
    -- | The store\'s description.
    GetVariantStoreResponse -> Text
description :: Prelude.Text,
    -- | The store\'s ID.
    GetVariantStoreResponse -> Text
id :: Prelude.Text,
    -- | The store\'s name.
    GetVariantStoreResponse -> Text
name :: Prelude.Text,
    -- | The store\'s genome reference.
    GetVariantStoreResponse -> ReferenceItem
reference :: ReferenceItem,
    -- | The store\'s server-side encryption (SSE) settings.
    GetVariantStoreResponse -> SseConfig
sseConfig :: SseConfig,
    -- | The store\'s status.
    GetVariantStoreResponse -> StoreStatus
status :: StoreStatus,
    -- | The store\'s status message.
    GetVariantStoreResponse -> Text
statusMessage :: Prelude.Text,
    -- | The store\'s ARN.
    GetVariantStoreResponse -> Text
storeArn :: Prelude.Text,
    -- | The store\'s size in bytes.
    GetVariantStoreResponse -> Integer
storeSizeBytes :: Prelude.Integer,
    -- | The store\'s tags.
    GetVariantStoreResponse -> HashMap Text Text
tags :: Prelude.HashMap Prelude.Text Prelude.Text,
    -- | When the store was updated.
    GetVariantStoreResponse -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (GetVariantStoreResponse -> GetVariantStoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVariantStoreResponse -> GetVariantStoreResponse -> Bool
$c/= :: GetVariantStoreResponse -> GetVariantStoreResponse -> Bool
== :: GetVariantStoreResponse -> GetVariantStoreResponse -> Bool
$c== :: GetVariantStoreResponse -> GetVariantStoreResponse -> Bool
Prelude.Eq, ReadPrec [GetVariantStoreResponse]
ReadPrec GetVariantStoreResponse
Int -> ReadS GetVariantStoreResponse
ReadS [GetVariantStoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVariantStoreResponse]
$creadListPrec :: ReadPrec [GetVariantStoreResponse]
readPrec :: ReadPrec GetVariantStoreResponse
$creadPrec :: ReadPrec GetVariantStoreResponse
readList :: ReadS [GetVariantStoreResponse]
$creadList :: ReadS [GetVariantStoreResponse]
readsPrec :: Int -> ReadS GetVariantStoreResponse
$creadsPrec :: Int -> ReadS GetVariantStoreResponse
Prelude.Read, Int -> GetVariantStoreResponse -> ShowS
[GetVariantStoreResponse] -> ShowS
GetVariantStoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVariantStoreResponse] -> ShowS
$cshowList :: [GetVariantStoreResponse] -> ShowS
show :: GetVariantStoreResponse -> String
$cshow :: GetVariantStoreResponse -> String
showsPrec :: Int -> GetVariantStoreResponse -> ShowS
$cshowsPrec :: Int -> GetVariantStoreResponse -> ShowS
Prelude.Show, forall x. Rep GetVariantStoreResponse x -> GetVariantStoreResponse
forall x. GetVariantStoreResponse -> Rep GetVariantStoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVariantStoreResponse x -> GetVariantStoreResponse
$cfrom :: forall x. GetVariantStoreResponse -> Rep GetVariantStoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetVariantStoreResponse' 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:
--
-- 'httpStatus', 'getVariantStoreResponse_httpStatus' - The response's http status code.
--
-- 'creationTime', 'getVariantStoreResponse_creationTime' - When the store was created.
--
-- 'description', 'getVariantStoreResponse_description' - The store\'s description.
--
-- 'id', 'getVariantStoreResponse_id' - The store\'s ID.
--
-- 'name', 'getVariantStoreResponse_name' - The store\'s name.
--
-- 'reference', 'getVariantStoreResponse_reference' - The store\'s genome reference.
--
-- 'sseConfig', 'getVariantStoreResponse_sseConfig' - The store\'s server-side encryption (SSE) settings.
--
-- 'status', 'getVariantStoreResponse_status' - The store\'s status.
--
-- 'statusMessage', 'getVariantStoreResponse_statusMessage' - The store\'s status message.
--
-- 'storeArn', 'getVariantStoreResponse_storeArn' - The store\'s ARN.
--
-- 'storeSizeBytes', 'getVariantStoreResponse_storeSizeBytes' - The store\'s size in bytes.
--
-- 'tags', 'getVariantStoreResponse_tags' - The store\'s tags.
--
-- 'updateTime', 'getVariantStoreResponse_updateTime' - When the store was updated.
newGetVariantStoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'description'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'reference'
  ReferenceItem ->
  -- | 'sseConfig'
  SseConfig ->
  -- | 'status'
  StoreStatus ->
  -- | 'statusMessage'
  Prelude.Text ->
  -- | 'storeArn'
  Prelude.Text ->
  -- | 'storeSizeBytes'
  Prelude.Integer ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  GetVariantStoreResponse
newGetVariantStoreResponse :: Int
-> UTCTime
-> Text
-> Text
-> Text
-> ReferenceItem
-> SseConfig
-> StoreStatus
-> Text
-> Text
-> Integer
-> UTCTime
-> GetVariantStoreResponse
newGetVariantStoreResponse
  Int
pHttpStatus_
  UTCTime
pCreationTime_
  Text
pDescription_
  Text
pId_
  Text
pName_
  ReferenceItem
pReference_
  SseConfig
pSseConfig_
  StoreStatus
pStatus_
  Text
pStatusMessage_
  Text
pStoreArn_
  Integer
pStoreSizeBytes_
  UTCTime
pUpdateTime_ =
    GetVariantStoreResponse'
      { $sel:httpStatus:GetVariantStoreResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:creationTime:GetVariantStoreResponse' :: ISO8601
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:description:GetVariantStoreResponse' :: Text
description = Text
pDescription_,
        $sel:id:GetVariantStoreResponse' :: Text
id = Text
pId_,
        $sel:name:GetVariantStoreResponse' :: Text
name = Text
pName_,
        $sel:reference:GetVariantStoreResponse' :: ReferenceItem
reference = ReferenceItem
pReference_,
        $sel:sseConfig:GetVariantStoreResponse' :: SseConfig
sseConfig = SseConfig
pSseConfig_,
        $sel:status:GetVariantStoreResponse' :: StoreStatus
status = StoreStatus
pStatus_,
        $sel:statusMessage:GetVariantStoreResponse' :: Text
statusMessage = Text
pStatusMessage_,
        $sel:storeArn:GetVariantStoreResponse' :: Text
storeArn = Text
pStoreArn_,
        $sel:storeSizeBytes:GetVariantStoreResponse' :: Integer
storeSizeBytes = Integer
pStoreSizeBytes_,
        $sel:tags:GetVariantStoreResponse' :: HashMap Text Text
tags = forall a. Monoid a => a
Prelude.mempty,
        $sel:updateTime:GetVariantStoreResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

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

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

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

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

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

-- | The store\'s genome reference.
getVariantStoreResponse_reference :: Lens.Lens' GetVariantStoreResponse ReferenceItem
getVariantStoreResponse_reference :: Lens' GetVariantStoreResponse ReferenceItem
getVariantStoreResponse_reference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {ReferenceItem
reference :: ReferenceItem
$sel:reference:GetVariantStoreResponse' :: GetVariantStoreResponse -> ReferenceItem
reference} -> ReferenceItem
reference) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} ReferenceItem
a -> GetVariantStoreResponse
s {$sel:reference:GetVariantStoreResponse' :: ReferenceItem
reference = ReferenceItem
a} :: GetVariantStoreResponse)

-- | The store\'s server-side encryption (SSE) settings.
getVariantStoreResponse_sseConfig :: Lens.Lens' GetVariantStoreResponse SseConfig
getVariantStoreResponse_sseConfig :: Lens' GetVariantStoreResponse SseConfig
getVariantStoreResponse_sseConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {SseConfig
sseConfig :: SseConfig
$sel:sseConfig:GetVariantStoreResponse' :: GetVariantStoreResponse -> SseConfig
sseConfig} -> SseConfig
sseConfig) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} SseConfig
a -> GetVariantStoreResponse
s {$sel:sseConfig:GetVariantStoreResponse' :: SseConfig
sseConfig = SseConfig
a} :: GetVariantStoreResponse)

-- | The store\'s status.
getVariantStoreResponse_status :: Lens.Lens' GetVariantStoreResponse StoreStatus
getVariantStoreResponse_status :: Lens' GetVariantStoreResponse StoreStatus
getVariantStoreResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {StoreStatus
status :: StoreStatus
$sel:status:GetVariantStoreResponse' :: GetVariantStoreResponse -> StoreStatus
status} -> StoreStatus
status) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} StoreStatus
a -> GetVariantStoreResponse
s {$sel:status:GetVariantStoreResponse' :: StoreStatus
status = StoreStatus
a} :: GetVariantStoreResponse)

-- | The store\'s status message.
getVariantStoreResponse_statusMessage :: Lens.Lens' GetVariantStoreResponse Prelude.Text
getVariantStoreResponse_statusMessage :: Lens' GetVariantStoreResponse Text
getVariantStoreResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {Text
statusMessage :: Text
$sel:statusMessage:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
statusMessage} -> Text
statusMessage) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} Text
a -> GetVariantStoreResponse
s {$sel:statusMessage:GetVariantStoreResponse' :: Text
statusMessage = Text
a} :: GetVariantStoreResponse)

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

-- | The store\'s size in bytes.
getVariantStoreResponse_storeSizeBytes :: Lens.Lens' GetVariantStoreResponse Prelude.Integer
getVariantStoreResponse_storeSizeBytes :: Lens' GetVariantStoreResponse Integer
getVariantStoreResponse_storeSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {Integer
storeSizeBytes :: Integer
$sel:storeSizeBytes:GetVariantStoreResponse' :: GetVariantStoreResponse -> Integer
storeSizeBytes} -> Integer
storeSizeBytes) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} Integer
a -> GetVariantStoreResponse
s {$sel:storeSizeBytes:GetVariantStoreResponse' :: Integer
storeSizeBytes = Integer
a} :: GetVariantStoreResponse)

-- | The store\'s tags.
getVariantStoreResponse_tags :: Lens.Lens' GetVariantStoreResponse (Prelude.HashMap Prelude.Text Prelude.Text)
getVariantStoreResponse_tags :: Lens' GetVariantStoreResponse (HashMap Text Text)
getVariantStoreResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantStoreResponse' {HashMap Text Text
tags :: HashMap Text Text
$sel:tags:GetVariantStoreResponse' :: GetVariantStoreResponse -> HashMap Text Text
tags} -> HashMap Text Text
tags) (\s :: GetVariantStoreResponse
s@GetVariantStoreResponse' {} HashMap Text Text
a -> GetVariantStoreResponse
s {$sel:tags:GetVariantStoreResponse' :: HashMap Text Text
tags = HashMap Text Text
a} :: GetVariantStoreResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData GetVariantStoreResponse where
  rnf :: GetVariantStoreResponse -> ()
rnf GetVariantStoreResponse' {Int
Integer
Text
HashMap Text Text
ISO8601
ReferenceItem
SseConfig
StoreStatus
updateTime :: ISO8601
tags :: HashMap Text Text
storeSizeBytes :: Integer
storeArn :: Text
statusMessage :: Text
status :: StoreStatus
sseConfig :: SseConfig
reference :: ReferenceItem
name :: Text
id :: Text
description :: Text
creationTime :: ISO8601
httpStatus :: Int
$sel:updateTime:GetVariantStoreResponse' :: GetVariantStoreResponse -> ISO8601
$sel:tags:GetVariantStoreResponse' :: GetVariantStoreResponse -> HashMap Text Text
$sel:storeSizeBytes:GetVariantStoreResponse' :: GetVariantStoreResponse -> Integer
$sel:storeArn:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
$sel:statusMessage:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
$sel:status:GetVariantStoreResponse' :: GetVariantStoreResponse -> StoreStatus
$sel:sseConfig:GetVariantStoreResponse' :: GetVariantStoreResponse -> SseConfig
$sel:reference:GetVariantStoreResponse' :: GetVariantStoreResponse -> ReferenceItem
$sel:name:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
$sel:id:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
$sel:description:GetVariantStoreResponse' :: GetVariantStoreResponse -> Text
$sel:creationTime:GetVariantStoreResponse' :: GetVariantStoreResponse -> ISO8601
$sel:httpStatus:GetVariantStoreResponse' :: GetVariantStoreResponse -> Int
..} =
    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 ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ReferenceItem
reference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf SseConfig
sseConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StoreStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
storeArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
storeSizeBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Text
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime