{-# 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.GetAnnotationStore
-- 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 an annotation store.
module Amazonka.Omics.GetAnnotationStore
  ( -- * Creating a Request
    GetAnnotationStore (..),
    newGetAnnotationStore,

    -- * Request Lenses
    getAnnotationStore_name,

    -- * Destructuring the Response
    GetAnnotationStoreResponse (..),
    newGetAnnotationStoreResponse,

    -- * Response Lenses
    getAnnotationStoreResponse_storeFormat,
    getAnnotationStoreResponse_storeOptions,
    getAnnotationStoreResponse_httpStatus,
    getAnnotationStoreResponse_creationTime,
    getAnnotationStoreResponse_description,
    getAnnotationStoreResponse_id,
    getAnnotationStoreResponse_name,
    getAnnotationStoreResponse_reference,
    getAnnotationStoreResponse_sseConfig,
    getAnnotationStoreResponse_status,
    getAnnotationStoreResponse_statusMessage,
    getAnnotationStoreResponse_storeArn,
    getAnnotationStoreResponse_storeSizeBytes,
    getAnnotationStoreResponse_tags,
    getAnnotationStoreResponse_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:/ 'newGetAnnotationStore' smart constructor.
data GetAnnotationStore = GetAnnotationStore'
  { -- | The store\'s name.
    GetAnnotationStore -> Text
name :: Prelude.Text
  }
  deriving (GetAnnotationStore -> GetAnnotationStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnnotationStore -> GetAnnotationStore -> Bool
$c/= :: GetAnnotationStore -> GetAnnotationStore -> Bool
== :: GetAnnotationStore -> GetAnnotationStore -> Bool
$c== :: GetAnnotationStore -> GetAnnotationStore -> Bool
Prelude.Eq, ReadPrec [GetAnnotationStore]
ReadPrec GetAnnotationStore
Int -> ReadS GetAnnotationStore
ReadS [GetAnnotationStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnnotationStore]
$creadListPrec :: ReadPrec [GetAnnotationStore]
readPrec :: ReadPrec GetAnnotationStore
$creadPrec :: ReadPrec GetAnnotationStore
readList :: ReadS [GetAnnotationStore]
$creadList :: ReadS [GetAnnotationStore]
readsPrec :: Int -> ReadS GetAnnotationStore
$creadsPrec :: Int -> ReadS GetAnnotationStore
Prelude.Read, Int -> GetAnnotationStore -> ShowS
[GetAnnotationStore] -> ShowS
GetAnnotationStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnnotationStore] -> ShowS
$cshowList :: [GetAnnotationStore] -> ShowS
show :: GetAnnotationStore -> String
$cshow :: GetAnnotationStore -> String
showsPrec :: Int -> GetAnnotationStore -> ShowS
$cshowsPrec :: Int -> GetAnnotationStore -> ShowS
Prelude.Show, forall x. Rep GetAnnotationStore x -> GetAnnotationStore
forall x. GetAnnotationStore -> Rep GetAnnotationStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAnnotationStore x -> GetAnnotationStore
$cfrom :: forall x. GetAnnotationStore -> Rep GetAnnotationStore x
Prelude.Generic)

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

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

instance Core.AWSRequest GetAnnotationStore where
  type
    AWSResponse GetAnnotationStore =
      GetAnnotationStoreResponse
  request :: (Service -> Service)
-> GetAnnotationStore -> Request GetAnnotationStore
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 GetAnnotationStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAnnotationStore)))
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 StoreFormat
-> Maybe StoreOptions
-> Int
-> ISO8601
-> Text
-> Text
-> Text
-> ReferenceItem
-> SseConfig
-> StoreStatus
-> Text
-> Text
-> Integer
-> HashMap Text Text
-> ISO8601
-> GetAnnotationStoreResponse
GetAnnotationStoreResponse'
            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
"storeFormat")
            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
"storeOptions")
            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
"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 GetAnnotationStore where
  hashWithSalt :: Int -> GetAnnotationStore -> Int
hashWithSalt Int
_salt GetAnnotationStore' {Text
name :: Text
$sel:name:GetAnnotationStore' :: GetAnnotationStore -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

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

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

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

-- |
-- Create a value of 'GetAnnotationStoreResponse' 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:
--
-- 'storeFormat', 'getAnnotationStoreResponse_storeFormat' - The store\'s annotation file format.
--
-- 'storeOptions', 'getAnnotationStoreResponse_storeOptions' - The store\'s parsing options.
--
-- 'httpStatus', 'getAnnotationStoreResponse_httpStatus' - The response's http status code.
--
-- 'creationTime', 'getAnnotationStoreResponse_creationTime' - When the store was created.
--
-- 'description', 'getAnnotationStoreResponse_description' - The store\'s description.
--
-- 'id', 'getAnnotationStoreResponse_id' - The store\'s ID.
--
-- 'name', 'getAnnotationStoreResponse_name' - The store\'s name.
--
-- 'reference', 'getAnnotationStoreResponse_reference' - The store\'s genome reference.
--
-- 'sseConfig', 'getAnnotationStoreResponse_sseConfig' - The store\'s server-side encryption (SSE) settings.
--
-- 'status', 'getAnnotationStoreResponse_status' - The store\'s status.
--
-- 'statusMessage', 'getAnnotationStoreResponse_statusMessage' - A status message.
--
-- 'storeArn', 'getAnnotationStoreResponse_storeArn' - The store\'s ARN.
--
-- 'storeSizeBytes', 'getAnnotationStoreResponse_storeSizeBytes' - The store\'s size in bytes.
--
-- 'tags', 'getAnnotationStoreResponse_tags' - The store\'s tags.
--
-- 'updateTime', 'getAnnotationStoreResponse_updateTime' - When the store was updated.
newGetAnnotationStoreResponse ::
  -- | '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 ->
  GetAnnotationStoreResponse
newGetAnnotationStoreResponse :: Int
-> UTCTime
-> Text
-> Text
-> Text
-> ReferenceItem
-> SseConfig
-> StoreStatus
-> Text
-> Text
-> Integer
-> UTCTime
-> GetAnnotationStoreResponse
newGetAnnotationStoreResponse
  Int
pHttpStatus_
  UTCTime
pCreationTime_
  Text
pDescription_
  Text
pId_
  Text
pName_
  ReferenceItem
pReference_
  SseConfig
pSseConfig_
  StoreStatus
pStatus_
  Text
pStatusMessage_
  Text
pStoreArn_
  Integer
pStoreSizeBytes_
  UTCTime
pUpdateTime_ =
    GetAnnotationStoreResponse'
      { $sel:storeFormat:GetAnnotationStoreResponse' :: Maybe StoreFormat
storeFormat =
          forall a. Maybe a
Prelude.Nothing,
        $sel:storeOptions:GetAnnotationStoreResponse' :: Maybe StoreOptions
storeOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetAnnotationStoreResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:creationTime:GetAnnotationStoreResponse' :: ISO8601
creationTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:description:GetAnnotationStoreResponse' :: Text
description = Text
pDescription_,
        $sel:id:GetAnnotationStoreResponse' :: Text
id = Text
pId_,
        $sel:name:GetAnnotationStoreResponse' :: Text
name = Text
pName_,
        $sel:reference:GetAnnotationStoreResponse' :: ReferenceItem
reference = ReferenceItem
pReference_,
        $sel:sseConfig:GetAnnotationStoreResponse' :: SseConfig
sseConfig = SseConfig
pSseConfig_,
        $sel:status:GetAnnotationStoreResponse' :: StoreStatus
status = StoreStatus
pStatus_,
        $sel:statusMessage:GetAnnotationStoreResponse' :: Text
statusMessage = Text
pStatusMessage_,
        $sel:storeArn:GetAnnotationStoreResponse' :: Text
storeArn = Text
pStoreArn_,
        $sel:storeSizeBytes:GetAnnotationStoreResponse' :: Integer
storeSizeBytes = Integer
pStoreSizeBytes_,
        $sel:tags:GetAnnotationStoreResponse' :: HashMap Text Text
tags = forall a. Monoid a => a
Prelude.mempty,
        $sel:updateTime:GetAnnotationStoreResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

-- | The store\'s annotation file format.
getAnnotationStoreResponse_storeFormat :: Lens.Lens' GetAnnotationStoreResponse (Prelude.Maybe StoreFormat)
getAnnotationStoreResponse_storeFormat :: Lens' GetAnnotationStoreResponse (Maybe StoreFormat)
getAnnotationStoreResponse_storeFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationStoreResponse' {Maybe StoreFormat
storeFormat :: Maybe StoreFormat
$sel:storeFormat:GetAnnotationStoreResponse' :: GetAnnotationStoreResponse -> Maybe StoreFormat
storeFormat} -> Maybe StoreFormat
storeFormat) (\s :: GetAnnotationStoreResponse
s@GetAnnotationStoreResponse' {} Maybe StoreFormat
a -> GetAnnotationStoreResponse
s {$sel:storeFormat:GetAnnotationStoreResponse' :: Maybe StoreFormat
storeFormat = Maybe StoreFormat
a} :: GetAnnotationStoreResponse)

-- | The store\'s parsing options.
getAnnotationStoreResponse_storeOptions :: Lens.Lens' GetAnnotationStoreResponse (Prelude.Maybe StoreOptions)
getAnnotationStoreResponse_storeOptions :: Lens' GetAnnotationStoreResponse (Maybe StoreOptions)
getAnnotationStoreResponse_storeOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationStoreResponse' {Maybe StoreOptions
storeOptions :: Maybe StoreOptions
$sel:storeOptions:GetAnnotationStoreResponse' :: GetAnnotationStoreResponse -> Maybe StoreOptions
storeOptions} -> Maybe StoreOptions
storeOptions) (\s :: GetAnnotationStoreResponse
s@GetAnnotationStoreResponse' {} Maybe StoreOptions
a -> GetAnnotationStoreResponse
s {$sel:storeOptions:GetAnnotationStoreResponse' :: Maybe StoreOptions
storeOptions = Maybe StoreOptions
a} :: GetAnnotationStoreResponse)

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

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

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

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

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

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

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

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

-- | A status message.
getAnnotationStoreResponse_statusMessage :: Lens.Lens' GetAnnotationStoreResponse Prelude.Text
getAnnotationStoreResponse_statusMessage :: Lens' GetAnnotationStoreResponse Text
getAnnotationStoreResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationStoreResponse' {Text
statusMessage :: Text
$sel:statusMessage:GetAnnotationStoreResponse' :: GetAnnotationStoreResponse -> Text
statusMessage} -> Text
statusMessage) (\s :: GetAnnotationStoreResponse
s@GetAnnotationStoreResponse' {} Text
a -> GetAnnotationStoreResponse
s {$sel:statusMessage:GetAnnotationStoreResponse' :: Text
statusMessage = Text
a} :: GetAnnotationStoreResponse)

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

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

-- | The store\'s tags.
getAnnotationStoreResponse_tags :: Lens.Lens' GetAnnotationStoreResponse (Prelude.HashMap Prelude.Text Prelude.Text)
getAnnotationStoreResponse_tags :: Lens' GetAnnotationStoreResponse (HashMap Text Text)
getAnnotationStoreResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationStoreResponse' {HashMap Text Text
tags :: HashMap Text Text
$sel:tags:GetAnnotationStoreResponse' :: GetAnnotationStoreResponse -> HashMap Text Text
tags} -> HashMap Text Text
tags) (\s :: GetAnnotationStoreResponse
s@GetAnnotationStoreResponse' {} HashMap Text Text
a -> GetAnnotationStoreResponse
s {$sel:tags:GetAnnotationStoreResponse' :: HashMap Text Text
tags = HashMap Text Text
a} :: GetAnnotationStoreResponse) 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.
getAnnotationStoreResponse_updateTime :: Lens.Lens' GetAnnotationStoreResponse Prelude.UTCTime
getAnnotationStoreResponse_updateTime :: Lens' GetAnnotationStoreResponse UTCTime
getAnnotationStoreResponse_updateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationStoreResponse' {ISO8601
updateTime :: ISO8601
$sel:updateTime:GetAnnotationStoreResponse' :: GetAnnotationStoreResponse -> ISO8601
updateTime} -> ISO8601
updateTime) (\s :: GetAnnotationStoreResponse
s@GetAnnotationStoreResponse' {} ISO8601
a -> GetAnnotationStoreResponse
s {$sel:updateTime:GetAnnotationStoreResponse' :: ISO8601
updateTime = ISO8601
a} :: GetAnnotationStoreResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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