{-# 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.Snowball.DescribeReturnShippingLabel
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Information on the shipping label of a Snow device that is being
-- returned to Amazon Web Services.
module Amazonka.Snowball.DescribeReturnShippingLabel
  ( -- * Creating a Request
    DescribeReturnShippingLabel (..),
    newDescribeReturnShippingLabel,

    -- * Request Lenses
    describeReturnShippingLabel_jobId,

    -- * Destructuring the Response
    DescribeReturnShippingLabelResponse (..),
    newDescribeReturnShippingLabelResponse,

    -- * Response Lenses
    describeReturnShippingLabelResponse_expirationDate,
    describeReturnShippingLabelResponse_returnShippingLabelURI,
    describeReturnShippingLabelResponse_status,
    describeReturnShippingLabelResponse_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.Snowball.Types

-- | /See:/ 'newDescribeReturnShippingLabel' smart constructor.
data DescribeReturnShippingLabel = DescribeReturnShippingLabel'
  { -- | The automatically generated ID for a job, for example
    -- @JID123e4567-e89b-12d3-a456-426655440000@.
    DescribeReturnShippingLabel -> Text
jobId :: Prelude.Text
  }
  deriving (DescribeReturnShippingLabel -> DescribeReturnShippingLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeReturnShippingLabel -> DescribeReturnShippingLabel -> Bool
$c/= :: DescribeReturnShippingLabel -> DescribeReturnShippingLabel -> Bool
== :: DescribeReturnShippingLabel -> DescribeReturnShippingLabel -> Bool
$c== :: DescribeReturnShippingLabel -> DescribeReturnShippingLabel -> Bool
Prelude.Eq, ReadPrec [DescribeReturnShippingLabel]
ReadPrec DescribeReturnShippingLabel
Int -> ReadS DescribeReturnShippingLabel
ReadS [DescribeReturnShippingLabel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeReturnShippingLabel]
$creadListPrec :: ReadPrec [DescribeReturnShippingLabel]
readPrec :: ReadPrec DescribeReturnShippingLabel
$creadPrec :: ReadPrec DescribeReturnShippingLabel
readList :: ReadS [DescribeReturnShippingLabel]
$creadList :: ReadS [DescribeReturnShippingLabel]
readsPrec :: Int -> ReadS DescribeReturnShippingLabel
$creadsPrec :: Int -> ReadS DescribeReturnShippingLabel
Prelude.Read, Int -> DescribeReturnShippingLabel -> ShowS
[DescribeReturnShippingLabel] -> ShowS
DescribeReturnShippingLabel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeReturnShippingLabel] -> ShowS
$cshowList :: [DescribeReturnShippingLabel] -> ShowS
show :: DescribeReturnShippingLabel -> String
$cshow :: DescribeReturnShippingLabel -> String
showsPrec :: Int -> DescribeReturnShippingLabel -> ShowS
$cshowsPrec :: Int -> DescribeReturnShippingLabel -> ShowS
Prelude.Show, forall x.
Rep DescribeReturnShippingLabel x -> DescribeReturnShippingLabel
forall x.
DescribeReturnShippingLabel -> Rep DescribeReturnShippingLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeReturnShippingLabel x -> DescribeReturnShippingLabel
$cfrom :: forall x.
DescribeReturnShippingLabel -> Rep DescribeReturnShippingLabel x
Prelude.Generic)

-- |
-- Create a value of 'DescribeReturnShippingLabel' 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:
--
-- 'jobId', 'describeReturnShippingLabel_jobId' - The automatically generated ID for a job, for example
-- @JID123e4567-e89b-12d3-a456-426655440000@.
newDescribeReturnShippingLabel ::
  -- | 'jobId'
  Prelude.Text ->
  DescribeReturnShippingLabel
newDescribeReturnShippingLabel :: Text -> DescribeReturnShippingLabel
newDescribeReturnShippingLabel Text
pJobId_ =
  DescribeReturnShippingLabel' {$sel:jobId:DescribeReturnShippingLabel' :: Text
jobId = Text
pJobId_}

-- | The automatically generated ID for a job, for example
-- @JID123e4567-e89b-12d3-a456-426655440000@.
describeReturnShippingLabel_jobId :: Lens.Lens' DescribeReturnShippingLabel Prelude.Text
describeReturnShippingLabel_jobId :: Lens' DescribeReturnShippingLabel Text
describeReturnShippingLabel_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReturnShippingLabel' {Text
jobId :: Text
$sel:jobId:DescribeReturnShippingLabel' :: DescribeReturnShippingLabel -> Text
jobId} -> Text
jobId) (\s :: DescribeReturnShippingLabel
s@DescribeReturnShippingLabel' {} Text
a -> DescribeReturnShippingLabel
s {$sel:jobId:DescribeReturnShippingLabel' :: Text
jobId = Text
a} :: DescribeReturnShippingLabel)

