{-# 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.ImportNotebook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Imports a single @ipynb@ file to a Spark enabled workgroup. The maximum
-- file size that can be imported is 10 megabytes. If an @ipynb@ file with
-- the same name already exists in the workgroup, throws an error.
module Amazonka.Athena.ImportNotebook
  ( -- * Creating a Request
    ImportNotebook (..),
    newImportNotebook,

    -- * Request Lenses
    importNotebook_clientRequestToken,
    importNotebook_workGroup,
    importNotebook_name,
    importNotebook_payload,
    importNotebook_type,

    -- * Destructuring the Response
    ImportNotebookResponse (..),
    newImportNotebookResponse,

    -- * Response Lenses
    importNotebookResponse_notebookId,
    importNotebookResponse_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:/ 'newImportNotebook' smart constructor.
data ImportNotebook = ImportNotebook'
  { -- | A unique case-sensitive string used to ensure the request to import 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.
    ImportNotebook -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the Spark enabled workgroup to import the notebook to.
    ImportNotebook -> Text
workGroup :: Prelude.Text,
    -- | The name of the notebook to import.
    ImportNotebook -> Text
name :: Prelude.Text,
    -- | The notebook content to be imported.
    ImportNotebook -> Text
payload :: Prelude.Text,
    -- | The notebook content type. Currently, the only valid type is @IPYNB@.
    ImportNotebook -> NotebookType
type' :: NotebookType
  }
  deriving (ImportNotebook -> ImportNotebook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportNotebook -> ImportNotebook -> Bool
$c/= :: ImportNotebook -> ImportNotebook -> Bool
== :: ImportNotebook -> ImportNotebook -> Bool
$c== :: ImportNotebook -> ImportNotebook -> Bool
Prelude.Eq, ReadPrec [ImportNotebook]
ReadPrec ImportNotebook
Int -> ReadS ImportNotebook
ReadS [ImportNotebook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportNotebook]
$creadListPrec :: ReadPrec [ImportNotebook]
readPrec :: ReadPrec ImportNotebook
$creadPrec :: ReadPrec ImportNotebook
readList :: ReadS [ImportNotebook]
$creadList :: ReadS [ImportNotebook]
readsPrec :: Int -> ReadS ImportNotebook
$creadsPrec :: Int -> ReadS ImportNotebook
Prelude.Read, Int -> ImportNotebook -> ShowS
[ImportNotebook] -> ShowS
ImportNotebook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportNotebook] -> ShowS
$cshowList :: [ImportNotebook] -> ShowS
show :: ImportNotebook -> String
$cshow :: ImportNotebook -> String
showsPrec :: Int -> ImportNotebook -> ShowS
$cshowsPrec :: Int -> ImportNotebook -> ShowS
Prelude.Show, forall x. Rep ImportNotebook x -> ImportNotebook
forall x. ImportNotebook -> Rep ImportNotebook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportNotebook x -> ImportNotebook
$cfrom :: forall x. ImportNotebook -> Rep ImportNotebook x
Prelude.Generic)

-- |
-- Create a value of 'ImportNotebook' 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', 'importNotebook_clientRequestToken' - A unique case-sensitive string used to ensure the request to import 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.
--
-- 'workGroup', 'importNotebook_workGroup' - The name of the Spark enabled workgroup to import the notebook to.
--
-- 'name', 'importNotebook_name' - The name of the notebook to import.
--
-- 'payload', 'importNotebook_payload' - The notebook content to be imported.
--
-- 'type'', 'importNotebook_type' - The notebook content type. Currently, the only valid type is @IPYNB@.
newImportNotebook ::
  -- | 'workGroup'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'payload'
  Prelude.Text ->
  -- | 'type''
  NotebookType ->
  ImportNotebook
newImportNotebook :: Text -> Text -> Text -> NotebookType -> ImportNotebook
newImportNotebook Text
pWorkGroup_ Text
pName_ Text
pPayload_ NotebookType
pType_ =
  ImportNotebook'
    { $sel:clientRequestToken:ImportNotebook' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:workGroup:ImportNotebook' :: Text
workGroup = Text
pWorkGroup_,
      $sel:name:ImportNotebook' :: Text
name = Text
pName_,
      $sel:payload:ImportNotebook' :: Text
payload = Text
pPayload_,
      $sel:type':ImportNotebook' :: NotebookType
type' = NotebookType
pType_
    }

-- | A unique case-sensitive string used to ensure the request to import 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.
importNotebook_clientRequestToken :: Lens.Lens' ImportNotebook (Prelude.Maybe Prelude.Text)
importNotebook_clientRequestToken :: Lens' ImportNotebook (Maybe Text)
importNotebook_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportNotebook' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:ImportNotebook' :: ImportNotebook -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: ImportNotebook
s@ImportNotebook' {} Maybe Text
a -> ImportNotebook
s {$sel:clientRequestToken:ImportNotebook' :: Maybe Text
clientRequestToken = Maybe Text
a} :: ImportNotebook)

-- | The name of the Spark enabled workgroup to import the notebook to.
importNotebook_workGroup :: Lens.Lens' ImportNotebook Prelude.Text
importNotebook_workGroup :: Lens' ImportNotebook Text
importNotebook_workGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportNotebook' {Text
workGroup :: Text
$sel:workGroup:ImportNotebook' :: ImportNotebook -> Text
workGroup} -> Text
workGroup) (\s :: ImportNotebook
s@ImportNotebook' {} Text
a -> ImportNotebook
s {$sel:workGroup:ImportNotebook' :: Text
workGroup = Text
a} :: ImportNotebook)

-- | The name of the notebook to import.
importNotebook_name :: Lens.Lens' ImportNotebook Prelude.Text
importNotebook_name :: Lens' ImportNotebook Text
importNotebook_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportNotebook' {Text
name :: Text
$sel:name:ImportNotebook' :: ImportNotebook -> Text
name} -> Text
name) (\s :: ImportNotebook
s@ImportNotebook' {} Text
a -> ImportNotebook
s {$sel:name:ImportNotebook' :: Text
name = Text
a} :: ImportNotebook)

-- | The notebook content to be imported.
importNotebook_payload :: Lens.Lens' ImportNotebook Prelude.Text
importNotebook_payload :: Lens' ImportNotebook Text
importNotebook_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportNotebook' {Text
payload :: Text
$sel:payload:ImportNotebook' :: ImportNotebook -> Text
payload} -> Text
payload) (\s :: ImportNotebook
s@ImportNotebook' {} Text
a -> ImportNotebook
s {$sel:payload:ImportNotebook' :: Text
payload = Text
a} :: ImportNotebook)

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

instance Core.AWSRequest ImportNotebook where
  type
    AWSResponse ImportNotebook =
      ImportNotebookResponse
  request :: (Service -> Service) -> ImportNotebook -> Request ImportNotebook
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 ImportNotebook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ImportNotebook)))
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 Text -> Int -> ImportNotebookResponse
ImportNotebookResponse'
            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
"NotebookId")
            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))
      )

instance Prelude.Hashable ImportNotebook where
  hashWithSalt :: Int -> ImportNotebook -> Int
hashWithSalt Int
_salt ImportNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
name :: Text
workGroup :: Text
clientRequestToken :: Maybe Text
$sel:type':ImportNotebook' :: ImportNotebook -> NotebookType
$sel:payload:ImportNotebook' :: ImportNotebook -> Text
$sel:name:ImportNotebook' :: ImportNotebook -> Text
$sel:workGroup:ImportNotebook' :: ImportNotebook -> Text
$sel:clientRequestToken:ImportNotebook' :: ImportNotebook -> 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` Text
workGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      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 ImportNotebook where
  rnf :: ImportNotebook -> ()
rnf ImportNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
name :: Text
workGroup :: Text
clientRequestToken :: Maybe Text
$sel:type':ImportNotebook' :: ImportNotebook -> NotebookType
$sel:payload:ImportNotebook' :: ImportNotebook -> Text
$sel:name:ImportNotebook' :: ImportNotebook -> Text
$sel:workGroup:ImportNotebook' :: ImportNotebook -> Text
$sel:clientRequestToken:ImportNotebook' :: ImportNotebook -> 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 Text
workGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      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 ImportNotebook where
  toHeaders :: ImportNotebook -> 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.ImportNotebook" ::
                          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 ImportNotebook where
  toJSON :: ImportNotebook -> Value
toJSON ImportNotebook' {Maybe Text
Text
NotebookType
type' :: NotebookType
payload :: Text
name :: Text
workGroup :: Text
clientRequestToken :: Maybe Text
$sel:type':ImportNotebook' :: ImportNotebook -> NotebookType
$sel:payload:ImportNotebook' :: ImportNotebook -> Text
$sel:name:ImportNotebook' :: ImportNotebook -> Text
$sel:workGroup:ImportNotebook' :: ImportNotebook -> Text
$sel:clientRequestToken:ImportNotebook' :: ImportNotebook -> 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,
            forall a. a -> Maybe a
Prelude.Just (Key
"WorkGroup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
workGroup),
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            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 ImportNotebook where
  toPath :: ImportNotebook -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'ImportNotebookResponse' 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:
--
-- 'notebookId', 'importNotebookResponse_notebookId' - The ID of the notebook to import.
--
-- 'httpStatus', 'importNotebookResponse_httpStatus' - The response's http status code.
newImportNotebookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportNotebookResponse
newImportNotebookResponse :: Int -> ImportNotebookResponse
newImportNotebookResponse Int
pHttpStatus_ =
  ImportNotebookResponse'
    { $sel:notebookId:ImportNotebookResponse' :: Maybe Text
notebookId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportNotebookResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData ImportNotebookResponse where
  rnf :: ImportNotebookResponse -> ()
rnf ImportNotebookResponse' {Int
Maybe Text
httpStatus :: Int
notebookId :: Maybe Text
$sel:httpStatus:ImportNotebookResponse' :: ImportNotebookResponse -> Int
$sel:notebookId:ImportNotebookResponse' :: ImportNotebookResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notebookId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus