{-# 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.WorkMail.CancelMailboxExportJob
-- 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 a mailbox export job.
--
-- If the mailbox export job is near completion, it might not be possible
-- to cancel it.
module Amazonka.WorkMail.CancelMailboxExportJob
  ( -- * Creating a Request
    CancelMailboxExportJob (..),
    newCancelMailboxExportJob,

    -- * Request Lenses
    cancelMailboxExportJob_clientToken,
    cancelMailboxExportJob_jobId,
    cancelMailboxExportJob_organizationId,

    -- * Destructuring the Response
    CancelMailboxExportJobResponse (..),
    newCancelMailboxExportJobResponse,

    -- * Response Lenses
    cancelMailboxExportJobResponse_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.WorkMail.Types

-- | /See:/ 'newCancelMailboxExportJob' smart constructor.
data CancelMailboxExportJob = CancelMailboxExportJob'
  { -- | The idempotency token for the client request.
    CancelMailboxExportJob -> Text
clientToken :: Prelude.Text,
    -- | The job ID.
    CancelMailboxExportJob -> Text
jobId :: Prelude.Text,
    -- | The organization ID.
    CancelMailboxExportJob -> Text
organizationId :: Prelude.Text
  }
  deriving (CancelMailboxExportJob -> CancelMailboxExportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelMailboxExportJob -> CancelMailboxExportJob -> Bool
$c/= :: CancelMailboxExportJob -> CancelMailboxExportJob -> Bool
== :: CancelMailboxExportJob -> CancelMailboxExportJob -> Bool
$c== :: CancelMailboxExportJob -> CancelMailboxExportJob -> Bool
Prelude.Eq, ReadPrec [CancelMailboxExportJob]
ReadPrec CancelMailboxExportJob
Int -> ReadS CancelMailboxExportJob
ReadS [CancelMailboxExportJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelMailboxExportJob]
$creadListPrec :: ReadPrec [CancelMailboxExportJob]
readPrec :: ReadPrec CancelMailboxExportJob
$creadPrec :: ReadPrec CancelMailboxExportJob
readList :: ReadS [CancelMailboxExportJob]
$creadList :: ReadS [CancelMailboxExportJob]
readsPrec :: Int -> ReadS CancelMailboxExportJob
$creadsPrec :: Int -> ReadS CancelMailboxExportJob
Prelude.Read, Int -> CancelMailboxExportJob -> ShowS
[CancelMailboxExportJob] -> ShowS
CancelMailboxExportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelMailboxExportJob] -> ShowS
$cshowList :: [CancelMailboxExportJob] -> ShowS
show :: CancelMailboxExportJob -> String
$cshow :: CancelMailboxExportJob -> String
showsPrec :: Int -> CancelMailboxExportJob -> ShowS
$cshowsPrec :: Int -> CancelMailboxExportJob -> ShowS
Prelude.Show, forall x. Rep CancelMailboxExportJob x -> CancelMailboxExportJob
forall x. CancelMailboxExportJob -> Rep CancelMailboxExportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CancelMailboxExportJob x -> CancelMailboxExportJob
$cfrom :: forall x. CancelMailboxExportJob -> Rep CancelMailboxExportJob x
Prelude.Generic)

-- |
-- Create a value of 'CancelMailboxExportJob' 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:
--
-- 'clientToken', 'cancelMailboxExportJob_clientToken' - The idempotency token for the client request.
--
-- 'jobId', 'cancelMailboxExportJob_jobId' - The job ID.
--
-- 'organizationId', 'cancelMailboxExportJob_organizationId' - The organization ID.
newCancelMailboxExportJob ::
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'jobId'
  Prelude.Text ->
  -- | 'organizationId'
  Prelude.Text ->
  CancelMailboxExportJob
newCancelMailboxExportJob :: Text -> Text -> Text -> CancelMailboxExportJob
newCancelMailboxExportJob
  Text
pClientToken_
  Text
pJobId_
  Text
pOrganizationId_ =
    CancelMailboxExportJob'
      { $sel:clientToken:CancelMailboxExportJob' :: Text
clientToken =
          Text
pClientToken_,
        $sel:jobId:CancelMailboxExportJob' :: Text
jobId = Text
pJobId_,
        $sel:organizationId:CancelMailboxExportJob' :: Text
organizationId = Text
pOrganizationId_
      }

-- | The idempotency token for the client request.
cancelMailboxExportJob_clientToken :: Lens.Lens' CancelMailboxExportJob Prelude.Text
cancelMailboxExportJob_clientToken :: Lens' CancelMailboxExportJob Text
cancelMailboxExportJob_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMailboxExportJob' {Text
clientToken :: Text
$sel:clientToken:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
clientToken} -> Text
clientToken) (\s :: CancelMailboxExportJob
s@CancelMailboxExportJob' {} Text
a -> CancelMailboxExportJob
s {$sel:clientToken:CancelMailboxExportJob' :: Text
clientToken = Text
a} :: CancelMailboxExportJob)

-- | The job ID.
cancelMailboxExportJob_jobId :: Lens.Lens' CancelMailboxExportJob Prelude.Text
cancelMailboxExportJob_jobId :: Lens' CancelMailboxExportJob Text
cancelMailboxExportJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMailboxExportJob' {Text
jobId :: Text
$sel:jobId:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
jobId} -> Text
jobId) (\s :: CancelMailboxExportJob
s@CancelMailboxExportJob' {} Text
a -> CancelMailboxExportJob
s {$sel:jobId:CancelMailboxExportJob' :: Text
jobId = Text
a} :: CancelMailboxExportJob)

-- | The organization ID.
cancelMailboxExportJob_organizationId :: Lens.Lens' CancelMailboxExportJob Prelude.Text
cancelMailboxExportJob_organizationId :: Lens' CancelMailboxExportJob Text
cancelMailboxExportJob_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CancelMailboxExportJob' {Text
organizationId :: Text
$sel:organizationId:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
organizationId} -> Text
organizationId) (\s :: CancelMailboxExportJob
s@CancelMailboxExportJob' {} Text
a -> CancelMailboxExportJob
s {$sel:organizationId:CancelMailboxExportJob' :: Text
organizationId = Text
a} :: CancelMailboxExportJob)

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

instance Prelude.NFData CancelMailboxExportJob where
  rnf :: CancelMailboxExportJob -> ()
rnf CancelMailboxExportJob' {Text
organizationId :: Text
jobId :: Text
clientToken :: Text
$sel:organizationId:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
$sel:jobId:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
$sel:clientToken:CancelMailboxExportJob' :: CancelMailboxExportJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
organizationId

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

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

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

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

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

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

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