{-# 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.GetReferenceMetadata
-- 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 genome reference\'s metadata.
module Amazonka.Omics.GetReferenceMetadata
  ( -- * Creating a Request
    GetReferenceMetadata (..),
    newGetReferenceMetadata,

    -- * Request Lenses
    getReferenceMetadata_id,
    getReferenceMetadata_referenceStoreId,

    -- * Destructuring the Response
    GetReferenceMetadataResponse (..),
    newGetReferenceMetadataResponse,

    -- * Response Lenses
    getReferenceMetadataResponse_description,
    getReferenceMetadataResponse_files,
    getReferenceMetadataResponse_name,
    getReferenceMetadataResponse_status,
    getReferenceMetadataResponse_httpStatus,
    getReferenceMetadataResponse_arn,
    getReferenceMetadataResponse_creationTime,
    getReferenceMetadataResponse_id,
    getReferenceMetadataResponse_md5,
    getReferenceMetadataResponse_referenceStoreId,
    getReferenceMetadataResponse_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:/ 'newGetReferenceMetadata' smart constructor.
data GetReferenceMetadata = GetReferenceMetadata'
  { -- | The reference\'s ID.
    GetReferenceMetadata -> Text
id :: Prelude.Text,
    -- | The reference\'s reference store ID.
    GetReferenceMetadata -> Text
referenceStoreId :: Prelude.Text
  }
  deriving (GetReferenceMetadata -> GetReferenceMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetReferenceMetadata -> GetReferenceMetadata -> Bool
$c/= :: GetReferenceMetadata -> GetReferenceMetadata -> Bool
== :: GetReferenceMetadata -> GetReferenceMetadata -> Bool
$c== :: GetReferenceMetadata -> GetReferenceMetadata -> Bool
Prelude.Eq, ReadPrec [GetReferenceMetadata]
ReadPrec GetReferenceMetadata
Int -> ReadS GetReferenceMetadata
ReadS [GetReferenceMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetReferenceMetadata]
$creadListPrec :: ReadPrec [GetReferenceMetadata]
readPrec :: ReadPrec GetReferenceMetadata
$creadPrec :: ReadPrec GetReferenceMetadata
readList :: ReadS [GetReferenceMetadata]
$creadList :: ReadS [GetReferenceMetadata]
readsPrec :: Int -> ReadS GetReferenceMetadata
$creadsPrec :: Int -> ReadS GetReferenceMetadata
Prelude.Read, Int -> GetReferenceMetadata -> ShowS
[GetReferenceMetadata] -> ShowS
GetReferenceMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetReferenceMetadata] -> ShowS
$cshowList :: [GetReferenceMetadata] -> ShowS
show :: GetReferenceMetadata -> String
$cshow :: GetReferenceMetadata -> String
showsPrec :: Int -> GetReferenceMetadata -> ShowS
$cshowsPrec :: Int -> GetReferenceMetadata -> ShowS
Prelude.Show, forall x. Rep GetReferenceMetadata x -> GetReferenceMetadata
forall x. GetReferenceMetadata -> Rep GetReferenceMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetReferenceMetadata x -> GetReferenceMetadata
$cfrom :: forall x. GetReferenceMetadata -> Rep GetReferenceMetadata x
Prelude.Generic)

-- |
-- Create a value of 'GetReferenceMetadata' 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:
--
-- 'id', 'getReferenceMetadata_id' - The reference\'s ID.
--
-- 'referenceStoreId', 'getReferenceMetadata_referenceStoreId' - The reference\'s reference store ID.
newGetReferenceMetadata ::
  -- | 'id'
  Prelude.Text ->
  -- | 'referenceStoreId'
  Prelude.Text ->
  GetReferenceMetadata
newGetReferenceMetadata :: Text -> Text -> GetReferenceMetadata
newGetReferenceMetadata Text
pId_ Text
pReferenceStoreId_ =
  GetReferenceMetadata'
    { $sel:id:GetReferenceMetadata' :: Text
id = Text
pId_,
      $sel:referenceStoreId:GetReferenceMetadata' :: Text
referenceStoreId = Text
pReferenceStoreId_
    }

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

-- | The reference\'s reference store ID.
getReferenceMetadata_referenceStoreId :: Lens.Lens' GetReferenceMetadata Prelude.Text
getReferenceMetadata_referenceStoreId :: Lens' GetReferenceMetadata Text
getReferenceMetadata_referenceStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReferenceMetadata' {Text
referenceStoreId :: Text
$sel:referenceStoreId:GetReferenceMetadata' :: GetReferenceMetadata -> Text
referenceStoreId} -> Text
referenceStoreId) (\s :: GetReferenceMetadata
s@GetReferenceMetadata' {} Text
a -> GetReferenceMetadata
s {$sel:referenceStoreId:GetReferenceMetadata' :: Text
referenceStoreId = Text
a} :: GetReferenceMetadata)

instance Core.AWSRequest GetReferenceMetadata where
  type
    AWSResponse GetReferenceMetadata =
      GetReferenceMetadataResponse
  request :: (Service -> Service)
-> GetReferenceMetadata -> Request GetReferenceMetadata
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 GetReferenceMetadata
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetReferenceMetadata)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe ReferenceFiles
-> Maybe Text
-> Maybe ReferenceStatus
-> Int
-> Text
-> ISO8601
-> Text
-> Text
-> Text
-> ISO8601
-> GetReferenceMetadataResponse
GetReferenceMetadataResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"files")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"creationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"id")
            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
"md5")
            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
"referenceStoreId")
            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 GetReferenceMetadata where
  hashWithSalt :: Int -> GetReferenceMetadata -> Int
hashWithSalt Int
_salt GetReferenceMetadata' {Text
referenceStoreId :: Text
id :: Text
$sel:referenceStoreId:GetReferenceMetadata' :: GetReferenceMetadata -> Text
$sel:id:GetReferenceMetadata' :: GetReferenceMetadata -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
referenceStoreId

instance Prelude.NFData GetReferenceMetadata where
  rnf :: GetReferenceMetadata -> ()
rnf GetReferenceMetadata' {Text
referenceStoreId :: Text
id :: Text
$sel:referenceStoreId:GetReferenceMetadata' :: GetReferenceMetadata -> Text
$sel:id:GetReferenceMetadata' :: GetReferenceMetadata -> Text
..} =
    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
referenceStoreId

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

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

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

-- |
-- Create a value of 'GetReferenceMetadataResponse' 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', 'getReferenceMetadataResponse_description' - The reference\'s description.
--
-- 'files', 'getReferenceMetadataResponse_files' - The reference\'s files.
--
-- 'name', 'getReferenceMetadataResponse_name' - The reference\'s name.
--
-- 'status', 'getReferenceMetadataResponse_status' - The reference\'s status.
--
-- 'httpStatus', 'getReferenceMetadataResponse_httpStatus' - The response's http status code.
--
-- 'arn', 'getReferenceMetadataResponse_arn' - The reference\'s ARN.
--
-- 'creationTime', 'getReferenceMetadataResponse_creationTime' - When the reference was created.
--
-- 'id', 'getReferenceMetadataResponse_id' - The reference\'s ID.
--
-- 'md5', 'getReferenceMetadataResponse_md5' - The reference\'s MD5 checksum.
--
-- 'referenceStoreId', 'getReferenceMetadataResponse_referenceStoreId' - The reference\'s reference store ID.
--
-- 'updateTime', 'getReferenceMetadataResponse_updateTime' - When the reference was updated.
newGetReferenceMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'arn'
  Prelude.Text ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'id'
  Prelude.Text ->
  -- | 'md5'
  Prelude.Text ->
  -- | 'referenceStoreId'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  GetReferenceMetadataResponse
newGetReferenceMetadataResponse :: Int
-> Text
-> UTCTime
-> Text
-> Text
-> Text
-> UTCTime
-> GetReferenceMetadataResponse
newGetReferenceMetadataResponse
  Int
pHttpStatus_
  Text
pArn_
  UTCTime
pCreationTime_
  Text
pId_
  Text
pMd5_
  Text
pReferenceStoreId_
  UTCTime
pUpdateTime_ =
    GetReferenceMetadataResponse'
      { $sel:description:GetReferenceMetadataResponse' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:files:GetReferenceMetadataResponse' :: Maybe ReferenceFiles
files = forall a. Maybe a
Prelude.Nothing,
        $sel:name:GetReferenceMetadataResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:status:GetReferenceMetadataResponse' :: Maybe ReferenceStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetReferenceMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:arn:GetReferenceMetadataResponse' :: Text
arn = Text
pArn_,
        $sel:creationTime:GetReferenceMetadataResponse' :: ISO8601
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:id:GetReferenceMetadataResponse' :: Text
id = Text
pId_,
        $sel:md5:GetReferenceMetadataResponse' :: Text
md5 = Text
pMd5_,
        $sel:referenceStoreId:GetReferenceMetadataResponse' :: Text
referenceStoreId = Text
pReferenceStoreId_,
        $sel:updateTime:GetReferenceMetadataResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

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

-- | The reference\'s files.
getReferenceMetadataResponse_files :: Lens.Lens' GetReferenceMetadataResponse (Prelude.Maybe ReferenceFiles)
getReferenceMetadataResponse_files :: Lens' GetReferenceMetadataResponse (Maybe ReferenceFiles)
getReferenceMetadataResponse_files = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReferenceMetadataResponse' {Maybe ReferenceFiles
files :: Maybe ReferenceFiles
$sel:files:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Maybe ReferenceFiles
files} -> Maybe ReferenceFiles
files) (\s :: GetReferenceMetadataResponse
s@GetReferenceMetadataResponse' {} Maybe ReferenceFiles
a -> GetReferenceMetadataResponse
s {$sel:files:GetReferenceMetadataResponse' :: Maybe ReferenceFiles
files = Maybe ReferenceFiles
a} :: GetReferenceMetadataResponse)

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

-- | The reference\'s status.
getReferenceMetadataResponse_status :: Lens.Lens' GetReferenceMetadataResponse (Prelude.Maybe ReferenceStatus)
getReferenceMetadataResponse_status :: Lens' GetReferenceMetadataResponse (Maybe ReferenceStatus)
getReferenceMetadataResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReferenceMetadataResponse' {Maybe ReferenceStatus
status :: Maybe ReferenceStatus
$sel:status:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Maybe ReferenceStatus
status} -> Maybe ReferenceStatus
status) (\s :: GetReferenceMetadataResponse
s@GetReferenceMetadataResponse' {} Maybe ReferenceStatus
a -> GetReferenceMetadataResponse
s {$sel:status:GetReferenceMetadataResponse' :: Maybe ReferenceStatus
status = Maybe ReferenceStatus
a} :: GetReferenceMetadataResponse)

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

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

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

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

-- | The reference\'s MD5 checksum.
getReferenceMetadataResponse_md5 :: Lens.Lens' GetReferenceMetadataResponse Prelude.Text
getReferenceMetadataResponse_md5 :: Lens' GetReferenceMetadataResponse Text
getReferenceMetadataResponse_md5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReferenceMetadataResponse' {Text
md5 :: Text
$sel:md5:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
md5} -> Text
md5) (\s :: GetReferenceMetadataResponse
s@GetReferenceMetadataResponse' {} Text
a -> GetReferenceMetadataResponse
s {$sel:md5:GetReferenceMetadataResponse' :: Text
md5 = Text
a} :: GetReferenceMetadataResponse)

-- | The reference\'s reference store ID.
getReferenceMetadataResponse_referenceStoreId :: Lens.Lens' GetReferenceMetadataResponse Prelude.Text
getReferenceMetadataResponse_referenceStoreId :: Lens' GetReferenceMetadataResponse Text
getReferenceMetadataResponse_referenceStoreId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetReferenceMetadataResponse' {Text
referenceStoreId :: Text
$sel:referenceStoreId:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
referenceStoreId} -> Text
referenceStoreId) (\s :: GetReferenceMetadataResponse
s@GetReferenceMetadataResponse' {} Text
a -> GetReferenceMetadataResponse
s {$sel:referenceStoreId:GetReferenceMetadataResponse' :: Text
referenceStoreId = Text
a} :: GetReferenceMetadataResponse)

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

instance Prelude.NFData GetReferenceMetadataResponse where
  rnf :: GetReferenceMetadataResponse -> ()
rnf GetReferenceMetadataResponse' {Int
Maybe Text
Maybe ReferenceFiles
Maybe ReferenceStatus
Text
ISO8601
updateTime :: ISO8601
referenceStoreId :: Text
md5 :: Text
id :: Text
creationTime :: ISO8601
arn :: Text
httpStatus :: Int
status :: Maybe ReferenceStatus
name :: Maybe Text
files :: Maybe ReferenceFiles
description :: Maybe Text
$sel:updateTime:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> ISO8601
$sel:referenceStoreId:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
$sel:md5:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
$sel:id:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
$sel:creationTime:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> ISO8601
$sel:arn:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Text
$sel:httpStatus:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Int
$sel:status:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Maybe ReferenceStatus
$sel:name:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Maybe Text
$sel:files:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> Maybe ReferenceFiles
$sel:description:GetReferenceMetadataResponse' :: GetReferenceMetadataResponse -> 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 ReferenceFiles
files
      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 ReferenceStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
md5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
referenceStoreId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime