{-# 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.CreatePresignedNotebookUrl
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets an authentication token and the URL at which the notebook can be
-- accessed. During programmatic access, @CreatePresignedNotebookUrl@ must
-- be called every 10 minutes to refresh the authentication token.
module Amazonka.Athena.CreatePresignedNotebookUrl
  ( -- * Creating a Request
    CreatePresignedNotebookUrl (..),
    newCreatePresignedNotebookUrl,

    -- * Request Lenses
    createPresignedNotebookUrl_sessionId,

    -- * Destructuring the Response
    CreatePresignedNotebookUrlResponse (..),
    newCreatePresignedNotebookUrlResponse,

    -- * Response Lenses
    createPresignedNotebookUrlResponse_httpStatus,
    createPresignedNotebookUrlResponse_notebookUrl,
    createPresignedNotebookUrlResponse_authToken,
    createPresignedNotebookUrlResponse_authTokenExpirationTime,
  )
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:/ 'newCreatePresignedNotebookUrl' smart constructor.
data CreatePresignedNotebookUrl = CreatePresignedNotebookUrl'
  { -- | The session ID.
    CreatePresignedNotebookUrl -> Text
sessionId :: Prelude.Text
  }
  deriving (CreatePresignedNotebookUrl -> CreatePresignedNotebookUrl -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePresignedNotebookUrl -> CreatePresignedNotebookUrl -> Bool
$c/= :: CreatePresignedNotebookUrl -> CreatePresignedNotebookUrl -> Bool
== :: CreatePresignedNotebookUrl -> CreatePresignedNotebookUrl -> Bool
$c== :: CreatePresignedNotebookUrl -> CreatePresignedNotebookUrl -> Bool
Prelude.Eq, ReadPrec [CreatePresignedNotebookUrl]
ReadPrec CreatePresignedNotebookUrl
Int -> ReadS CreatePresignedNotebookUrl
ReadS [CreatePresignedNotebookUrl]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePresignedNotebookUrl]
$creadListPrec :: ReadPrec [CreatePresignedNotebookUrl]
readPrec :: ReadPrec CreatePresignedNotebookUrl
$creadPrec :: ReadPrec CreatePresignedNotebookUrl
readList :: ReadS [CreatePresignedNotebookUrl]
$creadList :: ReadS [CreatePresignedNotebookUrl]
readsPrec :: Int -> ReadS CreatePresignedNotebookUrl
$creadsPrec :: Int -> ReadS CreatePresignedNotebookUrl
Prelude.Read, Int -> CreatePresignedNotebookUrl -> ShowS
[CreatePresignedNotebookUrl] -> ShowS
CreatePresignedNotebookUrl -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePresignedNotebookUrl] -> ShowS
$cshowList :: [CreatePresignedNotebookUrl] -> ShowS
show :: CreatePresignedNotebookUrl -> String
$cshow :: CreatePresignedNotebookUrl -> String
showsPrec :: Int -> CreatePresignedNotebookUrl -> ShowS
$cshowsPrec :: Int -> CreatePresignedNotebookUrl -> ShowS
Prelude.Show, forall x.
Rep CreatePresignedNotebookUrl x -> CreatePresignedNotebookUrl
forall x.
CreatePresignedNotebookUrl -> Rep CreatePresignedNotebookUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePresignedNotebookUrl x -> CreatePresignedNotebookUrl
$cfrom :: forall x.
CreatePresignedNotebookUrl -> Rep CreatePresignedNotebookUrl x
Prelude.Generic)

-- |
-- Create a value of 'CreatePresignedNotebookUrl' 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:
--
-- 'sessionId', 'createPresignedNotebookUrl_sessionId' - The session ID.
newCreatePresignedNotebookUrl ::
  -- | 'sessionId'
  Prelude.Text ->
  CreatePresignedNotebookUrl
newCreatePresignedNotebookUrl :: Text -> CreatePresignedNotebookUrl
newCreatePresignedNotebookUrl Text
pSessionId_ =
  CreatePresignedNotebookUrl'
    { $sel:sessionId:CreatePresignedNotebookUrl' :: Text
sessionId =
        Text
pSessionId_
    }

-- | The session ID.
createPresignedNotebookUrl_sessionId :: Lens.Lens' CreatePresignedNotebookUrl Prelude.Text
createPresignedNotebookUrl_sessionId :: Lens' CreatePresignedNotebookUrl Text
createPresignedNotebookUrl_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePresignedNotebookUrl' {Text
sessionId :: Text
$sel:sessionId:CreatePresignedNotebookUrl' :: CreatePresignedNotebookUrl -> Text
sessionId} -> Text
sessionId) (\s :: CreatePresignedNotebookUrl
s@CreatePresignedNotebookUrl' {} Text
a -> CreatePresignedNotebookUrl
s {$sel:sessionId:CreatePresignedNotebookUrl' :: Text
sessionId = Text
a} :: CreatePresignedNotebookUrl)

instance Core.AWSRequest CreatePresignedNotebookUrl where
  type
    AWSResponse CreatePresignedNotebookUrl =
      CreatePresignedNotebookUrlResponse
  request :: (Service -> Service)
-> CreatePresignedNotebookUrl -> Request CreatePresignedNotebookUrl
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 CreatePresignedNotebookUrl
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreatePresignedNotebookUrl)))
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 ->
          Int
-> Text -> Text -> Integer -> CreatePresignedNotebookUrlResponse
CreatePresignedNotebookUrlResponse'
            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))
            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
"NotebookUrl")
            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
"AuthToken")
            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
"AuthTokenExpirationTime")
      )

instance Prelude.Hashable CreatePresignedNotebookUrl where
  hashWithSalt :: Int -> CreatePresignedNotebookUrl -> Int
hashWithSalt Int
_salt CreatePresignedNotebookUrl' {Text
sessionId :: Text
$sel:sessionId:CreatePresignedNotebookUrl' :: CreatePresignedNotebookUrl -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionId

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

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

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

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

-- | /See:/ 'newCreatePresignedNotebookUrlResponse' smart constructor.
data CreatePresignedNotebookUrlResponse = CreatePresignedNotebookUrlResponse'
  { -- | The response's http status code.
    CreatePresignedNotebookUrlResponse -> Int
httpStatus :: Prelude.Int,
    -- | The URL of the notebook. The URL includes the authentication token and
    -- notebook file name and points directly to the opened notebook.
    CreatePresignedNotebookUrlResponse -> Text
notebookUrl :: Prelude.Text,
    -- | The authentication token for the notebook.
    CreatePresignedNotebookUrlResponse -> Text
authToken :: Prelude.Text,
    -- | The UTC epoch time when the authentication token expires.
    CreatePresignedNotebookUrlResponse -> Integer
authTokenExpirationTime :: Prelude.Integer
  }
  deriving (CreatePresignedNotebookUrlResponse
-> CreatePresignedNotebookUrlResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePresignedNotebookUrlResponse
-> CreatePresignedNotebookUrlResponse -> Bool
$c/= :: CreatePresignedNotebookUrlResponse
-> CreatePresignedNotebookUrlResponse -> Bool
== :: CreatePresignedNotebookUrlResponse
-> CreatePresignedNotebookUrlResponse -> Bool
$c== :: CreatePresignedNotebookUrlResponse
-> CreatePresignedNotebookUrlResponse -> Bool
Prelude.Eq, ReadPrec [CreatePresignedNotebookUrlResponse]
ReadPrec CreatePresignedNotebookUrlResponse
Int -> ReadS CreatePresignedNotebookUrlResponse
ReadS [CreatePresignedNotebookUrlResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePresignedNotebookUrlResponse]
$creadListPrec :: ReadPrec [CreatePresignedNotebookUrlResponse]
readPrec :: ReadPrec CreatePresignedNotebookUrlResponse
$creadPrec :: ReadPrec CreatePresignedNotebookUrlResponse
readList :: ReadS [CreatePresignedNotebookUrlResponse]
$creadList :: ReadS [CreatePresignedNotebookUrlResponse]
readsPrec :: Int -> ReadS CreatePresignedNotebookUrlResponse
$creadsPrec :: Int -> ReadS CreatePresignedNotebookUrlResponse
Prelude.Read, Int -> CreatePresignedNotebookUrlResponse -> ShowS
[CreatePresignedNotebookUrlResponse] -> ShowS
CreatePresignedNotebookUrlResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePresignedNotebookUrlResponse] -> ShowS
$cshowList :: [CreatePresignedNotebookUrlResponse] -> ShowS
show :: CreatePresignedNotebookUrlResponse -> String
$cshow :: CreatePresignedNotebookUrlResponse -> String
showsPrec :: Int -> CreatePresignedNotebookUrlResponse -> ShowS
$cshowsPrec :: Int -> CreatePresignedNotebookUrlResponse -> ShowS
Prelude.Show, forall x.
Rep CreatePresignedNotebookUrlResponse x
-> CreatePresignedNotebookUrlResponse
forall x.
CreatePresignedNotebookUrlResponse
-> Rep CreatePresignedNotebookUrlResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreatePresignedNotebookUrlResponse x
-> CreatePresignedNotebookUrlResponse
$cfrom :: forall x.
CreatePresignedNotebookUrlResponse
-> Rep CreatePresignedNotebookUrlResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePresignedNotebookUrlResponse' 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', 'createPresignedNotebookUrlResponse_httpStatus' - The response's http status code.
--
-- 'notebookUrl', 'createPresignedNotebookUrlResponse_notebookUrl' - The URL of the notebook. The URL includes the authentication token and
-- notebook file name and points directly to the opened notebook.
--
-- 'authToken', 'createPresignedNotebookUrlResponse_authToken' - The authentication token for the notebook.
--
-- 'authTokenExpirationTime', 'createPresignedNotebookUrlResponse_authTokenExpirationTime' - The UTC epoch time when the authentication token expires.
newCreatePresignedNotebookUrlResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'notebookUrl'
  Prelude.Text ->
  -- | 'authToken'
  Prelude.Text ->
  -- | 'authTokenExpirationTime'
  Prelude.Integer ->
  CreatePresignedNotebookUrlResponse
newCreatePresignedNotebookUrlResponse :: Int
-> Text -> Text -> Integer -> CreatePresignedNotebookUrlResponse
newCreatePresignedNotebookUrlResponse
  Int
pHttpStatus_
  Text
pNotebookUrl_
  Text
pAuthToken_
  Integer
pAuthTokenExpirationTime_ =
    CreatePresignedNotebookUrlResponse'
      { $sel:httpStatus:CreatePresignedNotebookUrlResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:notebookUrl:CreatePresignedNotebookUrlResponse' :: Text
notebookUrl = Text
pNotebookUrl_,
        $sel:authToken:CreatePresignedNotebookUrlResponse' :: Text
authToken = Text
pAuthToken_,
        $sel:authTokenExpirationTime:CreatePresignedNotebookUrlResponse' :: Integer
authTokenExpirationTime =
          Integer
pAuthTokenExpirationTime_
      }

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

-- | The URL of the notebook. The URL includes the authentication token and
-- notebook file name and points directly to the opened notebook.
createPresignedNotebookUrlResponse_notebookUrl :: Lens.Lens' CreatePresignedNotebookUrlResponse Prelude.Text
createPresignedNotebookUrlResponse_notebookUrl :: Lens' CreatePresignedNotebookUrlResponse Text
createPresignedNotebookUrlResponse_notebookUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePresignedNotebookUrlResponse' {Text
notebookUrl :: Text
$sel:notebookUrl:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Text
notebookUrl} -> Text
notebookUrl) (\s :: CreatePresignedNotebookUrlResponse
s@CreatePresignedNotebookUrlResponse' {} Text
a -> CreatePresignedNotebookUrlResponse
s {$sel:notebookUrl:CreatePresignedNotebookUrlResponse' :: Text
notebookUrl = Text
a} :: CreatePresignedNotebookUrlResponse)

-- | The authentication token for the notebook.
createPresignedNotebookUrlResponse_authToken :: Lens.Lens' CreatePresignedNotebookUrlResponse Prelude.Text
createPresignedNotebookUrlResponse_authToken :: Lens' CreatePresignedNotebookUrlResponse Text
createPresignedNotebookUrlResponse_authToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePresignedNotebookUrlResponse' {Text
authToken :: Text
$sel:authToken:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Text
authToken} -> Text
authToken) (\s :: CreatePresignedNotebookUrlResponse
s@CreatePresignedNotebookUrlResponse' {} Text
a -> CreatePresignedNotebookUrlResponse
s {$sel:authToken:CreatePresignedNotebookUrlResponse' :: Text
authToken = Text
a} :: CreatePresignedNotebookUrlResponse)

-- | The UTC epoch time when the authentication token expires.
createPresignedNotebookUrlResponse_authTokenExpirationTime :: Lens.Lens' CreatePresignedNotebookUrlResponse Prelude.Integer
createPresignedNotebookUrlResponse_authTokenExpirationTime :: Lens' CreatePresignedNotebookUrlResponse Integer
createPresignedNotebookUrlResponse_authTokenExpirationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePresignedNotebookUrlResponse' {Integer
authTokenExpirationTime :: Integer
$sel:authTokenExpirationTime:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Integer
authTokenExpirationTime} -> Integer
authTokenExpirationTime) (\s :: CreatePresignedNotebookUrlResponse
s@CreatePresignedNotebookUrlResponse' {} Integer
a -> CreatePresignedNotebookUrlResponse
s {$sel:authTokenExpirationTime:CreatePresignedNotebookUrlResponse' :: Integer
authTokenExpirationTime = Integer
a} :: CreatePresignedNotebookUrlResponse)

instance
  Prelude.NFData
    CreatePresignedNotebookUrlResponse
  where
  rnf :: CreatePresignedNotebookUrlResponse -> ()
rnf CreatePresignedNotebookUrlResponse' {Int
Integer
Text
authTokenExpirationTime :: Integer
authToken :: Text
notebookUrl :: Text
httpStatus :: Int
$sel:authTokenExpirationTime:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Integer
$sel:authToken:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Text
$sel:notebookUrl:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Text
$sel:httpStatus:CreatePresignedNotebookUrlResponse' :: CreatePresignedNotebookUrlResponse -> Int
..} =
    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
notebookUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
authToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
authTokenExpirationTime