{-# 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.HoneyCode.InvokeScreenAutomation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- The InvokeScreenAutomation API allows invoking an action defined in a
-- screen in a Honeycode app. The API allows setting local variables, which
-- can then be used in the automation being invoked. This allows automating
-- the Honeycode app interactions to write, update or delete data in the
-- workbook.
module Amazonka.HoneyCode.InvokeScreenAutomation
  ( -- * Creating a Request
    InvokeScreenAutomation (..),
    newInvokeScreenAutomation,

    -- * Request Lenses
    invokeScreenAutomation_clientRequestToken,
    invokeScreenAutomation_rowId,
    invokeScreenAutomation_variables,
    invokeScreenAutomation_workbookId,
    invokeScreenAutomation_appId,
    invokeScreenAutomation_screenId,
    invokeScreenAutomation_screenAutomationId,

    -- * Destructuring the Response
    InvokeScreenAutomationResponse (..),
    newInvokeScreenAutomationResponse,

    -- * Response Lenses
    invokeScreenAutomationResponse_httpStatus,
    invokeScreenAutomationResponse_workbookCursor,
  )
where

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

-- | /See:/ 'newInvokeScreenAutomation' smart constructor.
data InvokeScreenAutomation = InvokeScreenAutomation'
  { -- | The request token for performing the automation action. Request tokens
    -- help to identify duplicate requests. If a call times out or fails due to
    -- a transient error like a failed network connection, you can retry the
    -- call with the same request token. The service ensures that if the first
    -- call using that request token is successfully performed, the second call
    -- will return the response of the previous call rather than performing the
    -- action again.
    --
    -- Note that request tokens are valid only for a few minutes. You cannot
    -- use request tokens to dedupe requests spanning hours or days.
    InvokeScreenAutomation -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The row ID for the automation if the automation is defined inside a
    -- block with source or list.
    InvokeScreenAutomation -> Maybe Text
rowId :: Prelude.Maybe Prelude.Text,
    -- | Variables are specified as a map where the key is the name of the
    -- variable as defined on the screen. The value is an object which
    -- currently has only one property, rawValue, which holds the value of the
    -- variable to be passed to the screen. Any variables defined in a screen
    -- are required to be passed in the call.
    InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text (Data.Sensitive VariableValue))),
    -- | The ID of the workbook that contains the screen automation.
    InvokeScreenAutomation -> Text
workbookId :: Prelude.Text,
    -- | The ID of the app that contains the screen automation.
    InvokeScreenAutomation -> Text
appId :: Prelude.Text,
    -- | The ID of the screen that contains the screen automation.
    InvokeScreenAutomation -> Text
screenId :: Prelude.Text,
    -- | The ID of the automation action to be performed.
    InvokeScreenAutomation -> Text
screenAutomationId :: Prelude.Text
  }
  deriving (InvokeScreenAutomation -> InvokeScreenAutomation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvokeScreenAutomation -> InvokeScreenAutomation -> Bool
$c/= :: InvokeScreenAutomation -> InvokeScreenAutomation -> Bool
== :: InvokeScreenAutomation -> InvokeScreenAutomation -> Bool
$c== :: InvokeScreenAutomation -> InvokeScreenAutomation -> Bool
Prelude.Eq, Int -> InvokeScreenAutomation -> ShowS
[InvokeScreenAutomation] -> ShowS
InvokeScreenAutomation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvokeScreenAutomation] -> ShowS
$cshowList :: [InvokeScreenAutomation] -> ShowS
show :: InvokeScreenAutomation -> String
$cshow :: InvokeScreenAutomation -> String
showsPrec :: Int -> InvokeScreenAutomation -> ShowS
$cshowsPrec :: Int -> InvokeScreenAutomation -> ShowS
Prelude.Show, forall x. Rep InvokeScreenAutomation x -> InvokeScreenAutomation
forall x. InvokeScreenAutomation -> Rep InvokeScreenAutomation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvokeScreenAutomation x -> InvokeScreenAutomation
$cfrom :: forall x. InvokeScreenAutomation -> Rep InvokeScreenAutomation x
Prelude.Generic)

-- |
-- Create a value of 'InvokeScreenAutomation' 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:
--
-- 'clientRequestToken', 'invokeScreenAutomation_clientRequestToken' - The request token for performing the automation action. Request tokens
-- help to identify duplicate requests. If a call times out or fails due to
-- a transient error like a failed network connection, you can retry the
-- call with the same request token. The service ensures that if the first
-- call using that request token is successfully performed, the second call
-- will return the response of the previous call rather than performing the
-- action again.
--
-- Note that request tokens are valid only for a few minutes. You cannot
-- use request tokens to dedupe requests spanning hours or days.
--
-- 'rowId', 'invokeScreenAutomation_rowId' - The row ID for the automation if the automation is defined inside a
-- block with source or list.
--
-- 'variables', 'invokeScreenAutomation_variables' - Variables are specified as a map where the key is the name of the
-- variable as defined on the screen. The value is an object which
-- currently has only one property, rawValue, which holds the value of the
-- variable to be passed to the screen. Any variables defined in a screen
-- are required to be passed in the call.
--
-- 'workbookId', 'invokeScreenAutomation_workbookId' - The ID of the workbook that contains the screen automation.
--
-- 'appId', 'invokeScreenAutomation_appId' - The ID of the app that contains the screen automation.
--
-- 'screenId', 'invokeScreenAutomation_screenId' - The ID of the screen that contains the screen automation.
--
-- 'screenAutomationId', 'invokeScreenAutomation_screenAutomationId' - The ID of the automation action to be performed.
newInvokeScreenAutomation ::
  -- | 'workbookId'
  Prelude.Text ->
  -- | 'appId'
  Prelude.Text ->
  -- | 'screenId'
  Prelude.Text ->
  -- | 'screenAutomationId'
  Prelude.Text ->
  InvokeScreenAutomation
newInvokeScreenAutomation :: Text -> Text -> Text -> Text -> InvokeScreenAutomation
newInvokeScreenAutomation
  Text
pWorkbookId_
  Text
pAppId_
  Text
pScreenId_
  Text
pScreenAutomationId_ =
    InvokeScreenAutomation'
      { $sel:clientRequestToken:InvokeScreenAutomation' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:rowId:InvokeScreenAutomation' :: Maybe Text
rowId = forall a. Maybe a
Prelude.Nothing,
        $sel:variables:InvokeScreenAutomation' :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables = forall a. Maybe a
Prelude.Nothing,
        $sel:workbookId:InvokeScreenAutomation' :: Text
workbookId = Text
pWorkbookId_,
        $sel:appId:InvokeScreenAutomation' :: Text
appId = Text
pAppId_,
        $sel:screenId:InvokeScreenAutomation' :: Text
screenId = Text
pScreenId_,
        $sel:screenAutomationId:InvokeScreenAutomation' :: Text
screenAutomationId = Text
pScreenAutomationId_
      }

-- | The request token for performing the automation action. Request tokens
-- help to identify duplicate requests. If a call times out or fails due to
-- a transient error like a failed network connection, you can retry the
-- call with the same request token. The service ensures that if the first
-- call using that request token is successfully performed, the second call
-- will return the response of the previous call rather than performing the
-- action again.
--
-- Note that request tokens are valid only for a few minutes. You cannot
-- use request tokens to dedupe requests spanning hours or days.
invokeScreenAutomation_clientRequestToken :: Lens.Lens' InvokeScreenAutomation (Prelude.Maybe Prelude.Text)
invokeScreenAutomation_clientRequestToken :: Lens' InvokeScreenAutomation (Maybe Text)
invokeScreenAutomation_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Maybe Text
a -> InvokeScreenAutomation
s {$sel:clientRequestToken:InvokeScreenAutomation' :: Maybe Text
clientRequestToken = Maybe Text
a} :: InvokeScreenAutomation)

-- | The row ID for the automation if the automation is defined inside a
-- block with source or list.
invokeScreenAutomation_rowId :: Lens.Lens' InvokeScreenAutomation (Prelude.Maybe Prelude.Text)
invokeScreenAutomation_rowId :: Lens' InvokeScreenAutomation (Maybe Text)
invokeScreenAutomation_rowId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Maybe Text
rowId :: Maybe Text
$sel:rowId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
rowId} -> Maybe Text
rowId) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Maybe Text
a -> InvokeScreenAutomation
s {$sel:rowId:InvokeScreenAutomation' :: Maybe Text
rowId = Maybe Text
a} :: InvokeScreenAutomation)

-- | Variables are specified as a map where the key is the name of the
-- variable as defined on the screen. The value is an object which
-- currently has only one property, rawValue, which holds the value of the
-- variable to be passed to the screen. Any variables defined in a screen
-- are required to be passed in the call.
invokeScreenAutomation_variables :: Lens.Lens' InvokeScreenAutomation (Prelude.Maybe (Prelude.HashMap Prelude.Text VariableValue))
invokeScreenAutomation_variables :: Lens' InvokeScreenAutomation (Maybe (HashMap Text VariableValue))
invokeScreenAutomation_variables = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
$sel:variables:InvokeScreenAutomation' :: InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables} -> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
a -> InvokeScreenAutomation
s {$sel:variables:InvokeScreenAutomation' :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables = Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
a} :: InvokeScreenAutomation) 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 a. Iso' (Sensitive a) a
Data._Sensitive 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)

-- | The ID of the workbook that contains the screen automation.
invokeScreenAutomation_workbookId :: Lens.Lens' InvokeScreenAutomation Prelude.Text
invokeScreenAutomation_workbookId :: Lens' InvokeScreenAutomation Text
invokeScreenAutomation_workbookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Text
workbookId :: Text
$sel:workbookId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
workbookId} -> Text
workbookId) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Text
a -> InvokeScreenAutomation
s {$sel:workbookId:InvokeScreenAutomation' :: Text
workbookId = Text
a} :: InvokeScreenAutomation)

-- | The ID of the app that contains the screen automation.
invokeScreenAutomation_appId :: Lens.Lens' InvokeScreenAutomation Prelude.Text
invokeScreenAutomation_appId :: Lens' InvokeScreenAutomation Text
invokeScreenAutomation_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Text
appId :: Text
$sel:appId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
appId} -> Text
appId) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Text
a -> InvokeScreenAutomation
s {$sel:appId:InvokeScreenAutomation' :: Text
appId = Text
a} :: InvokeScreenAutomation)

-- | The ID of the screen that contains the screen automation.
invokeScreenAutomation_screenId :: Lens.Lens' InvokeScreenAutomation Prelude.Text
invokeScreenAutomation_screenId :: Lens' InvokeScreenAutomation Text
invokeScreenAutomation_screenId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Text
screenId :: Text
$sel:screenId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
screenId} -> Text
screenId) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Text
a -> InvokeScreenAutomation
s {$sel:screenId:InvokeScreenAutomation' :: Text
screenId = Text
a} :: InvokeScreenAutomation)

-- | The ID of the automation action to be performed.
invokeScreenAutomation_screenAutomationId :: Lens.Lens' InvokeScreenAutomation Prelude.Text
invokeScreenAutomation_screenAutomationId :: Lens' InvokeScreenAutomation Text
invokeScreenAutomation_screenAutomationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomation' {Text
screenAutomationId :: Text
$sel:screenAutomationId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
screenAutomationId} -> Text
screenAutomationId) (\s :: InvokeScreenAutomation
s@InvokeScreenAutomation' {} Text
a -> InvokeScreenAutomation
s {$sel:screenAutomationId:InvokeScreenAutomation' :: Text
screenAutomationId = Text
a} :: InvokeScreenAutomation)

instance Core.AWSRequest InvokeScreenAutomation where
  type
    AWSResponse InvokeScreenAutomation =
      InvokeScreenAutomationResponse
  request :: (Service -> Service)
-> InvokeScreenAutomation -> Request InvokeScreenAutomation
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 InvokeScreenAutomation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse InvokeScreenAutomation)))
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 -> Integer -> InvokeScreenAutomationResponse
InvokeScreenAutomationResponse'
            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
"workbookCursor")
      )

instance Prelude.Hashable InvokeScreenAutomation where
  hashWithSalt :: Int -> InvokeScreenAutomation -> Int
hashWithSalt Int
_salt InvokeScreenAutomation' {Maybe Text
Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
Text
screenAutomationId :: Text
screenId :: Text
appId :: Text
workbookId :: Text
variables :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
rowId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:screenAutomationId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:screenId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:appId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:workbookId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:variables:InvokeScreenAutomation' :: InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
$sel:rowId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
$sel:clientRequestToken:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
rowId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workbookId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
appId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
screenId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
screenAutomationId

instance Prelude.NFData InvokeScreenAutomation where
  rnf :: InvokeScreenAutomation -> ()
rnf InvokeScreenAutomation' {Maybe Text
Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
Text
screenAutomationId :: Text
screenId :: Text
appId :: Text
workbookId :: Text
variables :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
rowId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:screenAutomationId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:screenId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:appId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:workbookId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:variables:InvokeScreenAutomation' :: InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
$sel:rowId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
$sel:clientRequestToken:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
rowId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
variables
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workbookId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
appId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
screenId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
screenAutomationId

instance Data.ToHeaders InvokeScreenAutomation where
  toHeaders :: InvokeScreenAutomation -> 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 InvokeScreenAutomation where
  toJSON :: InvokeScreenAutomation -> Value
toJSON InvokeScreenAutomation' {Maybe Text
Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
Text
screenAutomationId :: Text
screenId :: Text
appId :: Text
workbookId :: Text
variables :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
rowId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:screenAutomationId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:screenId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:appId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:workbookId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:variables:InvokeScreenAutomation' :: InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
$sel:rowId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
$sel:clientRequestToken:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientRequestToken" 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
clientRequestToken,
            (Key
"rowId" 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
rowId,
            (Key
"variables" 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 (Sensitive (HashMap Text (Sensitive VariableValue)))
variables
          ]
      )

instance Data.ToPath InvokeScreenAutomation where
  toPath :: InvokeScreenAutomation -> ByteString
toPath InvokeScreenAutomation' {Maybe Text
Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
Text
screenAutomationId :: Text
screenId :: Text
appId :: Text
workbookId :: Text
variables :: Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
rowId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:screenAutomationId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:screenId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:appId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:workbookId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Text
$sel:variables:InvokeScreenAutomation' :: InvokeScreenAutomation
-> Maybe (Sensitive (HashMap Text (Sensitive VariableValue)))
$sel:rowId:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
$sel:clientRequestToken:InvokeScreenAutomation' :: InvokeScreenAutomation -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workbooks/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workbookId,
        ByteString
"/apps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId,
        ByteString
"/screens/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
screenId,
        ByteString
"/automations/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
screenAutomationId
      ]

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

-- | /See:/ 'newInvokeScreenAutomationResponse' smart constructor.
data InvokeScreenAutomationResponse = InvokeScreenAutomationResponse'
  { -- | The response's http status code.
    InvokeScreenAutomationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The updated workbook cursor after performing the automation action.
    InvokeScreenAutomationResponse -> Integer
workbookCursor :: Prelude.Integer
  }
  deriving (InvokeScreenAutomationResponse
-> InvokeScreenAutomationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvokeScreenAutomationResponse
-> InvokeScreenAutomationResponse -> Bool
$c/= :: InvokeScreenAutomationResponse
-> InvokeScreenAutomationResponse -> Bool
== :: InvokeScreenAutomationResponse
-> InvokeScreenAutomationResponse -> Bool
$c== :: InvokeScreenAutomationResponse
-> InvokeScreenAutomationResponse -> Bool
Prelude.Eq, ReadPrec [InvokeScreenAutomationResponse]
ReadPrec InvokeScreenAutomationResponse
Int -> ReadS InvokeScreenAutomationResponse
ReadS [InvokeScreenAutomationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InvokeScreenAutomationResponse]
$creadListPrec :: ReadPrec [InvokeScreenAutomationResponse]
readPrec :: ReadPrec InvokeScreenAutomationResponse
$creadPrec :: ReadPrec InvokeScreenAutomationResponse
readList :: ReadS [InvokeScreenAutomationResponse]
$creadList :: ReadS [InvokeScreenAutomationResponse]
readsPrec :: Int -> ReadS InvokeScreenAutomationResponse
$creadsPrec :: Int -> ReadS InvokeScreenAutomationResponse
Prelude.Read, Int -> InvokeScreenAutomationResponse -> ShowS
[InvokeScreenAutomationResponse] -> ShowS
InvokeScreenAutomationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvokeScreenAutomationResponse] -> ShowS
$cshowList :: [InvokeScreenAutomationResponse] -> ShowS
show :: InvokeScreenAutomationResponse -> String
$cshow :: InvokeScreenAutomationResponse -> String
showsPrec :: Int -> InvokeScreenAutomationResponse -> ShowS
$cshowsPrec :: Int -> InvokeScreenAutomationResponse -> ShowS
Prelude.Show, forall x.
Rep InvokeScreenAutomationResponse x
-> InvokeScreenAutomationResponse
forall x.
InvokeScreenAutomationResponse
-> Rep InvokeScreenAutomationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep InvokeScreenAutomationResponse x
-> InvokeScreenAutomationResponse
$cfrom :: forall x.
InvokeScreenAutomationResponse
-> Rep InvokeScreenAutomationResponse x
Prelude.Generic)

-- |
-- Create a value of 'InvokeScreenAutomationResponse' 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', 'invokeScreenAutomationResponse_httpStatus' - The response's http status code.
--
-- 'workbookCursor', 'invokeScreenAutomationResponse_workbookCursor' - The updated workbook cursor after performing the automation action.
newInvokeScreenAutomationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'workbookCursor'
  Prelude.Integer ->
  InvokeScreenAutomationResponse
newInvokeScreenAutomationResponse :: Int -> Integer -> InvokeScreenAutomationResponse
newInvokeScreenAutomationResponse
  Int
pHttpStatus_
  Integer
pWorkbookCursor_ =
    InvokeScreenAutomationResponse'
      { $sel:httpStatus:InvokeScreenAutomationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:workbookCursor:InvokeScreenAutomationResponse' :: Integer
workbookCursor = Integer
pWorkbookCursor_
      }

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

-- | The updated workbook cursor after performing the automation action.
invokeScreenAutomationResponse_workbookCursor :: Lens.Lens' InvokeScreenAutomationResponse Prelude.Integer
invokeScreenAutomationResponse_workbookCursor :: Lens' InvokeScreenAutomationResponse Integer
invokeScreenAutomationResponse_workbookCursor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InvokeScreenAutomationResponse' {Integer
workbookCursor :: Integer
$sel:workbookCursor:InvokeScreenAutomationResponse' :: InvokeScreenAutomationResponse -> Integer
workbookCursor} -> Integer
workbookCursor) (\s :: InvokeScreenAutomationResponse
s@InvokeScreenAutomationResponse' {} Integer
a -> InvokeScreenAutomationResponse
s {$sel:workbookCursor:InvokeScreenAutomationResponse' :: Integer
workbookCursor = Integer
a} :: InvokeScreenAutomationResponse)

instance
  Prelude.NFData
    InvokeScreenAutomationResponse
  where
  rnf :: InvokeScreenAutomationResponse -> ()
rnf InvokeScreenAutomationResponse' {Int
Integer
workbookCursor :: Integer
httpStatus :: Int
$sel:workbookCursor:InvokeScreenAutomationResponse' :: InvokeScreenAutomationResponse -> Integer
$sel:httpStatus:InvokeScreenAutomationResponse' :: InvokeScreenAutomationResponse -> 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 Integer
workbookCursor