{-# 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.UpdateJobShipmentState
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the state when a shipment state changes to a different state.
module Amazonka.Snowball.UpdateJobShipmentState
  ( -- * Creating a Request
    UpdateJobShipmentState (..),
    newUpdateJobShipmentState,

    -- * Request Lenses
    updateJobShipmentState_jobId,
    updateJobShipmentState_shipmentState,

    -- * Destructuring the Response
    UpdateJobShipmentStateResponse (..),
    newUpdateJobShipmentStateResponse,

    -- * Response Lenses
    updateJobShipmentStateResponse_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:/ 'newUpdateJobShipmentState' smart constructor.
data UpdateJobShipmentState = UpdateJobShipmentState'
  { -- | The job ID of the job whose shipment date you want to update, for
    -- example @JID123e4567-e89b-12d3-a456-426655440000@.
    UpdateJobShipmentState -> Text
jobId :: Prelude.Text,
    -- | The state of a device when it is being shipped.
    --
    -- Set to @RECEIVED@ when the device arrives at your location.
    --
    -- Set to @RETURNED@ when you have returned the device to Amazon Web
    -- Services.
    UpdateJobShipmentState -> ShipmentState
shipmentState :: ShipmentState
  }
  deriving (UpdateJobShipmentState -> UpdateJobShipmentState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateJobShipmentState -> UpdateJobShipmentState -> Bool
$c/= :: UpdateJobShipmentState -> UpdateJobShipmentState -> Bool
== :: UpdateJobShipmentState -> UpdateJobShipmentState -> Bool
$c== :: UpdateJobShipmentState -> UpdateJobShipmentState -> Bool
Prelude.Eq, ReadPrec [UpdateJobShipmentState]
ReadPrec UpdateJobShipmentState
Int -> ReadS UpdateJobShipmentState
ReadS [UpdateJobShipmentState]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateJobShipmentState]
$creadListPrec :: ReadPrec [UpdateJobShipmentState]
readPrec :: ReadPrec UpdateJobShipmentState
$creadPrec :: ReadPrec UpdateJobShipmentState
readList :: ReadS [UpdateJobShipmentState]
$creadList :: ReadS [UpdateJobShipmentState]
readsPrec :: Int -> ReadS UpdateJobShipmentState
$creadsPrec :: Int -> ReadS UpdateJobShipmentState
Prelude.Read, Int -> UpdateJobShipmentState -> ShowS
[UpdateJobShipmentState] -> ShowS
UpdateJobShipmentState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateJobShipmentState] -> ShowS
$cshowList :: [UpdateJobShipmentState] -> ShowS
show :: UpdateJobShipmentState -> String
$cshow :: UpdateJobShipmentState -> String
showsPrec :: Int -> UpdateJobShipmentState -> ShowS
$cshowsPrec :: Int -> UpdateJobShipmentState -> ShowS
Prelude.Show, forall x. Rep UpdateJobShipmentState x -> UpdateJobShipmentState
forall x. UpdateJobShipmentState -> Rep UpdateJobShipmentState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateJobShipmentState x -> UpdateJobShipmentState
$cfrom :: forall x. UpdateJobShipmentState -> Rep UpdateJobShipmentState x
Prelude.Generic)

-- |
-- Create a value of 'UpdateJobShipmentState' 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', 'updateJobShipmentState_jobId' - The job ID of the job whose shipment date you want to update, for
-- example @JID123e4567-e89b-12d3-a456-426655440000@.
--
-- 'shipmentState', 'updateJobShipmentState_shipmentState' - The state of a device when it is being shipped.
--
-- Set to @RECEIVED@ when the device arrives at your location.
--
-- Set to @RETURNED@ when you have returned the device to Amazon Web
-- Services.
newUpdateJobShipmentState ::
  -- | 'jobId'
  Prelude.Text ->
  -- | 'shipmentState'
  ShipmentState ->
  UpdateJobShipmentState
newUpdateJobShipmentState :: Text -> ShipmentState -> UpdateJobShipmentState
newUpdateJobShipmentState Text
pJobId_ ShipmentState
pShipmentState_ =
  UpdateJobShipmentState'
    { $sel:jobId:UpdateJobShipmentState' :: Text
jobId = Text
pJobId_,
      $sel:shipmentState:UpdateJobShipmentState' :: ShipmentState
shipmentState = ShipmentState
pShipmentState_
    }

-- | The job ID of the job whose shipment date you want to update, for
-- example @JID123e4567-e89b-12d3-a456-426655440000@.
updateJobShipmentState_jobId :: Lens.Lens' UpdateJobShipmentState Prelude.Text
updateJobShipmentState_jobId :: Lens' UpdateJobShipmentState Text
updateJobShipmentState_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJobShipmentState' {Text
jobId :: Text
$sel:jobId:UpdateJobShipmentState' :: UpdateJobShipmentState -> Text
jobId} -> Text
jobId) (\s :: UpdateJobShipmentState
s@UpdateJobShipmentState' {} Text
a -> UpdateJobShipmentState
s {$sel:jobId:UpdateJobShipmentState' :: Text
jobId = Text
a} :: UpdateJobShipmentState)

-- | The state of a device when it is being shipped.
--
-- Set to @RECEIVED@ when the device arrives at your location.
--
-- Set to @RETURNED@ when you have returned the device to Amazon Web
-- Services.
updateJobShipmentState_shipmentState :: Lens.Lens' UpdateJobShipmentState ShipmentState
updateJobShipmentState_shipmentState :: Lens' UpdateJobShipmentState ShipmentState
updateJobShipmentState_shipmentState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateJobShipmentState' {ShipmentState
shipmentState :: ShipmentState
$sel:shipmentState:UpdateJobShipmentState' :: UpdateJobShipmentState -> ShipmentState
shipmentState} -> ShipmentState
shipmentState) (\s :: UpdateJobShipmentState
s@UpdateJobShipmentState' {} ShipmentState
a -> UpdateJobShipmentState
s {$sel:shipmentState:UpdateJobShipmentState' :: ShipmentState
shipmentState = ShipmentState
a} :: UpdateJobShipmentState)

instance Core.AWSRequest UpdateJobShipmentState where
  type
    AWSResponse UpdateJobShipmentState =
      UpdateJobShipmentStateResponse
  request :: (Service -> Service)
-> UpdateJobShipmentState -> Request UpdateJobShipmentState
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 UpdateJobShipmentState
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateJobShipmentState)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateJobShipmentStateResponse
UpdateJobShipmentStateResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateJobShipmentState where
  hashWithSalt :: Int -> UpdateJobShipmentState -> Int
hashWithSalt Int
_salt UpdateJobShipmentState' {Text
ShipmentState
shipmentState :: ShipmentState
jobId :: Text
$sel:shipmentState:UpdateJobShipmentState' :: UpdateJobShipmentState -> ShipmentState
$sel:jobId:UpdateJobShipmentState' :: UpdateJobShipmentState -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ShipmentState
shipmentState

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

instance Data.ToHeaders UpdateJobShipmentState where
  toHeaders :: UpdateJobShipmentState -> 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.UpdateJobShipmentState" ::
                          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 UpdateJobShipmentState where
  toJSON :: UpdateJobShipmentState -> Value
toJSON UpdateJobShipmentState' {Text
ShipmentState
shipmentState :: ShipmentState
jobId :: Text
$sel:shipmentState:UpdateJobShipmentState' :: UpdateJobShipmentState -> ShipmentState
$sel:jobId:UpdateJobShipmentState' :: UpdateJobShipmentState -> 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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ShipmentState" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ShipmentState
shipmentState)
          ]
      )

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

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

-- | /See:/ 'newUpdateJobShipmentStateResponse' smart constructor.
data UpdateJobShipmentStateResponse = UpdateJobShipmentStateResponse'
  { -- | The response's http status code.
    UpdateJobShipmentStateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateJobShipmentStateResponse
-> UpdateJobShipmentStateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateJobShipmentStateResponse
-> UpdateJobShipmentStateResponse -> Bool
$c/= :: UpdateJobShipmentStateResponse
-> UpdateJobShipmentStateResponse -> Bool
== :: UpdateJobShipmentStateResponse
-> UpdateJobShipmentStateResponse -> Bool
$c== :: UpdateJobShipmentStateResponse
-> UpdateJobShipmentStateResponse -> Bool
Prelude.Eq, ReadPrec [UpdateJobShipmentStateResponse]
ReadPrec UpdateJobShipmentStateResponse
Int -> ReadS UpdateJobShipmentStateResponse
ReadS [UpdateJobShipmentStateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateJobShipmentStateResponse]
$creadListPrec :: ReadPrec [UpdateJobShipmentStateResponse]
readPrec :: ReadPrec UpdateJobShipmentStateResponse
$creadPrec :: ReadPrec UpdateJobShipmentStateResponse
readList :: ReadS [UpdateJobShipmentStateResponse]
$creadList :: ReadS [UpdateJobShipmentStateResponse]
readsPrec :: Int -> ReadS UpdateJobShipmentStateResponse
$creadsPrec :: Int -> ReadS UpdateJobShipmentStateResponse
Prelude.Read, Int -> UpdateJobShipmentStateResponse -> ShowS
[UpdateJobShipmentStateResponse] -> ShowS
UpdateJobShipmentStateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateJobShipmentStateResponse] -> ShowS
$cshowList :: [UpdateJobShipmentStateResponse] -> ShowS
show :: UpdateJobShipmentStateResponse -> String
$cshow :: UpdateJobShipmentStateResponse -> String
showsPrec :: Int -> UpdateJobShipmentStateResponse -> ShowS
$cshowsPrec :: Int -> UpdateJobShipmentStateResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateJobShipmentStateResponse x
-> UpdateJobShipmentStateResponse
forall x.
UpdateJobShipmentStateResponse
-> Rep UpdateJobShipmentStateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateJobShipmentStateResponse x
-> UpdateJobShipmentStateResponse
$cfrom :: forall x.
UpdateJobShipmentStateResponse
-> Rep UpdateJobShipmentStateResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateJobShipmentStateResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'updateJobShipmentStateResponse_httpStatus' - The response's http status code.
newUpdateJobShipmentStateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateJobShipmentStateResponse
newUpdateJobShipmentStateResponse :: Int -> UpdateJobShipmentStateResponse
newUpdateJobShipmentStateResponse Int
pHttpStatus_ =
  UpdateJobShipmentStateResponse'
    { $sel:httpStatus:UpdateJobShipmentStateResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance
  Prelude.NFData
    UpdateJobShipmentStateResponse
  where
  rnf :: UpdateJobShipmentStateResponse -> ()
rnf UpdateJobShipmentStateResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateJobShipmentStateResponse' :: UpdateJobShipmentStateResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus