{-# 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.MediaLive.CancelInputDeviceTransfer
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancel an input device transfer that you have requested.
module Amazonka.MediaLive.CancelInputDeviceTransfer
  ( -- * Creating a Request
    CancelInputDeviceTransfer (..),
    newCancelInputDeviceTransfer,

    -- * Request Lenses
    cancelInputDeviceTransfer_inputDeviceId,

    -- * Destructuring the Response
    CancelInputDeviceTransferResponse (..),
    newCancelInputDeviceTransferResponse,

    -- * Response Lenses
    cancelInputDeviceTransferResponse_httpStatus,
  )
where

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

-- | Placeholder documentation for CancelInputDeviceTransferRequest
--
-- /See:/ 'newCancelInputDeviceTransfer' smart constructor.
data CancelInputDeviceTransfer = CancelInputDeviceTransfer'
  { -- | The unique ID of the input device to cancel. For example,
    -- hd-123456789abcdef.
    CancelInputDeviceTransfer -> Text
inputDeviceId :: Prelude.Text
  }
  deriving (CancelInputDeviceTransfer -> CancelInputDeviceTransfer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelInputDeviceTransfer -> CancelInputDeviceTransfer -> Bool
$c/= :: CancelInputDeviceTransfer -> CancelInputDeviceTransfer -> Bool
== :: CancelInputDeviceTransfer -> CancelInputDeviceTransfer -> Bool
$c== :: CancelInputDeviceTransfer -> CancelInputDeviceTransfer -> Bool
Prelude.Eq, ReadPrec [CancelInputDeviceTransfer]
ReadPrec CancelInputDeviceTransfer
Int -> ReadS CancelInputDeviceTransfer
ReadS [CancelInputDeviceTransfer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelInputDeviceTransfer]
$creadListPrec :: ReadPrec [CancelInputDeviceTransfer]
readPrec :: ReadPrec CancelInputDeviceTransfer
$creadPrec :: ReadPrec CancelInputDeviceTransfer
readList :: ReadS [CancelInputDeviceTransfer]
$creadList :: ReadS [CancelInputDeviceTransfer]
readsPrec :: Int -> ReadS CancelInputDeviceTransfer
$creadsPrec :: Int -> ReadS CancelInputDeviceTransfer
Prelude.Read, Int -> CancelInputDeviceTransfer -> ShowS
[CancelInputDeviceTransfer] -> ShowS
CancelInputDeviceTransfer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelInputDeviceTransfer] -> ShowS
$cshowList :: [CancelInputDeviceTransfer] -> ShowS
show :: CancelInputDeviceTransfer -> String
$cshow :: CancelInputDeviceTransfer -> String
showsPrec :: Int -> CancelInputDeviceTransfer -> ShowS
$cshowsPrec :: Int -> CancelInputDeviceTransfer -> ShowS
Prelude.Show, forall x.
Rep CancelInputDeviceTransfer x -> CancelInputDeviceTransfer
forall x.
CancelInputDeviceTransfer -> Rep CancelInputDeviceTransfer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelInputDeviceTransfer x -> CancelInputDeviceTransfer
$cfrom :: forall x.
CancelInputDeviceTransfer -> Rep CancelInputDeviceTransfer x
Prelude.Generic)

-- |
-- Create a value of 'CancelInputDeviceTransfer' 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:
--
-- 'inputDeviceId', 'cancelInputDeviceTransfer_inputDeviceId' - The unique ID of the input device to cancel. For example,
-- hd-123456789abcdef.
newCancelInputDeviceTransfer ::
  -- | 'inputDeviceId'
  Prelude.Text ->
  CancelInputDeviceTransfer
newCancelInputDeviceTransfer :: Text -> CancelInputDeviceTransfer
newCancelInputDeviceTransfer Text
pInputDeviceId_ =
  CancelInputDeviceTransfer'
    { $sel:inputDeviceId:CancelInputDeviceTransfer' :: Text
inputDeviceId =
        Text
pInputDeviceId_
    }

-- | The unique ID of the input device to cancel. For example,
-- hd-123456789abcdef.
cancelInputDeviceTransfer_inputDeviceId :: Lens.Lens' CancelInputDeviceTransfer Prelude.Text
cancelInputDeviceTransfer_inputDeviceId :: Lens' CancelInputDeviceTransfer Text
cancelInputDeviceTransfer_inputDeviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelInputDeviceTransfer' {Text
inputDeviceId :: Text
$sel:inputDeviceId:CancelInputDeviceTransfer' :: CancelInputDeviceTransfer -> Text
inputDeviceId} -> Text
inputDeviceId) (\s :: CancelInputDeviceTransfer
s@CancelInputDeviceTransfer' {} Text
a -> CancelInputDeviceTransfer
s {$sel:inputDeviceId:CancelInputDeviceTransfer' :: Text
inputDeviceId = Text
a} :: CancelInputDeviceTransfer)

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

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

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

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

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

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

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

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

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