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

    -- * Request Lenses
    describeDatastore_includeStatistics,
    describeDatastore_datastoreName,

    -- * Destructuring the Response
    DescribeDatastoreResponse (..),
    newDescribeDatastoreResponse,

    -- * Response Lenses
    describeDatastoreResponse_datastore,
    describeDatastoreResponse_statistics,
    describeDatastoreResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeDatastore' smart constructor.
data DescribeDatastore = DescribeDatastore'
  { -- | If true, additional statistical information about the data store is
    -- included in the response. This feature can\'t be used with a data store
    -- whose S3 storage is customer-managed.
    DescribeDatastore -> Maybe Bool
includeStatistics :: Prelude.Maybe Prelude.Bool,
    -- | The name of the data store
    DescribeDatastore -> Text
datastoreName :: Prelude.Text
  }
  deriving (DescribeDatastore -> DescribeDatastore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDatastore -> DescribeDatastore -> Bool
$c/= :: DescribeDatastore -> DescribeDatastore -> Bool
== :: DescribeDatastore -> DescribeDatastore -> Bool
$c== :: DescribeDatastore -> DescribeDatastore -> Bool
Prelude.Eq, ReadPrec [DescribeDatastore]
ReadPrec DescribeDatastore
Int -> ReadS DescribeDatastore
ReadS [DescribeDatastore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDatastore]
$creadListPrec :: ReadPrec [DescribeDatastore]
readPrec :: ReadPrec DescribeDatastore
$creadPrec :: ReadPrec DescribeDatastore
readList :: ReadS [DescribeDatastore]
$creadList :: ReadS [DescribeDatastore]
readsPrec :: Int -> ReadS DescribeDatastore
$creadsPrec :: Int -> ReadS DescribeDatastore
Prelude.Read, Int -> DescribeDatastore -> ShowS
[DescribeDatastore] -> ShowS
DescribeDatastore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDatastore] -> ShowS
$cshowList :: [DescribeDatastore] -> ShowS
show :: DescribeDatastore -> String
$cshow :: DescribeDatastore -> String
showsPrec :: Int -> DescribeDatastore -> ShowS
$cshowsPrec :: Int -> DescribeDatastore -> ShowS
Prelude.Show, forall x. Rep DescribeDatastore x -> DescribeDatastore
forall x. DescribeDatastore -> Rep DescribeDatastore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeDatastore x -> DescribeDatastore
$cfrom :: forall x. DescribeDatastore -> Rep DescribeDatastore x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDatastore' 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:
--
-- 'includeStatistics', 'describeDatastore_includeStatistics' - If true, additional statistical information about the data store is
-- included in the response. This feature can\'t be used with a data store
-- whose S3 storage is customer-managed.
--
-- 'datastoreName', 'describeDatastore_datastoreName' - The name of the data store
newDescribeDatastore ::
  -- | 'datastoreName'
  Prelude.Text ->
  DescribeDatastore
newDescribeDatastore :: Text -> DescribeDatastore
newDescribeDatastore Text
pDatastoreName_ =
  DescribeDatastore'
    { $sel:includeStatistics:DescribeDatastore' :: Maybe Bool
includeStatistics =
        forall a. Maybe a
Prelude.Nothing,
      $sel:datastoreName:DescribeDatastore' :: Text
datastoreName = Text
pDatastoreName_
    }

-- | If true, additional statistical information about the data store is
-- included in the response. This feature can\'t be used with a data store
-- whose S3 storage is customer-managed.
describeDatastore_includeStatistics :: Lens.Lens' DescribeDatastore (Prelude.Maybe Prelude.Bool)
describeDatastore_includeStatistics :: Lens' DescribeDatastore (Maybe Bool)
describeDatastore_includeStatistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDatastore' {Maybe Bool
includeStatistics :: Maybe Bool
$sel:includeStatistics:DescribeDatastore' :: DescribeDatastore -> Maybe Bool
includeStatistics} -> Maybe Bool
includeStatistics) (\s :: DescribeDatastore
s@DescribeDatastore' {} Maybe Bool
a -> DescribeDatastore
s {$sel:includeStatistics:DescribeDatastore' :: Maybe Bool
includeStatistics = Maybe Bool
a} :: DescribeDatastore)

-- | The name of the data store
describeDatastore_datastoreName :: Lens.Lens' DescribeDatastore Prelude.Text
describeDatastore_datastoreName :: Lens' DescribeDatastore Text
describeDatastore_datastoreName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDatastore' {Text
datastoreName :: Text
$sel:datastoreName:DescribeDatastore' :: DescribeDatastore -> Text
datastoreName} -> Text
datastoreName) (\s :: DescribeDatastore
s@DescribeDatastore' {} Text
a -> DescribeDatastore
s {$sel:datastoreName:DescribeDatastore' :: Text
datastoreName = Text
a} :: DescribeDatastore)

instance Core.AWSRequest DescribeDatastore where
  type
    AWSResponse DescribeDatastore =
      DescribeDatastoreResponse
  request :: (Service -> Service)
-> DescribeDatastore -> Request DescribeDatastore
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 DescribeDatastore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeDatastore)))
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 Datastore
-> Maybe DatastoreStatistics -> Int -> DescribeDatastoreResponse
DescribeDatastoreResponse'
            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
"datastore")
            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
"statistics")
            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))
      )

instance Prelude.Hashable DescribeDatastore where
  hashWithSalt :: Int -> DescribeDatastore -> Int
hashWithSalt Int
_salt DescribeDatastore' {Maybe Bool
Text
datastoreName :: Text
includeStatistics :: Maybe Bool
$sel:datastoreName:DescribeDatastore' :: DescribeDatastore -> Text
$sel:includeStatistics:DescribeDatastore' :: DescribeDatastore -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeStatistics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datastoreName

instance Prelude.NFData DescribeDatastore where
  rnf :: DescribeDatastore -> ()
rnf DescribeDatastore' {Maybe Bool
Text
datastoreName :: Text
includeStatistics :: Maybe Bool
$sel:datastoreName:DescribeDatastore' :: DescribeDatastore -> Text
$sel:includeStatistics:DescribeDatastore' :: DescribeDatastore -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeStatistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datastoreName

instance Data.ToHeaders DescribeDatastore where
  toHeaders :: DescribeDatastore -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DescribeDatastore where
  toPath :: DescribeDatastore -> ByteString
toPath DescribeDatastore' {Maybe Bool
Text
datastoreName :: Text
includeStatistics :: Maybe Bool
$sel:datastoreName:DescribeDatastore' :: DescribeDatastore -> Text
$sel:includeStatistics:DescribeDatastore' :: DescribeDatastore -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/datastores/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
datastoreName]

instance Data.ToQuery DescribeDatastore where
  toQuery :: DescribeDatastore -> QueryString
toQuery DescribeDatastore' {Maybe Bool
Text
datastoreName :: Text
includeStatistics :: Maybe Bool
$sel:datastoreName:DescribeDatastore' :: DescribeDatastore -> Text
$sel:includeStatistics:DescribeDatastore' :: DescribeDatastore -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"includeStatistics" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
includeStatistics]

-- | /See:/ 'newDescribeDatastoreResponse' smart constructor.
data DescribeDatastoreResponse = DescribeDatastoreResponse'
  { -- | Information about the data store.
    DescribeDatastoreResponse -> Maybe Datastore
datastore :: Prelude.Maybe Datastore,
    -- | Additional statistical information about the data store. Included if the
    -- @includeStatistics@ parameter is set to @true@ in the request.
    DescribeDatastoreResponse -> Maybe DatastoreStatistics
statistics :: Prelude.Maybe DatastoreStatistics,
    -- | The response's http status code.
    DescribeDatastoreResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDatastoreResponse -> DescribeDatastoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDatastoreResponse -> DescribeDatastoreResponse -> Bool
$c/= :: DescribeDatastoreResponse -> DescribeDatastoreResponse -> Bool
== :: DescribeDatastoreResponse -> DescribeDatastoreResponse -> Bool
$c== :: DescribeDatastoreResponse -> DescribeDatastoreResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDatastoreResponse]
ReadPrec DescribeDatastoreResponse
Int -> ReadS DescribeDatastoreResponse
ReadS [DescribeDatastoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDatastoreResponse]
$creadListPrec :: ReadPrec [DescribeDatastoreResponse]
readPrec :: ReadPrec DescribeDatastoreResponse
$creadPrec :: ReadPrec DescribeDatastoreResponse
readList :: ReadS [DescribeDatastoreResponse]
$creadList :: ReadS [DescribeDatastoreResponse]
readsPrec :: Int -> ReadS DescribeDatastoreResponse
$creadsPrec :: Int -> ReadS DescribeDatastoreResponse
Prelude.Read, Int -> DescribeDatastoreResponse -> ShowS
[DescribeDatastoreResponse] -> ShowS
DescribeDatastoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDatastoreResponse] -> ShowS
$cshowList :: [DescribeDatastoreResponse] -> ShowS
show :: DescribeDatastoreResponse -> String
$cshow :: DescribeDatastoreResponse -> String
showsPrec :: Int -> DescribeDatastoreResponse -> ShowS
$cshowsPrec :: Int -> DescribeDatastoreResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDatastoreResponse x -> DescribeDatastoreResponse
forall x.
DescribeDatastoreResponse -> Rep DescribeDatastoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDatastoreResponse x -> DescribeDatastoreResponse
$cfrom :: forall x.
DescribeDatastoreResponse -> Rep DescribeDatastoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDatastoreResponse' 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:
--
-- 'datastore', 'describeDatastoreResponse_datastore' - Information about the data store.
--
-- 'statistics', 'describeDatastoreResponse_statistics' - Additional statistical information about the data store. Included if the
-- @includeStatistics@ parameter is set to @true@ in the request.
--
-- 'httpStatus', 'describeDatastoreResponse_httpStatus' - The response's http status code.
newDescribeDatastoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDatastoreResponse
newDescribeDatastoreResponse :: Int -> DescribeDatastoreResponse
newDescribeDatastoreResponse Int
pHttpStatus_ =
  DescribeDatastoreResponse'
    { $sel:datastore:DescribeDatastoreResponse' :: Maybe Datastore
datastore =
        forall a. Maybe a
Prelude.Nothing,
      $sel:statistics:DescribeDatastoreResponse' :: Maybe DatastoreStatistics
statistics = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeDatastoreResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the data store.
describeDatastoreResponse_datastore :: Lens.Lens' DescribeDatastoreResponse (Prelude.Maybe Datastore)
describeDatastoreResponse_datastore :: Lens' DescribeDatastoreResponse (Maybe Datastore)
describeDatastoreResponse_datastore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDatastoreResponse' {Maybe Datastore
datastore :: Maybe Datastore
$sel:datastore:DescribeDatastoreResponse' :: DescribeDatastoreResponse -> Maybe Datastore
datastore} -> Maybe Datastore
datastore) (\s :: DescribeDatastoreResponse
s@DescribeDatastoreResponse' {} Maybe Datastore
a -> DescribeDatastoreResponse
s {$sel:datastore:DescribeDatastoreResponse' :: Maybe Datastore
datastore = Maybe Datastore
a} :: DescribeDatastoreResponse)

-- | Additional statistical information about the data store. Included if the
-- @includeStatistics@ parameter is set to @true@ in the request.
describeDatastoreResponse_statistics :: Lens.Lens' DescribeDatastoreResponse (Prelude.Maybe DatastoreStatistics)
describeDatastoreResponse_statistics :: Lens' DescribeDatastoreResponse (Maybe DatastoreStatistics)
describeDatastoreResponse_statistics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDatastoreResponse' {Maybe DatastoreStatistics
statistics :: Maybe DatastoreStatistics
$sel:statistics:DescribeDatastoreResponse' :: DescribeDatastoreResponse -> Maybe DatastoreStatistics
statistics} -> Maybe DatastoreStatistics
statistics) (\s :: DescribeDatastoreResponse
s@DescribeDatastoreResponse' {} Maybe DatastoreStatistics
a -> DescribeDatastoreResponse
s {$sel:statistics:DescribeDatastoreResponse' :: Maybe DatastoreStatistics
statistics = Maybe DatastoreStatistics
a} :: DescribeDatastoreResponse)

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

instance Prelude.NFData DescribeDatastoreResponse where
  rnf :: DescribeDatastoreResponse -> ()
rnf DescribeDatastoreResponse' {Int
Maybe DatastoreStatistics
Maybe Datastore
httpStatus :: Int
statistics :: Maybe DatastoreStatistics
datastore :: Maybe Datastore
$sel:httpStatus:DescribeDatastoreResponse' :: DescribeDatastoreResponse -> Int
$sel:statistics:DescribeDatastoreResponse' :: DescribeDatastoreResponse -> Maybe DatastoreStatistics
$sel:datastore:DescribeDatastoreResponse' :: DescribeDatastoreResponse -> Maybe Datastore
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Datastore
datastore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DatastoreStatistics
statistics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus