{-# 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.Support.ResolveCase
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Resolves a support case. This operation takes a @caseId@ and returns the
-- initial and final state of the case.
--
-- -   You must have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan to use the Amazon Web Services Support API.
--
-- -   If you call the Amazon Web Services Support API from an account that
--     doesn\'t have a Business, Enterprise On-Ramp, or Enterprise Support
--     plan, the @SubscriptionRequiredException@ error message appears. For
--     information about changing your support plan, see
--     <http://aws.amazon.com/premiumsupport/ Amazon Web Services Support>.
module Amazonka.Support.ResolveCase
  ( -- * Creating a Request
    ResolveCase (..),
    newResolveCase,

    -- * Request Lenses
    resolveCase_caseId,

    -- * Destructuring the Response
    ResolveCaseResponse (..),
    newResolveCaseResponse,

    -- * Response Lenses
    resolveCaseResponse_finalCaseStatus,
    resolveCaseResponse_initialCaseStatus,
    resolveCaseResponse_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.Support.Types

-- | /See:/ 'newResolveCase' smart constructor.
data ResolveCase = ResolveCase'
  { -- | The support case ID requested or returned in the call. The case ID is an
    -- alphanumeric string formatted as shown in this example:
    -- case-/12345678910-2013-c4c1d2bf33c5cf47/
    ResolveCase -> Maybe Text
caseId :: Prelude.Maybe Prelude.Text
  }
  deriving (ResolveCase -> ResolveCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolveCase -> ResolveCase -> Bool
$c/= :: ResolveCase -> ResolveCase -> Bool
== :: ResolveCase -> ResolveCase -> Bool
$c== :: ResolveCase -> ResolveCase -> Bool
Prelude.Eq, ReadPrec [ResolveCase]
ReadPrec ResolveCase
Int -> ReadS ResolveCase
ReadS [ResolveCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResolveCase]
$creadListPrec :: ReadPrec [ResolveCase]
readPrec :: ReadPrec ResolveCase
$creadPrec :: ReadPrec ResolveCase
readList :: ReadS [ResolveCase]
$creadList :: ReadS [ResolveCase]
readsPrec :: Int -> ReadS ResolveCase
$creadsPrec :: Int -> ReadS ResolveCase
Prelude.Read, Int -> ResolveCase -> ShowS
[ResolveCase] -> ShowS
ResolveCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolveCase] -> ShowS
$cshowList :: [ResolveCase] -> ShowS
show :: ResolveCase -> String
$cshow :: ResolveCase -> String
showsPrec :: Int -> ResolveCase -> ShowS
$cshowsPrec :: Int -> ResolveCase -> ShowS
Prelude.Show, forall x. Rep ResolveCase x -> ResolveCase
forall x. ResolveCase -> Rep ResolveCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolveCase x -> ResolveCase
$cfrom :: forall x. ResolveCase -> Rep ResolveCase x
Prelude.Generic)

-- |
-- Create a value of 'ResolveCase' 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:
--
-- 'caseId', 'resolveCase_caseId' - The support case ID requested or returned in the call. The case ID is an
-- alphanumeric string formatted as shown in this example:
-- case-/12345678910-2013-c4c1d2bf33c5cf47/
newResolveCase ::
  ResolveCase
newResolveCase :: ResolveCase
newResolveCase =
  ResolveCase' {$sel:caseId:ResolveCase' :: Maybe Text
caseId = forall a. Maybe a
Prelude.Nothing}

-- | The support case ID requested or returned in the call. The case ID is an
-- alphanumeric string formatted as shown in this example:
-- case-/12345678910-2013-c4c1d2bf33c5cf47/
resolveCase_caseId :: Lens.Lens' ResolveCase (Prelude.Maybe Prelude.Text)
resolveCase_caseId :: Lens' ResolveCase (Maybe Text)
resolveCase_caseId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResolveCase' {Maybe Text
caseId :: Maybe Text
$sel:caseId:ResolveCase' :: ResolveCase -> Maybe Text
caseId} -> Maybe Text
caseId) (\s :: ResolveCase
s@ResolveCase' {} Maybe Text
a -> ResolveCase
s {$sel:caseId:ResolveCase' :: Maybe Text
caseId = Maybe Text
a} :: ResolveCase)

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

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

instance Data.ToHeaders ResolveCase where
  toHeaders :: ResolveCase -> 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
"AWSSupport_20130415.ResolveCase" ::
                          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 ResolveCase where
  toJSON :: ResolveCase -> Value
toJSON ResolveCase' {Maybe Text
caseId :: Maybe Text
$sel:caseId:ResolveCase' :: ResolveCase -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"caseId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
caseId]
      )

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

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

-- | The status of the case returned by the ResolveCase operation.
--
-- /See:/ 'newResolveCaseResponse' smart constructor.
data ResolveCaseResponse = ResolveCaseResponse'
  { -- | The status of the case after the ResolveCase request was processed.
    ResolveCaseResponse -> Maybe Text
finalCaseStatus :: Prelude.Maybe Prelude.Text,
    -- | The status of the case when the ResolveCase request was sent.
    ResolveCaseResponse -> Maybe Text
initialCaseStatus :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ResolveCaseResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ResolveCaseResponse -> ResolveCaseResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolveCaseResponse -> ResolveCaseResponse -> Bool
$c/= :: ResolveCaseResponse -> ResolveCaseResponse -> Bool
== :: ResolveCaseResponse -> ResolveCaseResponse -> Bool
$c== :: ResolveCaseResponse -> ResolveCaseResponse -> Bool
Prelude.Eq, ReadPrec [ResolveCaseResponse]
ReadPrec ResolveCaseResponse
Int -> ReadS ResolveCaseResponse
ReadS [ResolveCaseResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResolveCaseResponse]
$creadListPrec :: ReadPrec [ResolveCaseResponse]
readPrec :: ReadPrec ResolveCaseResponse
$creadPrec :: ReadPrec ResolveCaseResponse
readList :: ReadS [ResolveCaseResponse]
$creadList :: ReadS [ResolveCaseResponse]
readsPrec :: Int -> ReadS ResolveCaseResponse
$creadsPrec :: Int -> ReadS ResolveCaseResponse
Prelude.Read, Int -> ResolveCaseResponse -> ShowS
[ResolveCaseResponse] -> ShowS
ResolveCaseResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolveCaseResponse] -> ShowS
$cshowList :: [ResolveCaseResponse] -> ShowS
show :: ResolveCaseResponse -> String
$cshow :: ResolveCaseResponse -> String
showsPrec :: Int -> ResolveCaseResponse -> ShowS
$cshowsPrec :: Int -> ResolveCaseResponse -> ShowS
Prelude.Show, forall x. Rep ResolveCaseResponse x -> ResolveCaseResponse
forall x. ResolveCaseResponse -> Rep ResolveCaseResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResolveCaseResponse x -> ResolveCaseResponse
$cfrom :: forall x. ResolveCaseResponse -> Rep ResolveCaseResponse x
Prelude.Generic)

-- |
-- Create a value of 'ResolveCaseResponse' 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:
--
-- 'finalCaseStatus', 'resolveCaseResponse_finalCaseStatus' - The status of the case after the ResolveCase request was processed.
--
-- 'initialCaseStatus', 'resolveCaseResponse_initialCaseStatus' - The status of the case when the ResolveCase request was sent.
--
-- 'httpStatus', 'resolveCaseResponse_httpStatus' - The response's http status code.
newResolveCaseResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResolveCaseResponse
newResolveCaseResponse :: Int -> ResolveCaseResponse
newResolveCaseResponse Int
pHttpStatus_ =
  ResolveCaseResponse'
    { $sel:finalCaseStatus:ResolveCaseResponse' :: Maybe Text
finalCaseStatus =
        forall a. Maybe a
Prelude.Nothing,
      $sel:initialCaseStatus:ResolveCaseResponse' :: Maybe Text
initialCaseStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResolveCaseResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the case after the ResolveCase request was processed.
resolveCaseResponse_finalCaseStatus :: Lens.Lens' ResolveCaseResponse (Prelude.Maybe Prelude.Text)
resolveCaseResponse_finalCaseStatus :: Lens' ResolveCaseResponse (Maybe Text)
resolveCaseResponse_finalCaseStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResolveCaseResponse' {Maybe Text
finalCaseStatus :: Maybe Text
$sel:finalCaseStatus:ResolveCaseResponse' :: ResolveCaseResponse -> Maybe Text
finalCaseStatus} -> Maybe Text
finalCaseStatus) (\s :: ResolveCaseResponse
s@ResolveCaseResponse' {} Maybe Text
a -> ResolveCaseResponse
s {$sel:finalCaseStatus:ResolveCaseResponse' :: Maybe Text
finalCaseStatus = Maybe Text
a} :: ResolveCaseResponse)

-- | The status of the case when the ResolveCase request was sent.
resolveCaseResponse_initialCaseStatus :: Lens.Lens' ResolveCaseResponse (Prelude.Maybe Prelude.Text)
resolveCaseResponse_initialCaseStatus :: Lens' ResolveCaseResponse (Maybe Text)
resolveCaseResponse_initialCaseStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResolveCaseResponse' {Maybe Text
initialCaseStatus :: Maybe Text
$sel:initialCaseStatus:ResolveCaseResponse' :: ResolveCaseResponse -> Maybe Text
initialCaseStatus} -> Maybe Text
initialCaseStatus) (\s :: ResolveCaseResponse
s@ResolveCaseResponse' {} Maybe Text
a -> ResolveCaseResponse
s {$sel:initialCaseStatus:ResolveCaseResponse' :: Maybe Text
initialCaseStatus = Maybe Text
a} :: ResolveCaseResponse)

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

instance Prelude.NFData ResolveCaseResponse where
  rnf :: ResolveCaseResponse -> ()
rnf ResolveCaseResponse' {Int
Maybe Text
httpStatus :: Int
initialCaseStatus :: Maybe Text
finalCaseStatus :: Maybe Text
$sel:httpStatus:ResolveCaseResponse' :: ResolveCaseResponse -> Int
$sel:initialCaseStatus:ResolveCaseResponse' :: ResolveCaseResponse -> Maybe Text
$sel:finalCaseStatus:ResolveCaseResponse' :: ResolveCaseResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
finalCaseStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
initialCaseStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus