{-# 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.Outposts.CancelOrder
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels the specified order for an Outpost.
module Amazonka.Outposts.CancelOrder
  ( -- * Creating a Request
    CancelOrder (..),
    newCancelOrder,

    -- * Request Lenses
    cancelOrder_orderId,

    -- * Destructuring the Response
    CancelOrderResponse (..),
    newCancelOrderResponse,

    -- * Response Lenses
    cancelOrderResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCancelOrder' smart constructor.
data CancelOrder = CancelOrder'
  { -- | The ID of the order.
    CancelOrder -> Text
orderId :: Prelude.Text
  }
  deriving (CancelOrder -> CancelOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelOrder -> CancelOrder -> Bool
$c/= :: CancelOrder -> CancelOrder -> Bool
== :: CancelOrder -> CancelOrder -> Bool
$c== :: CancelOrder -> CancelOrder -> Bool
Prelude.Eq, ReadPrec [CancelOrder]
ReadPrec CancelOrder
Int -> ReadS CancelOrder
ReadS [CancelOrder]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelOrder]
$creadListPrec :: ReadPrec [CancelOrder]
readPrec :: ReadPrec CancelOrder
$creadPrec :: ReadPrec CancelOrder
readList :: ReadS [CancelOrder]
$creadList :: ReadS [CancelOrder]
readsPrec :: Int -> ReadS CancelOrder
$creadsPrec :: Int -> ReadS CancelOrder
Prelude.Read, Int -> CancelOrder -> ShowS
[CancelOrder] -> ShowS
CancelOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelOrder] -> ShowS
$cshowList :: [CancelOrder] -> ShowS
show :: CancelOrder -> String
$cshow :: CancelOrder -> String
showsPrec :: Int -> CancelOrder -> ShowS
$cshowsPrec :: Int -> CancelOrder -> ShowS
Prelude.Show, forall x. Rep CancelOrder x -> CancelOrder
forall x. CancelOrder -> Rep CancelOrder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelOrder x -> CancelOrder
$cfrom :: forall x. CancelOrder -> Rep CancelOrder x
Prelude.Generic)

-- |
-- Create a value of 'CancelOrder' 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:
--
-- 'orderId', 'cancelOrder_orderId' - The ID of the order.
newCancelOrder ::
  -- | 'orderId'
  Prelude.Text ->
  CancelOrder
newCancelOrder :: Text -> CancelOrder
newCancelOrder Text
pOrderId_ =
  CancelOrder' {$sel:orderId:CancelOrder' :: Text
orderId = Text
pOrderId_}

-- | The ID of the order.
cancelOrder_orderId :: Lens.Lens' CancelOrder Prelude.Text
cancelOrder_orderId :: Lens' CancelOrder Text
cancelOrder_orderId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelOrder' {Text
orderId :: Text
$sel:orderId:CancelOrder' :: CancelOrder -> Text
orderId} -> Text
orderId) (\s :: CancelOrder
s@CancelOrder' {} Text
a -> CancelOrder
s {$sel:orderId:CancelOrder' :: Text
orderId = Text
a} :: CancelOrder)

instance Core.AWSRequest CancelOrder where
  type AWSResponse CancelOrder = CancelOrderResponse
  request :: (Service -> Service) -> CancelOrder -> Request CancelOrder
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 CancelOrder
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CancelOrder)))
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 -> CancelOrderResponse
CancelOrderResponse'
            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 CancelOrder where
  hashWithSalt :: Int -> CancelOrder -> Int
hashWithSalt Int
_salt CancelOrder' {Text
orderId :: Text
$sel:orderId:CancelOrder' :: CancelOrder -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
orderId

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

instance Data.ToHeaders CancelOrder where
  toHeaders :: CancelOrder -> 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.ToJSON CancelOrder where
  toJSON :: CancelOrder -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CancelOrder where
  toPath :: CancelOrder -> ByteString
toPath CancelOrder' {Text
orderId :: Text
$sel:orderId:CancelOrder' :: CancelOrder -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/orders/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
orderId, ByteString
"/cancel"]

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

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

-- |
-- Create a value of 'CancelOrderResponse' 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', 'cancelOrderResponse_httpStatus' - The response's http status code.
newCancelOrderResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CancelOrderResponse
newCancelOrderResponse :: Int -> CancelOrderResponse
newCancelOrderResponse Int
pHttpStatus_ =
  CancelOrderResponse' {$sel:httpStatus:CancelOrderResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

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