instance Core.AWSRequest DescribeReturnShippingLabel where
  type
    AWSResponse DescribeReturnShippingLabel =
      DescribeReturnShippingLabelResponse
  request :: (Service -> Service)
-> DescribeReturnShippingLabel
-> Request DescribeReturnShippingLabel
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 DescribeReturnShippingLabel
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeReturnShippingLabel)))
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 POSIX
-> Maybe Text
-> Maybe ShippingLabelStatus
-> Int
-> DescribeReturnShippingLabelResponse
DescribeReturnShippingLabelResponse'
            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
"ExpirationDate")
            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
"ReturnShippingLabelURI")
            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
"Status")
            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 DescribeReturnShippingLabel where
  hashWithSalt :: Int -> DescribeReturnShippingLabel -> Int
hashWithSalt Int
_salt DescribeReturnShippingLabel' {Text
jobId :: Text
$sel:jobId:DescribeReturnShippingLabel' :: DescribeReturnShippingLabel -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

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

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

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

-- | /See:/ 'newDescribeReturnShippingLabelResponse' smart constructor.
data DescribeReturnShippingLabelResponse = DescribeReturnShippingLabelResponse'
  { -- | The expiration date of the current return shipping label.
    DescribeReturnShippingLabelResponse -> Maybe POSIX
expirationDate :: Prelude.Maybe Data.POSIX,
    -- | The pre-signed Amazon S3 URI used to download the return shipping label.
    DescribeReturnShippingLabelResponse -> Maybe Text
returnShippingLabelURI :: Prelude.Maybe Prelude.Text,
    -- | The status information of the task on a Snow device that is being
    -- returned to Amazon Web Services.
    DescribeReturnShippingLabelResponse -> Maybe ShippingLabelStatus
status :: Prelude.Maybe ShippingLabelStatus,
    -- | The response's http status code.
    DescribeReturnShippingLabelResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeReturnShippingLabelResponse
-> DescribeReturnShippingLabelResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeReturnShippingLabelResponse
-> DescribeReturnShippingLabelResponse -> Bool
$c/= :: DescribeReturnShippingLabelResponse
-> DescribeReturnShippingLabelResponse -> Bool
== :: DescribeReturnShippingLabelResponse
-> DescribeReturnShippingLabelResponse -> Bool
$c== :: DescribeReturnShippingLabelResponse
-> DescribeReturnShippingLabelResponse -> Bool
Prelude.Eq, ReadPrec [DescribeReturnShippingLabelResponse]
ReadPrec DescribeReturnShippingLabelResponse
Int -> ReadS DescribeReturnShippingLabelResponse
ReadS [DescribeReturnShippingLabelResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeReturnShippingLabelResponse]
$creadListPrec :: ReadPrec [DescribeReturnShippingLabelResponse]
readPrec :: ReadPrec DescribeReturnShippingLabelResponse
$creadPrec :: ReadPrec DescribeReturnShippingLabelResponse
readList :: ReadS [DescribeReturnShippingLabelResponse]
$creadList :: ReadS [DescribeReturnShippingLabelResponse]
readsPrec :: Int -> ReadS DescribeReturnShippingLabelResponse
$creadsPrec :: Int -> ReadS DescribeReturnShippingLabelResponse
Prelude.Read, Int -> DescribeReturnShippingLabelResponse -> ShowS
[DescribeReturnShippingLabelResponse] -> ShowS
DescribeReturnShippingLabelResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeReturnShippingLabelResponse] -> ShowS
$cshowList :: [DescribeReturnShippingLabelResponse] -> ShowS
show :: DescribeReturnShippingLabelResponse -> String
$cshow :: DescribeReturnShippingLabelResponse -> String
showsPrec :: Int -> DescribeReturnShippingLabelResponse -> ShowS
$cshowsPrec :: Int -> DescribeReturnShippingLabelResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeReturnShippingLabelResponse x
-> DescribeReturnShippingLabelResponse
forall x.
DescribeReturnShippingLabelResponse
-> Rep DescribeReturnShippingLabelResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeReturnShippingLabelResponse x
-> DescribeReturnShippingLabelResponse
$cfrom :: forall x.
DescribeReturnShippingLabelResponse
-> Rep DescribeReturnShippingLabelResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeReturnShippingLabelResponse' 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:
--
-- 'expirationDate', 'describeReturnShippingLabelResponse_expirationDate' - The expiration date of the current return shipping label.
--
-- 'returnShippingLabelURI', 'describeReturnShippingLabelResponse_returnShippingLabelURI' - The pre-signed Amazon S3 URI used to download the return shipping label.
--
-- 'status', 'describeReturnShippingLabelResponse_status' - The status information of the task on a Snow device that is being
-- returned to Amazon Web Services.
--
-- 'httpStatus', 'describeReturnShippingLabelResponse_httpStatus' - The response's http status code.
newDescribeReturnShippingLabelResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeReturnShippingLabelResponse
newDescribeReturnShippingLabelResponse :: Int -> DescribeReturnShippingLabelResponse
newDescribeReturnShippingLabelResponse Int
pHttpStatus_ =
  DescribeReturnShippingLabelResponse'
    { $sel:expirationDate:DescribeReturnShippingLabelResponse' :: Maybe POSIX
expirationDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:returnShippingLabelURI:DescribeReturnShippingLabelResponse' :: Maybe Text
returnShippingLabelURI =
        forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeReturnShippingLabelResponse' :: Maybe ShippingLabelStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeReturnShippingLabelResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The expiration date of the current return shipping label.
describeReturnShippingLabelResponse_expirationDate :: Lens.Lens' DescribeReturnShippingLabelResponse (Prelude.Maybe Prelude.UTCTime)
describeReturnShippingLabelResponse_expirationDate :: Lens' DescribeReturnShippingLabelResponse (Maybe UTCTime)
describeReturnShippingLabelResponse_expirationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReturnShippingLabelResponse' {Maybe POSIX
expirationDate :: Maybe POSIX
$sel:expirationDate:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe POSIX
expirationDate} -> Maybe POSIX
expirationDate) (\s :: DescribeReturnShippingLabelResponse
s@DescribeReturnShippingLabelResponse' {} Maybe POSIX
a -> DescribeReturnShippingLabelResponse
s {$sel:expirationDate:DescribeReturnShippingLabelResponse' :: Maybe POSIX
expirationDate = Maybe POSIX
a} :: DescribeReturnShippingLabelResponse) 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 pre-signed Amazon S3 URI used to download the return shipping label.
describeReturnShippingLabelResponse_returnShippingLabelURI :: Lens.Lens' DescribeReturnShippingLabelResponse (Prelude.Maybe Prelude.Text)
describeReturnShippingLabelResponse_returnShippingLabelURI :: Lens' DescribeReturnShippingLabelResponse (Maybe Text)
describeReturnShippingLabelResponse_returnShippingLabelURI = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReturnShippingLabelResponse' {Maybe Text
returnShippingLabelURI :: Maybe Text
$sel:returnShippingLabelURI:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe Text
returnShippingLabelURI} -> Maybe Text
returnShippingLabelURI) (\s :: DescribeReturnShippingLabelResponse
s@DescribeReturnShippingLabelResponse' {} Maybe Text
a -> DescribeReturnShippingLabelResponse
s {$sel:returnShippingLabelURI:DescribeReturnShippingLabelResponse' :: Maybe Text
returnShippingLabelURI = Maybe Text
a} :: DescribeReturnShippingLabelResponse)

-- | The status information of the task on a Snow device that is being
-- returned to Amazon Web Services.
describeReturnShippingLabelResponse_status :: Lens.Lens' DescribeReturnShippingLabelResponse (Prelude.Maybe ShippingLabelStatus)
describeReturnShippingLabelResponse_status :: Lens'
  DescribeReturnShippingLabelResponse (Maybe ShippingLabelStatus)
describeReturnShippingLabelResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeReturnShippingLabelResponse' {Maybe ShippingLabelStatus
status :: Maybe ShippingLabelStatus
$sel:status:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe ShippingLabelStatus
status} -> Maybe ShippingLabelStatus
status) (\s :: DescribeReturnShippingLabelResponse
s@DescribeReturnShippingLabelResponse' {} Maybe ShippingLabelStatus
a -> DescribeReturnShippingLabelResponse
s {$sel:status:DescribeReturnShippingLabelResponse' :: Maybe ShippingLabelStatus
status = Maybe ShippingLabelStatus
a} :: DescribeReturnShippingLabelResponse)

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

instance
  Prelude.NFData
    DescribeReturnShippingLabelResponse
  where
  rnf :: DescribeReturnShippingLabelResponse -> ()
rnf DescribeReturnShippingLabelResponse' {Int
Maybe Text
Maybe POSIX
Maybe ShippingLabelStatus
httpStatus :: Int
status :: Maybe ShippingLabelStatus
returnShippingLabelURI :: Maybe Text
expirationDate :: Maybe POSIX
$sel:httpStatus:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Int
$sel:status:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe ShippingLabelStatus
$sel:returnShippingLabelURI:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe Text
$sel:expirationDate:DescribeReturnShippingLabelResponse' :: DescribeReturnShippingLabelResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
expirationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
returnShippingLabelURI
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ShippingLabelStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus