{-# 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.ImportExport.GetStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation returns information about a job, including where the job
-- is in the processing pipeline, the status of the results, and the
-- signature value associated with the job. You can only return information
-- about jobs you own.
module Amazonka.ImportExport.GetStatus
  ( -- * Creating a Request
    GetStatus (..),
    newGetStatus,

    -- * Request Lenses
    getStatus_aPIVersion,
    getStatus_jobId,

    -- * Destructuring the Response
    GetStatusResponse (..),
    newGetStatusResponse,

    -- * Response Lenses
    getStatusResponse_artifactList,
    getStatusResponse_carrier,
    getStatusResponse_creationDate,
    getStatusResponse_currentManifest,
    getStatusResponse_errorCount,
    getStatusResponse_jobId,
    getStatusResponse_jobType,
    getStatusResponse_locationCode,
    getStatusResponse_locationMessage,
    getStatusResponse_logBucket,
    getStatusResponse_logKey,
    getStatusResponse_progressCode,
    getStatusResponse_progressMessage,
    getStatusResponse_signature,
    getStatusResponse_signatureFileContents,
    getStatusResponse_trackingNumber,
    getStatusResponse_httpStatus,
  )
where

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

-- | Input structure for the GetStatus operation.
--
-- /See:/ 'newGetStatus' smart constructor.
data GetStatus = GetStatus'
  { GetStatus -> Maybe Text
aPIVersion :: Prelude.Maybe Prelude.Text,
    GetStatus -> Text
jobId :: Prelude.Text
  }
  deriving (GetStatus -> GetStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStatus -> GetStatus -> Bool
$c/= :: GetStatus -> GetStatus -> Bool
== :: GetStatus -> GetStatus -> Bool
$c== :: GetStatus -> GetStatus -> Bool
Prelude.Eq, ReadPrec [GetStatus]
ReadPrec GetStatus
Int -> ReadS GetStatus
ReadS [GetStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStatus]
$creadListPrec :: ReadPrec [GetStatus]
readPrec :: ReadPrec GetStatus
$creadPrec :: ReadPrec GetStatus
readList :: ReadS [GetStatus]
$creadList :: ReadS [GetStatus]
readsPrec :: Int -> ReadS GetStatus
$creadsPrec :: Int -> ReadS GetStatus
Prelude.Read, Int -> GetStatus -> ShowS
[GetStatus] -> ShowS
GetStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStatus] -> ShowS
$cshowList :: [GetStatus] -> ShowS
show :: GetStatus -> String
$cshow :: GetStatus -> String
showsPrec :: Int -> GetStatus -> ShowS
$cshowsPrec :: Int -> GetStatus -> ShowS
Prelude.Show, forall x. Rep GetStatus x -> GetStatus
forall x. GetStatus -> Rep GetStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStatus x -> GetStatus
$cfrom :: forall x. GetStatus -> Rep GetStatus x
Prelude.Generic)

-- |
-- Create a value of 'GetStatus' 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:
--
-- 'aPIVersion', 'getStatus_aPIVersion' - Undocumented member.
--
-- 'jobId', 'getStatus_jobId' - Undocumented member.
newGetStatus ::
  -- | 'jobId'
  Prelude.Text ->
  GetStatus
newGetStatus :: Text -> GetStatus
newGetStatus Text
pJobId_ =
  GetStatus'
    { $sel:aPIVersion:GetStatus' :: Maybe Text
aPIVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetStatus' :: Text
jobId = Text
pJobId_
    }

-- | Undocumented member.
getStatus_aPIVersion :: Lens.Lens' GetStatus (Prelude.Maybe Prelude.Text)
getStatus_aPIVersion :: Lens' GetStatus (Maybe Text)
getStatus_aPIVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatus' {Maybe Text
aPIVersion :: Maybe Text
$sel:aPIVersion:GetStatus' :: GetStatus -> Maybe Text
aPIVersion} -> Maybe Text
aPIVersion) (\s :: GetStatus
s@GetStatus' {} Maybe Text
a -> GetStatus
s {$sel:aPIVersion:GetStatus' :: Maybe Text
aPIVersion = Maybe Text
a} :: GetStatus)

-- | Undocumented member.
getStatus_jobId :: Lens.Lens' GetStatus Prelude.Text
getStatus_jobId :: Lens' GetStatus Text
getStatus_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatus' {Text
jobId :: Text
$sel:jobId:GetStatus' :: GetStatus -> Text
jobId} -> Text
jobId) (\s :: GetStatus
s@GetStatus' {} Text
a -> GetStatus
s {$sel:jobId:GetStatus' :: Text
jobId = Text
a} :: GetStatus)

instance Core.AWSRequest GetStatus where
  type AWSResponse GetStatus = GetStatusResponse
  request :: (Service -> Service) -> GetStatus -> Request GetStatus
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetStatus
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetStatus)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetStatusResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Artifact]
-> Maybe Text
-> Maybe ISO8601
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe JobType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetStatusResponse
GetStatusResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ArtifactList"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Carrier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CreationDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CurrentManifest")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ErrorCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"JobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"JobType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LocationCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LocationMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LogBucket")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LogKey")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ProgressCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ProgressMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Signature")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"SignatureFileContents")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TrackingNumber")
            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 GetStatus where
  hashWithSalt :: Int -> GetStatus -> Int
hashWithSalt Int
_salt GetStatus' {Maybe Text
Text
jobId :: Text
aPIVersion :: Maybe Text
$sel:jobId:GetStatus' :: GetStatus -> Text
$sel:aPIVersion:GetStatus' :: GetStatus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
aPIVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance Prelude.NFData GetStatus where
  rnf :: GetStatus -> ()
rnf GetStatus' {Maybe Text
Text
jobId :: Text
aPIVersion :: Maybe Text
$sel:jobId:GetStatus' :: GetStatus -> Text
$sel:aPIVersion:GetStatus' :: GetStatus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
aPIVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders GetStatus where
  toHeaders :: GetStatus -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetStatus where
  toQuery :: GetStatus -> QueryString
toQuery GetStatus' {Maybe Text
Text
jobId :: Text
aPIVersion :: Maybe Text
$sel:jobId:GetStatus' :: GetStatus -> Text
$sel:aPIVersion:GetStatus' :: GetStatus -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ QueryString
"Operation=GetStatus",
        ByteString
"Action" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetStatus" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-06-01" :: Prelude.ByteString),
        ByteString
"APIVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
aPIVersion,
        ByteString
"JobId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
jobId
      ]

-- | Output structure for the GetStatus operation.
--
-- /See:/ 'newGetStatusResponse' smart constructor.
data GetStatusResponse = GetStatusResponse'
  { GetStatusResponse -> Maybe [Artifact]
artifactList :: Prelude.Maybe [Artifact],
    GetStatusResponse -> Maybe Text
carrier :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe ISO8601
creationDate :: Prelude.Maybe Data.ISO8601,
    GetStatusResponse -> Maybe Text
currentManifest :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Int
errorCount :: Prelude.Maybe Prelude.Int,
    GetStatusResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe JobType
jobType :: Prelude.Maybe JobType,
    GetStatusResponse -> Maybe Text
locationCode :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
locationMessage :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
logBucket :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
logKey :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
progressCode :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
progressMessage :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
signature :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
signatureFileContents :: Prelude.Maybe Prelude.Text,
    GetStatusResponse -> Maybe Text
trackingNumber :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetStatusResponse -> GetStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStatusResponse -> GetStatusResponse -> Bool
$c/= :: GetStatusResponse -> GetStatusResponse -> Bool
== :: GetStatusResponse -> GetStatusResponse -> Bool
$c== :: GetStatusResponse -> GetStatusResponse -> Bool
Prelude.Eq, ReadPrec [GetStatusResponse]
ReadPrec GetStatusResponse
Int -> ReadS GetStatusResponse
ReadS [GetStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStatusResponse]
$creadListPrec :: ReadPrec [GetStatusResponse]
readPrec :: ReadPrec GetStatusResponse
$creadPrec :: ReadPrec GetStatusResponse
readList :: ReadS [GetStatusResponse]
$creadList :: ReadS [GetStatusResponse]
readsPrec :: Int -> ReadS GetStatusResponse
$creadsPrec :: Int -> ReadS GetStatusResponse
Prelude.Read, Int -> GetStatusResponse -> ShowS
[GetStatusResponse] -> ShowS
GetStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStatusResponse] -> ShowS
$cshowList :: [GetStatusResponse] -> ShowS
show :: GetStatusResponse -> String
$cshow :: GetStatusResponse -> String
showsPrec :: Int -> GetStatusResponse -> ShowS
$cshowsPrec :: Int -> GetStatusResponse -> ShowS
Prelude.Show, forall x. Rep GetStatusResponse x -> GetStatusResponse
forall x. GetStatusResponse -> Rep GetStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStatusResponse x -> GetStatusResponse
$cfrom :: forall x. GetStatusResponse -> Rep GetStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStatusResponse' 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:
--
-- 'artifactList', 'getStatusResponse_artifactList' - Undocumented member.
--
-- 'carrier', 'getStatusResponse_carrier' - Undocumented member.
--
-- 'creationDate', 'getStatusResponse_creationDate' - Undocumented member.
--
-- 'currentManifest', 'getStatusResponse_currentManifest' - Undocumented member.
--
-- 'errorCount', 'getStatusResponse_errorCount' - Undocumented member.
--
-- 'jobId', 'getStatusResponse_jobId' - Undocumented member.
--
-- 'jobType', 'getStatusResponse_jobType' - Undocumented member.
--
-- 'locationCode', 'getStatusResponse_locationCode' - Undocumented member.
--
-- 'locationMessage', 'getStatusResponse_locationMessage' - Undocumented member.
--
-- 'logBucket', 'getStatusResponse_logBucket' - Undocumented member.
--
-- 'logKey', 'getStatusResponse_logKey' - Undocumented member.
--
-- 'progressCode', 'getStatusResponse_progressCode' - Undocumented member.
--
-- 'progressMessage', 'getStatusResponse_progressMessage' - Undocumented member.
--
-- 'signature', 'getStatusResponse_signature' - Undocumented member.
--
-- 'signatureFileContents', 'getStatusResponse_signatureFileContents' - Undocumented member.
--
-- 'trackingNumber', 'getStatusResponse_trackingNumber' - Undocumented member.
--
-- 'httpStatus', 'getStatusResponse_httpStatus' - The response's http status code.
newGetStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStatusResponse
newGetStatusResponse :: Int -> GetStatusResponse
newGetStatusResponse Int
pHttpStatus_ =
  GetStatusResponse'
    { $sel:artifactList:GetStatusResponse' :: Maybe [Artifact]
artifactList = forall a. Maybe a
Prelude.Nothing,
      $sel:carrier:GetStatusResponse' :: Maybe Text
carrier = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:GetStatusResponse' :: Maybe ISO8601
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:currentManifest:GetStatusResponse' :: Maybe Text
currentManifest = forall a. Maybe a
Prelude.Nothing,
      $sel:errorCount:GetStatusResponse' :: Maybe Int
errorCount = forall a. Maybe a
Prelude.Nothing,
      $sel:jobId:GetStatusResponse' :: Maybe Text
jobId = forall a. Maybe a
Prelude.Nothing,
      $sel:jobType:GetStatusResponse' :: Maybe JobType
jobType = forall a. Maybe a
Prelude.Nothing,
      $sel:locationCode:GetStatusResponse' :: Maybe Text
locationCode = forall a. Maybe a
Prelude.Nothing,
      $sel:locationMessage:GetStatusResponse' :: Maybe Text
locationMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:logBucket:GetStatusResponse' :: Maybe Text
logBucket = forall a. Maybe a
Prelude.Nothing,
      $sel:logKey:GetStatusResponse' :: Maybe Text
logKey = forall a. Maybe a
Prelude.Nothing,
      $sel:progressCode:GetStatusResponse' :: Maybe Text
progressCode = forall a. Maybe a
Prelude.Nothing,
      $sel:progressMessage:GetStatusResponse' :: Maybe Text
progressMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:signature:GetStatusResponse' :: Maybe Text
signature = forall a. Maybe a
Prelude.Nothing,
      $sel:signatureFileContents:GetStatusResponse' :: Maybe Text
signatureFileContents = forall a. Maybe a
Prelude.Nothing,
      $sel:trackingNumber:GetStatusResponse' :: Maybe Text
trackingNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getStatusResponse_artifactList :: Lens.Lens' GetStatusResponse (Prelude.Maybe [Artifact])
getStatusResponse_artifactList :: Lens' GetStatusResponse (Maybe [Artifact])
getStatusResponse_artifactList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe [Artifact]
artifactList :: Maybe [Artifact]
$sel:artifactList:GetStatusResponse' :: GetStatusResponse -> Maybe [Artifact]
artifactList} -> Maybe [Artifact]
artifactList) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe [Artifact]
a -> GetStatusResponse
s {$sel:artifactList:GetStatusResponse' :: Maybe [Artifact]
artifactList = Maybe [Artifact]
a} :: GetStatusResponse) 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

-- | Undocumented member.
getStatusResponse_carrier :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_carrier :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_carrier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
carrier :: Maybe Text
$sel:carrier:GetStatusResponse' :: GetStatusResponse -> Maybe Text
carrier} -> Maybe Text
carrier) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:carrier:GetStatusResponse' :: Maybe Text
carrier = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_creationDate :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.UTCTime)
getStatusResponse_creationDate :: Lens' GetStatusResponse (Maybe UTCTime)
getStatusResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe ISO8601
creationDate :: Maybe ISO8601
$sel:creationDate:GetStatusResponse' :: GetStatusResponse -> Maybe ISO8601
creationDate} -> Maybe ISO8601
creationDate) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe ISO8601
a -> GetStatusResponse
s {$sel:creationDate:GetStatusResponse' :: Maybe ISO8601
creationDate = Maybe ISO8601
a} :: GetStatusResponse) 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

-- | Undocumented member.
getStatusResponse_currentManifest :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_currentManifest :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_currentManifest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
currentManifest :: Maybe Text
$sel:currentManifest:GetStatusResponse' :: GetStatusResponse -> Maybe Text
currentManifest} -> Maybe Text
currentManifest) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:currentManifest:GetStatusResponse' :: Maybe Text
currentManifest = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_errorCount :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Int)
getStatusResponse_errorCount :: Lens' GetStatusResponse (Maybe Int)
getStatusResponse_errorCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Int
errorCount :: Maybe Int
$sel:errorCount:GetStatusResponse' :: GetStatusResponse -> Maybe Int
errorCount} -> Maybe Int
errorCount) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Int
a -> GetStatusResponse
s {$sel:errorCount:GetStatusResponse' :: Maybe Int
errorCount = Maybe Int
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_jobId :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_jobId :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:GetStatusResponse' :: GetStatusResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:jobId:GetStatusResponse' :: Maybe Text
jobId = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_jobType :: Lens.Lens' GetStatusResponse (Prelude.Maybe JobType)
getStatusResponse_jobType :: Lens' GetStatusResponse (Maybe JobType)
getStatusResponse_jobType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe JobType
jobType :: Maybe JobType
$sel:jobType:GetStatusResponse' :: GetStatusResponse -> Maybe JobType
jobType} -> Maybe JobType
jobType) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe JobType
a -> GetStatusResponse
s {$sel:jobType:GetStatusResponse' :: Maybe JobType
jobType = Maybe JobType
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_locationCode :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_locationCode :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_locationCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
locationCode :: Maybe Text
$sel:locationCode:GetStatusResponse' :: GetStatusResponse -> Maybe Text
locationCode} -> Maybe Text
locationCode) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:locationCode:GetStatusResponse' :: Maybe Text
locationCode = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_locationMessage :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_locationMessage :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_locationMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
locationMessage :: Maybe Text
$sel:locationMessage:GetStatusResponse' :: GetStatusResponse -> Maybe Text
locationMessage} -> Maybe Text
locationMessage) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:locationMessage:GetStatusResponse' :: Maybe Text
locationMessage = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_logBucket :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_logBucket :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_logBucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
logBucket :: Maybe Text
$sel:logBucket:GetStatusResponse' :: GetStatusResponse -> Maybe Text
logBucket} -> Maybe Text
logBucket) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:logBucket:GetStatusResponse' :: Maybe Text
logBucket = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_logKey :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_logKey :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_logKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
logKey :: Maybe Text
$sel:logKey:GetStatusResponse' :: GetStatusResponse -> Maybe Text
logKey} -> Maybe Text
logKey) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:logKey:GetStatusResponse' :: Maybe Text
logKey = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_progressCode :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_progressCode :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_progressCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
progressCode :: Maybe Text
$sel:progressCode:GetStatusResponse' :: GetStatusResponse -> Maybe Text
progressCode} -> Maybe Text
progressCode) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:progressCode:GetStatusResponse' :: Maybe Text
progressCode = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_progressMessage :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_progressMessage :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_progressMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
progressMessage :: Maybe Text
$sel:progressMessage:GetStatusResponse' :: GetStatusResponse -> Maybe Text
progressMessage} -> Maybe Text
progressMessage) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:progressMessage:GetStatusResponse' :: Maybe Text
progressMessage = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_signature :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_signature :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_signature = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
signature :: Maybe Text
$sel:signature:GetStatusResponse' :: GetStatusResponse -> Maybe Text
signature} -> Maybe Text
signature) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:signature:GetStatusResponse' :: Maybe Text
signature = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_signatureFileContents :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_signatureFileContents :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_signatureFileContents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
signatureFileContents :: Maybe Text
$sel:signatureFileContents:GetStatusResponse' :: GetStatusResponse -> Maybe Text
signatureFileContents} -> Maybe Text
signatureFileContents) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:signatureFileContents:GetStatusResponse' :: Maybe Text
signatureFileContents = Maybe Text
a} :: GetStatusResponse)

-- | Undocumented member.
getStatusResponse_trackingNumber :: Lens.Lens' GetStatusResponse (Prelude.Maybe Prelude.Text)
getStatusResponse_trackingNumber :: Lens' GetStatusResponse (Maybe Text)
getStatusResponse_trackingNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStatusResponse' {Maybe Text
trackingNumber :: Maybe Text
$sel:trackingNumber:GetStatusResponse' :: GetStatusResponse -> Maybe Text
trackingNumber} -> Maybe Text
trackingNumber) (\s :: GetStatusResponse
s@GetStatusResponse' {} Maybe Text
a -> GetStatusResponse
s {$sel:trackingNumber:GetStatusResponse' :: Maybe Text
trackingNumber = Maybe Text
a} :: GetStatusResponse)

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

instance Prelude.NFData GetStatusResponse where
  rnf :: GetStatusResponse -> ()
rnf GetStatusResponse' {Int
Maybe Int
Maybe [Artifact]
Maybe Text
Maybe ISO8601
Maybe JobType
httpStatus :: Int
trackingNumber :: Maybe Text
signatureFileContents :: Maybe Text
signature :: Maybe Text
progressMessage :: Maybe Text
progressCode :: Maybe Text
logKey :: Maybe Text
logBucket :: Maybe Text
locationMessage :: Maybe Text
locationCode :: Maybe Text
jobType :: Maybe JobType
jobId :: Maybe Text
errorCount :: Maybe Int
currentManifest :: Maybe Text
creationDate :: Maybe ISO8601
carrier :: Maybe Text
artifactList :: Maybe [Artifact]
$sel:httpStatus:GetStatusResponse' :: GetStatusResponse -> Int
$sel:trackingNumber:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:signatureFileContents:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:signature:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:progressMessage:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:progressCode:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:logKey:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:logBucket:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:locationMessage:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:locationCode:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:jobType:GetStatusResponse' :: GetStatusResponse -> Maybe JobType
$sel:jobId:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:errorCount:GetStatusResponse' :: GetStatusResponse -> Maybe Int
$sel:currentManifest:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:creationDate:GetStatusResponse' :: GetStatusResponse -> Maybe ISO8601
$sel:carrier:GetStatusResponse' :: GetStatusResponse -> Maybe Text
$sel:artifactList:GetStatusResponse' :: GetStatusResponse -> Maybe [Artifact]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Artifact]
artifactList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
carrier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
currentManifest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
errorCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe JobType
jobType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
locationCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
locationMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logBucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
progressCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
progressMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signature
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
signatureFileContents
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
trackingNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus