{-# 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.TimeStreamQuery.PrepareQuery
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A synchronous operation that allows you to submit a query with
-- parameters to be stored by Timestream for later running. Timestream only
-- supports using this operation with the
-- @PrepareQueryRequest$ValidateOnly@ set to @true@.
module Amazonka.TimeStreamQuery.PrepareQuery
  ( -- * Creating a Request
    PrepareQuery (..),
    newPrepareQuery,

    -- * Request Lenses
    prepareQuery_validateOnly,
    prepareQuery_queryString,

    -- * Destructuring the Response
    PrepareQueryResponse (..),
    newPrepareQueryResponse,

    -- * Response Lenses
    prepareQueryResponse_httpStatus,
    prepareQueryResponse_queryString,
    prepareQueryResponse_columns,
    prepareQueryResponse_parameters,
  )
where

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

-- | /See:/ 'newPrepareQuery' smart constructor.
data PrepareQuery = PrepareQuery'
  { -- | By setting this value to @true@, Timestream will only validate that the
    -- query string is a valid Timestream query, and not store the prepared
    -- query for later use.
    PrepareQuery -> Maybe Bool
validateOnly :: Prelude.Maybe Prelude.Bool,
    -- | The Timestream query string that you want to use as a prepared
    -- statement. Parameter names can be specified in the query string @\@@
    -- character followed by an identifier.
    PrepareQuery -> Sensitive Text
queryString :: Data.Sensitive Prelude.Text
  }
  deriving (PrepareQuery -> PrepareQuery -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrepareQuery -> PrepareQuery -> Bool
$c/= :: PrepareQuery -> PrepareQuery -> Bool
== :: PrepareQuery -> PrepareQuery -> Bool
$c== :: PrepareQuery -> PrepareQuery -> Bool
Prelude.Eq, Int -> PrepareQuery -> ShowS
[PrepareQuery] -> ShowS
PrepareQuery -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrepareQuery] -> ShowS
$cshowList :: [PrepareQuery] -> ShowS
show :: PrepareQuery -> String
$cshow :: PrepareQuery -> String
showsPrec :: Int -> PrepareQuery -> ShowS
$cshowsPrec :: Int -> PrepareQuery -> ShowS
Prelude.Show, forall x. Rep PrepareQuery x -> PrepareQuery
forall x. PrepareQuery -> Rep PrepareQuery x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrepareQuery x -> PrepareQuery
$cfrom :: forall x. PrepareQuery -> Rep PrepareQuery x
Prelude.Generic)

-- |
-- Create a value of 'PrepareQuery' 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:
--
-- 'validateOnly', 'prepareQuery_validateOnly' - By setting this value to @true@, Timestream will only validate that the
-- query string is a valid Timestream query, and not store the prepared
-- query for later use.
--
-- 'queryString', 'prepareQuery_queryString' - The Timestream query string that you want to use as a prepared
-- statement. Parameter names can be specified in the query string @\@@
-- character followed by an identifier.
newPrepareQuery ::
  -- | 'queryString'
  Prelude.Text ->
  PrepareQuery
newPrepareQuery :: Text -> PrepareQuery
newPrepareQuery Text
pQueryString_ =
  PrepareQuery'
    { $sel:validateOnly:PrepareQuery' :: Maybe Bool
validateOnly = forall a. Maybe a
Prelude.Nothing,
      $sel:queryString:PrepareQuery' :: Sensitive Text
queryString = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pQueryString_
    }

-- | By setting this value to @true@, Timestream will only validate that the
-- query string is a valid Timestream query, and not store the prepared
-- query for later use.
prepareQuery_validateOnly :: Lens.Lens' PrepareQuery (Prelude.Maybe Prelude.Bool)
prepareQuery_validateOnly :: Lens' PrepareQuery (Maybe Bool)
prepareQuery_validateOnly = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrepareQuery' {Maybe Bool
validateOnly :: Maybe Bool
$sel:validateOnly:PrepareQuery' :: PrepareQuery -> Maybe Bool
validateOnly} -> Maybe Bool
validateOnly) (\s :: PrepareQuery
s@PrepareQuery' {} Maybe Bool
a -> PrepareQuery
s {$sel:validateOnly:PrepareQuery' :: Maybe Bool
validateOnly = Maybe Bool
a} :: PrepareQuery)

-- | The Timestream query string that you want to use as a prepared
-- statement. Parameter names can be specified in the query string @\@@
-- character followed by an identifier.
prepareQuery_queryString :: Lens.Lens' PrepareQuery Prelude.Text
prepareQuery_queryString :: Lens' PrepareQuery Text
prepareQuery_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrepareQuery' {Sensitive Text
queryString :: Sensitive Text
$sel:queryString:PrepareQuery' :: PrepareQuery -> Sensitive Text
queryString} -> Sensitive Text
queryString) (\s :: PrepareQuery
s@PrepareQuery' {} Sensitive Text
a -> PrepareQuery
s {$sel:queryString:PrepareQuery' :: Sensitive Text
queryString = Sensitive Text
a} :: PrepareQuery) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest PrepareQuery where
  type AWSResponse PrepareQuery = PrepareQueryResponse
  request :: (Service -> Service) -> PrepareQuery -> Request PrepareQuery
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 PrepareQuery
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PrepareQuery)))
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 ->
          Int
-> Sensitive Text
-> [SelectColumn]
-> [ParameterMapping]
-> PrepareQueryResponse
PrepareQueryResponse'
            forall (f :: * -> *) a b. Functor 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
"QueryString")
            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
"Columns" 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
"Parameters" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable PrepareQuery where
  hashWithSalt :: Int -> PrepareQuery -> Int
hashWithSalt Int
_salt PrepareQuery' {Maybe Bool
Sensitive Text
queryString :: Sensitive Text
validateOnly :: Maybe Bool
$sel:queryString:PrepareQuery' :: PrepareQuery -> Sensitive Text
$sel:validateOnly:PrepareQuery' :: PrepareQuery -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
validateOnly
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
queryString

instance Prelude.NFData PrepareQuery where
  rnf :: PrepareQuery -> ()
rnf PrepareQuery' {Maybe Bool
Sensitive Text
queryString :: Sensitive Text
validateOnly :: Maybe Bool
$sel:queryString:PrepareQuery' :: PrepareQuery -> Sensitive Text
$sel:validateOnly:PrepareQuery' :: PrepareQuery -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
validateOnly
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
queryString

instance Data.ToHeaders PrepareQuery where
  toHeaders :: PrepareQuery -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"Timestream_20181101.PrepareQuery" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PrepareQuery where
  toJSON :: PrepareQuery -> Value
toJSON PrepareQuery' {Maybe Bool
Sensitive Text
queryString :: Sensitive Text
validateOnly :: Maybe Bool
$sel:queryString:PrepareQuery' :: PrepareQuery -> Sensitive Text
$sel:validateOnly:PrepareQuery' :: PrepareQuery -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ValidateOnly" 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
validateOnly,
            forall a. a -> Maybe a
Prelude.Just (Key
"QueryString" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
queryString)
          ]
      )

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

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

-- | /See:/ 'newPrepareQueryResponse' smart constructor.
data PrepareQueryResponse = PrepareQueryResponse'
  { -- | The response's http status code.
    PrepareQueryResponse -> Int
httpStatus :: Prelude.Int,
    -- | The query string that you want prepare.
    PrepareQueryResponse -> Sensitive Text
queryString :: Data.Sensitive Prelude.Text,
    -- | A list of SELECT clause columns of the submitted query string.
    PrepareQueryResponse -> [SelectColumn]
columns :: [SelectColumn],
    -- | A list of parameters used in the submitted query string.
    PrepareQueryResponse -> [ParameterMapping]
parameters :: [ParameterMapping]
  }
  deriving (PrepareQueryResponse -> PrepareQueryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrepareQueryResponse -> PrepareQueryResponse -> Bool
$c/= :: PrepareQueryResponse -> PrepareQueryResponse -> Bool
== :: PrepareQueryResponse -> PrepareQueryResponse -> Bool
$c== :: PrepareQueryResponse -> PrepareQueryResponse -> Bool
Prelude.Eq, Int -> PrepareQueryResponse -> ShowS
[PrepareQueryResponse] -> ShowS
PrepareQueryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrepareQueryResponse] -> ShowS
$cshowList :: [PrepareQueryResponse] -> ShowS
show :: PrepareQueryResponse -> String
$cshow :: PrepareQueryResponse -> String
showsPrec :: Int -> PrepareQueryResponse -> ShowS
$cshowsPrec :: Int -> PrepareQueryResponse -> ShowS
Prelude.Show, forall x. Rep PrepareQueryResponse x -> PrepareQueryResponse
forall x. PrepareQueryResponse -> Rep PrepareQueryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrepareQueryResponse x -> PrepareQueryResponse
$cfrom :: forall x. PrepareQueryResponse -> Rep PrepareQueryResponse x
Prelude.Generic)

-- |
-- Create a value of 'PrepareQueryResponse' 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:
--
-- 'httpStatus', 'prepareQueryResponse_httpStatus' - The response's http status code.
--
-- 'queryString', 'prepareQueryResponse_queryString' - The query string that you want prepare.
--
-- 'columns', 'prepareQueryResponse_columns' - A list of SELECT clause columns of the submitted query string.
--
-- 'parameters', 'prepareQueryResponse_parameters' - A list of parameters used in the submitted query string.
newPrepareQueryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'queryString'
  Prelude.Text ->
  PrepareQueryResponse
newPrepareQueryResponse :: Int -> Text -> PrepareQueryResponse
newPrepareQueryResponse Int
pHttpStatus_ Text
pQueryString_ =
  PrepareQueryResponse'
    { $sel:httpStatus:PrepareQueryResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:queryString:PrepareQueryResponse' :: Sensitive Text
queryString = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pQueryString_,
      $sel:columns:PrepareQueryResponse' :: [SelectColumn]
columns = forall a. Monoid a => a
Prelude.mempty,
      $sel:parameters:PrepareQueryResponse' :: [ParameterMapping]
parameters = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | The query string that you want prepare.
prepareQueryResponse_queryString :: Lens.Lens' PrepareQueryResponse Prelude.Text
prepareQueryResponse_queryString :: Lens' PrepareQueryResponse Text
prepareQueryResponse_queryString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrepareQueryResponse' {Sensitive Text
queryString :: Sensitive Text
$sel:queryString:PrepareQueryResponse' :: PrepareQueryResponse -> Sensitive Text
queryString} -> Sensitive Text
queryString) (\s :: PrepareQueryResponse
s@PrepareQueryResponse' {} Sensitive Text
a -> PrepareQueryResponse
s {$sel:queryString:PrepareQueryResponse' :: Sensitive Text
queryString = Sensitive Text
a} :: PrepareQueryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | A list of SELECT clause columns of the submitted query string.
prepareQueryResponse_columns :: Lens.Lens' PrepareQueryResponse [SelectColumn]
prepareQueryResponse_columns :: Lens' PrepareQueryResponse [SelectColumn]
prepareQueryResponse_columns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrepareQueryResponse' {[SelectColumn]
columns :: [SelectColumn]
$sel:columns:PrepareQueryResponse' :: PrepareQueryResponse -> [SelectColumn]
columns} -> [SelectColumn]
columns) (\s :: PrepareQueryResponse
s@PrepareQueryResponse' {} [SelectColumn]
a -> PrepareQueryResponse
s {$sel:columns:PrepareQueryResponse' :: [SelectColumn]
columns = [SelectColumn]
a} :: PrepareQueryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A list of parameters used in the submitted query string.
prepareQueryResponse_parameters :: Lens.Lens' PrepareQueryResponse [ParameterMapping]
prepareQueryResponse_parameters :: Lens' PrepareQueryResponse [ParameterMapping]
prepareQueryResponse_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PrepareQueryResponse' {[ParameterMapping]
parameters :: [ParameterMapping]
$sel:parameters:PrepareQueryResponse' :: PrepareQueryResponse -> [ParameterMapping]
parameters} -> [ParameterMapping]
parameters) (\s :: PrepareQueryResponse
s@PrepareQueryResponse' {} [ParameterMapping]
a -> PrepareQueryResponse
s {$sel:parameters:PrepareQueryResponse' :: [ParameterMapping]
parameters = [ParameterMapping]
a} :: PrepareQueryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData PrepareQueryResponse where
  rnf :: PrepareQueryResponse -> ()
rnf PrepareQueryResponse' {Int
[SelectColumn]
[ParameterMapping]
Sensitive Text
parameters :: [ParameterMapping]
columns :: [SelectColumn]
queryString :: Sensitive Text
httpStatus :: Int
$sel:parameters:PrepareQueryResponse' :: PrepareQueryResponse -> [ParameterMapping]
$sel:columns:PrepareQueryResponse' :: PrepareQueryResponse -> [SelectColumn]
$sel:queryString:PrepareQueryResponse' :: PrepareQueryResponse -> Sensitive Text
$sel:httpStatus:PrepareQueryResponse' :: PrepareQueryResponse -> Int
..} =
    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 Sensitive Text
queryString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [SelectColumn]
columns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ParameterMapping]
parameters