{-# 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.DataBrew.SendProjectSessionAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Performs a recipe step within an interactive DataBrew session that\'s
-- currently open.
module Amazonka.DataBrew.SendProjectSessionAction
  ( -- * Creating a Request
    SendProjectSessionAction (..),
    newSendProjectSessionAction,

    -- * Request Lenses
    sendProjectSessionAction_clientSessionId,
    sendProjectSessionAction_preview,
    sendProjectSessionAction_recipeStep,
    sendProjectSessionAction_stepIndex,
    sendProjectSessionAction_viewFrame,
    sendProjectSessionAction_name,

    -- * Destructuring the Response
    SendProjectSessionActionResponse (..),
    newSendProjectSessionActionResponse,

    -- * Response Lenses
    sendProjectSessionActionResponse_actionId,
    sendProjectSessionActionResponse_result,
    sendProjectSessionActionResponse_httpStatus,
    sendProjectSessionActionResponse_name,
  )
where

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

-- | /See:/ 'newSendProjectSessionAction' smart constructor.
data SendProjectSessionAction = SendProjectSessionAction'
  { -- | A unique identifier for an interactive session that\'s currently open
    -- and ready for work. The action will be performed on this session.
    SendProjectSessionAction -> Maybe (Sensitive Text)
clientSessionId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | If true, the result of the recipe step will be returned, but not
    -- applied.
    SendProjectSessionAction -> Maybe Bool
preview :: Prelude.Maybe Prelude.Bool,
    SendProjectSessionAction -> Maybe RecipeStep
recipeStep :: Prelude.Maybe RecipeStep,
    -- | The index from which to preview a step. This index is used to preview
    -- the result of steps that have already been applied, so that the
    -- resulting view frame is from earlier in the view frame stack.
    SendProjectSessionAction -> Maybe Natural
stepIndex :: Prelude.Maybe Prelude.Natural,
    SendProjectSessionAction -> Maybe ViewFrame
viewFrame :: Prelude.Maybe ViewFrame,
    -- | The name of the project to apply the action to.
    SendProjectSessionAction -> Text
name :: Prelude.Text
  }
  deriving (SendProjectSessionAction -> SendProjectSessionAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendProjectSessionAction -> SendProjectSessionAction -> Bool
$c/= :: SendProjectSessionAction -> SendProjectSessionAction -> Bool
== :: SendProjectSessionAction -> SendProjectSessionAction -> Bool
$c== :: SendProjectSessionAction -> SendProjectSessionAction -> Bool
Prelude.Eq, Int -> SendProjectSessionAction -> ShowS
[SendProjectSessionAction] -> ShowS
SendProjectSessionAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendProjectSessionAction] -> ShowS
$cshowList :: [SendProjectSessionAction] -> ShowS
show :: SendProjectSessionAction -> String
$cshow :: SendProjectSessionAction -> String
showsPrec :: Int -> SendProjectSessionAction -> ShowS
$cshowsPrec :: Int -> SendProjectSessionAction -> ShowS
Prelude.Show, forall x.
Rep SendProjectSessionAction x -> SendProjectSessionAction
forall x.
SendProjectSessionAction -> Rep SendProjectSessionAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendProjectSessionAction x -> SendProjectSessionAction
$cfrom :: forall x.
SendProjectSessionAction -> Rep SendProjectSessionAction x
Prelude.Generic)

-- |
-- Create a value of 'SendProjectSessionAction' 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:
--
-- 'clientSessionId', 'sendProjectSessionAction_clientSessionId' - A unique identifier for an interactive session that\'s currently open
-- and ready for work. The action will be performed on this session.
--
-- 'preview', 'sendProjectSessionAction_preview' - If true, the result of the recipe step will be returned, but not
-- applied.
--
-- 'recipeStep', 'sendProjectSessionAction_recipeStep' - Undocumented member.
--
-- 'stepIndex', 'sendProjectSessionAction_stepIndex' - The index from which to preview a step. This index is used to preview
-- the result of steps that have already been applied, so that the
-- resulting view frame is from earlier in the view frame stack.
--
-- 'viewFrame', 'sendProjectSessionAction_viewFrame' - Undocumented member.
--
-- 'name', 'sendProjectSessionAction_name' - The name of the project to apply the action to.
newSendProjectSessionAction ::
  -- | 'name'
  Prelude.Text ->
  SendProjectSessionAction
newSendProjectSessionAction :: Text -> SendProjectSessionAction
newSendProjectSessionAction Text
pName_ =
  SendProjectSessionAction'
    { $sel:clientSessionId:SendProjectSessionAction' :: Maybe (Sensitive Text)
clientSessionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:preview:SendProjectSessionAction' :: Maybe Bool
preview = forall a. Maybe a
Prelude.Nothing,
      $sel:recipeStep:SendProjectSessionAction' :: Maybe RecipeStep
recipeStep = forall a. Maybe a
Prelude.Nothing,
      $sel:stepIndex:SendProjectSessionAction' :: Maybe Natural
stepIndex = forall a. Maybe a
Prelude.Nothing,
      $sel:viewFrame:SendProjectSessionAction' :: Maybe ViewFrame
viewFrame = forall a. Maybe a
Prelude.Nothing,
      $sel:name:SendProjectSessionAction' :: Text
name = Text
pName_
    }

-- | A unique identifier for an interactive session that\'s currently open
-- and ready for work. The action will be performed on this session.
sendProjectSessionAction_clientSessionId :: Lens.Lens' SendProjectSessionAction (Prelude.Maybe Prelude.Text)
sendProjectSessionAction_clientSessionId :: Lens' SendProjectSessionAction (Maybe Text)
sendProjectSessionAction_clientSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Maybe (Sensitive Text)
clientSessionId :: Maybe (Sensitive Text)
$sel:clientSessionId:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe (Sensitive Text)
clientSessionId} -> Maybe (Sensitive Text)
clientSessionId) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Maybe (Sensitive Text)
a -> SendProjectSessionAction
s {$sel:clientSessionId:SendProjectSessionAction' :: Maybe (Sensitive Text)
clientSessionId = Maybe (Sensitive Text)
a} :: SendProjectSessionAction) 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

-- | If true, the result of the recipe step will be returned, but not
-- applied.
sendProjectSessionAction_preview :: Lens.Lens' SendProjectSessionAction (Prelude.Maybe Prelude.Bool)
sendProjectSessionAction_preview :: Lens' SendProjectSessionAction (Maybe Bool)
sendProjectSessionAction_preview = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Maybe Bool
preview :: Maybe Bool
$sel:preview:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Bool
preview} -> Maybe Bool
preview) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Maybe Bool
a -> SendProjectSessionAction
s {$sel:preview:SendProjectSessionAction' :: Maybe Bool
preview = Maybe Bool
a} :: SendProjectSessionAction)

-- | Undocumented member.
sendProjectSessionAction_recipeStep :: Lens.Lens' SendProjectSessionAction (Prelude.Maybe RecipeStep)
sendProjectSessionAction_recipeStep :: Lens' SendProjectSessionAction (Maybe RecipeStep)
sendProjectSessionAction_recipeStep = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Maybe RecipeStep
recipeStep :: Maybe RecipeStep
$sel:recipeStep:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe RecipeStep
recipeStep} -> Maybe RecipeStep
recipeStep) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Maybe RecipeStep
a -> SendProjectSessionAction
s {$sel:recipeStep:SendProjectSessionAction' :: Maybe RecipeStep
recipeStep = Maybe RecipeStep
a} :: SendProjectSessionAction)

-- | The index from which to preview a step. This index is used to preview
-- the result of steps that have already been applied, so that the
-- resulting view frame is from earlier in the view frame stack.
sendProjectSessionAction_stepIndex :: Lens.Lens' SendProjectSessionAction (Prelude.Maybe Prelude.Natural)
sendProjectSessionAction_stepIndex :: Lens' SendProjectSessionAction (Maybe Natural)
sendProjectSessionAction_stepIndex = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Maybe Natural
stepIndex :: Maybe Natural
$sel:stepIndex:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Natural
stepIndex} -> Maybe Natural
stepIndex) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Maybe Natural
a -> SendProjectSessionAction
s {$sel:stepIndex:SendProjectSessionAction' :: Maybe Natural
stepIndex = Maybe Natural
a} :: SendProjectSessionAction)

-- | Undocumented member.
sendProjectSessionAction_viewFrame :: Lens.Lens' SendProjectSessionAction (Prelude.Maybe ViewFrame)
sendProjectSessionAction_viewFrame :: Lens' SendProjectSessionAction (Maybe ViewFrame)
sendProjectSessionAction_viewFrame = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Maybe ViewFrame
viewFrame :: Maybe ViewFrame
$sel:viewFrame:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe ViewFrame
viewFrame} -> Maybe ViewFrame
viewFrame) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Maybe ViewFrame
a -> SendProjectSessionAction
s {$sel:viewFrame:SendProjectSessionAction' :: Maybe ViewFrame
viewFrame = Maybe ViewFrame
a} :: SendProjectSessionAction)

-- | The name of the project to apply the action to.
sendProjectSessionAction_name :: Lens.Lens' SendProjectSessionAction Prelude.Text
sendProjectSessionAction_name :: Lens' SendProjectSessionAction Text
sendProjectSessionAction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionAction' {Text
name :: Text
$sel:name:SendProjectSessionAction' :: SendProjectSessionAction -> Text
name} -> Text
name) (\s :: SendProjectSessionAction
s@SendProjectSessionAction' {} Text
a -> SendProjectSessionAction
s {$sel:name:SendProjectSessionAction' :: Text
name = Text
a} :: SendProjectSessionAction)

instance Core.AWSRequest SendProjectSessionAction where
  type
    AWSResponse SendProjectSessionAction =
      SendProjectSessionActionResponse
  request :: (Service -> Service)
-> SendProjectSessionAction -> Request SendProjectSessionAction
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy SendProjectSessionAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse SendProjectSessionAction)))
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 Int
-> Maybe Text -> Int -> Text -> SendProjectSessionActionResponse
SendProjectSessionActionResponse'
            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
"ActionId")
            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
"Result")
            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))
            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
"Name")
      )

instance Prelude.Hashable SendProjectSessionAction where
  hashWithSalt :: Int -> SendProjectSessionAction -> Int
hashWithSalt Int
_salt SendProjectSessionAction' {Maybe Bool
Maybe Natural
Maybe (Sensitive Text)
Maybe RecipeStep
Maybe ViewFrame
Text
name :: Text
viewFrame :: Maybe ViewFrame
stepIndex :: Maybe Natural
recipeStep :: Maybe RecipeStep
preview :: Maybe Bool
clientSessionId :: Maybe (Sensitive Text)
$sel:name:SendProjectSessionAction' :: SendProjectSessionAction -> Text
$sel:viewFrame:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe ViewFrame
$sel:stepIndex:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Natural
$sel:recipeStep:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe RecipeStep
$sel:preview:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Bool
$sel:clientSessionId:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
clientSessionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
preview
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RecipeStep
recipeStep
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
stepIndex
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ViewFrame
viewFrame
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData SendProjectSessionAction where
  rnf :: SendProjectSessionAction -> ()
rnf SendProjectSessionAction' {Maybe Bool
Maybe Natural
Maybe (Sensitive Text)
Maybe RecipeStep
Maybe ViewFrame
Text
name :: Text
viewFrame :: Maybe ViewFrame
stepIndex :: Maybe Natural
recipeStep :: Maybe RecipeStep
preview :: Maybe Bool
clientSessionId :: Maybe (Sensitive Text)
$sel:name:SendProjectSessionAction' :: SendProjectSessionAction -> Text
$sel:viewFrame:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe ViewFrame
$sel:stepIndex:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Natural
$sel:recipeStep:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe RecipeStep
$sel:preview:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Bool
$sel:clientSessionId:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
clientSessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
preview
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecipeStep
recipeStep
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
stepIndex
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ViewFrame
viewFrame
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders SendProjectSessionAction where
  toHeaders :: SendProjectSessionAction -> 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 SendProjectSessionAction where
  toJSON :: SendProjectSessionAction -> Value
toJSON SendProjectSessionAction' {Maybe Bool
Maybe Natural
Maybe (Sensitive Text)
Maybe RecipeStep
Maybe ViewFrame
Text
name :: Text
viewFrame :: Maybe ViewFrame
stepIndex :: Maybe Natural
recipeStep :: Maybe RecipeStep
preview :: Maybe Bool
clientSessionId :: Maybe (Sensitive Text)
$sel:name:SendProjectSessionAction' :: SendProjectSessionAction -> Text
$sel:viewFrame:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe ViewFrame
$sel:stepIndex:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Natural
$sel:recipeStep:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe RecipeStep
$sel:preview:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Bool
$sel:clientSessionId:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientSessionId" 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 Text)
clientSessionId,
            (Key
"Preview" 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
preview,
            (Key
"RecipeStep" 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 RecipeStep
recipeStep,
            (Key
"StepIndex" 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 Natural
stepIndex,
            (Key
"ViewFrame" 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 ViewFrame
viewFrame
          ]
      )

instance Data.ToPath SendProjectSessionAction where
  toPath :: SendProjectSessionAction -> ByteString
toPath SendProjectSessionAction' {Maybe Bool
Maybe Natural
Maybe (Sensitive Text)
Maybe RecipeStep
Maybe ViewFrame
Text
name :: Text
viewFrame :: Maybe ViewFrame
stepIndex :: Maybe Natural
recipeStep :: Maybe RecipeStep
preview :: Maybe Bool
clientSessionId :: Maybe (Sensitive Text)
$sel:name:SendProjectSessionAction' :: SendProjectSessionAction -> Text
$sel:viewFrame:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe ViewFrame
$sel:stepIndex:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Natural
$sel:recipeStep:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe RecipeStep
$sel:preview:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe Bool
$sel:clientSessionId:SendProjectSessionAction' :: SendProjectSessionAction -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name,
        ByteString
"/sendProjectSessionAction"
      ]

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

-- | /See:/ 'newSendProjectSessionActionResponse' smart constructor.
data SendProjectSessionActionResponse = SendProjectSessionActionResponse'
  { -- | A unique identifier for the action that was performed.
    SendProjectSessionActionResponse -> Maybe Int
actionId :: Prelude.Maybe Prelude.Int,
    -- | A message indicating the result of performing the action.
    SendProjectSessionActionResponse -> Maybe Text
result :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    SendProjectSessionActionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the project that was affected by the action.
    SendProjectSessionActionResponse -> Text
name :: Prelude.Text
  }
  deriving (SendProjectSessionActionResponse
-> SendProjectSessionActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SendProjectSessionActionResponse
-> SendProjectSessionActionResponse -> Bool
$c/= :: SendProjectSessionActionResponse
-> SendProjectSessionActionResponse -> Bool
== :: SendProjectSessionActionResponse
-> SendProjectSessionActionResponse -> Bool
$c== :: SendProjectSessionActionResponse
-> SendProjectSessionActionResponse -> Bool
Prelude.Eq, ReadPrec [SendProjectSessionActionResponse]
ReadPrec SendProjectSessionActionResponse
Int -> ReadS SendProjectSessionActionResponse
ReadS [SendProjectSessionActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SendProjectSessionActionResponse]
$creadListPrec :: ReadPrec [SendProjectSessionActionResponse]
readPrec :: ReadPrec SendProjectSessionActionResponse
$creadPrec :: ReadPrec SendProjectSessionActionResponse
readList :: ReadS [SendProjectSessionActionResponse]
$creadList :: ReadS [SendProjectSessionActionResponse]
readsPrec :: Int -> ReadS SendProjectSessionActionResponse
$creadsPrec :: Int -> ReadS SendProjectSessionActionResponse
Prelude.Read, Int -> SendProjectSessionActionResponse -> ShowS
[SendProjectSessionActionResponse] -> ShowS
SendProjectSessionActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SendProjectSessionActionResponse] -> ShowS
$cshowList :: [SendProjectSessionActionResponse] -> ShowS
show :: SendProjectSessionActionResponse -> String
$cshow :: SendProjectSessionActionResponse -> String
showsPrec :: Int -> SendProjectSessionActionResponse -> ShowS
$cshowsPrec :: Int -> SendProjectSessionActionResponse -> ShowS
Prelude.Show, forall x.
Rep SendProjectSessionActionResponse x
-> SendProjectSessionActionResponse
forall x.
SendProjectSessionActionResponse
-> Rep SendProjectSessionActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SendProjectSessionActionResponse x
-> SendProjectSessionActionResponse
$cfrom :: forall x.
SendProjectSessionActionResponse
-> Rep SendProjectSessionActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'SendProjectSessionActionResponse' 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:
--
-- 'actionId', 'sendProjectSessionActionResponse_actionId' - A unique identifier for the action that was performed.
--
-- 'result', 'sendProjectSessionActionResponse_result' - A message indicating the result of performing the action.
--
-- 'httpStatus', 'sendProjectSessionActionResponse_httpStatus' - The response's http status code.
--
-- 'name', 'sendProjectSessionActionResponse_name' - The name of the project that was affected by the action.
newSendProjectSessionActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  SendProjectSessionActionResponse
newSendProjectSessionActionResponse :: Int -> Text -> SendProjectSessionActionResponse
newSendProjectSessionActionResponse
  Int
pHttpStatus_
  Text
pName_ =
    SendProjectSessionActionResponse'
      { $sel:actionId:SendProjectSessionActionResponse' :: Maybe Int
actionId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:result:SendProjectSessionActionResponse' :: Maybe Text
result = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:SendProjectSessionActionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:name:SendProjectSessionActionResponse' :: Text
name = Text
pName_
      }

-- | A unique identifier for the action that was performed.
sendProjectSessionActionResponse_actionId :: Lens.Lens' SendProjectSessionActionResponse (Prelude.Maybe Prelude.Int)
sendProjectSessionActionResponse_actionId :: Lens' SendProjectSessionActionResponse (Maybe Int)
sendProjectSessionActionResponse_actionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionActionResponse' {Maybe Int
actionId :: Maybe Int
$sel:actionId:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Maybe Int
actionId} -> Maybe Int
actionId) (\s :: SendProjectSessionActionResponse
s@SendProjectSessionActionResponse' {} Maybe Int
a -> SendProjectSessionActionResponse
s {$sel:actionId:SendProjectSessionActionResponse' :: Maybe Int
actionId = Maybe Int
a} :: SendProjectSessionActionResponse)

-- | A message indicating the result of performing the action.
sendProjectSessionActionResponse_result :: Lens.Lens' SendProjectSessionActionResponse (Prelude.Maybe Prelude.Text)
sendProjectSessionActionResponse_result :: Lens' SendProjectSessionActionResponse (Maybe Text)
sendProjectSessionActionResponse_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionActionResponse' {Maybe Text
result :: Maybe Text
$sel:result:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Maybe Text
result} -> Maybe Text
result) (\s :: SendProjectSessionActionResponse
s@SendProjectSessionActionResponse' {} Maybe Text
a -> SendProjectSessionActionResponse
s {$sel:result:SendProjectSessionActionResponse' :: Maybe Text
result = Maybe Text
a} :: SendProjectSessionActionResponse)

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

-- | The name of the project that was affected by the action.
sendProjectSessionActionResponse_name :: Lens.Lens' SendProjectSessionActionResponse Prelude.Text
sendProjectSessionActionResponse_name :: Lens' SendProjectSessionActionResponse Text
sendProjectSessionActionResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SendProjectSessionActionResponse' {Text
name :: Text
$sel:name:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Text
name} -> Text
name) (\s :: SendProjectSessionActionResponse
s@SendProjectSessionActionResponse' {} Text
a -> SendProjectSessionActionResponse
s {$sel:name:SendProjectSessionActionResponse' :: Text
name = Text
a} :: SendProjectSessionActionResponse)

instance
  Prelude.NFData
    SendProjectSessionActionResponse
  where
  rnf :: SendProjectSessionActionResponse -> ()
rnf SendProjectSessionActionResponse' {Int
Maybe Int
Maybe Text
Text
name :: Text
httpStatus :: Int
result :: Maybe Text
actionId :: Maybe Int
$sel:name:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Text
$sel:httpStatus:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Int
$sel:result:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Maybe Text
$sel:actionId:SendProjectSessionActionResponse' :: SendProjectSessionActionResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
actionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
name