{-# 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.ExportNotebook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Exports the specified notebook and its metadata.
module Amazonka.Athena.ExportNotebook
  ( -- * Creating a Request
    ExportNotebook (..),
    newExportNotebook,

    -- * Request Lenses
    exportNotebook_notebookId,

    -- * Destructuring the Response
    ExportNotebookResponse (..),
    newExportNotebookResponse,

    -- * Response Lenses
    exportNotebookResponse_notebookMetadata,
    exportNotebookResponse_payload,
    exportNotebookResponse_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:/ 'newExportNotebook' smart constructor.
data ExportNotebook = ExportNotebook'
  { -- | The ID of the notebook to export.
    ExportNotebook -> Text
notebookId :: Prelude.Text
  }
  deriving (ExportNotebook -> ExportNotebook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportNotebook -> ExportNotebook -> Bool
$c/= :: ExportNotebook -> ExportNotebook -> Bool
== :: ExportNotebook -> ExportNotebook -> Bool
$c== :: ExportNotebook -> ExportNotebook -> Bool
Prelude.Eq, ReadPrec [ExportNotebook]
ReadPrec ExportNotebook
Int -> ReadS ExportNotebook
ReadS [ExportNotebook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportNotebook]
$creadListPrec :: ReadPrec [ExportNotebook]
readPrec :: ReadPrec ExportNotebook
$creadPrec :: ReadPrec ExportNotebook
readList :: ReadS [ExportNotebook]
$creadList :: ReadS [ExportNotebook]
readsPrec :: Int -> ReadS ExportNotebook
$creadsPrec :: Int -> ReadS ExportNotebook
Prelude.Read, Int -> ExportNotebook -> ShowS
[ExportNotebook] -> ShowS
ExportNotebook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportNotebook] -> ShowS
$cshowList :: [ExportNotebook] -> ShowS
show :: ExportNotebook -> String
$cshow :: ExportNotebook -> String
showsPrec :: Int -> ExportNotebook -> ShowS
$cshowsPrec :: Int -> ExportNotebook -> ShowS
Prelude.Show, forall x. Rep ExportNotebook x -> ExportNotebook
forall x. ExportNotebook -> Rep ExportNotebook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportNotebook x -> ExportNotebook
$cfrom :: forall x. ExportNotebook -> Rep ExportNotebook x
Prelude.Generic)

-- |
-- Create a value of 'ExportNotebook' 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', 'exportNotebook_notebookId' - The ID of the notebook to export.
newExportNotebook ::
  -- | 'notebookId'
  Prelude.Text ->
  ExportNotebook
newExportNotebook :: Text -> ExportNotebook
newExportNotebook Text
pNotebookId_ =
  ExportNotebook' {$sel:notebookId:ExportNotebook' :: Text
notebookId = Text
pNotebookId_}

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

instance Core.AWSRequest ExportNotebook where
  type
    AWSResponse ExportNotebook =
      ExportNotebookResponse
  request :: (Service -> Service) -> ExportNotebook -> Request ExportNotebook
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 ExportNotebook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ExportNotebook)))
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 NotebookMetadata
-> Maybe Text -> Int -> ExportNotebookResponse
ExportNotebookResponse'
            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
"NotebookMetadata")
            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
"Payload")
            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 ExportNotebook where
  hashWithSalt :: Int -> ExportNotebook -> Int
hashWithSalt Int
_salt ExportNotebook' {Text
notebookId :: Text
$sel:notebookId:ExportNotebook' :: ExportNotebook -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
notebookId

instance Prelude.NFData ExportNotebook where
  rnf :: ExportNotebook -> ()
rnf ExportNotebook' {Text
notebookId :: Text
$sel:notebookId:ExportNotebook' :: ExportNotebook -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
notebookId

instance Data.ToHeaders ExportNotebook where
  toHeaders :: ExportNotebook -> 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.ExportNotebook" ::
                          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 ExportNotebook where
  toJSON :: ExportNotebook -> Value
toJSON ExportNotebook' {Text
notebookId :: Text
$sel:notebookId:ExportNotebook' :: ExportNotebook -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"NotebookId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
notebookId)]
      )

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

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

-- | /See:/ 'newExportNotebookResponse' smart constructor.
data ExportNotebookResponse = ExportNotebookResponse'
  { -- | The notebook metadata, including notebook ID, notebook name, and
    -- workgroup name.
    ExportNotebookResponse -> Maybe NotebookMetadata
notebookMetadata :: Prelude.Maybe NotebookMetadata,
    -- | The content of the exported notebook.
    ExportNotebookResponse -> Maybe Text
payload :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ExportNotebookResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ExportNotebookResponse -> ExportNotebookResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExportNotebookResponse -> ExportNotebookResponse -> Bool
$c/= :: ExportNotebookResponse -> ExportNotebookResponse -> Bool
== :: ExportNotebookResponse -> ExportNotebookResponse -> Bool
$c== :: ExportNotebookResponse -> ExportNotebookResponse -> Bool
Prelude.Eq, ReadPrec [ExportNotebookResponse]
ReadPrec ExportNotebookResponse
Int -> ReadS ExportNotebookResponse
ReadS [ExportNotebookResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExportNotebookResponse]
$creadListPrec :: ReadPrec [ExportNotebookResponse]
readPrec :: ReadPrec ExportNotebookResponse
$creadPrec :: ReadPrec ExportNotebookResponse
readList :: ReadS [ExportNotebookResponse]
$creadList :: ReadS [ExportNotebookResponse]
readsPrec :: Int -> ReadS ExportNotebookResponse
$creadsPrec :: Int -> ReadS ExportNotebookResponse
Prelude.Read, Int -> ExportNotebookResponse -> ShowS
[ExportNotebookResponse] -> ShowS
ExportNotebookResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExportNotebookResponse] -> ShowS
$cshowList :: [ExportNotebookResponse] -> ShowS
show :: ExportNotebookResponse -> String
$cshow :: ExportNotebookResponse -> String
showsPrec :: Int -> ExportNotebookResponse -> ShowS
$cshowsPrec :: Int -> ExportNotebookResponse -> ShowS
Prelude.Show, forall x. Rep ExportNotebookResponse x -> ExportNotebookResponse
forall x. ExportNotebookResponse -> Rep ExportNotebookResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ExportNotebookResponse x -> ExportNotebookResponse
$cfrom :: forall x. ExportNotebookResponse -> Rep ExportNotebookResponse x
Prelude.Generic)

-- |
-- Create a value of 'ExportNotebookResponse' 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:
--
-- 'notebookMetadata', 'exportNotebookResponse_notebookMetadata' - The notebook metadata, including notebook ID, notebook name, and
-- workgroup name.
--
-- 'payload', 'exportNotebookResponse_payload' - The content of the exported notebook.
--
-- 'httpStatus', 'exportNotebookResponse_httpStatus' - The response's http status code.
newExportNotebookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ExportNotebookResponse
newExportNotebookResponse :: Int -> ExportNotebookResponse
newExportNotebookResponse Int
pHttpStatus_ =
  ExportNotebookResponse'
    { $sel:notebookMetadata:ExportNotebookResponse' :: Maybe NotebookMetadata
notebookMetadata =
        forall a. Maybe a
Prelude.Nothing,
      $sel:payload:ExportNotebookResponse' :: Maybe Text
payload = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ExportNotebookResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The notebook metadata, including notebook ID, notebook name, and
-- workgroup name.
exportNotebookResponse_notebookMetadata :: Lens.Lens' ExportNotebookResponse (Prelude.Maybe NotebookMetadata)
exportNotebookResponse_notebookMetadata :: Lens' ExportNotebookResponse (Maybe NotebookMetadata)
exportNotebookResponse_notebookMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportNotebookResponse' {Maybe NotebookMetadata
notebookMetadata :: Maybe NotebookMetadata
$sel:notebookMetadata:ExportNotebookResponse' :: ExportNotebookResponse -> Maybe NotebookMetadata
notebookMetadata} -> Maybe NotebookMetadata
notebookMetadata) (\s :: ExportNotebookResponse
s@ExportNotebookResponse' {} Maybe NotebookMetadata
a -> ExportNotebookResponse
s {$sel:notebookMetadata:ExportNotebookResponse' :: Maybe NotebookMetadata
notebookMetadata = Maybe NotebookMetadata
a} :: ExportNotebookResponse)

-- | The content of the exported notebook.
exportNotebookResponse_payload :: Lens.Lens' ExportNotebookResponse (Prelude.Maybe Prelude.Text)
exportNotebookResponse_payload :: Lens' ExportNotebookResponse (Maybe Text)
exportNotebookResponse_payload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ExportNotebookResponse' {Maybe Text
payload :: Maybe Text
$sel:payload:ExportNotebookResponse' :: ExportNotebookResponse -> Maybe Text
payload} -> Maybe Text
payload) (\s :: ExportNotebookResponse
s@ExportNotebookResponse' {} Maybe Text
a -> ExportNotebookResponse
s {$sel:payload:ExportNotebookResponse' :: Maybe Text
payload = Maybe Text
a} :: ExportNotebookResponse)

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

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