{-# 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.FinSpaceData.CreateDataView
-- 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 a Dataview for a Dataset.
module Amazonka.FinSpaceData.CreateDataView
  ( -- * Creating a Request
    CreateDataView (..),
    newCreateDataView,

    -- * Request Lenses
    createDataView_asOfTimestamp,
    createDataView_autoUpdate,
    createDataView_clientToken,
    createDataView_partitionColumns,
    createDataView_sortColumns,
    createDataView_datasetId,
    createDataView_destinationTypeParams,

    -- * Destructuring the Response
    CreateDataViewResponse (..),
    newCreateDataViewResponse,

    -- * Response Lenses
    createDataViewResponse_dataViewId,
    createDataViewResponse_datasetId,
    createDataViewResponse_httpStatus,
  )
where

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

-- | Request for creating a data view.
--
-- /See:/ 'newCreateDataView' smart constructor.
data CreateDataView = CreateDataView'
  { -- | Beginning time to use for the Dataview. The value is determined as epoch
    -- time in milliseconds. For example, the value for Monday, November 1,
    -- 2021 12:00:00 PM UTC is specified as 1635768000000.
    CreateDataView -> Maybe Integer
asOfTimestamp :: Prelude.Maybe Prelude.Integer,
    -- | Flag to indicate Dataview should be updated automatically.
    CreateDataView -> Maybe Bool
autoUpdate :: Prelude.Maybe Prelude.Bool,
    -- | A token that ensures idempotency. This token expires in 10 minutes.
    CreateDataView -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Ordered set of column names used to partition data.
    CreateDataView -> Maybe [Text]
partitionColumns :: Prelude.Maybe [Prelude.Text],
    -- | Columns to be used for sorting the data.
    CreateDataView -> Maybe [Text]
sortColumns :: Prelude.Maybe [Prelude.Text],
    -- | The unique Dataset identifier that is used to create a Dataview.
    CreateDataView -> Text
datasetId :: Prelude.Text,
    -- | Options that define the destination type for the Dataview.
    CreateDataView -> DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
  }
  deriving (CreateDataView -> CreateDataView -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataView -> CreateDataView -> Bool
$c/= :: CreateDataView -> CreateDataView -> Bool
== :: CreateDataView -> CreateDataView -> Bool
$c== :: CreateDataView -> CreateDataView -> Bool
Prelude.Eq, ReadPrec [CreateDataView]
ReadPrec CreateDataView
Int -> ReadS CreateDataView
ReadS [CreateDataView]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataView]
$creadListPrec :: ReadPrec [CreateDataView]
readPrec :: ReadPrec CreateDataView
$creadPrec :: ReadPrec CreateDataView
readList :: ReadS [CreateDataView]
$creadList :: ReadS [CreateDataView]
readsPrec :: Int -> ReadS CreateDataView
$creadsPrec :: Int -> ReadS CreateDataView
Prelude.Read, Int -> CreateDataView -> ShowS
[CreateDataView] -> ShowS
CreateDataView -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataView] -> ShowS
$cshowList :: [CreateDataView] -> ShowS
show :: CreateDataView -> String
$cshow :: CreateDataView -> String
showsPrec :: Int -> CreateDataView -> ShowS
$cshowsPrec :: Int -> CreateDataView -> ShowS
Prelude.Show, forall x. Rep CreateDataView x -> CreateDataView
forall x. CreateDataView -> Rep CreateDataView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDataView x -> CreateDataView
$cfrom :: forall x. CreateDataView -> Rep CreateDataView x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataView' 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:
--
-- 'asOfTimestamp', 'createDataView_asOfTimestamp' - Beginning time to use for the Dataview. The value is determined as epoch
-- time in milliseconds. For example, the value for Monday, November 1,
-- 2021 12:00:00 PM UTC is specified as 1635768000000.
--
-- 'autoUpdate', 'createDataView_autoUpdate' - Flag to indicate Dataview should be updated automatically.
--
-- 'clientToken', 'createDataView_clientToken' - A token that ensures idempotency. This token expires in 10 minutes.
--
-- 'partitionColumns', 'createDataView_partitionColumns' - Ordered set of column names used to partition data.
--
-- 'sortColumns', 'createDataView_sortColumns' - Columns to be used for sorting the data.
--
-- 'datasetId', 'createDataView_datasetId' - The unique Dataset identifier that is used to create a Dataview.
--
-- 'destinationTypeParams', 'createDataView_destinationTypeParams' - Options that define the destination type for the Dataview.
newCreateDataView ::
  -- | 'datasetId'
  Prelude.Text ->
  -- | 'destinationTypeParams'
  DataViewDestinationTypeParams ->
  CreateDataView
newCreateDataView :: Text -> DataViewDestinationTypeParams -> CreateDataView
newCreateDataView Text
pDatasetId_ DataViewDestinationTypeParams
pDestinationTypeParams_ =
  CreateDataView'
    { $sel:asOfTimestamp:CreateDataView' :: Maybe Integer
asOfTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:autoUpdate:CreateDataView' :: Maybe Bool
autoUpdate = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:CreateDataView' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:partitionColumns:CreateDataView' :: Maybe [Text]
partitionColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:sortColumns:CreateDataView' :: Maybe [Text]
sortColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:datasetId:CreateDataView' :: Text
datasetId = Text
pDatasetId_,
      $sel:destinationTypeParams:CreateDataView' :: DataViewDestinationTypeParams
destinationTypeParams = DataViewDestinationTypeParams
pDestinationTypeParams_
    }

-- | Beginning time to use for the Dataview. The value is determined as epoch
-- time in milliseconds. For example, the value for Monday, November 1,
-- 2021 12:00:00 PM UTC is specified as 1635768000000.
createDataView_asOfTimestamp :: Lens.Lens' CreateDataView (Prelude.Maybe Prelude.Integer)
createDataView_asOfTimestamp :: Lens' CreateDataView (Maybe Integer)
createDataView_asOfTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Maybe Integer
asOfTimestamp :: Maybe Integer
$sel:asOfTimestamp:CreateDataView' :: CreateDataView -> Maybe Integer
asOfTimestamp} -> Maybe Integer
asOfTimestamp) (\s :: CreateDataView
s@CreateDataView' {} Maybe Integer
a -> CreateDataView
s {$sel:asOfTimestamp:CreateDataView' :: Maybe Integer
asOfTimestamp = Maybe Integer
a} :: CreateDataView)

-- | Flag to indicate Dataview should be updated automatically.
createDataView_autoUpdate :: Lens.Lens' CreateDataView (Prelude.Maybe Prelude.Bool)
createDataView_autoUpdate :: Lens' CreateDataView (Maybe Bool)
createDataView_autoUpdate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Maybe Bool
autoUpdate :: Maybe Bool
$sel:autoUpdate:CreateDataView' :: CreateDataView -> Maybe Bool
autoUpdate} -> Maybe Bool
autoUpdate) (\s :: CreateDataView
s@CreateDataView' {} Maybe Bool
a -> CreateDataView
s {$sel:autoUpdate:CreateDataView' :: Maybe Bool
autoUpdate = Maybe Bool
a} :: CreateDataView)

-- | A token that ensures idempotency. This token expires in 10 minutes.
createDataView_clientToken :: Lens.Lens' CreateDataView (Prelude.Maybe Prelude.Text)
createDataView_clientToken :: Lens' CreateDataView (Maybe Text)
createDataView_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateDataView' :: CreateDataView -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateDataView
s@CreateDataView' {} Maybe Text
a -> CreateDataView
s {$sel:clientToken:CreateDataView' :: Maybe Text
clientToken = Maybe Text
a} :: CreateDataView)

-- | Ordered set of column names used to partition data.
createDataView_partitionColumns :: Lens.Lens' CreateDataView (Prelude.Maybe [Prelude.Text])
createDataView_partitionColumns :: Lens' CreateDataView (Maybe [Text])
createDataView_partitionColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Maybe [Text]
partitionColumns :: Maybe [Text]
$sel:partitionColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
partitionColumns} -> Maybe [Text]
partitionColumns) (\s :: CreateDataView
s@CreateDataView' {} Maybe [Text]
a -> CreateDataView
s {$sel:partitionColumns:CreateDataView' :: Maybe [Text]
partitionColumns = Maybe [Text]
a} :: CreateDataView) 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

-- | Columns to be used for sorting the data.
createDataView_sortColumns :: Lens.Lens' CreateDataView (Prelude.Maybe [Prelude.Text])
createDataView_sortColumns :: Lens' CreateDataView (Maybe [Text])
createDataView_sortColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Maybe [Text]
sortColumns :: Maybe [Text]
$sel:sortColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
sortColumns} -> Maybe [Text]
sortColumns) (\s :: CreateDataView
s@CreateDataView' {} Maybe [Text]
a -> CreateDataView
s {$sel:sortColumns:CreateDataView' :: Maybe [Text]
sortColumns = Maybe [Text]
a} :: CreateDataView) 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 unique Dataset identifier that is used to create a Dataview.
createDataView_datasetId :: Lens.Lens' CreateDataView Prelude.Text
createDataView_datasetId :: Lens' CreateDataView Text
createDataView_datasetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {Text
datasetId :: Text
$sel:datasetId:CreateDataView' :: CreateDataView -> Text
datasetId} -> Text
datasetId) (\s :: CreateDataView
s@CreateDataView' {} Text
a -> CreateDataView
s {$sel:datasetId:CreateDataView' :: Text
datasetId = Text
a} :: CreateDataView)

-- | Options that define the destination type for the Dataview.
createDataView_destinationTypeParams :: Lens.Lens' CreateDataView DataViewDestinationTypeParams
createDataView_destinationTypeParams :: Lens' CreateDataView DataViewDestinationTypeParams
createDataView_destinationTypeParams = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataView' {DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
$sel:destinationTypeParams:CreateDataView' :: CreateDataView -> DataViewDestinationTypeParams
destinationTypeParams} -> DataViewDestinationTypeParams
destinationTypeParams) (\s :: CreateDataView
s@CreateDataView' {} DataViewDestinationTypeParams
a -> CreateDataView
s {$sel:destinationTypeParams:CreateDataView' :: DataViewDestinationTypeParams
destinationTypeParams = DataViewDestinationTypeParams
a} :: CreateDataView)

instance Core.AWSRequest CreateDataView where
  type
    AWSResponse CreateDataView =
      CreateDataViewResponse
  request :: (Service -> Service) -> CreateDataView -> Request CreateDataView
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 CreateDataView
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateDataView)))
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 -> CreateDataViewResponse
CreateDataViewResponse'
            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
"dataViewId")
            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
"datasetId")
            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 CreateDataView where
  hashWithSalt :: Int -> CreateDataView -> Int
hashWithSalt Int
_salt CreateDataView' {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Text
DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
datasetId :: Text
sortColumns :: Maybe [Text]
partitionColumns :: Maybe [Text]
clientToken :: Maybe Text
autoUpdate :: Maybe Bool
asOfTimestamp :: Maybe Integer
$sel:destinationTypeParams:CreateDataView' :: CreateDataView -> DataViewDestinationTypeParams
$sel:datasetId:CreateDataView' :: CreateDataView -> Text
$sel:sortColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:partitionColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:clientToken:CreateDataView' :: CreateDataView -> Maybe Text
$sel:autoUpdate:CreateDataView' :: CreateDataView -> Maybe Bool
$sel:asOfTimestamp:CreateDataView' :: CreateDataView -> Maybe Integer
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
asOfTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoUpdate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
partitionColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
sortColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
datasetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DataViewDestinationTypeParams
destinationTypeParams

instance Prelude.NFData CreateDataView where
  rnf :: CreateDataView -> ()
rnf CreateDataView' {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Text
DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
datasetId :: Text
sortColumns :: Maybe [Text]
partitionColumns :: Maybe [Text]
clientToken :: Maybe Text
autoUpdate :: Maybe Bool
asOfTimestamp :: Maybe Integer
$sel:destinationTypeParams:CreateDataView' :: CreateDataView -> DataViewDestinationTypeParams
$sel:datasetId:CreateDataView' :: CreateDataView -> Text
$sel:sortColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:partitionColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:clientToken:CreateDataView' :: CreateDataView -> Maybe Text
$sel:autoUpdate:CreateDataView' :: CreateDataView -> Maybe Bool
$sel:asOfTimestamp:CreateDataView' :: CreateDataView -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
asOfTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoUpdate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
partitionColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
sortColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
datasetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DataViewDestinationTypeParams
destinationTypeParams

instance Data.ToHeaders CreateDataView where
  toHeaders :: CreateDataView -> 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 CreateDataView where
  toJSON :: CreateDataView -> Value
toJSON CreateDataView' {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Text
DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
datasetId :: Text
sortColumns :: Maybe [Text]
partitionColumns :: Maybe [Text]
clientToken :: Maybe Text
autoUpdate :: Maybe Bool
asOfTimestamp :: Maybe Integer
$sel:destinationTypeParams:CreateDataView' :: CreateDataView -> DataViewDestinationTypeParams
$sel:datasetId:CreateDataView' :: CreateDataView -> Text
$sel:sortColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:partitionColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:clientToken:CreateDataView' :: CreateDataView -> Maybe Text
$sel:autoUpdate:CreateDataView' :: CreateDataView -> Maybe Bool
$sel:asOfTimestamp:CreateDataView' :: CreateDataView -> Maybe Integer
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"asOfTimestamp" 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 Integer
asOfTimestamp,
            (Key
"autoUpdate" 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 Bool
autoUpdate,
            (Key
"clientToken" 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
clientToken,
            (Key
"partitionColumns" 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]
partitionColumns,
            (Key
"sortColumns" 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]
sortColumns,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"destinationTypeParams"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DataViewDestinationTypeParams
destinationTypeParams
              )
          ]
      )

instance Data.ToPath CreateDataView where
  toPath :: CreateDataView -> ByteString
toPath CreateDataView' {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Text
DataViewDestinationTypeParams
destinationTypeParams :: DataViewDestinationTypeParams
datasetId :: Text
sortColumns :: Maybe [Text]
partitionColumns :: Maybe [Text]
clientToken :: Maybe Text
autoUpdate :: Maybe Bool
asOfTimestamp :: Maybe Integer
$sel:destinationTypeParams:CreateDataView' :: CreateDataView -> DataViewDestinationTypeParams
$sel:datasetId:CreateDataView' :: CreateDataView -> Text
$sel:sortColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:partitionColumns:CreateDataView' :: CreateDataView -> Maybe [Text]
$sel:clientToken:CreateDataView' :: CreateDataView -> Maybe Text
$sel:autoUpdate:CreateDataView' :: CreateDataView -> Maybe Bool
$sel:asOfTimestamp:CreateDataView' :: CreateDataView -> Maybe Integer
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/datasets/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
datasetId, ByteString
"/dataviewsv2"]

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

-- | Response for creating a data view.
--
-- /See:/ 'newCreateDataViewResponse' smart constructor.
data CreateDataViewResponse = CreateDataViewResponse'
  { -- | The unique identifier for the created Dataview.
    CreateDataViewResponse -> Maybe Text
dataViewId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the Dataset used for the Dataview.
    CreateDataViewResponse -> Maybe Text
datasetId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateDataViewResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateDataViewResponse -> CreateDataViewResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateDataViewResponse -> CreateDataViewResponse -> Bool
$c/= :: CreateDataViewResponse -> CreateDataViewResponse -> Bool
== :: CreateDataViewResponse -> CreateDataViewResponse -> Bool
$c== :: CreateDataViewResponse -> CreateDataViewResponse -> Bool
Prelude.Eq, ReadPrec [CreateDataViewResponse]
ReadPrec CreateDataViewResponse
Int -> ReadS CreateDataViewResponse
ReadS [CreateDataViewResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateDataViewResponse]
$creadListPrec :: ReadPrec [CreateDataViewResponse]
readPrec :: ReadPrec CreateDataViewResponse
$creadPrec :: ReadPrec CreateDataViewResponse
readList :: ReadS [CreateDataViewResponse]
$creadList :: ReadS [CreateDataViewResponse]
readsPrec :: Int -> ReadS CreateDataViewResponse
$creadsPrec :: Int -> ReadS CreateDataViewResponse
Prelude.Read, Int -> CreateDataViewResponse -> ShowS
[CreateDataViewResponse] -> ShowS
CreateDataViewResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateDataViewResponse] -> ShowS
$cshowList :: [CreateDataViewResponse] -> ShowS
show :: CreateDataViewResponse -> String
$cshow :: CreateDataViewResponse -> String
showsPrec :: Int -> CreateDataViewResponse -> ShowS
$cshowsPrec :: Int -> CreateDataViewResponse -> ShowS
Prelude.Show, forall x. Rep CreateDataViewResponse x -> CreateDataViewResponse
forall x. CreateDataViewResponse -> Rep CreateDataViewResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateDataViewResponse x -> CreateDataViewResponse
$cfrom :: forall x. CreateDataViewResponse -> Rep CreateDataViewResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateDataViewResponse' 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:
--
-- 'dataViewId', 'createDataViewResponse_dataViewId' - The unique identifier for the created Dataview.
--
-- 'datasetId', 'createDataViewResponse_datasetId' - The unique identifier of the Dataset used for the Dataview.
--
-- 'httpStatus', 'createDataViewResponse_httpStatus' - The response's http status code.
newCreateDataViewResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateDataViewResponse
newCreateDataViewResponse :: Int -> CreateDataViewResponse
newCreateDataViewResponse Int
pHttpStatus_ =
  CreateDataViewResponse'
    { $sel:dataViewId:CreateDataViewResponse' :: Maybe Text
dataViewId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:datasetId:CreateDataViewResponse' :: Maybe Text
datasetId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateDataViewResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for the created Dataview.
createDataViewResponse_dataViewId :: Lens.Lens' CreateDataViewResponse (Prelude.Maybe Prelude.Text)
createDataViewResponse_dataViewId :: Lens' CreateDataViewResponse (Maybe Text)
createDataViewResponse_dataViewId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataViewResponse' {Maybe Text
dataViewId :: Maybe Text
$sel:dataViewId:CreateDataViewResponse' :: CreateDataViewResponse -> Maybe Text
dataViewId} -> Maybe Text
dataViewId) (\s :: CreateDataViewResponse
s@CreateDataViewResponse' {} Maybe Text
a -> CreateDataViewResponse
s {$sel:dataViewId:CreateDataViewResponse' :: Maybe Text
dataViewId = Maybe Text
a} :: CreateDataViewResponse)

-- | The unique identifier of the Dataset used for the Dataview.
createDataViewResponse_datasetId :: Lens.Lens' CreateDataViewResponse (Prelude.Maybe Prelude.Text)
createDataViewResponse_datasetId :: Lens' CreateDataViewResponse (Maybe Text)
createDataViewResponse_datasetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateDataViewResponse' {Maybe Text
datasetId :: Maybe Text
$sel:datasetId:CreateDataViewResponse' :: CreateDataViewResponse -> Maybe Text
datasetId} -> Maybe Text
datasetId) (\s :: CreateDataViewResponse
s@CreateDataViewResponse' {} Maybe Text
a -> CreateDataViewResponse
s {$sel:datasetId:CreateDataViewResponse' :: Maybe Text
datasetId = Maybe Text
a} :: CreateDataViewResponse)

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

instance Prelude.NFData CreateDataViewResponse where
  rnf :: CreateDataViewResponse -> ()
rnf CreateDataViewResponse' {Int
Maybe Text
httpStatus :: Int
datasetId :: Maybe Text
dataViewId :: Maybe Text
$sel:httpStatus:CreateDataViewResponse' :: CreateDataViewResponse -> Int
$sel:datasetId:CreateDataViewResponse' :: CreateDataViewResponse -> Maybe Text
$sel:dataViewId:CreateDataViewResponse' :: CreateDataViewResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dataViewId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
datasetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus