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

    -- * Request Lenses
    createAnnotationStore_description,
    createAnnotationStore_name,
    createAnnotationStore_reference,
    createAnnotationStore_sseConfig,
    createAnnotationStore_storeOptions,
    createAnnotationStore_tags,
    createAnnotationStore_storeFormat,

    -- * Destructuring the Response
    CreateAnnotationStoreResponse (..),
    newCreateAnnotationStoreResponse,

    -- * Response Lenses
    createAnnotationStoreResponse_reference,
    createAnnotationStoreResponse_storeFormat,
    createAnnotationStoreResponse_storeOptions,
    createAnnotationStoreResponse_httpStatus,
    createAnnotationStoreResponse_creationTime,
    createAnnotationStoreResponse_id,
    createAnnotationStoreResponse_name,
    createAnnotationStoreResponse_status,
  )
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:/ 'newCreateAnnotationStore' smart constructor.
data CreateAnnotationStore = CreateAnnotationStore'
  { -- | A description for the store.
    CreateAnnotationStore -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A name for the store.
    CreateAnnotationStore -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The genome reference for the store\'s annotations.
    CreateAnnotationStore -> Maybe ReferenceItem
reference :: Prelude.Maybe ReferenceItem,
    -- | Server-side encryption (SSE) settings for the store.
    CreateAnnotationStore -> Maybe SseConfig
sseConfig :: Prelude.Maybe SseConfig,
    -- | File parsing options for the annotation store.
    CreateAnnotationStore -> Maybe StoreOptions
storeOptions :: Prelude.Maybe StoreOptions,
    -- | Tags for the store.
    CreateAnnotationStore -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The annotation file format of the store.
    CreateAnnotationStore -> StoreFormat
storeFormat :: StoreFormat
  }
  deriving (CreateAnnotationStore -> CreateAnnotationStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAnnotationStore -> CreateAnnotationStore -> Bool
$c/= :: CreateAnnotationStore -> CreateAnnotationStore -> Bool
== :: CreateAnnotationStore -> CreateAnnotationStore -> Bool
$c== :: CreateAnnotationStore -> CreateAnnotationStore -> Bool
Prelude.Eq, ReadPrec [CreateAnnotationStore]
ReadPrec CreateAnnotationStore
Int -> ReadS CreateAnnotationStore
ReadS [CreateAnnotationStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAnnotationStore]
$creadListPrec :: ReadPrec [CreateAnnotationStore]
readPrec :: ReadPrec CreateAnnotationStore
$creadPrec :: ReadPrec CreateAnnotationStore
readList :: ReadS [CreateAnnotationStore]
$creadList :: ReadS [CreateAnnotationStore]
readsPrec :: Int -> ReadS CreateAnnotationStore
$creadsPrec :: Int -> ReadS CreateAnnotationStore
Prelude.Read, Int -> CreateAnnotationStore -> ShowS
[CreateAnnotationStore] -> ShowS
CreateAnnotationStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAnnotationStore] -> ShowS
$cshowList :: [CreateAnnotationStore] -> ShowS
show :: CreateAnnotationStore -> String
$cshow :: CreateAnnotationStore -> String
showsPrec :: Int -> CreateAnnotationStore -> ShowS
$cshowsPrec :: Int -> CreateAnnotationStore -> ShowS
Prelude.Show, forall x. Rep CreateAnnotationStore x -> CreateAnnotationStore
forall x. CreateAnnotationStore -> Rep CreateAnnotationStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAnnotationStore x -> CreateAnnotationStore
$cfrom :: forall x. CreateAnnotationStore -> Rep CreateAnnotationStore x
Prelude.Generic)

-- |
-- Create a value of 'CreateAnnotationStore' 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', 'createAnnotationStore_description' - A description for the store.
--
-- 'name', 'createAnnotationStore_name' - A name for the store.
--
-- 'reference', 'createAnnotationStore_reference' - The genome reference for the store\'s annotations.
--
-- 'sseConfig', 'createAnnotationStore_sseConfig' - Server-side encryption (SSE) settings for the store.
--
-- 'storeOptions', 'createAnnotationStore_storeOptions' - File parsing options for the annotation store.
--
-- 'tags', 'createAnnotationStore_tags' - Tags for the store.
--
-- 'storeFormat', 'createAnnotationStore_storeFormat' - The annotation file format of the store.
newCreateAnnotationStore ::
  -- | 'storeFormat'
  StoreFormat ->
  CreateAnnotationStore
newCreateAnnotationStore :: StoreFormat -> CreateAnnotationStore
newCreateAnnotationStore StoreFormat
pStoreFormat_ =
  CreateAnnotationStore'
    { $sel:description:CreateAnnotationStore' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateAnnotationStore' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:reference:CreateAnnotationStore' :: Maybe ReferenceItem
reference = forall a. Maybe a
Prelude.Nothing,
      $sel:sseConfig:CreateAnnotationStore' :: Maybe SseConfig
sseConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:storeOptions:CreateAnnotationStore' :: Maybe StoreOptions
storeOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateAnnotationStore' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:storeFormat:CreateAnnotationStore' :: StoreFormat
storeFormat = StoreFormat
pStoreFormat_
    }

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

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

-- | The genome reference for the store\'s annotations.
createAnnotationStore_reference :: Lens.Lens' CreateAnnotationStore (Prelude.Maybe ReferenceItem)
createAnnotationStore_reference :: Lens' CreateAnnotationStore (Maybe ReferenceItem)
createAnnotationStore_reference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnnotationStore' {Maybe ReferenceItem
reference :: Maybe ReferenceItem
$sel:reference:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe ReferenceItem
reference} -> Maybe ReferenceItem
reference) (\s :: CreateAnnotationStore
s@CreateAnnotationStore' {} Maybe ReferenceItem
a -> CreateAnnotationStore
s {$sel:reference:CreateAnnotationStore' :: Maybe ReferenceItem
reference = Maybe ReferenceItem
a} :: CreateAnnotationStore)

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

-- | File parsing options for the annotation store.
createAnnotationStore_storeOptions :: Lens.Lens' CreateAnnotationStore (Prelude.Maybe StoreOptions)
createAnnotationStore_storeOptions :: Lens' CreateAnnotationStore (Maybe StoreOptions)
createAnnotationStore_storeOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnnotationStore' {Maybe StoreOptions
storeOptions :: Maybe StoreOptions
$sel:storeOptions:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe StoreOptions
storeOptions} -> Maybe StoreOptions
storeOptions) (\s :: CreateAnnotationStore
s@CreateAnnotationStore' {} Maybe StoreOptions
a -> CreateAnnotationStore
s {$sel:storeOptions:CreateAnnotationStore' :: Maybe StoreOptions
storeOptions = Maybe StoreOptions
a} :: CreateAnnotationStore)

-- | Tags for the store.
createAnnotationStore_tags :: Lens.Lens' CreateAnnotationStore (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createAnnotationStore_tags :: Lens' CreateAnnotationStore (Maybe (HashMap Text Text))
createAnnotationStore_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnnotationStore' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateAnnotationStore
s@CreateAnnotationStore' {} Maybe (HashMap Text Text)
a -> CreateAnnotationStore
s {$sel:tags:CreateAnnotationStore' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateAnnotationStore) 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 annotation file format of the store.
createAnnotationStore_storeFormat :: Lens.Lens' CreateAnnotationStore StoreFormat
createAnnotationStore_storeFormat :: Lens' CreateAnnotationStore StoreFormat
createAnnotationStore_storeFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAnnotationStore' {StoreFormat
storeFormat :: StoreFormat
$sel:storeFormat:CreateAnnotationStore' :: CreateAnnotationStore -> StoreFormat
storeFormat} -> StoreFormat
storeFormat) (\s :: CreateAnnotationStore
s@CreateAnnotationStore' {} StoreFormat
a -> CreateAnnotationStore
s {$sel:storeFormat:CreateAnnotationStore' :: StoreFormat
storeFormat = StoreFormat
a} :: CreateAnnotationStore)

instance Core.AWSRequest CreateAnnotationStore where
  type
    AWSResponse CreateAnnotationStore =
      CreateAnnotationStoreResponse
  request :: (Service -> Service)
-> CreateAnnotationStore -> Request CreateAnnotationStore
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 CreateAnnotationStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAnnotationStore)))
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 ReferenceItem
-> Maybe StoreFormat
-> Maybe StoreOptions
-> Int
-> ISO8601
-> Text
-> Text
-> StoreStatus
-> CreateAnnotationStoreResponse
CreateAnnotationStoreResponse'
            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
"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 (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
"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
"status")
      )

instance Prelude.Hashable CreateAnnotationStore where
  hashWithSalt :: Int -> CreateAnnotationStore -> Int
hashWithSalt Int
_salt CreateAnnotationStore' {Maybe Text
Maybe (HashMap Text Text)
Maybe ReferenceItem
Maybe SseConfig
Maybe StoreOptions
StoreFormat
storeFormat :: StoreFormat
tags :: Maybe (HashMap Text Text)
storeOptions :: Maybe StoreOptions
sseConfig :: Maybe SseConfig
reference :: Maybe ReferenceItem
name :: Maybe Text
description :: Maybe Text
$sel:storeFormat:CreateAnnotationStore' :: CreateAnnotationStore -> StoreFormat
$sel:tags:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe (HashMap Text Text)
$sel:storeOptions:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe StoreOptions
$sel:sseConfig:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe SseConfig
$sel:reference:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe ReferenceItem
$sel:name:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe Text
$sel:description:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReferenceItem
reference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SseConfig
sseConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StoreOptions
storeOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StoreFormat
storeFormat

instance Prelude.NFData CreateAnnotationStore where
  rnf :: CreateAnnotationStore -> ()
rnf CreateAnnotationStore' {Maybe Text
Maybe (HashMap Text Text)
Maybe ReferenceItem
Maybe SseConfig
Maybe StoreOptions
StoreFormat
storeFormat :: StoreFormat
tags :: Maybe (HashMap Text Text)
storeOptions :: Maybe StoreOptions
sseConfig :: Maybe SseConfig
reference :: Maybe ReferenceItem
name :: Maybe Text
description :: Maybe Text
$sel:storeFormat:CreateAnnotationStore' :: CreateAnnotationStore -> StoreFormat
$sel:tags:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe (HashMap Text Text)
$sel:storeOptions:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe StoreOptions
$sel:sseConfig:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe SseConfig
$sel:reference:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe ReferenceItem
$sel:name:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe Text
$sel:description:CreateAnnotationStore' :: CreateAnnotationStore -> 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 ReferenceItem
reference
      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 StoreOptions
storeOptions
      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 StoreFormat
storeFormat

instance Data.ToHeaders CreateAnnotationStore where
  toHeaders :: CreateAnnotationStore -> 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 CreateAnnotationStore where
  toJSON :: CreateAnnotationStore -> Value
toJSON CreateAnnotationStore' {Maybe Text
Maybe (HashMap Text Text)
Maybe ReferenceItem
Maybe SseConfig
Maybe StoreOptions
StoreFormat
storeFormat :: StoreFormat
tags :: Maybe (HashMap Text Text)
storeOptions :: Maybe StoreOptions
sseConfig :: Maybe SseConfig
reference :: Maybe ReferenceItem
name :: Maybe Text
description :: Maybe Text
$sel:storeFormat:CreateAnnotationStore' :: CreateAnnotationStore -> StoreFormat
$sel:tags:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe (HashMap Text Text)
$sel:storeOptions:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe StoreOptions
$sel:sseConfig:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe SseConfig
$sel:reference:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe ReferenceItem
$sel:name:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe Text
$sel:description:CreateAnnotationStore' :: CreateAnnotationStore -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"name" 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
name,
            (Key
"reference" 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 ReferenceItem
reference,
            (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
"storeOptions" 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 StoreOptions
storeOptions,
            (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
"storeFormat" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StoreFormat
storeFormat)
          ]
      )

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

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

-- | /See:/ 'newCreateAnnotationStoreResponse' smart constructor.
data CreateAnnotationStoreResponse = CreateAnnotationStoreResponse'
  { -- | The store\'s genome reference.
    CreateAnnotationStoreResponse -> Maybe ReferenceItem
reference :: Prelude.Maybe ReferenceItem,
    -- | The annotation file format of the store.
    CreateAnnotationStoreResponse -> Maybe StoreFormat
storeFormat :: Prelude.Maybe StoreFormat,
    -- | The store\'s file parsing options.
    CreateAnnotationStoreResponse -> Maybe StoreOptions
storeOptions :: Prelude.Maybe StoreOptions,
    -- | The response's http status code.
    CreateAnnotationStoreResponse -> Int
httpStatus :: Prelude.Int,
    -- | When the store was created.
    CreateAnnotationStoreResponse -> ISO8601
creationTime :: Data.ISO8601,
    -- | The store\'s ID.
    CreateAnnotationStoreResponse -> Text
id :: Prelude.Text,
    -- | The store\'s name.
    CreateAnnotationStoreResponse -> Text
name :: Prelude.Text,
    -- | The store\'s status.
    CreateAnnotationStoreResponse -> StoreStatus
status :: StoreStatus
  }
  deriving (CreateAnnotationStoreResponse
-> CreateAnnotationStoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAnnotationStoreResponse
-> CreateAnnotationStoreResponse -> Bool
$c/= :: CreateAnnotationStoreResponse
-> CreateAnnotationStoreResponse -> Bool
== :: CreateAnnotationStoreResponse
-> CreateAnnotationStoreResponse -> Bool
$c== :: CreateAnnotationStoreResponse
-> CreateAnnotationStoreResponse -> Bool
Prelude.Eq, ReadPrec [CreateAnnotationStoreResponse]
ReadPrec CreateAnnotationStoreResponse
Int -> ReadS CreateAnnotationStoreResponse
ReadS [CreateAnnotationStoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAnnotationStoreResponse]
$creadListPrec :: ReadPrec [CreateAnnotationStoreResponse]
readPrec :: ReadPrec CreateAnnotationStoreResponse
$creadPrec :: ReadPrec CreateAnnotationStoreResponse
readList :: ReadS [CreateAnnotationStoreResponse]
$creadList :: ReadS [CreateAnnotationStoreResponse]
readsPrec :: Int -> ReadS CreateAnnotationStoreResponse
$creadsPrec :: Int -> ReadS CreateAnnotationStoreResponse
Prelude.Read, Int -> CreateAnnotationStoreResponse -> ShowS
[CreateAnnotationStoreResponse] -> ShowS
CreateAnnotationStoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAnnotationStoreResponse] -> ShowS
$cshowList :: [CreateAnnotationStoreResponse] -> ShowS
show :: CreateAnnotationStoreResponse -> String
$cshow :: CreateAnnotationStoreResponse -> String
showsPrec :: Int -> CreateAnnotationStoreResponse -> ShowS
$cshowsPrec :: Int -> CreateAnnotationStoreResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAnnotationStoreResponse x
-> CreateAnnotationStoreResponse
forall x.
CreateAnnotationStoreResponse
-> Rep CreateAnnotationStoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAnnotationStoreResponse x
-> CreateAnnotationStoreResponse
$cfrom :: forall x.
CreateAnnotationStoreResponse
-> Rep CreateAnnotationStoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAnnotationStoreResponse' 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:
--
-- 'reference', 'createAnnotationStoreResponse_reference' - The store\'s genome reference.
--
-- 'storeFormat', 'createAnnotationStoreResponse_storeFormat' - The annotation file format of the store.
--
-- 'storeOptions', 'createAnnotationStoreResponse_storeOptions' - The store\'s file parsing options.
--
-- 'httpStatus', 'createAnnotationStoreResponse_httpStatus' - The response's http status code.
--
-- 'creationTime', 'createAnnotationStoreResponse_creationTime' - When the store was created.
--
-- 'id', 'createAnnotationStoreResponse_id' - The store\'s ID.
--
-- 'name', 'createAnnotationStoreResponse_name' - The store\'s name.
--
-- 'status', 'createAnnotationStoreResponse_status' - The store\'s status.
newCreateAnnotationStoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'id'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  StoreStatus ->
  CreateAnnotationStoreResponse
newCreateAnnotationStoreResponse :: Int
-> UTCTime
-> Text
-> Text
-> StoreStatus
-> CreateAnnotationStoreResponse
newCreateAnnotationStoreResponse
  Int
pHttpStatus_
  UTCTime
pCreationTime_
  Text
pId_
  Text
pName_
  StoreStatus
pStatus_ =
    CreateAnnotationStoreResponse'
      { $sel:reference:CreateAnnotationStoreResponse' :: Maybe ReferenceItem
reference =
          forall a. Maybe a
Prelude.Nothing,
        $sel:storeFormat:CreateAnnotationStoreResponse' :: Maybe StoreFormat
storeFormat = forall a. Maybe a
Prelude.Nothing,
        $sel:storeOptions:CreateAnnotationStoreResponse' :: Maybe StoreOptions
storeOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateAnnotationStoreResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:creationTime:CreateAnnotationStoreResponse' :: ISO8601
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:id:CreateAnnotationStoreResponse' :: Text
id = Text
pId_,
        $sel:name:CreateAnnotationStoreResponse' :: Text
name = Text
pName_,
        $sel:status:CreateAnnotationStoreResponse' :: StoreStatus
status = StoreStatus
pStatus_
      }

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

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

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

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

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

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

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

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

instance Prelude.NFData CreateAnnotationStoreResponse where
  rnf :: CreateAnnotationStoreResponse -> ()
rnf CreateAnnotationStoreResponse' {Int
Maybe ReferenceItem
Maybe StoreFormat
Maybe StoreOptions
Text
ISO8601
StoreStatus
status :: StoreStatus
name :: Text
id :: Text
creationTime :: ISO8601
httpStatus :: Int
storeOptions :: Maybe StoreOptions
storeFormat :: Maybe StoreFormat
reference :: Maybe ReferenceItem
$sel:status:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> StoreStatus
$sel:name:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Text
$sel:id:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Text
$sel:creationTime:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> ISO8601
$sel:httpStatus:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Int
$sel:storeOptions:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Maybe StoreOptions
$sel:storeFormat:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Maybe StoreFormat
$sel:reference:CreateAnnotationStoreResponse' :: CreateAnnotationStoreResponse -> Maybe ReferenceItem
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReferenceItem
reference
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
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 StoreStatus
status