{-# 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.StartProjectSession
-- 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 an interactive session, enabling you to manipulate data in a
-- DataBrew project.
module Amazonka.DataBrew.StartProjectSession
  ( -- * Creating a Request
    StartProjectSession (..),
    newStartProjectSession,

    -- * Request Lenses
    startProjectSession_assumeControl,
    startProjectSession_name,

    -- * Destructuring the Response
    StartProjectSessionResponse (..),
    newStartProjectSessionResponse,

    -- * Response Lenses
    startProjectSessionResponse_clientSessionId,
    startProjectSessionResponse_httpStatus,
    startProjectSessionResponse_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:/ 'newStartProjectSession' smart constructor.
data StartProjectSession = StartProjectSession'
  { -- | A value that, if true, enables you to take control of a session, even if
    -- a different client is currently accessing the project.
    StartProjectSession -> Maybe Bool
assumeControl :: Prelude.Maybe Prelude.Bool,
    -- | The name of the project to act upon.
    StartProjectSession -> Text
name :: Prelude.Text
  }
  deriving (StartProjectSession -> StartProjectSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartProjectSession -> StartProjectSession -> Bool
$c/= :: StartProjectSession -> StartProjectSession -> Bool
== :: StartProjectSession -> StartProjectSession -> Bool
$c== :: StartProjectSession -> StartProjectSession -> Bool
Prelude.Eq, ReadPrec [StartProjectSession]
ReadPrec StartProjectSession
Int -> ReadS StartProjectSession
ReadS [StartProjectSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartProjectSession]
$creadListPrec :: ReadPrec [StartProjectSession]
readPrec :: ReadPrec StartProjectSession
$creadPrec :: ReadPrec StartProjectSession
readList :: ReadS [StartProjectSession]
$creadList :: ReadS [StartProjectSession]
readsPrec :: Int -> ReadS StartProjectSession
$creadsPrec :: Int -> ReadS StartProjectSession
Prelude.Read, Int -> StartProjectSession -> ShowS
[StartProjectSession] -> ShowS
StartProjectSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartProjectSession] -> ShowS
$cshowList :: [StartProjectSession] -> ShowS
show :: StartProjectSession -> String
$cshow :: StartProjectSession -> String
showsPrec :: Int -> StartProjectSession -> ShowS
$cshowsPrec :: Int -> StartProjectSession -> ShowS
Prelude.Show, forall x. Rep StartProjectSession x -> StartProjectSession
forall x. StartProjectSession -> Rep StartProjectSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartProjectSession x -> StartProjectSession
$cfrom :: forall x. StartProjectSession -> Rep StartProjectSession x
Prelude.Generic)

-- |
-- Create a value of 'StartProjectSession' 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:
--
-- 'assumeControl', 'startProjectSession_assumeControl' - A value that, if true, enables you to take control of a session, even if
-- a different client is currently accessing the project.
--
-- 'name', 'startProjectSession_name' - The name of the project to act upon.
newStartProjectSession ::
  -- | 'name'
  Prelude.Text ->
  StartProjectSession
newStartProjectSession :: Text -> StartProjectSession
newStartProjectSession Text
pName_ =
  StartProjectSession'
    { $sel:assumeControl:StartProjectSession' :: Maybe Bool
assumeControl =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:StartProjectSession' :: Text
name = Text
pName_
    }

-- | A value that, if true, enables you to take control of a session, even if
-- a different client is currently accessing the project.
startProjectSession_assumeControl :: Lens.Lens' StartProjectSession (Prelude.Maybe Prelude.Bool)
startProjectSession_assumeControl :: Lens' StartProjectSession (Maybe Bool)
startProjectSession_assumeControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectSession' {Maybe Bool
assumeControl :: Maybe Bool
$sel:assumeControl:StartProjectSession' :: StartProjectSession -> Maybe Bool
assumeControl} -> Maybe Bool
assumeControl) (\s :: StartProjectSession
s@StartProjectSession' {} Maybe Bool
a -> StartProjectSession
s {$sel:assumeControl:StartProjectSession' :: Maybe Bool
assumeControl = Maybe Bool
a} :: StartProjectSession)

-- | The name of the project to act upon.
startProjectSession_name :: Lens.Lens' StartProjectSession Prelude.Text
startProjectSession_name :: Lens' StartProjectSession Text
startProjectSession_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectSession' {Text
name :: Text
$sel:name:StartProjectSession' :: StartProjectSession -> Text
name} -> Text
name) (\s :: StartProjectSession
s@StartProjectSession' {} Text
a -> StartProjectSession
s {$sel:name:StartProjectSession' :: Text
name = Text
a} :: StartProjectSession)

instance Core.AWSRequest StartProjectSession where
  type
    AWSResponse StartProjectSession =
      StartProjectSessionResponse
  request :: (Service -> Service)
-> StartProjectSession -> Request StartProjectSession
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 StartProjectSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartProjectSession)))
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 (Sensitive Text)
-> Int -> Text -> StartProjectSessionResponse
StartProjectSessionResponse'
            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
"ClientSessionId")
            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 StartProjectSession where
  hashWithSalt :: Int -> StartProjectSession -> Int
hashWithSalt Int
_salt StartProjectSession' {Maybe Bool
Text
name :: Text
assumeControl :: Maybe Bool
$sel:name:StartProjectSession' :: StartProjectSession -> Text
$sel:assumeControl:StartProjectSession' :: StartProjectSession -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
assumeControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData StartProjectSession where
  rnf :: StartProjectSession -> ()
rnf StartProjectSession' {Maybe Bool
Text
name :: Text
assumeControl :: Maybe Bool
$sel:name:StartProjectSession' :: StartProjectSession -> Text
$sel:assumeControl:StartProjectSession' :: StartProjectSession -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
assumeControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders StartProjectSession where
  toHeaders :: StartProjectSession -> 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 StartProjectSession where
  toJSON :: StartProjectSession -> Value
toJSON StartProjectSession' {Maybe Bool
Text
name :: Text
assumeControl :: Maybe Bool
$sel:name:StartProjectSession' :: StartProjectSession -> Text
$sel:assumeControl:StartProjectSession' :: StartProjectSession -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AssumeControl" 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
assumeControl
          ]
      )

instance Data.ToPath StartProjectSession where
  toPath :: StartProjectSession -> ByteString
toPath StartProjectSession' {Maybe Bool
Text
name :: Text
assumeControl :: Maybe Bool
$sel:name:StartProjectSession' :: StartProjectSession -> Text
$sel:assumeControl:StartProjectSession' :: StartProjectSession -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/projects/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name,
        ByteString
"/startProjectSession"
      ]

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

-- | /See:/ 'newStartProjectSessionResponse' smart constructor.
data StartProjectSessionResponse = StartProjectSessionResponse'
  { -- | A system-generated identifier for the session.
    StartProjectSessionResponse -> Maybe (Sensitive Text)
clientSessionId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The response's http status code.
    StartProjectSessionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the project to be acted upon.
    StartProjectSessionResponse -> Text
name :: Prelude.Text
  }
  deriving (StartProjectSessionResponse -> StartProjectSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartProjectSessionResponse -> StartProjectSessionResponse -> Bool
$c/= :: StartProjectSessionResponse -> StartProjectSessionResponse -> Bool
== :: StartProjectSessionResponse -> StartProjectSessionResponse -> Bool
$c== :: StartProjectSessionResponse -> StartProjectSessionResponse -> Bool
Prelude.Eq, Int -> StartProjectSessionResponse -> ShowS
[StartProjectSessionResponse] -> ShowS
StartProjectSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartProjectSessionResponse] -> ShowS
$cshowList :: [StartProjectSessionResponse] -> ShowS
show :: StartProjectSessionResponse -> String
$cshow :: StartProjectSessionResponse -> String
showsPrec :: Int -> StartProjectSessionResponse -> ShowS
$cshowsPrec :: Int -> StartProjectSessionResponse -> ShowS
Prelude.Show, forall x.
Rep StartProjectSessionResponse x -> StartProjectSessionResponse
forall x.
StartProjectSessionResponse -> Rep StartProjectSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartProjectSessionResponse x -> StartProjectSessionResponse
$cfrom :: forall x.
StartProjectSessionResponse -> Rep StartProjectSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartProjectSessionResponse' 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', 'startProjectSessionResponse_clientSessionId' - A system-generated identifier for the session.
--
-- 'httpStatus', 'startProjectSessionResponse_httpStatus' - The response's http status code.
--
-- 'name', 'startProjectSessionResponse_name' - The name of the project to be acted upon.
newStartProjectSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'name'
  Prelude.Text ->
  StartProjectSessionResponse
newStartProjectSessionResponse :: Int -> Text -> StartProjectSessionResponse
newStartProjectSessionResponse Int
pHttpStatus_ Text
pName_ =
  StartProjectSessionResponse'
    { $sel:clientSessionId:StartProjectSessionResponse' :: Maybe (Sensitive Text)
clientSessionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartProjectSessionResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:name:StartProjectSessionResponse' :: Text
name = Text
pName_
    }

-- | A system-generated identifier for the session.
startProjectSessionResponse_clientSessionId :: Lens.Lens' StartProjectSessionResponse (Prelude.Maybe Prelude.Text)
startProjectSessionResponse_clientSessionId :: Lens' StartProjectSessionResponse (Maybe Text)
startProjectSessionResponse_clientSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectSessionResponse' {Maybe (Sensitive Text)
clientSessionId :: Maybe (Sensitive Text)
$sel:clientSessionId:StartProjectSessionResponse' :: StartProjectSessionResponse -> Maybe (Sensitive Text)
clientSessionId} -> Maybe (Sensitive Text)
clientSessionId) (\s :: StartProjectSessionResponse
s@StartProjectSessionResponse' {} Maybe (Sensitive Text)
a -> StartProjectSessionResponse
s {$sel:clientSessionId:StartProjectSessionResponse' :: Maybe (Sensitive Text)
clientSessionId = Maybe (Sensitive Text)
a} :: StartProjectSessionResponse) 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

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

-- | The name of the project to be acted upon.
startProjectSessionResponse_name :: Lens.Lens' StartProjectSessionResponse Prelude.Text
startProjectSessionResponse_name :: Lens' StartProjectSessionResponse Text
startProjectSessionResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartProjectSessionResponse' {Text
name :: Text
$sel:name:StartProjectSessionResponse' :: StartProjectSessionResponse -> Text
name} -> Text
name) (\s :: StartProjectSessionResponse
s@StartProjectSessionResponse' {} Text
a -> StartProjectSessionResponse
s {$sel:name:StartProjectSessionResponse' :: Text
name = Text
a} :: StartProjectSessionResponse)

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