{-# 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.Signer.ListSigningJobs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all your signing jobs. You can use the @maxResults@ parameter to
-- limit the number of signing jobs that are returned in the response. If
-- additional jobs remain to be listed, code signing returns a @nextToken@
-- value. Use this value in subsequent calls to @ListSigningJobs@ to fetch
-- the remaining values. You can continue calling @ListSigningJobs@ with
-- your @maxResults@ parameter and with new values that code signing
-- returns in the @nextToken@ parameter until all of your signing jobs have
-- been returned.
--
-- This operation returns paginated results.
module Amazonka.Signer.ListSigningJobs
  ( -- * Creating a Request
    ListSigningJobs (..),
    newListSigningJobs,

    -- * Request Lenses
    listSigningJobs_isRevoked,
    listSigningJobs_jobInvoker,
    listSigningJobs_maxResults,
    listSigningJobs_nextToken,
    listSigningJobs_platformId,
    listSigningJobs_requestedBy,
    listSigningJobs_signatureExpiresAfter,
    listSigningJobs_signatureExpiresBefore,
    listSigningJobs_status,

    -- * Destructuring the Response
    ListSigningJobsResponse (..),
    newListSigningJobsResponse,

    -- * Response Lenses
    listSigningJobsResponse_jobs,
    listSigningJobsResponse_nextToken,
    listSigningJobsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListSigningJobs' smart constructor.
data ListSigningJobs = ListSigningJobs'
  { -- | Filters results to return only signing jobs with revoked signatures.
    ListSigningJobs -> Maybe Bool
isRevoked :: Prelude.Maybe Prelude.Bool,
    -- | Filters results to return only signing jobs initiated by a specified IAM
    -- entity.
    ListSigningJobs -> Maybe Text
jobInvoker :: Prelude.Maybe Prelude.Text,
    -- | Specifies the maximum number of items to return in the response. Use
    -- this parameter when paginating results. If additional items exist beyond
    -- the number you specify, the @nextToken@ element is set in the response.
    -- Use the @nextToken@ value in a subsequent request to retrieve additional
    -- items.
    ListSigningJobs -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | String for specifying the next set of paginated results to return. After
    -- you receive a response with truncated results, use this parameter in a
    -- subsequent request. Set it to the value of @nextToken@ from the response
    -- that you just received.
    ListSigningJobs -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The ID of microcontroller platform that you specified for the
    -- distribution of your code image.
    ListSigningJobs -> Maybe Text
platformId :: Prelude.Maybe Prelude.Text,
    -- | The IAM principal that requested the signing job.
    ListSigningJobs -> Maybe Text
requestedBy :: Prelude.Maybe Prelude.Text,
    -- | Filters results to return only signing jobs with signatures expiring
    -- after a specified timestamp.
    ListSigningJobs -> Maybe POSIX
signatureExpiresAfter :: Prelude.Maybe Data.POSIX,
    -- | Filters results to return only signing jobs with signatures expiring
    -- before a specified timestamp.
    ListSigningJobs -> Maybe POSIX
signatureExpiresBefore :: Prelude.Maybe Data.POSIX,
    -- | A status value with which to filter your results.
    ListSigningJobs -> Maybe SigningStatus
status :: Prelude.Maybe SigningStatus
  }
  deriving (ListSigningJobs -> ListSigningJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSigningJobs -> ListSigningJobs -> Bool
$c/= :: ListSigningJobs -> ListSigningJobs -> Bool
== :: ListSigningJobs -> ListSigningJobs -> Bool
$c== :: ListSigningJobs -> ListSigningJobs -> Bool
Prelude.Eq, ReadPrec [ListSigningJobs]
ReadPrec ListSigningJobs
Int -> ReadS ListSigningJobs
ReadS [ListSigningJobs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSigningJobs]
$creadListPrec :: ReadPrec [ListSigningJobs]
readPrec :: ReadPrec ListSigningJobs
$creadPrec :: ReadPrec ListSigningJobs
readList :: ReadS [ListSigningJobs]
$creadList :: ReadS [ListSigningJobs]
readsPrec :: Int -> ReadS ListSigningJobs
$creadsPrec :: Int -> ReadS ListSigningJobs
Prelude.Read, Int -> ListSigningJobs -> ShowS
[ListSigningJobs] -> ShowS
ListSigningJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSigningJobs] -> ShowS
$cshowList :: [ListSigningJobs] -> ShowS
show :: ListSigningJobs -> String
$cshow :: ListSigningJobs -> String
showsPrec :: Int -> ListSigningJobs -> ShowS
$cshowsPrec :: Int -> ListSigningJobs -> ShowS
Prelude.Show, forall x. Rep ListSigningJobs x -> ListSigningJobs
forall x. ListSigningJobs -> Rep ListSigningJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSigningJobs x -> ListSigningJobs
$cfrom :: forall x. ListSigningJobs -> Rep ListSigningJobs x
Prelude.Generic)

-- |
-- Create a value of 'ListSigningJobs' 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:
--
-- 'isRevoked', 'listSigningJobs_isRevoked' - Filters results to return only signing jobs with revoked signatures.
--
-- 'jobInvoker', 'listSigningJobs_jobInvoker' - Filters results to return only signing jobs initiated by a specified IAM
-- entity.
--
-- 'maxResults', 'listSigningJobs_maxResults' - Specifies the maximum number of items to return in the response. Use
-- this parameter when paginating results. If additional items exist beyond
-- the number you specify, the @nextToken@ element is set in the response.
-- Use the @nextToken@ value in a subsequent request to retrieve additional
-- items.
--
-- 'nextToken', 'listSigningJobs_nextToken' - String for specifying the next set of paginated results to return. After
-- you receive a response with truncated results, use this parameter in a
-- subsequent request. Set it to the value of @nextToken@ from the response
-- that you just received.
--
-- 'platformId', 'listSigningJobs_platformId' - The ID of microcontroller platform that you specified for the
-- distribution of your code image.
--
-- 'requestedBy', 'listSigningJobs_requestedBy' - The IAM principal that requested the signing job.
--
-- 'signatureExpiresAfter', 'listSigningJobs_signatureExpiresAfter' - Filters results to return only signing jobs with signatures expiring
-- after a specified timestamp.
--
-- 'signatureExpiresBefore', 'listSigningJobs_signatureExpiresBefore' - Filters results to return only signing jobs with signatures expiring
-- before a specified timestamp.
--
-- 'status', 'listSigningJobs_status' - A status value with which to filter your results.
newListSigningJobs ::
  ListSigningJobs
newListSigningJobs :: ListSigningJobs
newListSigningJobs =
  ListSigningJobs'
    { $sel:isRevoked:ListSigningJobs' :: Maybe Bool
isRevoked = forall a. Maybe a
Prelude.Nothing,
      $sel:jobInvoker:ListSigningJobs' :: Maybe Text
jobInvoker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListSigningJobs' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSigningJobs' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:platformId:ListSigningJobs' :: Maybe Text
platformId = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedBy:ListSigningJobs' :: Maybe Text
requestedBy = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureExpiresAfter:ListSigningJobs' :: Maybe POSIX
signatureExpiresAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureExpiresBefore:ListSigningJobs' :: Maybe POSIX
signatureExpiresBefore = forall a. Maybe a
Prelude.Nothing,
      $sel:status:ListSigningJobs' :: Maybe SigningStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | Filters results to return only signing jobs with revoked signatures.
listSigningJobs_isRevoked :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Bool)
listSigningJobs_isRevoked :: Lens' ListSigningJobs (Maybe Bool)
listSigningJobs_isRevoked = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Bool
isRevoked :: Maybe Bool
$sel:isRevoked:ListSigningJobs' :: ListSigningJobs -> Maybe Bool
isRevoked} -> Maybe Bool
isRevoked) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Bool
a -> ListSigningJobs
s {$sel:isRevoked:ListSigningJobs' :: Maybe Bool
isRevoked = Maybe Bool
a} :: ListSigningJobs)

-- | Filters results to return only signing jobs initiated by a specified IAM
-- entity.
listSigningJobs_jobInvoker :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Text)
listSigningJobs_jobInvoker :: Lens' ListSigningJobs (Maybe Text)
listSigningJobs_jobInvoker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Text
jobInvoker :: Maybe Text
$sel:jobInvoker:ListSigningJobs' :: ListSigningJobs -> Maybe Text
jobInvoker} -> Maybe Text
jobInvoker) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Text
a -> ListSigningJobs
s {$sel:jobInvoker:ListSigningJobs' :: Maybe Text
jobInvoker = Maybe Text
a} :: ListSigningJobs)

-- | Specifies the maximum number of items to return in the response. Use
-- this parameter when paginating results. If additional items exist beyond
-- the number you specify, the @nextToken@ element is set in the response.
-- Use the @nextToken@ value in a subsequent request to retrieve additional
-- items.
listSigningJobs_maxResults :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Natural)
listSigningJobs_maxResults :: Lens' ListSigningJobs (Maybe Natural)
listSigningJobs_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListSigningJobs' :: ListSigningJobs -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Natural
a -> ListSigningJobs
s {$sel:maxResults:ListSigningJobs' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListSigningJobs)

-- | String for specifying the next set of paginated results to return. After
-- you receive a response with truncated results, use this parameter in a
-- subsequent request. Set it to the value of @nextToken@ from the response
-- that you just received.
listSigningJobs_nextToken :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Text)
listSigningJobs_nextToken :: Lens' ListSigningJobs (Maybe Text)
listSigningJobs_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSigningJobs' :: ListSigningJobs -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Text
a -> ListSigningJobs
s {$sel:nextToken:ListSigningJobs' :: Maybe Text
nextToken = Maybe Text
a} :: ListSigningJobs)

-- | The ID of microcontroller platform that you specified for the
-- distribution of your code image.
listSigningJobs_platformId :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Text)
listSigningJobs_platformId :: Lens' ListSigningJobs (Maybe Text)
listSigningJobs_platformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Text
platformId :: Maybe Text
$sel:platformId:ListSigningJobs' :: ListSigningJobs -> Maybe Text
platformId} -> Maybe Text
platformId) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Text
a -> ListSigningJobs
s {$sel:platformId:ListSigningJobs' :: Maybe Text
platformId = Maybe Text
a} :: ListSigningJobs)

-- | The IAM principal that requested the signing job.
listSigningJobs_requestedBy :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.Text)
listSigningJobs_requestedBy :: Lens' ListSigningJobs (Maybe Text)
listSigningJobs_requestedBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe Text
requestedBy :: Maybe Text
$sel:requestedBy:ListSigningJobs' :: ListSigningJobs -> Maybe Text
requestedBy} -> Maybe Text
requestedBy) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe Text
a -> ListSigningJobs
s {$sel:requestedBy:ListSigningJobs' :: Maybe Text
requestedBy = Maybe Text
a} :: ListSigningJobs)

-- | Filters results to return only signing jobs with signatures expiring
-- after a specified timestamp.
listSigningJobs_signatureExpiresAfter :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.UTCTime)
listSigningJobs_signatureExpiresAfter :: Lens' ListSigningJobs (Maybe UTCTime)
listSigningJobs_signatureExpiresAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe POSIX
signatureExpiresAfter :: Maybe POSIX
$sel:signatureExpiresAfter:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
signatureExpiresAfter} -> Maybe POSIX
signatureExpiresAfter) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe POSIX
a -> ListSigningJobs
s {$sel:signatureExpiresAfter:ListSigningJobs' :: Maybe POSIX
signatureExpiresAfter = Maybe POSIX
a} :: ListSigningJobs) 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

-- | Filters results to return only signing jobs with signatures expiring
-- before a specified timestamp.
listSigningJobs_signatureExpiresBefore :: Lens.Lens' ListSigningJobs (Prelude.Maybe Prelude.UTCTime)
listSigningJobs_signatureExpiresBefore :: Lens' ListSigningJobs (Maybe UTCTime)
listSigningJobs_signatureExpiresBefore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe POSIX
signatureExpiresBefore :: Maybe POSIX
$sel:signatureExpiresBefore:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
signatureExpiresBefore} -> Maybe POSIX
signatureExpiresBefore) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe POSIX
a -> ListSigningJobs
s {$sel:signatureExpiresBefore:ListSigningJobs' :: Maybe POSIX
signatureExpiresBefore = Maybe POSIX
a} :: ListSigningJobs) 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

-- | A status value with which to filter your results.
listSigningJobs_status :: Lens.Lens' ListSigningJobs (Prelude.Maybe SigningStatus)
listSigningJobs_status :: Lens' ListSigningJobs (Maybe SigningStatus)
listSigningJobs_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobs' {Maybe SigningStatus
status :: Maybe SigningStatus
$sel:status:ListSigningJobs' :: ListSigningJobs -> Maybe SigningStatus
status} -> Maybe SigningStatus
status) (\s :: ListSigningJobs
s@ListSigningJobs' {} Maybe SigningStatus
a -> ListSigningJobs
s {$sel:status:ListSigningJobs' :: Maybe SigningStatus
status = Maybe SigningStatus
a} :: ListSigningJobs)

instance Core.AWSPager ListSigningJobs where
  page :: ListSigningJobs
-> AWSResponse ListSigningJobs -> Maybe ListSigningJobs
page ListSigningJobs
rq AWSResponse ListSigningJobs
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListSigningJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSigningJobsResponse (Maybe Text)
listSigningJobsResponse_nextToken
            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 ListSigningJobs
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSigningJobsResponse (Maybe [SigningJob])
listSigningJobsResponse_jobs
            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.$ ListSigningJobs
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListSigningJobs (Maybe Text)
listSigningJobs_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListSigningJobs
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListSigningJobsResponse (Maybe Text)
listSigningJobsResponse_nextToken
          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 ListSigningJobs where
  type
    AWSResponse ListSigningJobs =
      ListSigningJobsResponse
  request :: (Service -> Service) -> ListSigningJobs -> Request ListSigningJobs
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListSigningJobs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListSigningJobs)))
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 [SigningJob] -> Maybe Text -> Int -> ListSigningJobsResponse
ListSigningJobsResponse'
            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
"jobs" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"nextToken")
            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 ListSigningJobs where
  hashWithSalt :: Int -> ListSigningJobs -> Int
hashWithSalt Int
_salt ListSigningJobs' {Maybe Bool
Maybe Natural
Maybe Text
Maybe POSIX
Maybe SigningStatus
status :: Maybe SigningStatus
signatureExpiresBefore :: Maybe POSIX
signatureExpiresAfter :: Maybe POSIX
requestedBy :: Maybe Text
platformId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobInvoker :: Maybe Text
isRevoked :: Maybe Bool
$sel:status:ListSigningJobs' :: ListSigningJobs -> Maybe SigningStatus
$sel:signatureExpiresBefore:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:signatureExpiresAfter:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:requestedBy:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:platformId:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:nextToken:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:maxResults:ListSigningJobs' :: ListSigningJobs -> Maybe Natural
$sel:jobInvoker:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:isRevoked:ListSigningJobs' :: ListSigningJobs -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
isRevoked
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobInvoker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
platformId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestedBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
signatureExpiresAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
signatureExpiresBefore
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningStatus
status

instance Prelude.NFData ListSigningJobs where
  rnf :: ListSigningJobs -> ()
rnf ListSigningJobs' {Maybe Bool
Maybe Natural
Maybe Text
Maybe POSIX
Maybe SigningStatus
status :: Maybe SigningStatus
signatureExpiresBefore :: Maybe POSIX
signatureExpiresAfter :: Maybe POSIX
requestedBy :: Maybe Text
platformId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobInvoker :: Maybe Text
isRevoked :: Maybe Bool
$sel:status:ListSigningJobs' :: ListSigningJobs -> Maybe SigningStatus
$sel:signatureExpiresBefore:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:signatureExpiresAfter:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:requestedBy:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:platformId:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:nextToken:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:maxResults:ListSigningJobs' :: ListSigningJobs -> Maybe Natural
$sel:jobInvoker:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:isRevoked:ListSigningJobs' :: ListSigningJobs -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isRevoked
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobInvoker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
platformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestedBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
signatureExpiresAfter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
signatureExpiresBefore
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningStatus
status

instance Data.ToHeaders ListSigningJobs where
  toHeaders :: ListSigningJobs -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance Data.ToQuery ListSigningJobs where
  toQuery :: ListSigningJobs -> QueryString
toQuery ListSigningJobs' {Maybe Bool
Maybe Natural
Maybe Text
Maybe POSIX
Maybe SigningStatus
status :: Maybe SigningStatus
signatureExpiresBefore :: Maybe POSIX
signatureExpiresAfter :: Maybe POSIX
requestedBy :: Maybe Text
platformId :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
jobInvoker :: Maybe Text
isRevoked :: Maybe Bool
$sel:status:ListSigningJobs' :: ListSigningJobs -> Maybe SigningStatus
$sel:signatureExpiresBefore:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:signatureExpiresAfter:ListSigningJobs' :: ListSigningJobs -> Maybe POSIX
$sel:requestedBy:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:platformId:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:nextToken:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:maxResults:ListSigningJobs' :: ListSigningJobs -> Maybe Natural
$sel:jobInvoker:ListSigningJobs' :: ListSigningJobs -> Maybe Text
$sel:isRevoked:ListSigningJobs' :: ListSigningJobs -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"isRevoked" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
isRevoked,
        ByteString
"jobInvoker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
jobInvoker,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"platformId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
platformId,
        ByteString
"requestedBy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
requestedBy,
        ByteString
"signatureExpiresAfter"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
signatureExpiresAfter,
        ByteString
"signatureExpiresBefore"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
signatureExpiresBefore,
        ByteString
"status" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SigningStatus
status
      ]

-- | /See:/ 'newListSigningJobsResponse' smart constructor.
data ListSigningJobsResponse = ListSigningJobsResponse'
  { -- | A list of your signing jobs.
    ListSigningJobsResponse -> Maybe [SigningJob]
jobs :: Prelude.Maybe [SigningJob],
    -- | String for specifying the next set of paginated results.
    ListSigningJobsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListSigningJobsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListSigningJobsResponse -> ListSigningJobsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListSigningJobsResponse -> ListSigningJobsResponse -> Bool
$c/= :: ListSigningJobsResponse -> ListSigningJobsResponse -> Bool
== :: ListSigningJobsResponse -> ListSigningJobsResponse -> Bool
$c== :: ListSigningJobsResponse -> ListSigningJobsResponse -> Bool
Prelude.Eq, ReadPrec [ListSigningJobsResponse]
ReadPrec ListSigningJobsResponse
Int -> ReadS ListSigningJobsResponse
ReadS [ListSigningJobsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListSigningJobsResponse]
$creadListPrec :: ReadPrec [ListSigningJobsResponse]
readPrec :: ReadPrec ListSigningJobsResponse
$creadPrec :: ReadPrec ListSigningJobsResponse
readList :: ReadS [ListSigningJobsResponse]
$creadList :: ReadS [ListSigningJobsResponse]
readsPrec :: Int -> ReadS ListSigningJobsResponse
$creadsPrec :: Int -> ReadS ListSigningJobsResponse
Prelude.Read, Int -> ListSigningJobsResponse -> ShowS
[ListSigningJobsResponse] -> ShowS
ListSigningJobsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListSigningJobsResponse] -> ShowS
$cshowList :: [ListSigningJobsResponse] -> ShowS
show :: ListSigningJobsResponse -> String
$cshow :: ListSigningJobsResponse -> String
showsPrec :: Int -> ListSigningJobsResponse -> ShowS
$cshowsPrec :: Int -> ListSigningJobsResponse -> ShowS
Prelude.Show, forall x. Rep ListSigningJobsResponse x -> ListSigningJobsResponse
forall x. ListSigningJobsResponse -> Rep ListSigningJobsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListSigningJobsResponse x -> ListSigningJobsResponse
$cfrom :: forall x. ListSigningJobsResponse -> Rep ListSigningJobsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListSigningJobsResponse' 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:
--
-- 'jobs', 'listSigningJobsResponse_jobs' - A list of your signing jobs.
--
-- 'nextToken', 'listSigningJobsResponse_nextToken' - String for specifying the next set of paginated results.
--
-- 'httpStatus', 'listSigningJobsResponse_httpStatus' - The response's http status code.
newListSigningJobsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListSigningJobsResponse
newListSigningJobsResponse :: Int -> ListSigningJobsResponse
newListSigningJobsResponse Int
pHttpStatus_ =
  ListSigningJobsResponse'
    { $sel:jobs:ListSigningJobsResponse' :: Maybe [SigningJob]
jobs = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListSigningJobsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListSigningJobsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of your signing jobs.
listSigningJobsResponse_jobs :: Lens.Lens' ListSigningJobsResponse (Prelude.Maybe [SigningJob])
listSigningJobsResponse_jobs :: Lens' ListSigningJobsResponse (Maybe [SigningJob])
listSigningJobsResponse_jobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobsResponse' {Maybe [SigningJob]
jobs :: Maybe [SigningJob]
$sel:jobs:ListSigningJobsResponse' :: ListSigningJobsResponse -> Maybe [SigningJob]
jobs} -> Maybe [SigningJob]
jobs) (\s :: ListSigningJobsResponse
s@ListSigningJobsResponse' {} Maybe [SigningJob]
a -> ListSigningJobsResponse
s {$sel:jobs:ListSigningJobsResponse' :: Maybe [SigningJob]
jobs = Maybe [SigningJob]
a} :: ListSigningJobsResponse) 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

-- | String for specifying the next set of paginated results.
listSigningJobsResponse_nextToken :: Lens.Lens' ListSigningJobsResponse (Prelude.Maybe Prelude.Text)
listSigningJobsResponse_nextToken :: Lens' ListSigningJobsResponse (Maybe Text)
listSigningJobsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListSigningJobsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListSigningJobsResponse' :: ListSigningJobsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListSigningJobsResponse
s@ListSigningJobsResponse' {} Maybe Text
a -> ListSigningJobsResponse
s {$sel:nextToken:ListSigningJobsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListSigningJobsResponse)

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

instance Prelude.NFData ListSigningJobsResponse where
  rnf :: ListSigningJobsResponse -> ()
rnf ListSigningJobsResponse' {Int
Maybe [SigningJob]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
jobs :: Maybe [SigningJob]
$sel:httpStatus:ListSigningJobsResponse' :: ListSigningJobsResponse -> Int
$sel:nextToken:ListSigningJobsResponse' :: ListSigningJobsResponse -> Maybe Text
$sel:jobs:ListSigningJobsResponse' :: ListSigningJobsResponse -> Maybe [SigningJob]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SigningJob]
jobs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus