{-# 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.EMR.ListNotebookExecutions
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides summaries of all notebook executions. You can filter the list
-- based on multiple criteria such as status, time range, and editor id.
-- Returns a maximum of 50 notebook executions and a marker to track the
-- paging of a longer notebook execution list across multiple
-- @ListNotebookExecution@ calls.
--
-- This operation returns paginated results.
module Amazonka.EMR.ListNotebookExecutions
  ( -- * Creating a Request
    ListNotebookExecutions (..),
    newListNotebookExecutions,

    -- * Request Lenses
    listNotebookExecutions_editorId,
    listNotebookExecutions_from,
    listNotebookExecutions_marker,
    listNotebookExecutions_status,
    listNotebookExecutions_to,

    -- * Destructuring the Response
    ListNotebookExecutionsResponse (..),
    newListNotebookExecutionsResponse,

    -- * Response Lenses
    listNotebookExecutionsResponse_marker,
    listNotebookExecutionsResponse_notebookExecutions,
    listNotebookExecutionsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EMR.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newListNotebookExecutions' smart constructor.
data ListNotebookExecutions = ListNotebookExecutions'
  { -- | The unique ID of the editor associated with the notebook execution.
    ListNotebookExecutions -> Maybe Text
editorId :: Prelude.Maybe Prelude.Text,
    -- | The beginning of time range filter for listing notebook executions. The
    -- default is the timestamp of 30 days ago.
    ListNotebookExecutions -> Maybe POSIX
from :: Prelude.Maybe Data.POSIX,
    -- | The pagination token, returned by a previous @ListNotebookExecutions@
    -- call, that indicates the start of the list for this
    -- @ListNotebookExecutions@ call.
    ListNotebookExecutions -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The status filter for listing notebook executions.
    --
    -- -   @START_PENDING@ indicates that the cluster has received the
    --     execution request but execution has not begun.
    --
    -- -   @STARTING@ indicates that the execution is starting on the cluster.
    --
    -- -   @RUNNING@ indicates that the execution is being processed by the
    --     cluster.
    --
    -- -   @FINISHING@ indicates that execution processing is in the final
    --     stages.
    --
    -- -   @FINISHED@ indicates that the execution has completed without error.
    --
    -- -   @FAILING@ indicates that the execution is failing and will not
    --     finish successfully.
    --
    -- -   @FAILED@ indicates that the execution failed.
    --
    -- -   @STOP_PENDING@ indicates that the cluster has received a
    --     @StopNotebookExecution@ request and the stop is pending.
    --
    -- -   @STOPPING@ indicates that the cluster is in the process of stopping
    --     the execution as a result of a @StopNotebookExecution@ request.
    --
    -- -   @STOPPED@ indicates that the execution stopped because of a
    --     @StopNotebookExecution@ request.
    ListNotebookExecutions -> Maybe NotebookExecutionStatus
status :: Prelude.Maybe NotebookExecutionStatus,
    -- | The end of time range filter for listing notebook executions. The
    -- default is the current timestamp.
    ListNotebookExecutions -> Maybe POSIX
to :: Prelude.Maybe Data.POSIX
  }
  deriving (ListNotebookExecutions -> ListNotebookExecutions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNotebookExecutions -> ListNotebookExecutions -> Bool
$c/= :: ListNotebookExecutions -> ListNotebookExecutions -> Bool
== :: ListNotebookExecutions -> ListNotebookExecutions -> Bool
$c== :: ListNotebookExecutions -> ListNotebookExecutions -> Bool
Prelude.Eq, ReadPrec [ListNotebookExecutions]
ReadPrec ListNotebookExecutions
Int -> ReadS ListNotebookExecutions
ReadS [ListNotebookExecutions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNotebookExecutions]
$creadListPrec :: ReadPrec [ListNotebookExecutions]
readPrec :: ReadPrec ListNotebookExecutions
$creadPrec :: ReadPrec ListNotebookExecutions
readList :: ReadS [ListNotebookExecutions]
$creadList :: ReadS [ListNotebookExecutions]
readsPrec :: Int -> ReadS ListNotebookExecutions
$creadsPrec :: Int -> ReadS ListNotebookExecutions
Prelude.Read, Int -> ListNotebookExecutions -> ShowS
[ListNotebookExecutions] -> ShowS
ListNotebookExecutions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNotebookExecutions] -> ShowS
$cshowList :: [ListNotebookExecutions] -> ShowS
show :: ListNotebookExecutions -> String
$cshow :: ListNotebookExecutions -> String
showsPrec :: Int -> ListNotebookExecutions -> ShowS
$cshowsPrec :: Int -> ListNotebookExecutions -> ShowS
Prelude.Show, forall x. Rep ListNotebookExecutions x -> ListNotebookExecutions
forall x. ListNotebookExecutions -> Rep ListNotebookExecutions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListNotebookExecutions x -> ListNotebookExecutions
$cfrom :: forall x. ListNotebookExecutions -> Rep ListNotebookExecutions x
Prelude.Generic)

-- |
-- Create a value of 'ListNotebookExecutions' 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:
--
-- 'editorId', 'listNotebookExecutions_editorId' - The unique ID of the editor associated with the notebook execution.
--
-- 'from', 'listNotebookExecutions_from' - The beginning of time range filter for listing notebook executions. The
-- default is the timestamp of 30 days ago.
--
-- 'marker', 'listNotebookExecutions_marker' - The pagination token, returned by a previous @ListNotebookExecutions@
-- call, that indicates the start of the list for this
-- @ListNotebookExecutions@ call.
--
-- 'status', 'listNotebookExecutions_status' - The status filter for listing notebook executions.
--
-- -   @START_PENDING@ indicates that the cluster has received the
--     execution request but execution has not begun.
--
-- -   @STARTING@ indicates that the execution is starting on the cluster.
--
-- -   @RUNNING@ indicates that the execution is being processed by the
--     cluster.
--
-- -   @FINISHING@ indicates that execution processing is in the final
--     stages.
--
-- -   @FINISHED@ indicates that the execution has completed without error.
--
-- -   @FAILING@ indicates that the execution is failing and will not
--     finish successfully.
--
-- -   @FAILED@ indicates that the execution failed.
--
-- -   @STOP_PENDING@ indicates that the cluster has received a
--     @StopNotebookExecution@ request and the stop is pending.
--
-- -   @STOPPING@ indicates that the cluster is in the process of stopping
--     the execution as a result of a @StopNotebookExecution@ request.
--
-- -   @STOPPED@ indicates that the execution stopped because of a
--     @StopNotebookExecution@ request.
--
-- 'to', 'listNotebookExecutions_to' - The end of time range filter for listing notebook executions. The
-- default is the current timestamp.
newListNotebookExecutions ::
  ListNotebookExecutions
newListNotebookExecutions :: ListNotebookExecutions
newListNotebookExecutions =
  ListNotebookExecutions'
    { $sel:editorId:ListNotebookExecutions' :: Maybe Text
editorId = forall a. Maybe a
Prelude.Nothing,
      $sel:from:ListNotebookExecutions' :: Maybe POSIX
from = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListNotebookExecutions' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListNotebookExecutions' :: Maybe NotebookExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:to:ListNotebookExecutions' :: Maybe POSIX
to = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique ID of the editor associated with the notebook execution.
listNotebookExecutions_editorId :: Lens.Lens' ListNotebookExecutions (Prelude.Maybe Prelude.Text)
listNotebookExecutions_editorId :: Lens' ListNotebookExecutions (Maybe Text)
listNotebookExecutions_editorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutions' {Maybe Text
editorId :: Maybe Text
$sel:editorId:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
editorId} -> Maybe Text
editorId) (\s :: ListNotebookExecutions
s@ListNotebookExecutions' {} Maybe Text
a -> ListNotebookExecutions
s {$sel:editorId:ListNotebookExecutions' :: Maybe Text
editorId = Maybe Text
a} :: ListNotebookExecutions)

-- | The beginning of time range filter for listing notebook executions. The
-- default is the timestamp of 30 days ago.
listNotebookExecutions_from :: Lens.Lens' ListNotebookExecutions (Prelude.Maybe Prelude.UTCTime)
listNotebookExecutions_from :: Lens' ListNotebookExecutions (Maybe UTCTime)
listNotebookExecutions_from = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutions' {Maybe POSIX
from :: Maybe POSIX
$sel:from:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
from} -> Maybe POSIX
from) (\s :: ListNotebookExecutions
s@ListNotebookExecutions' {} Maybe POSIX
a -> ListNotebookExecutions
s {$sel:from:ListNotebookExecutions' :: Maybe POSIX
from = Maybe POSIX
a} :: ListNotebookExecutions) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The pagination token, returned by a previous @ListNotebookExecutions@
-- call, that indicates the start of the list for this
-- @ListNotebookExecutions@ call.
listNotebookExecutions_marker :: Lens.Lens' ListNotebookExecutions (Prelude.Maybe Prelude.Text)
listNotebookExecutions_marker :: Lens' ListNotebookExecutions (Maybe Text)
listNotebookExecutions_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutions' {Maybe Text
marker :: Maybe Text
$sel:marker:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListNotebookExecutions
s@ListNotebookExecutions' {} Maybe Text
a -> ListNotebookExecutions
s {$sel:marker:ListNotebookExecutions' :: Maybe Text
marker = Maybe Text
a} :: ListNotebookExecutions)

-- | The status filter for listing notebook executions.
--
-- -   @START_PENDING@ indicates that the cluster has received the
--     execution request but execution has not begun.
--
-- -   @STARTING@ indicates that the execution is starting on the cluster.
--
-- -   @RUNNING@ indicates that the execution is being processed by the
--     cluster.
--
-- -   @FINISHING@ indicates that execution processing is in the final
--     stages.
--
-- -   @FINISHED@ indicates that the execution has completed without error.
--
-- -   @FAILING@ indicates that the execution is failing and will not
--     finish successfully.
--
-- -   @FAILED@ indicates that the execution failed.
--
-- -   @STOP_PENDING@ indicates that the cluster has received a
--     @StopNotebookExecution@ request and the stop is pending.
--
-- -   @STOPPING@ indicates that the cluster is in the process of stopping
--     the execution as a result of a @StopNotebookExecution@ request.
--
-- -   @STOPPED@ indicates that the execution stopped because of a
--     @StopNotebookExecution@ request.
listNotebookExecutions_status :: Lens.Lens' ListNotebookExecutions (Prelude.Maybe NotebookExecutionStatus)
listNotebookExecutions_status :: Lens' ListNotebookExecutions (Maybe NotebookExecutionStatus)
listNotebookExecutions_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutions' {Maybe NotebookExecutionStatus
status :: Maybe NotebookExecutionStatus
$sel:status:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe NotebookExecutionStatus
status} -> Maybe NotebookExecutionStatus
status) (\s :: ListNotebookExecutions
s@ListNotebookExecutions' {} Maybe NotebookExecutionStatus
a -> ListNotebookExecutions
s {$sel:status:ListNotebookExecutions' :: Maybe NotebookExecutionStatus
status = Maybe NotebookExecutionStatus
a} :: ListNotebookExecutions)

-- | The end of time range filter for listing notebook executions. The
-- default is the current timestamp.
listNotebookExecutions_to :: Lens.Lens' ListNotebookExecutions (Prelude.Maybe Prelude.UTCTime)
listNotebookExecutions_to :: Lens' ListNotebookExecutions (Maybe UTCTime)
listNotebookExecutions_to = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutions' {Maybe POSIX
to :: Maybe POSIX
$sel:to:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
to} -> Maybe POSIX
to) (\s :: ListNotebookExecutions
s@ListNotebookExecutions' {} Maybe POSIX
a -> ListNotebookExecutions
s {$sel:to:ListNotebookExecutions' :: Maybe POSIX
to = Maybe POSIX
a} :: ListNotebookExecutions) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager ListNotebookExecutions where
  page :: ListNotebookExecutions
-> AWSResponse ListNotebookExecutions
-> Maybe ListNotebookExecutions
page ListNotebookExecutions
rq AWSResponse ListNotebookExecutions
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListNotebookExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListNotebookExecutionsResponse (Maybe Text)
listNotebookExecutionsResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListNotebookExecutions
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListNotebookExecutionsResponse (Maybe [NotebookExecutionSummary])
listNotebookExecutionsResponse_notebookExecutions
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListNotebookExecutions
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListNotebookExecutions (Maybe Text)
listNotebookExecutions_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListNotebookExecutions
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListNotebookExecutionsResponse (Maybe Text)
listNotebookExecutionsResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListNotebookExecutions where
  type
    AWSResponse ListNotebookExecutions =
      ListNotebookExecutionsResponse
  request :: (Service -> Service)
-> ListNotebookExecutions -> Request ListNotebookExecutions
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 ListNotebookExecutions
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListNotebookExecutions)))
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
-> Maybe [NotebookExecutionSummary]
-> Int
-> ListNotebookExecutionsResponse
ListNotebookExecutionsResponse'
            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
"Marker")
            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
"NotebookExecutions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 ListNotebookExecutions where
  hashWithSalt :: Int -> ListNotebookExecutions -> Int
hashWithSalt Int
_salt ListNotebookExecutions' {Maybe Text
Maybe POSIX
Maybe NotebookExecutionStatus
to :: Maybe POSIX
status :: Maybe NotebookExecutionStatus
marker :: Maybe Text
from :: Maybe POSIX
editorId :: Maybe Text
$sel:to:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:status:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe NotebookExecutionStatus
$sel:marker:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
$sel:from:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:editorId:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
editorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
from
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotebookExecutionStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
to

instance Prelude.NFData ListNotebookExecutions where
  rnf :: ListNotebookExecutions -> ()
rnf ListNotebookExecutions' {Maybe Text
Maybe POSIX
Maybe NotebookExecutionStatus
to :: Maybe POSIX
status :: Maybe NotebookExecutionStatus
marker :: Maybe Text
from :: Maybe POSIX
editorId :: Maybe Text
$sel:to:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:status:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe NotebookExecutionStatus
$sel:marker:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
$sel:from:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:editorId:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
editorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
from
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NotebookExecutionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
to

instance Data.ToHeaders ListNotebookExecutions where
  toHeaders :: ListNotebookExecutions -> 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
"ElasticMapReduce.ListNotebookExecutions" ::
                          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 ListNotebookExecutions where
  toJSON :: ListNotebookExecutions -> Value
toJSON ListNotebookExecutions' {Maybe Text
Maybe POSIX
Maybe NotebookExecutionStatus
to :: Maybe POSIX
status :: Maybe NotebookExecutionStatus
marker :: Maybe Text
from :: Maybe POSIX
editorId :: Maybe Text
$sel:to:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:status:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe NotebookExecutionStatus
$sel:marker:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
$sel:from:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe POSIX
$sel:editorId:ListNotebookExecutions' :: ListNotebookExecutions -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EditorId" 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
editorId,
            (Key
"From" 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 POSIX
from,
            (Key
"Marker" 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
marker,
            (Key
"Status" 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 NotebookExecutionStatus
status,
            (Key
"To" 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 POSIX
to
          ]
      )

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

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

-- | /See:/ 'newListNotebookExecutionsResponse' smart constructor.
data ListNotebookExecutionsResponse = ListNotebookExecutionsResponse'
  { -- | A pagination token that a subsequent @ListNotebookExecutions@ can use to
    -- determine the next set of results to retrieve.
    ListNotebookExecutionsResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | A list of notebook executions.
    ListNotebookExecutionsResponse -> Maybe [NotebookExecutionSummary]
notebookExecutions :: Prelude.Maybe [NotebookExecutionSummary],
    -- | The response's http status code.
    ListNotebookExecutionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListNotebookExecutionsResponse
-> ListNotebookExecutionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListNotebookExecutionsResponse
-> ListNotebookExecutionsResponse -> Bool
$c/= :: ListNotebookExecutionsResponse
-> ListNotebookExecutionsResponse -> Bool
== :: ListNotebookExecutionsResponse
-> ListNotebookExecutionsResponse -> Bool
$c== :: ListNotebookExecutionsResponse
-> ListNotebookExecutionsResponse -> Bool
Prelude.Eq, ReadPrec [ListNotebookExecutionsResponse]
ReadPrec ListNotebookExecutionsResponse
Int -> ReadS ListNotebookExecutionsResponse
ReadS [ListNotebookExecutionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListNotebookExecutionsResponse]
$creadListPrec :: ReadPrec [ListNotebookExecutionsResponse]
readPrec :: ReadPrec ListNotebookExecutionsResponse
$creadPrec :: ReadPrec ListNotebookExecutionsResponse
readList :: ReadS [ListNotebookExecutionsResponse]
$creadList :: ReadS [ListNotebookExecutionsResponse]
readsPrec :: Int -> ReadS ListNotebookExecutionsResponse
$creadsPrec :: Int -> ReadS ListNotebookExecutionsResponse
Prelude.Read, Int -> ListNotebookExecutionsResponse -> ShowS
[ListNotebookExecutionsResponse] -> ShowS
ListNotebookExecutionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListNotebookExecutionsResponse] -> ShowS
$cshowList :: [ListNotebookExecutionsResponse] -> ShowS
show :: ListNotebookExecutionsResponse -> String
$cshow :: ListNotebookExecutionsResponse -> String
showsPrec :: Int -> ListNotebookExecutionsResponse -> ShowS
$cshowsPrec :: Int -> ListNotebookExecutionsResponse -> ShowS
Prelude.Show, forall x.
Rep ListNotebookExecutionsResponse x
-> ListNotebookExecutionsResponse
forall x.
ListNotebookExecutionsResponse
-> Rep ListNotebookExecutionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListNotebookExecutionsResponse x
-> ListNotebookExecutionsResponse
$cfrom :: forall x.
ListNotebookExecutionsResponse
-> Rep ListNotebookExecutionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListNotebookExecutionsResponse' 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:
--
-- 'marker', 'listNotebookExecutionsResponse_marker' - A pagination token that a subsequent @ListNotebookExecutions@ can use to
-- determine the next set of results to retrieve.
--
-- 'notebookExecutions', 'listNotebookExecutionsResponse_notebookExecutions' - A list of notebook executions.
--
-- 'httpStatus', 'listNotebookExecutionsResponse_httpStatus' - The response's http status code.
newListNotebookExecutionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListNotebookExecutionsResponse
newListNotebookExecutionsResponse :: Int -> ListNotebookExecutionsResponse
newListNotebookExecutionsResponse Int
pHttpStatus_ =
  ListNotebookExecutionsResponse'
    { $sel:marker:ListNotebookExecutionsResponse' :: Maybe Text
marker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:notebookExecutions:ListNotebookExecutionsResponse' :: Maybe [NotebookExecutionSummary]
notebookExecutions = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListNotebookExecutionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A pagination token that a subsequent @ListNotebookExecutions@ can use to
-- determine the next set of results to retrieve.
listNotebookExecutionsResponse_marker :: Lens.Lens' ListNotebookExecutionsResponse (Prelude.Maybe Prelude.Text)
listNotebookExecutionsResponse_marker :: Lens' ListNotebookExecutionsResponse (Maybe Text)
listNotebookExecutionsResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutionsResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListNotebookExecutionsResponse' :: ListNotebookExecutionsResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListNotebookExecutionsResponse
s@ListNotebookExecutionsResponse' {} Maybe Text
a -> ListNotebookExecutionsResponse
s {$sel:marker:ListNotebookExecutionsResponse' :: Maybe Text
marker = Maybe Text
a} :: ListNotebookExecutionsResponse)

-- | A list of notebook executions.
listNotebookExecutionsResponse_notebookExecutions :: Lens.Lens' ListNotebookExecutionsResponse (Prelude.Maybe [NotebookExecutionSummary])
listNotebookExecutionsResponse_notebookExecutions :: Lens'
  ListNotebookExecutionsResponse (Maybe [NotebookExecutionSummary])
listNotebookExecutionsResponse_notebookExecutions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListNotebookExecutionsResponse' {Maybe [NotebookExecutionSummary]
notebookExecutions :: Maybe [NotebookExecutionSummary]
$sel:notebookExecutions:ListNotebookExecutionsResponse' :: ListNotebookExecutionsResponse -> Maybe [NotebookExecutionSummary]
notebookExecutions} -> Maybe [NotebookExecutionSummary]
notebookExecutions) (\s :: ListNotebookExecutionsResponse
s@ListNotebookExecutionsResponse' {} Maybe [NotebookExecutionSummary]
a -> ListNotebookExecutionsResponse
s {$sel:notebookExecutions:ListNotebookExecutionsResponse' :: Maybe [NotebookExecutionSummary]
notebookExecutions = Maybe [NotebookExecutionSummary]
a} :: ListNotebookExecutionsResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance
  Prelude.NFData
    ListNotebookExecutionsResponse
  where
  rnf :: ListNotebookExecutionsResponse -> ()
rnf ListNotebookExecutionsResponse' {Int
Maybe [NotebookExecutionSummary]
Maybe Text
httpStatus :: Int
notebookExecutions :: Maybe [NotebookExecutionSummary]
marker :: Maybe Text
$sel:httpStatus:ListNotebookExecutionsResponse' :: ListNotebookExecutionsResponse -> Int
$sel:notebookExecutions:ListNotebookExecutionsResponse' :: ListNotebookExecutionsResponse -> Maybe [NotebookExecutionSummary]
$sel:marker:ListNotebookExecutionsResponse' :: ListNotebookExecutionsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [NotebookExecutionSummary]
notebookExecutions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus