{-# 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.LookoutMetrics.GetSampleData
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a selection of sample records from an Amazon S3 datasource.
module Amazonka.LookoutMetrics.GetSampleData
  ( -- * Creating a Request
    GetSampleData (..),
    newGetSampleData,

    -- * Request Lenses
    getSampleData_s3SourceConfig,

    -- * Destructuring the Response
    GetSampleDataResponse (..),
    newGetSampleDataResponse,

    -- * Response Lenses
    getSampleDataResponse_headerValues,
    getSampleDataResponse_sampleRows,
    getSampleDataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetSampleData' smart constructor.
data GetSampleData = GetSampleData'
  { -- | A datasource bucket in Amazon S3.
    GetSampleData -> Maybe SampleDataS3SourceConfig
s3SourceConfig :: Prelude.Maybe SampleDataS3SourceConfig
  }
  deriving (GetSampleData -> GetSampleData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSampleData -> GetSampleData -> Bool
$c/= :: GetSampleData -> GetSampleData -> Bool
== :: GetSampleData -> GetSampleData -> Bool
$c== :: GetSampleData -> GetSampleData -> Bool
Prelude.Eq, ReadPrec [GetSampleData]
ReadPrec GetSampleData
Int -> ReadS GetSampleData
ReadS [GetSampleData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSampleData]
$creadListPrec :: ReadPrec [GetSampleData]
readPrec :: ReadPrec GetSampleData
$creadPrec :: ReadPrec GetSampleData
readList :: ReadS [GetSampleData]
$creadList :: ReadS [GetSampleData]
readsPrec :: Int -> ReadS GetSampleData
$creadsPrec :: Int -> ReadS GetSampleData
Prelude.Read, Int -> GetSampleData -> ShowS
[GetSampleData] -> ShowS
GetSampleData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSampleData] -> ShowS
$cshowList :: [GetSampleData] -> ShowS
show :: GetSampleData -> String
$cshow :: GetSampleData -> String
showsPrec :: Int -> GetSampleData -> ShowS
$cshowsPrec :: Int -> GetSampleData -> ShowS
Prelude.Show, forall x. Rep GetSampleData x -> GetSampleData
forall x. GetSampleData -> Rep GetSampleData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSampleData x -> GetSampleData
$cfrom :: forall x. GetSampleData -> Rep GetSampleData x
Prelude.Generic)

-- |
-- Create a value of 'GetSampleData' 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:
--
-- 's3SourceConfig', 'getSampleData_s3SourceConfig' - A datasource bucket in Amazon S3.
newGetSampleData ::
  GetSampleData
newGetSampleData :: GetSampleData
newGetSampleData =
  GetSampleData' {$sel:s3SourceConfig:GetSampleData' :: Maybe SampleDataS3SourceConfig
s3SourceConfig = forall a. Maybe a
Prelude.Nothing}

-- | A datasource bucket in Amazon S3.
getSampleData_s3SourceConfig :: Lens.Lens' GetSampleData (Prelude.Maybe SampleDataS3SourceConfig)
getSampleData_s3SourceConfig :: Lens' GetSampleData (Maybe SampleDataS3SourceConfig)
getSampleData_s3SourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSampleData' {Maybe SampleDataS3SourceConfig
s3SourceConfig :: Maybe SampleDataS3SourceConfig
$sel:s3SourceConfig:GetSampleData' :: GetSampleData -> Maybe SampleDataS3SourceConfig
s3SourceConfig} -> Maybe SampleDataS3SourceConfig
s3SourceConfig) (\s :: GetSampleData
s@GetSampleData' {} Maybe SampleDataS3SourceConfig
a -> GetSampleData
s {$sel:s3SourceConfig:GetSampleData' :: Maybe SampleDataS3SourceConfig
s3SourceConfig = Maybe SampleDataS3SourceConfig
a} :: GetSampleData)

instance Core.AWSRequest GetSampleData where
  type
    AWSResponse GetSampleData =
      GetSampleDataResponse
  request :: (Service -> Service) -> GetSampleData -> Request GetSampleData
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 GetSampleData
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetSampleData)))
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 [[Text]] -> Int -> GetSampleDataResponse
GetSampleDataResponse'
            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
"HeaderValues" 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 (Maybe a)
Data..?> Key
"SampleRows" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetSampleData where
  hashWithSalt :: Int -> GetSampleData -> Int
hashWithSalt Int
_salt GetSampleData' {Maybe SampleDataS3SourceConfig
s3SourceConfig :: Maybe SampleDataS3SourceConfig
$sel:s3SourceConfig:GetSampleData' :: GetSampleData -> Maybe SampleDataS3SourceConfig
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SampleDataS3SourceConfig
s3SourceConfig

instance Prelude.NFData GetSampleData where
  rnf :: GetSampleData -> ()
rnf GetSampleData' {Maybe SampleDataS3SourceConfig
s3SourceConfig :: Maybe SampleDataS3SourceConfig
$sel:s3SourceConfig:GetSampleData' :: GetSampleData -> Maybe SampleDataS3SourceConfig
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe SampleDataS3SourceConfig
s3SourceConfig

instance Data.ToHeaders GetSampleData where
  toHeaders :: GetSampleData -> 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 GetSampleData where
  toJSON :: GetSampleData -> Value
toJSON GetSampleData' {Maybe SampleDataS3SourceConfig
s3SourceConfig :: Maybe SampleDataS3SourceConfig
$sel:s3SourceConfig:GetSampleData' :: GetSampleData -> Maybe SampleDataS3SourceConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"S3SourceConfig" 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 SampleDataS3SourceConfig
s3SourceConfig
          ]
      )

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

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

-- | /See:/ 'newGetSampleDataResponse' smart constructor.
data GetSampleDataResponse = GetSampleDataResponse'
  { -- | A list of header labels for the records.
    GetSampleDataResponse -> Maybe [Text]
headerValues :: Prelude.Maybe [Prelude.Text],
    -- | A list of records.
    GetSampleDataResponse -> Maybe [[Text]]
sampleRows :: Prelude.Maybe [[Prelude.Text]],
    -- | The response's http status code.
    GetSampleDataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetSampleDataResponse -> GetSampleDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetSampleDataResponse -> GetSampleDataResponse -> Bool
$c/= :: GetSampleDataResponse -> GetSampleDataResponse -> Bool
== :: GetSampleDataResponse -> GetSampleDataResponse -> Bool
$c== :: GetSampleDataResponse -> GetSampleDataResponse -> Bool
Prelude.Eq, ReadPrec [GetSampleDataResponse]
ReadPrec GetSampleDataResponse
Int -> ReadS GetSampleDataResponse
ReadS [GetSampleDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetSampleDataResponse]
$creadListPrec :: ReadPrec [GetSampleDataResponse]
readPrec :: ReadPrec GetSampleDataResponse
$creadPrec :: ReadPrec GetSampleDataResponse
readList :: ReadS [GetSampleDataResponse]
$creadList :: ReadS [GetSampleDataResponse]
readsPrec :: Int -> ReadS GetSampleDataResponse
$creadsPrec :: Int -> ReadS GetSampleDataResponse
Prelude.Read, Int -> GetSampleDataResponse -> ShowS
[GetSampleDataResponse] -> ShowS
GetSampleDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetSampleDataResponse] -> ShowS
$cshowList :: [GetSampleDataResponse] -> ShowS
show :: GetSampleDataResponse -> String
$cshow :: GetSampleDataResponse -> String
showsPrec :: Int -> GetSampleDataResponse -> ShowS
$cshowsPrec :: Int -> GetSampleDataResponse -> ShowS
Prelude.Show, forall x. Rep GetSampleDataResponse x -> GetSampleDataResponse
forall x. GetSampleDataResponse -> Rep GetSampleDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetSampleDataResponse x -> GetSampleDataResponse
$cfrom :: forall x. GetSampleDataResponse -> Rep GetSampleDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetSampleDataResponse' 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:
--
-- 'headerValues', 'getSampleDataResponse_headerValues' - A list of header labels for the records.
--
-- 'sampleRows', 'getSampleDataResponse_sampleRows' - A list of records.
--
-- 'httpStatus', 'getSampleDataResponse_httpStatus' - The response's http status code.
newGetSampleDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetSampleDataResponse
newGetSampleDataResponse :: Int -> GetSampleDataResponse
newGetSampleDataResponse Int
pHttpStatus_ =
  GetSampleDataResponse'
    { $sel:headerValues:GetSampleDataResponse' :: Maybe [Text]
headerValues =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sampleRows:GetSampleDataResponse' :: Maybe [[Text]]
sampleRows = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetSampleDataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of header labels for the records.
getSampleDataResponse_headerValues :: Lens.Lens' GetSampleDataResponse (Prelude.Maybe [Prelude.Text])
getSampleDataResponse_headerValues :: Lens' GetSampleDataResponse (Maybe [Text])
getSampleDataResponse_headerValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSampleDataResponse' {Maybe [Text]
headerValues :: Maybe [Text]
$sel:headerValues:GetSampleDataResponse' :: GetSampleDataResponse -> Maybe [Text]
headerValues} -> Maybe [Text]
headerValues) (\s :: GetSampleDataResponse
s@GetSampleDataResponse' {} Maybe [Text]
a -> GetSampleDataResponse
s {$sel:headerValues:GetSampleDataResponse' :: Maybe [Text]
headerValues = Maybe [Text]
a} :: GetSampleDataResponse) 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

-- | A list of records.
getSampleDataResponse_sampleRows :: Lens.Lens' GetSampleDataResponse (Prelude.Maybe [[Prelude.Text]])
getSampleDataResponse_sampleRows :: Lens' GetSampleDataResponse (Maybe [[Text]])
getSampleDataResponse_sampleRows = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSampleDataResponse' {Maybe [[Text]]
sampleRows :: Maybe [[Text]]
$sel:sampleRows:GetSampleDataResponse' :: GetSampleDataResponse -> Maybe [[Text]]
sampleRows} -> Maybe [[Text]]
sampleRows) (\s :: GetSampleDataResponse
s@GetSampleDataResponse' {} Maybe [[Text]]
a -> GetSampleDataResponse
s {$sel:sampleRows:GetSampleDataResponse' :: Maybe [[Text]]
sampleRows = Maybe [[Text]]
a} :: GetSampleDataResponse) 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 response's http status code.
getSampleDataResponse_httpStatus :: Lens.Lens' GetSampleDataResponse Prelude.Int
getSampleDataResponse_httpStatus :: Lens' GetSampleDataResponse Int
getSampleDataResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetSampleDataResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetSampleDataResponse' :: GetSampleDataResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetSampleDataResponse
s@GetSampleDataResponse' {} Int
a -> GetSampleDataResponse
s {$sel:httpStatus:GetSampleDataResponse' :: Int
httpStatus = Int
a} :: GetSampleDataResponse)

instance Prelude.NFData GetSampleDataResponse where
  rnf :: GetSampleDataResponse -> ()
rnf GetSampleDataResponse' {Int
Maybe [[Text]]
Maybe [Text]
httpStatus :: Int
sampleRows :: Maybe [[Text]]
headerValues :: Maybe [Text]
$sel:httpStatus:GetSampleDataResponse' :: GetSampleDataResponse -> Int
$sel:sampleRows:GetSampleDataResponse' :: GetSampleDataResponse -> Maybe [[Text]]
$sel:headerValues:GetSampleDataResponse' :: GetSampleDataResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
headerValues
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [[Text]]
sampleRows
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus