{-# 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.Athena.UpdateNotebook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the contents of a Spark notebook.
module Amazonka.Athena.UpdateNotebook
  ( -- * Creating a Request
    UpdateNotebook (..),
    newUpdateNotebook,

    -- * Request Lenses
    updateNotebook_clientRequestToken,
    updateNotebook_sessionId,
    updateNotebook_notebookId,
    updateNotebook_payload,
    updateNotebook_type,

    -- * Destructuring the Response
    UpdateNotebookResponse (..),
    newUpdateNotebookResponse,

    -- * Response Lenses
    updateNotebookResponse_httpStatus,
  )
where

import Amazonka.Athena.Types
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

-- | /See:/ 'newUpdateNotebook' smart constructor.
data UpdateNotebook = UpdateNotebook'
  { -- | A unique case-sensitive string used to ensure the request to create the
    -- notebook is idempotent (executes only once).
    --
    -- This token is listed as not required because Amazon Web Services SDKs
    -- (for example the Amazon Web Services SDK for Java) auto-generate the
    -- token for you. If you are not using the Amazon Web Services SDK or the
    -- Amazon Web Services CLI, you must provide this token or the action will
    -- fail.
    UpdateNotebook -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of the session in which the notebook will be updated.
    UpdateNotebook -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the notebook to update.
    UpdateNotebook -> Text
notebookId :: Prelude.Text,
    -- | The updated content for the notebook.
    UpdateNotebook -> Text
payload :: Prelude.Text,
    -- | The notebook content type. Currently, the only valid type is @IPYNB@.
    UpdateNotebook -> NotebookType
type' :: NotebookType
  }
  deriving (UpdateNotebook -> UpdateNotebook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateNotebook -> UpdateNotebook -> Bool
$c/= :: UpdateNotebook -> UpdateNotebook -> Bool
== :: UpdateNotebook -> UpdateNotebook -> Bool
$c== :: UpdateNotebook -> UpdateNotebook -> Bool
Prelude.Eq, ReadPrec [UpdateNotebook]
ReadPrec UpdateNotebook
Int -> ReadS UpdateNotebook
ReadS [UpdateNotebook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateNotebook]
$creadListPrec :: ReadPrec [UpdateNotebook]
readPrec :: ReadPrec UpdateNotebook
$creadPrec :: ReadPrec UpdateNotebook
readList :: ReadS [UpdateNotebook]
$creadList :: ReadS [UpdateNotebook]
readsPrec :: Int -> ReadS UpdateNotebook
$creadsPrec :: Int -> ReadS UpdateNotebook
Prelude.Read, Int -> UpdateNotebook -> ShowS
[UpdateNotebook] -> ShowS
UpdateNotebook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateNotebook] -> ShowS
$cshowList :: [UpdateNotebook] -> ShowS
show :: UpdateNotebook -> String
$cshow :: UpdateNotebook -> String
showsPrec :: Int -> UpdateNotebook -> ShowS
$cshowsPrec :: Int -> UpdateNotebook -> ShowS
Prelude.Show, forall x. Rep UpdateNotebook x -> UpdateNotebook
forall x. UpdateNotebook -> Rep UpdateNotebook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateNotebook x -> UpdateNotebook
$cfrom :: forall x. UpdateNotebook -> Rep UpdateNotebook x
Prelude.Generic)

-- |
-- Create a value of 'UpdateNotebook' 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', 'updateNotebook_clientRequestToken' - A unique case-sensitive string used to ensure the request to create the
-- notebook is idempotent (executes only once).
--
-- This token is listed as not required because Amazon Web Services SDKs
-- (for example the Amazon Web Services SDK for Java) auto-generate the
-- token for you. If you are not using the Amazon Web Services SDK or the
-- Amazon Web Services CLI, you must provide this token or the action will
-- fail.
--
-- 'sessionId', 'updateNotebook_sessionId' - The ID of the session in which the notebook will be updated.
--
-- 'notebookId', 'updateNotebook_notebookId' - The ID of the notebook to update.
--
-- 'payload', 'updateNotebook_payload' - The updated content for the notebook.
--
-- 'type'', 'updateNotebook_type' - The notebook content type. Currently, the only valid type is @IPYNB@.
newUpdateNotebook ::
  -- | 'notebookId'
  Prelude.Text ->
  -- | 'payload'
  Prelude.Text ->
  -- | 'type''
  NotebookType ->
  UpdateNotebook
newUpdateNotebook :: Text -> Text -> NotebookType -> UpdateNotebook
newUpdateNotebook Text
pNotebookId_ Text
pPayload_ NotebookType
pType_ =
  UpdateNotebook'
    { $sel:clientRequestToken:UpdateNotebook' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:UpdateNotebook' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:notebookId:UpdateNotebook' :: Text
notebookId = Text
pNotebookId_,
      $sel:payload:UpdateNotebook' :: Text
payload = Text
pPayload_,
      $sel:type':UpdateNotebook' :: NotebookType
type' = NotebookType
pType_
    }

-- | A unique case-sensitive string used to ensure the request to create the
-- notebook is idempotent (executes only once).
--
-- This token is listed as not required because Amazon Web Services SDKs
-- (for example the Amazon Web Services SDK for Java) auto-generate the
-- token for you. If you are not using the Amazon Web Services SDK or the
-- Amazon Web Services CLI, you must provide this token or the action will
-- fail.
updateNotebook_clientRequestToken :: Lens.Lens' UpdateNotebook (Prelude.Maybe Prelude.Text)
updateNotebook_clientRequestToken :: Lens' UpdateNotebook (Maybe Text)
updateNotebook_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebook' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:UpdateNotebook' :: UpdateNotebook -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: UpdateNotebook
s@UpdateNotebook' {} Maybe Text
a -> UpdateNotebook
s {$sel:clientRequestToken:UpdateNotebook' :: Maybe Text
clientRequestToken = Maybe Text
a} :: UpdateNotebook)

-- | The ID of the session in which the notebook will be updated.
updateNotebook_sessionId :: Lens.Lens' UpdateNotebook (Prelude.Maybe Prelude.Text)
updateNotebook_sessionId :: Lens' UpdateNotebook (Maybe Text)
updateNotebook_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebook' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:UpdateNotebook' :: UpdateNotebook -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: UpdateNotebook
s@UpdateNotebook' {} Maybe Text
a -> UpdateNotebook
s {$sel:sessionId:UpdateNotebook' :: Maybe Text
sessionId = Maybe Text
a} :: UpdateNotebook)

-- | The ID of the notebook to update.
updateNotebook_notebookId :: Lens.Lens' UpdateNotebook Prelude.Text
updateNotebook_notebookId :: Lens' UpdateNotebook Text
updateNotebook_notebookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebook' {Text
notebookId :: Text
$sel:notebookId:UpdateNotebook' :: UpdateNotebook -> Text
notebookId} -> Text
notebookId) (\s :: UpdateNotebook
s@UpdateNotebook' {} Text
a -> UpdateNotebook
s {$sel:notebookId:UpdateNotebook' :: Text
notebookId = Text
a} :: UpdateNotebook)

-- | The updated content for the notebook.
updateNotebook_payload :: Lens.Lens' UpdateNotebook Prelude.Text
updateNotebook_payload :: Lens' UpdateNotebook Text
updateNotebook_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebook' {Text
payload :: Text
$sel:payload:UpdateNotebook' :: UpdateNotebook -> Text
payload} -> Text
payload) (\s :: UpdateNotebook
s@UpdateNotebook' {} Text
a -> UpdateNotebook
s {$sel:payload:UpdateNotebook' :: Text
payload = Text
a} :: UpdateNotebook)

-- | The notebook content type. Currently, the only valid type is @IPYNB@.
updateNotebook_type :: Lens.Lens' UpdateNotebook NotebookType
updateNotebook_type :: Lens' UpdateNotebook NotebookType
updateNotebook_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateNotebook' {NotebookType
type' :: NotebookType
$sel:type':UpdateNotebook' :: UpdateNotebook -> NotebookType
type'} -> NotebookType
type') (\s :: UpdateNotebook
s@UpdateNotebook' {} NotebookType
a -> UpdateNotebook
s {$sel:type':UpdateNotebook' :: NotebookType
type' = NotebookType
a} :: UpdateNotebook)

instance Core.AWSRequest UpdateNotebook where
  type
    AWSResponse UpdateNotebook =
      UpdateNotebookResponse
  request :: (Service -> Service) -> UpdateNotebook -> Request UpdateNotebook
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 UpdateNotebook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateNotebook)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateNotebookResponse
UpdateNotebookResponse'
            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))
      )

instance Prelude.Hashable UpdateNotebook where
  hashWithSalt :: Int -> UpdateNotebook -> Int
hashWithSalt Int
_salt UpdateNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
notebookId :: Text
sessionId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:type':UpdateNotebook' :: UpdateNotebook -> NotebookType
$sel:payload:UpdateNotebook' :: UpdateNotebook -> Text
$sel:notebookId:UpdateNotebook' :: UpdateNotebook -> Text
$sel:sessionId:UpdateNotebook' :: UpdateNotebook -> Maybe Text
$sel:clientRequestToken:UpdateNotebook' :: UpdateNotebook -> 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
sessionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
notebookId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
payload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NotebookType
type'

instance Prelude.NFData UpdateNotebook where
  rnf :: UpdateNotebook -> ()
rnf UpdateNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
notebookId :: Text
sessionId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:type':UpdateNotebook' :: UpdateNotebook -> NotebookType
$sel:payload:UpdateNotebook' :: UpdateNotebook -> Text
$sel:notebookId:UpdateNotebook' :: UpdateNotebook -> Text
$sel:sessionId:UpdateNotebook' :: UpdateNotebook -> Maybe Text
$sel:clientRequestToken:UpdateNotebook' :: UpdateNotebook -> 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
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
notebookId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
payload
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NotebookType
type'

instance Data.ToHeaders UpdateNotebook where
  toHeaders :: UpdateNotebook -> 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
"AmazonAthena.UpdateNotebook" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateNotebook where
  toJSON :: UpdateNotebook -> Value
toJSON UpdateNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
notebookId :: Text
sessionId :: Maybe Text
clientRequestToken :: Maybe Text
$sel:type':UpdateNotebook' :: UpdateNotebook -> NotebookType
$sel:payload:UpdateNotebook' :: UpdateNotebook -> Text
$sel:notebookId:UpdateNotebook' :: UpdateNotebook -> Text
$sel:sessionId:UpdateNotebook' :: UpdateNotebook -> Maybe Text
$sel:clientRequestToken:UpdateNotebook' :: UpdateNotebook -> 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
"SessionId" 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
sessionId,
            forall a. a -> Maybe a
Prelude.Just (Key
"NotebookId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
notebookId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Payload" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
payload),
            forall a. a -> Maybe a
Prelude.Just (Key
"Type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NotebookType
type')
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateNotebookResponse' 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', 'updateNotebookResponse_httpStatus' - The response's http status code.
newUpdateNotebookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateNotebookResponse
newUpdateNotebookResponse :: Int -> UpdateNotebookResponse
newUpdateNotebookResponse Int
pHttpStatus_ =
  UpdateNotebookResponse' {$sel:httpStatus:UpdateNotebookResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData UpdateNotebookResponse where
  rnf :: UpdateNotebookResponse -> ()
rnf UpdateNotebookResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateNotebookResponse' :: UpdateNotebookResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus